VB中用API实现字体公用对话框例子

王朝c#·作者佚名  2006-12-17
窄屏简体版  字體: |||超大  

Private Const LF_FACESIZE = 32

Private Const CF_PRINTERFONTS = &H2

Private Const CF_SCREENFONTS = &H1

Private Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)

Private Const CF_EFFECTS = &H100&

Private Const CF_FORCEFONTEXIST = &H10000

Private Const CF_INITTOLOGFONTSTRUCT = &H40&

Private Const CF_LIMITSIZE = &H2000&

Private Const REGULAR_FONTTYPE = &H400

'charset Constants

Private Const ANSI_CHARSET = 0

Private Const ARABIC_CHARSET = 178

Private Const BALTIC_CHARSET = 186

Private Const CHINESEBIG5_CHARSET = 136

Private Const DEFAULT_CHARSET = 1

Private Const EASTEUROPE_CHARSET = 238

Private Const GB2312_CHARSET = 134

Private Const GREEK_CHARSET = 161

Private Const HANGEUL_CHARSET = 129

Private Const HEBREW_CHARSET = 177

Private Const JOHAB_CHARSET = 130

Private Const MAC_CHARSET = 77

Private Const OEM_CHARSET = 255

Private Const RUSSIAN_CHARSET = 204

Private Const SHIFTJIS_CHARSET = 128

Private Const SYMBOL_CHARSET = 2

Private Const THAI_CHARSET = 222

Private Const TURKISH_CHARSET = 162

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 As String * 31

End Type

Private Type CHOOSEFONT

lStructSize As Long

hwndOwner As Long ' caller's window handle

hDC As Long ' printer DC/IC or NULL

lpLogFont As Long ' ptr. to a LOGFONT struct

iPointSize As Long ' 10 * size in points of selected font

flags As Long ' enum. type flags

rgbColors As Long ' returned text color

lCustData As Long ' data passed to hook fn.

lpfnHook As Long ' ptr. to hook function

lpTemplateName As String ' custom template name

hInstance As Long ' instance handle of.EXE that

' contains cust. dlg. template

lpszStyle As String ' return the style field here

' must be LF_FACESIZE or bigger

nFontType As Integer ' same value reported to the EnumFonts

' call back with the extra FONTTYPE_

' bits added

MISSING_ALIGNMENT As Integer

nSizeMin As Long ' minimum pt size allowed &

nSizeMax As Long ' max pt size allowed if

' CF_LIMITSIZE is used

End Type

Private Declare Function CHOOSEFONT Lib "comdlg32.dll" Alias "ChooseFontA" _

(ByRef pChoosefont As CHOOSEFONT) As Long

Private Sub Command1_Click()

Dim cf As CHOOSEFONT, lfont As LOGFONT

Dim fontname As String, ret As Long

cf.flags = CF_BOTH Or CF_EFFECTS Or CF_FORCEFONTEXIST Or CF_INITTOLOGFONTSTRUCT Or CF_LIMITSIZE

cf.lpLogFont = VarPtr(lfont)

cf.lStructSize = LenB(cf)

'cf.lStructSize = Len(cf) ' size of structure

cf.hwndOwner = Form1.hWnd ' window Form1 is opening this dialog box

cf.hDC = Printer.hDC ' device context of default printer (using VB's mechanism)

cf.rgbColors = RGB(0, 0, 0) ' black

cf.nFontType = REGULAR_FONTTYPE ' regular font type i.e. not bold or anything

cf.nSizeMin = 10 ' minimum point size

cf.nSizeMax = 72 ' maximum point size

ret = CHOOSEFONT(cf) 'brings up the font dialog

If ret <> 0 Then ' success

fontname = StrConv(lfont.lfFaceName, vbUnicode, &H804) 'Retrieve chinese font name in english version os

fontname = Left$(fontname, InStr(1, fontname, vbNullChar) - 1)

'Assign the font properties to text1

With Text1.Font

.Charset = lfont.lfCharSet 'assign charset to font

.Name = fontname

.Size = cf.iPointSize / 10 'assign point size

Text1.Text = .Name & ":" & .Charset & ":" & .Size 'display data in chosen Font

End With

End If

End Sub

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航