Get selected value from Script Combo box of Common Dialog control in VB6 - vb6

Question

I am using Common Dialog Control of VB6 to select Font by calling ShowFont method. Here I can select desired font, font size, bold, italic, strike thru etc. I also select Arabic from script combo box. The problem is not able to get the value which I selected from the Script combo box. Any one please help.
Code:
With CommonDialog1.ShowFont
FontObject.Name = .FontName
FontObject.Bold = .FontBold
FontObject.Italic = .FontItalic
FontObject.Size = .FontSize
FontObject.Strikethrough = .FontStrikethru
FontObject.Underline = .FontUnderline
End With

Answer 1

You have two options:
Subclass the Common Dialog Window -
Here is an example from VBForum
Use the Windows API to call the ChooseFont Common Dialog by your self
Here is a snippet using the second approach:
Option Explicit
Private FontObject As New StdFont
Const FW_REGULAR As Integer = 400
Const FW_BOLD As Integer = 700
Const CF_BOTH = &H3
Const CF_EFFECTS = &H100
Const CF_INITTOLOGFONTSTRUCT = &H40
Const LF_FACESIZE = 32
Const LOGPIXELSY As Long = 90
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(LF_FACESIZE) As Byte
End Type
Private Type CHOOSEFONT
lStructSize As Long
hwndOwner As Long
hDC As Long
lpLogFont As Long
iPointSize As Long
flags As Long
rgbColors As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
hInstance As Long
lpszStyle As String
nFontType As Integer
MISSING_ALIGNMENT As Integer
nSizeMin As Long
nSizeMax As Long
End Type
Private Declare Function GetDesktopWindow Lib "USER32" () As Long
Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function ChooseFontA Lib "comdlg32.dll" (pChoosefont As CHOOSEFONT) As Long
Private Sub String2ByteArr(ByVal str As String, ByRef arr)
Dim b() As Byte, i As Long, l As Long
b = StrConv(str & Chr(0), vbFromUnicode)
l = UBound(b)
For i = 0 To l
arr(i) = b(i)
Next
End Sub
Private Function ByteArr2String(ByRef arr) As String
Dim b() As Byte
b = StrConv(arr, vbUnicode)
bytearray2string = Left$(b, InStr(b, Chr$(0)) - 1)
End Function
Private Sub FontDialog()
Dim cf As CHOOSEFONT, lf As LOGFONT, hWnd As Long, hDC As Long, ppi As Long
hWnd = GetDesktopWindow
hDC = GetDC(hWnd)
ppi = GetDeviceCaps(hDC, LOGPIXELSY)
With lf
String2ByteArr FontObject.Name, lf.lfFaceName
.lfHeight = -(FontObject.Size * ppi) / 72
.lfWeight = IIf(FontObject.Bold, FW_BOLD, FW_REGULAR)
.lfItalic = FontObject.Italic
.lfUnderline = FontObject.Underline
.lfStrikeOut = FontObject.Strikethrough
.lfCharSet = FontObject.Charset
End With
With cf
.lStructSize = Len(cf)
.hDC = hDC
.flags = CF_BOTH Or CF_EFFECTS Or CF_INITTOLOGFONTSTRUCT
.hwndOwner = Me.hWnd
.lpLogFont = VarPtr(lf)
.lpTemplateName = vbNullString
End With
If ChooseFontA(cf) Then
With FontObject
.Name = ByteArr2String(lf.lfFaceName)
.Size = (-72 * lf.lfHeight) / ppi
.Bold = lf.lfWeight >= FW_BOLD
.Italic = lf.lfItalic
.Underline = lf.lfUnderline
.Strikethrough = lf.lfStrikeOut
.Charset = lf.lfCharSet
End With
' If you choose Arabic charset, this will print 178
Debug.Print "CharSet:", FontObject.Charset
End If
Call ReleaseDC(hWnd, hDC)
End Sub
Please note: as this topic is quite old, you will find many other examples by googling on the net (ChooseFont: Using the ChooseFont Common Dialog API, Karl E. Peterson and so on).