首页 > 代码库 > VB API 第四课 字体应用篇之二

VB API 第四课 字体应用篇之二

2024-07-25 23:49:05   220人阅读

　　首先来四个API函数，分别是DeltetObject,CreateFontIndirect,SelectOBject,TextOut.先分别对这几个函数的说明做下介绍。

  DeltetObject

 

函数功能：该函数删除一个逻辑笔、画笔、字体、位图、区域或者调色板，释放所有与该对象有关的系统资源，在对象被删除之后，指定的句柄也就失效了。

 

函数原型：BOOL DeleteObject(HGDIOBJ hObject)；

 

参数：

 

hObject：逻辑笔、画笔、字体、位图、区域或者调色板的句柄。

 

返回值：成功，返回非零值；如果指定的句柄无效或者它已被选入设备上下文环境，则返回值为零。

　　CreateFontIndirect

 

函数功能：该函数创建一种在指定结构定义其特性的逻辑字体。这种字体可在后面的应用中被任何设备环境选作字体。

 

函数原型：HFONT CreateFontIndirect(CONST LOGFONT *lplf)；

 

参数：

 

lplf：指向定义此逻辑字体特性的LOGFONT结构的指针。

 

返回值：如果函数调用成功，返回值是逻辑字体的句柄；如果函数调用失败，返回值是NULL

 

SelectOBject
函数功能：该函数选择一对象到指定的设备上下文环境中，该新对象替换先前的相同类型的对象。
函数原型：HGDIOBJ SelectObject(HDC hdc, HGDIOBJ hgdiobj)
参数：
hdc：设备上下文环境的句柄。
hgdiobj：被选择的对象的句柄，该指定对象必须由如下的函数创建。
位图：CreateBitmap, CreateBitmapIndirect, CreateCompatible Bitmap, CreateDIBitmap, CreateDIBsection（只有内存设备上下文环境可选择位图，并且在同一时刻只能一个设备上下文环境选择位图）。
画刷：CreateBrushIndirect, CreateDIBPatternBrush, CreateDIBPatternBrushPt, CreateHatchBrush, CreatePatternBrush, CreateSolidBrush。
字体：CreateFont, CreateFontIndirect。
笔：CreatePen, CreatePenIndirect。
区域：CombineRgn, CreateEllipticRgn, CreateEllipticRgnIndirect, CreatePolygonRgn, CreateRectRgn,CreateRectRgnIndirect。
返回值：如果选择对象不是区域并且函数执行成功，那么返回值是被取代的对象的句柄；如果选择对象是区域并且函数执行成功，返回如下一值:
SIMPLEREGION：区域由单个矩形组成；
COMPLEXREGION：区域由多个矩形组成;
NULLREGION：区域为空。
如果发生错误并且选择对象不是一个区域，那么返回值为NULL，否则返回HGDI_ERROR。
   textOut
该函数用当前选择的字体、背景颜色和正文颜色将一个字符串写到指定位置

函数原型

BOOL TextOut(
HDC hdc, // 设备描述表句柄
int nXStart, // 字符串的开始位置 x坐标
int nYStart, // 字符串的开始位置 y坐标
LPCTSTR lpString, // 字符串
int cbString // 字符串中字符的个数
);

参数　　

hdc
[输入] 设备环境的句柄
nXStart
[输入] 指定用于字符串对齐的基准点的逻辑X坐标。
nYStart
[输入] 指定用于字符串对齐的基准点的逻辑Y坐标。
lpString
[输入] 指向将被绘制字符串的指针。此字符串不必为以\0结束的，因为cbString中指定了字符串的长度。
cbString
[输入] 指定了字符串的长度

返回值

如果函数调用成功，返回值为非零值。
如果函数调用失败，返回值为0。
我们需要5个标签，5个编辑框，3个选择框，2个按钮和4个UPdown控件，直接上源码
 
Option ExplicitPrivate Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As LongPrivate Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As LongPrivate Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As LongPrivate Type RECT    Left As Long    Top As Long    Right As Long    Button As LongEnd TypePrivate 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 * 50End TypePrivate RF As LOGFONTPrivate NewFont As LongPrivate OldFont As LongFunction FontOption()    RF.lfWidth = Int(Val(Me.txtWidth.Text))    RF.lfHeight = Int(Val(Me.txtHeight.Text))    RF.lfEscapement = Int(Val(Me.txtEscapement.Text))    RF.lfWeight = Int(Val(Me.txtWeight.Text))    RF.lfItalic = Me.chkItalic.Value    RF.lfUnderline = Me.chkUnderline.Value    RF.lfStrikeOut = Me.chkStrikeOut.ValueEnd FunctionPrivate Sub Command1_Click()    Dim Throw As Long    Dim x, y As Long    FontOption   ‘设置字体参数    NewFont = CreateFontIndirect(RF)   ‘创建新字体    OldFont = SelectObject(Me.Picture1.hdc, NewFont) ‘应用新字体    x = Picture1.ScaleWidth / 2    y = Picture1.ScaleHeight / 2   ‘显示文本的位置    Throw = TextOut(Me.Picture1.hdc, x, y, Me.txtShow.Text, Len(Me.txtShow.Text))  ‘显示文本    NewFont = SelectObject(Me.Picture1.hdc, OldFont)  ‘选择旧字体    Throw = DeleteObject(NewFont)   ‘删除字体    End SubPrivate Sub Command2_Click()    Me.Picture1.ClsEnd SubPrivate Sub Form_Load()    RF.lfHeight = 50  ‘设置字体高度    RF.lfWidth = 10    ‘设置字体平均宽度    RF.lfEscapement = 0  ‘设置文本倾斜度    RF.lfWeight = 400   ‘设置字体的轻重    RF.lfItalic = 0    ‘设置字体不倾斜    RF.lfUnderline = 0  ‘字体不加下划线    RF.lfStrikeOut = 0   ‘字体不加删除线    RF.lfOutPrecision = 0  ‘设置输出进度    RF.lfClipPrecision = 0  ‘设置剪辑精度    RF.lfQuality = 0      ‘设置输出质量    RF.lfPitchAndFamily = 0  ‘设置字体的字距和字体族    RF.lfCharSet = 0        ‘设置字符集    RF.lfFaceName = "Arial" + Chr(0)   ‘设置字体名字    Me.txtEscapement.Text = RF.lfEscapement    Me.txtHeight.Text = RF.lfHeight    Me.txtWeight.Text = RF.lfWeight    Me.txtWidth.Text = RF.lfWidth    ‘设置文本框显示文本End Sub

　　

 

　

运行效果如下图

　

 

VB API 第四课 字体应用篇之二


联系
我们