|
给一个源代码你 在窗体插入一个文本框Private Const LF_FACESIZE = 32Private Const CF_PRINTERFONTS = &H2Private Const CF_SCREENFONTS = &H1Private Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)Private Const CF_EFFECTS = &H100&Private Const CF_FORCEFONTEXIST = &H10000Private Const CF_INITTOLOGFONTSTRUCT = &H40&Private Const CF_LIMITSIZE = &H2000&Private Const REGULAR_FONTTYPE = &H400'charset ConstantsPrivate Const ANSI_CHARSET = 0Private Const ARABIC_CHARSET = 178Private Const BALTIC_CHARSET = 186Private Const CHINESEBIG5_CHARSET = 136Private Const DEFAULT_CHARSET = 1Private Const EASTEUROPE_CHARSET = 238Private Const GB2312_CHARSET = 134Private Const GREEK_CHARSET = 161Private Const HANGEUL_CHARSET = 129Private Const HEBREW_CHARSET = 177Private Const JOHAB_CHARSET = 130Private Const MAC_CHARSET = 77Private Const OEM_CHARSET = 255Private Const RUSSIAN_CHARSET = 204Private Const SHIFTJIS_CHARSET = 128Private Const SYMBOL_CHARSET = 2Private Const THAI_CHARSET = 222Private Const TURKISH_CHARSET = 162Private Type LOGFONTlfHeight As LonglfWidth As LonglfEscapement As LonglfOrientation As LonglfWeight As LonglfItalic As BytelfUnderline As BytelfStrikeOut As BytelfCharSet As BytelfOutPrecision As BytelfClipPrecision As BytelfQuality As BytelfPitchAndFamily As BytelfFaceName As String * 31End TypePrivate Type CHOOSEFONTlStructSize As LonghwndOwner As Long ' caller's window handlehDC As Long ' printer DC/IC or NULLlpLogFont As Long ' ptr. to a LOGFONT structiPointSize As Long ' 10 * size in points of selected fontflags As Long ' enum. type flagsrgbColors As Long ' returned text colorlCustData As Long ' data passed to hook fn.lpfnHook As Long ' ptr. to hook functionlpTemplateName As String ' custom template namehInstance As Long ' instance handle of.EXE that' contains cust. dlg. templatelpszStyle As String ' return the style field here' must be LF_FACESIZE or biggernFontType As Integer ' same value reported to the EnumFonts' call back with the extra FONTTYPE_' bits addedMISSING_ALIGNMENT As IntegernSizeMin As Long ' minimum pt size allowed &nSizeMax As Long ' max pt size allowed if' CF_LIMITSIZE is usedEnd TypePrivate Declare Function CHOOSEFONT Lib "comdlg32.dll" Alias "ChooseFontA" _(ByRef pChoosefont As CHOOSEFONT) As LongPrivate Sub Command1_Click()Dim cf As CHOOSEFONT, lfont As LOGFONTDim fontname As String, ret As Longcf.flags = CF_BOTH Or CF_EFFECTS Or CF_FORCEFONTEXIST Or CF_INITTOLOGFONTSTRUCT Or CF_LIMITSIZEcf.lpLogFont = VarPtr(lfont)cf.lStructSize = LenB(cf)'cf.lStructSize = Len(cf) ' size of structurecf.hwndOwner = Form1.hWnd ' window Form1 is opening this dialog boxcf.hDC = Printer.hDC ' device context of default printer (using VB's mechanism)cf.rgbColors = RGB(0, 0, 0) ' blackcf.nFontType = REGULAR_FONTTYPE ' regular font type i.e. not bold or anythingcf.nSizeMin = 10 ' minimum point sizecf.nSizeMax = 72 ' maximum point sizeret = CHOOSEFONT(cf) 'brings up the font dialogIf ret0 Then ' successfontname = StrConv(lfont.lfFaceName, vbUnicode, &H804) 'Retrieve chinese font name in english version osfontname = 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 sizeText1.Text = .Name & ":" & .Charset & ":" & .Size 'display data in chosen FontEnd WithEnd If |
