Today, refer to a foreign language code:
(Author: Steve McMahon steve@vbaccelerator.com,
Website: http://www.shitalshah.com/vbxlr/tips/vba0035.htm)
Private Const LF_FACESIZE = 32Private Const FW_NORMAL = 400Private Const FW_BOLD = 700Private Const FF_DONTCARE = 0Private Const DEFAULT_QUALITY = 0Private Const DEFAULT_PITCH = 0Private Const DEFAULT_CHARSET = 1Private Const DT_CALCRECT = & H400Private 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 ByteEnd TypePrivate Type RECT Left As Long Top As Long Right As Long Bottom As LongEnd Type
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As LongPrivate Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long , ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As LongPrivate Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As LongPrivate Declare Function OffsetRect Lib "user32" ( LPRECT AS RECT, BYVAL Y AS Long, Byval Y As Long AS Long
Private Sub printtext (ByVal hdc As Long, ByVal mystr As String, myfont As StdFont, Optional ByVal fontwidth As Integer = 30, Optional ByVal fontheight As Integer = 15, Optional ByVal fontbold As Boolean = False, Optional ByVal fontitlaic As Boolean = False, optional ByVal fontunderline As Boolean = False, optional ByVal fontStrikethrough As Boolean = False) Dim tLF As LOGFONTDim hFnt As LongDim hFntOld As LongDim tR As RECTDim sFont As StringDim iChar As IntegerDim temp () As Byte
'Convert An Ole stdfont to a logfont structure: with tlfont = myfont.name temp = strconv (sfont, vbfromunicode) for iChar = 1 to len (sfont) .lffacename (iChar - 1) = Temp (iChar - 1) Next iChar 'Based on the Win32SDK documentation: .lfItalic = myfont.Italic lfWeight = IIf (myfont.Bold, FW_BOLD, FW_NORMAL) .lfWidth = fontwidth .lfHeight = fontheight .lfUnderline = fontunderline .lfStrikeOut = fontStrikethrough .lfCharSet = myfont.Charset End With
HFNT = CREATEFONTINDIRECT (TLF) 'Convert The Logfont Into A Font Handle
'Test The Font Out: HFNTOLD = SELECTOBJECT (HDC, HFNT) DrawText HDC, MYSTR, -1, TR, DT_CALCRECT OFFSETRECT TR, 32, 32 DrawText HDC, MySTR, -1, TR, 0 & SelectObject HDC, HFNTOLD
'Remember to delete the font when finished deleteObject HFNT
End Sub
Private submmand1_click () me.clsdim myfont as new stdfontmyfont.name = "Arial" PrintText Me.hdc, "Flat Pieces", MyFont, 50, 20
End Sub
Private submmand2_click () Dim Myfont As new stdfontmyfont.name = "Arial" PrintText Me.HDC, "Several words", MYFONT, 10, 200, TRUE, TRUE, FALSE, FALSEEND SUB Output:
