创建字体的例子：'In general section Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Const LF_FACESIZE = 32 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 'In form Private Sub Form_Load() 'KPD-Team 1998 'URL: http://www.allapi.net/ 'E-Mail: [email protected] Dim RotateMe As LOGFONT 'Set graphic-mode to 'persistent graphic' Me.AutoRedraw = True 'Rotate degrees Deg = 270 'Size (in points) Size = 20 'Set the rotation degree RotateMe.lfEscapement = Deg * 10 'Set the height of the font RotateMe.lfHeight = (Size * -20) / Screen.TwipsPerPixelY 'Create the font rFont = CreateFontIndirect(RotateMe) 'Select the font n the Form's device context Curent = SelectObject(Me.hdc, rFont) 'Print some text ... Me.CurrentX = 500 Me.CurrentY = 200 Me.Print ":-)" End Sub
至于设置字体，应该是发送“WM_SETFONT”消息。 MSDN:WM_SETFONT An application sends a WM_SETFONT message to specify the font that a control is to use when drawing text. WM_SETFONT wParam = (WPARAM) hfont; // handle of font lParam = MAKELPARAM(fRedraw, 0); // redraw flag
Parameters hfont Value of wParam. Handle to the font. If this parameter is NULL, the control uses the default system font to draw text. fRedraw Value of lParam. Specifies whether the control should be redrawn immediately upon setting the font. Setting the fRedraw parameter to TRUE causes the control to redraw itself. Return Values This message does not return a value. Res The WM_SETFONT message applies to all controls, not just those in dialog boxes. The best time for the owner of a dialog box control to set the font of the control is when it receives the WM_INITDIALOG message. The application should call theDeleteObject function to delete the font when it is no longer needed; for example, after it destroys the control. The size of the control does not change as a result of receiving this message. To avoid clipping text that does not fit within the boundaries of the control, the application should correct the size of the control window before it sets the font. When a dialog box uses the DS_SETFONT style to set the text in its controls, the system sends the WM_SETFONT message to the dialog box procedure before it creates the controls. An application can create a dialog box that contains the DS_SETFONT style by calling any of the following functions: CreateDialogIndirect CreateDialogIndirectParam DialogBoxIndirect DialogBoxIndirectParam QuickInfo Windows NT: Requires version 3.1 or later. Windows: Requires Windows 95 or later. Windows CE: Requires version 1.0 or later. Header: Declared in winuser.h.See Also Controls Overview, Control Messages, CreateDialogIndirect, CreateDialogIndirectParam,DeleteObject, DialogBoxIndirect, DialogBoxIndirectParam, WM_INITDIALOG, DLGTEMPLATE
以下即是创建字体与设置字体的代码： 不过这是用的PictureBox Option Explicit Private Declare Function CreateFontIndirect Lib "gdi32" Alias _ "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc _ As Long, ByVal hObject As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal _ hObject As Long) As Long Private Const LF_FACESIZE = 32 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 * LF_FACESIZE End Type Sub Command1_Click() Dim font As LOGFONT Dim prevFont As Long, hFont As Long, ret As Long Const FONTSIZE = 10 ' Desired point size of font font.lfEscapement = 1800 ' 180-degree rotation font.lfFaceName = "Arial" & Chr$(0) 'Null character at end ' Windows expects the font size to be in pixels and to ' be negative if you are specifying the character height ' you want. font.lfHeight = (FONTSIZE * -20) / Screen.TwipsPerPixelY hFont = CreateFontIndirect(font) prevFont = SelectObject(Picture1.hdc, hFont) Picture1.CurrentX = Picture1.ScaleWidth Picture1.CurrentY = Picture1.ScaleHeight / 2 Picture1.Print "Rotated Text" ' Clean up by restoring original font. ret = SelectObject(Picture1.hdc, prevFont) ret = DeleteObject(hFont) Picture1.CurrentY = Picture1.ScaleHeight / 2 Picture1.Print "Normal Text" End Sub
使文本框使用这一字体即可！
不过很复杂！！！！
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Const LF_FACESIZE = 32
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
'In form
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: [email protected] Dim RotateMe As LOGFONT
'Set graphic-mode to 'persistent graphic'
Me.AutoRedraw = True
'Rotate degrees
Deg = 270
'Size (in points)
Size = 20
'Set the rotation degree
RotateMe.lfEscapement = Deg * 10
'Set the height of the font
RotateMe.lfHeight = (Size * -20) / Screen.TwipsPerPixelY
'Create the font
rFont = CreateFontIndirect(RotateMe)
'Select the font n the Form's device context
Curent = SelectObject(Me.hdc, rFont)
'Print some text ...
Me.CurrentX = 500
Me.CurrentY = 200
Me.Print ":-)"
End Sub
MSDN:WM_SETFONT
An application sends a WM_SETFONT message to specify the font that a control is to use when drawing text. WM_SETFONT
wParam = (WPARAM) hfont; // handle of font
lParam = MAKELPARAM(fRedraw, 0); // redraw flag
Parameters
hfont
Value of wParam. Handle to the font. If this parameter is NULL, the control uses the default system font to draw text.
fRedraw
Value of lParam. Specifies whether the control should be redrawn immediately upon setting the font. Setting the fRedraw parameter to TRUE causes the control to redraw itself.
Return Values
This message does not return a value. Res
The WM_SETFONT message applies to all controls, not just those in dialog boxes. The best time for the owner of a dialog box control to set the font of the control is when it receives the WM_INITDIALOG message. The application should call theDeleteObject function to delete the font when it is no longer needed; for example, after it destroys the control. The size of the control does not change as a result of receiving this message. To avoid clipping text that does not fit within the boundaries of the control, the application should correct the size of the control window before it sets the font. When a dialog box uses the DS_SETFONT style to set the text in its controls, the system sends the WM_SETFONT message to the dialog box procedure before it creates the controls. An application can create a dialog box that contains the DS_SETFONT style by calling any of the following functions: CreateDialogIndirect
CreateDialogIndirectParam
DialogBoxIndirect
DialogBoxIndirectParam
QuickInfo
Windows NT: Requires version 3.1 or later.
Windows: Requires Windows 95 or later.
Windows CE: Requires version 1.0 or later.
Header: Declared in winuser.h.See Also
Controls Overview, Control Messages, CreateDialogIndirect, CreateDialogIndirectParam,DeleteObject, DialogBoxIndirect, DialogBoxIndirectParam, WM_INITDIALOG, DLGTEMPLATE
不过这是用的PictureBox
Option Explicit Private Declare Function CreateFontIndirect Lib "gdi32" Alias _
"CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc _
As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal _
hObject As Long) As Long
Private Const LF_FACESIZE = 32 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 * LF_FACESIZE
End Type Sub Command1_Click()
Dim font As LOGFONT
Dim prevFont As Long, hFont As Long, ret As Long
Const FONTSIZE = 10 ' Desired point size of font
font.lfEscapement = 1800 ' 180-degree rotation
font.lfFaceName = "Arial" & Chr$(0) 'Null character at end
' Windows expects the font size to be in pixels and to
' be negative if you are specifying the character height
' you want.
font.lfHeight = (FONTSIZE * -20) / Screen.TwipsPerPixelY
hFont = CreateFontIndirect(font)
prevFont = SelectObject(Picture1.hdc, hFont)
Picture1.CurrentX = Picture1.ScaleWidth
Picture1.CurrentY = Picture1.ScaleHeight / 2
Picture1.Print "Rotated Text"
' Clean up by restoring original font.
ret = SelectObject(Picture1.hdc, prevFont)
ret = DeleteObject(hFont)
Picture1.CurrentY = Picture1.ScaleHeight / 2
Picture1.Print "Normal Text"
End Sub
font.lfHeight = (FONTSIZE * -20) / Screen.TwipsPerPixelY
font.lfWidth = (FONTSIZE * -20) * 0.8 * 0.5 / Screen.TwipsPerPixelX
不知是为什么?
不过也很麻烦