Center API Dialog in screen

[gmaxey]

The following displays a color picker dialog in the top left of the application screen. Out of my league here. Can anyone advise how to revise the code so that dialog appears in the center of the application screen.

Option Explicit
Private Type CHOOSECOLOR
     lStructSize As Long
     hwndOwner As Long
     hInstance As Long
     rgbResult As Long
     lpCustColors As String
     Flags As Long
     lCustData As Long
     lpfnHook As Long
     lpTemplateName As String
End Type
Dim CustomColors() As Byte
Private Declare Function ChooseColorAPI Lib "comdlg32.dll" Alias _
    "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
Private Declare Function FindWindow Lib "user32" _
    Alias "FindWindowA" (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

Private Sub CallDialog()
ReDim CustomColors(0 To 16 * 4 - 1) As Byte
  Dim i As Integer
  For i = LBound(CustomColors) To UBound(CustomColors)
    CustomColors(i) = 0
  Next i
  ShowPicker
End Sub
Private Function GetWinwordHwnd() As Long
    Dim hWnd As Long
    hWnd = FindWindow("opusApp", vbNullString)
    GetWinwordHwnd = hWnd
End Function

Private Sub ShowPicker()
    Dim cc As CHOOSECOLOR
    Dim lReturn As Long, Rval As Long
    Dim Gval As Long, Bval As Long
    Dim i As Integer
    cc.lStructSize = Len(cc)
    cc.hwndOwner = GetWinwordHwnd()
    cc.hInstance = 0
    cc.lpCustColors = StrConv(CustomColors, vbUnicode)
    cc.Flags = 0
    ' call the color picker
    lReturn = ChooseColorAPI(cc)
    If lReturn <> 0 Then
        ' extract the color values
        Rval = cc.rgbResult Mod 256
        Bval = Int(cc.rgbResult / 65536)
        Gval = Int((cc.rgbResult - (Bval * 65536) - Rval) / 256)
        MsgBox "RGB Value User Chose: R=" & Str$(Rval) & _
             "  G=" & Str$(Gval) & "  B=" & Str$(Bval)
        ' save the color values to send to the
        ' color picker for the next iteration
        CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
        ReDim CustomColors(0 To 16 * 4 - 1) As Byte
        For i = LBound(CustomColors) To UBound(CustomColors)
           CustomColors(i) = 0
        Next i
    Else
        MsgBox "User chose the Cancel Button"
    End If
End Sub

[Paul_Hossler]

http://vbnet.mvps.org/index.html?cod...rcustomize.htm


Looks like you need to use MoveWindow on the ColorPicker


But most of that is over my head

[Paul_Hossler]

This isn't perfect, but could be a start

Capture.JPG

The referenced link using TwipsPerPixel and I forget how to do that

[gmaxey]

Paul,

thanks. I get it close on my screen using:

Call MoveWindow(hwnd, (ActiveWindow.Width - dlgWidth) / 1.3, _
(ActiveWindow.Height - dlgHeight), _
dlgWidth, _
dlgHeight, 1)

Seems finding a way to simply center it in the screen (regardless of what that screen size is) is beyond me at this point.

Thanks everyone for you input.

[Paul_Hossler]

I found some of my Excel VBA that reads the Device Context to get information using APIs

It handles screen resolution and dpi to calculate the 'adjustment factor'

I have to clean it up and try it in Word, but I'll update if it's more centered

[Paul_Hossler]

Look at this version -- I added a Device Context module that I had in Excel, and tweaked it for Word

Seems to center it pretty well


Capture.JPG

[gmaxey]

Paul,

Yes it does. Thank you!