首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

LOGFONT的lfFaceName无效解决方法

2012-02-16 
LOGFONT的lfFaceName无效请教高手在使用CreateFontIndirect函数时需结构LOGFONT,但无论如何设置LOGFONT的l

LOGFONT的lfFaceName无效
请教高手在使用CreateFontIndirect函数时需结构LOGFONT,但无论如何设置LOGFONT的lfFaceName都无法更改字体名。为何?通过国外网站搜索,可能原因有两个:1、UniCode码问题。2、lfFaceName是一个指向末字符为Null的字符串的指针。而不是直接赋值。以下是测试源代码,无论如何也不能显示“黑体”。工程需一个Picture1、Command1两个控件。将以下代码Copy即可。


'Add a PictureBox Control and Command Button to the form.

'Type the following code in the General Declaration Section of the form

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 Type LOGFONT
  lfHeight As Long
  lfWidth As Long
  lfEscapement As Long
  lfOrientation As Long
  lfWeight As Long
  lfItalic As String * 1
  lfUnderline As String * 1
  lfStrikeOut As String * 1
  lfCharSet As String * 1
  lfOutPrecision As String * 1
  lfClipPrecision As String * 1
  lfQuality As String * 1
  lfPitchAndFamily As String * 1
  lfFaceName As String * 32
End Type

'Create a procedure named RotateText and pass the following parameters as arguments
' Picturebox, Text to be displayed, current X and Current Y as parameters

'Call the procedure from the click event of the command button

Private Sub RotateText(PBCtrl As PictureBox, disptxt As String, CX, CY)
Dim Font As LOGFONT
Dim hFont As Long, ret As Long
Const FONTSIZE = 12 ' Desired point size of font

Font.lfEscapement = 0 '900 ' 180-degree rotation
Font.lfFaceName = StrConv("黑体" + Chr$(0), vbUnicode)
Font.lfWeight = 50

' 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)
SelectObject PBCtrl.hdc, hFont

PBCtrl.CurrentX = CX
PBCtrl.CurrentY = CY
PBCtrl.Print disptxt

' Clean up by restoring original font.
ret = DeleteObject(hFont)
End Sub

Private Sub Command1_Click()
 RotateText Picture1, "Heat Details", Picture1.Width \ 5, 100
End Sub



[解决办法]
不用哪么麻烦吧,
Font.lfFaceName = "黑体" + Chr$(0)
就行了,但是
Font.lfCharSet = GB2312_CHARSET

热点排行