Center API Dialog in screen
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.
Code:
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
