VB API 之第七课字体应用四

SelectClipRgn

功能：选取一个区域新的剪切区域

Declare Function SelectClipRgn Lib "gdi32" Alias "SelectClipRgn" (ByVal hdc As Long, ByVal hRgn As Long) As Long

参数

hdc：设备环境句柄。

hrgn：标识被选择的区域。

返回值：返回一个剪辑区域复杂度，可以是下列值之一。

NULLREGION：区域为空；

SIMPLEREGION：区域为单个矩形；

COMPLEXREGION：区域为多个矩形；

ERROR：发生错误（以前的剪切区域不受影响）。

CreateRectRgn

创建一个由点X1，Y1和X2，Y2描述的矩形区域

Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

参数

X1,Y1 Long，矩形左上角X，Y坐标

X2,Y2 Long，矩形右下角X，Y坐标

返回值

执行成功为区域句柄，失败则为零

SetTextAlign

该函数为指定设备环境设置文字对齐

Declare Function SetTextAlign Lib "gdi32" Alias "SetTextAlign" (ByVal hdc As Long, ByVal wFlags As Long) As Long

参数

HDC hdc, // 设备环境句柄

UINT fMode // 文本对齐选项

TA_BASELINE

基准点在正文的基线上。

TA_BOTTOM

基准点在限定矩形的下边界上。

TA_TOP

基准点在限定矩形的上边界上。

TA_CENTER

基准点与限定矩形的中心水平对齐。

TA_LEFT

基准点在限定矩形的左边界上。

TA_RIGHT

基准点在限定矩形的右边界上。

TA_RTLREADING

对于中东Windows版，正文从右到左的阅读顺序排列，与缺省的从左到右正好相反。

只有当被选择的字体是Hebrew或Arabic时，此值才有用。

TA_NOUPDATECP

每次文字输出调用后当前基准点不改变。基准点是传输给正文输出函数的位置。

TA_UPDATECP

每次文字输出调用后当前基准点改变。当前位置作为基准点。

若当前字体有一条缺省的垂直基线（如Kanji），下列值用于取代TA_BASELINE和TA_CENTER，各值含义为：

VTA_BASELINE

基准点在正文的基线上。

VTA_CENTER

基准点与限定矩形的中心垂直对齐。

缺省值是TA_LEFT, TA_TOP和TA_NOUPDATECP。

如果函数调用成功，返回值是文字对齐方式的前一个设置；

如果函数调用失败，返回值是GDI_ERROR

文本应用示例

Option Explicit

Private Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
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 SetTextAlign Lib "gdi32" (ByVal hdc As Long, ByVal wFlags As Long) As Long
Private 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 Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
  Private Const TA_LEFT = 0
  Private Const TA_RIGHT = 2
  Private Const TA_CENTER = 6
  Private Const TA_TOP = 0
  Private Const TA_BOTTOM = 8
  Private Const TA_BASELINE = 24
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 * 50
End Type
Private m_LF As LOGFONT
Private NewFont As Long
Private OrgFont As Long
Public Sub CharPlace(o As Object, txt, x, y)
Dim Throw As Long
Dim hregion As Long
Dim R As RECT
R.Left = x
     R.Right = x + o.TextWidth(txt) * 2
R.Top = y
R.Bottom = y + o.TextHeight(txt) * 2
hregion = CreateRectRgn(R.Left, R.Top, R.Right, R.Bottom)
Throw = SelectClipRgn(o.hdc, hregion)
Throw = TextOut(o.hdc, x, y, txt, Len(txt))
DeleteObject (hregion)
End Sub
Public Sub SetAlign(o As Object, Top, BaseLine, Bottom, Left, Center, Right)
Dim Vert As Long
Dim Horz As Long
If Top = True Then Vert = TA_TOP
If BaseLine = True Then Vert = TA_BASELINE
If Bottom = True Then Vert = TA_BOTTOM
If Left = True Then Horz = TA_LEFT
If Center = True Then Horz = TA_CENTER
If Right = True Then Horz = TA_RIGHT
SetTextAlign o.hdc, Vert Or Horz
End Sub
    Public Sub setcolor(o As Object, CValue As Long)
Dim Throw As Long
Throw = SetTextColor(o.hdc, CValue)
End Sub
Public Sub SelectOrg(o As Object)
Dim Throw As Long
NewFont = SelectObject(o.hdc, OrgFont)
Throw = DeleteObject(NewFont)
End Sub
Public Sub SelectFont(o As Object)
NewFont = CreateFontIndirect(m_LF)
OrgFont = SelectObject(o.hdc, NewFont)
End Sub
    Public Sub FontOut(text, o As Control, XX, YY)
Dim Throw As Long
Throw = TextOut(o.hdc, XX, YY, text, Len(text))
End Sub
Public Property Get Width() As Long
Width = m_LF.lfWidth
End Property
    Public Property Let Width(ByVal W As Long)
m_LF.lfWidth = W
End Property
Public Property Get Height() As Long
Height = m_LF.lfHeight
End Property
    Public Property Let Height(ByVal vNewValue As Long)
m_LF.lfHeight = vNewValue
End Property
Public Property Get Escapement() As Long
Escapement = m_LF.lfEscapement
End Property
    Public Property Let Escapement(ByVal vNewValue As Long)
m_LF.lfEscapement = vNewValue
End Property
Public Property Get Weight() As Long
Weight = m_LF.lfWeight
End Property
    Public Property Let Weight(ByVal vNewValue As Long)
m_LF.lfWeight = vNewValue
End Property
Public Property Get Italic() As Byte
Italic = m_LF.lfItalic
End Property
    Public Property Let Italic(ByVal vNewValue As Byte)
m_LF.lfItalic = vNewValue
End Property
Public Property Get UnderLine() As Byte
UnderLine = m_LF.lfUnderline
End Property
    Public Property Let UnderLine(ByVal vNewValue As Byte)
m_LF.lfUnderline = vNewValue
End Property
Public Property Get StrikeOut() As Byte
StrikeOut = m_LF.lfStrikeOut
End Property
    Public Property Let StrikeOut(ByVal vNewValue As Byte)
m_LF.lfStrikeOut = vNewValue
End Property
Public Property Get FaceName() As String
FaceName = m_LF.lfFaceName
End Property
    Public Property Let FaceName(ByVal vNewValue As String)
m_LF.lfFaceName = vNewValue
End Property
Private Sub Class_Initialize()
m_LF.lfHeight = 15
m_LF.lfWidth = 15
m_LF.lfEscapement = 0
m_LF.lfWeight = 400
m_LF.lfItalic = 0
m_LF.lfUnderline = 0
m_LF.lfStrikeOut = 0
m_LF.lfOutPrecision = 0
m_LF.lfClipPrecision = 0
m_LF.lfQuality = 0
m_LF.lfPitchAndFamily = 0
m_LF.lfCharSet = 0
m_LF.lfFaceName = "Arial" + Chr(0)
End Sub

消息响应函数

Option Explicit
Dim af As APIFont
Dim x, y As Integer

Private Sub cmdAngle_Click()
Dim i As Integer
Set af = Nothing
Set af = New APIFont
Picture1.Cls
     For i = 0 To 3600 Step 90
af.Escapement = i
af.SelectFont Picture1
x = Picture1.ScaleWidth / 2
y = Picture1.ScaleHeight / 2
af.FontOut "Comrade Studio", Picture1, x, y
af.SelectOrg Picture1
Next i
End Sub

Private Sub cmdHeight_Click()
  Dim i As Integer
Set af = Nothing
Set af = New APIFont
Picture1.Cls
     For i = 0 To 360 Step 1
Picture1.Cls
af.Height = i
af.SelectFont Picture1
x = Picture1.ScaleWidth / 2
y = Picture1.ScaleHeight / 2
af.FontOut "Comrade Studio", Picture1, x, y
af.SelectOrg Picture1
Next i
End Sub

Private Sub cmdWeight_Click()
Dim i As Integer
i = 0
Set af = Nothing
Set af = New APIFont
Picture1.Cls
     For i = 0 To 3600 Step 1
Picture1.Cls
af.Weight = i * 5
af.SelectFont Picture1
x = Picture1.ScaleWidth / 2
y = Picture1.ScaleHeight / 2
af.FontOut "Comrade Studio", Picture1, x, y
af.SelectOrg Picture1
Next i
End Sub

Private Sub cmdWidth_Click()
Dim i As Integer
Set af = Nothing
Set af = New APIFont
Picture1.Cls
     For i = 0 To 360 Step 1
Picture1.Cls
af.Width = i
af.SelectFont Picture1
x = Picture1.ScaleWidth / 2
y = Picture1.ScaleHeight / 2
‘在字符串后面要加入5个空格
af.FontOut "同志工作室     ", Picture1, x, y
af.SelectOrg Picture1
Next i
End Sub

Private Sub Form_Load()
Picture1.ScaleMode = 3
End Sub

运行结果如图：

时间： 2024-10-12 04:43:47

VB API 之第七课字体应用四的相关文章

VB API 之第五课字体之其他函数介绍

GetFontLanguageInfo() GetFontLanguageInfo()函数返回指定设备中字体的信息. 它的声明形式如下所示: Private Declare Function GetFontLanguageInfo Lib "gdi32" Alias "GetFontLanguageInfo" (ByVal hdc As Long) As Long GetFontLanguageInfo()函数返回Long型值,如果返回值为0,表示是简单字体:返回G

VB API 之第六课字体应用三

直接上源码不做解释自己看吧 Option Explicit Private 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 Long Private Declare Function Get

VB API 之第十课图像编程(三)

首先绘制多边形的API函数有: Polygon(); //描绘一个多边形,由两点或三点的任意系列构成 polyPolygon(); //用当前选定的画笔绘画两个或多个多边形 PolyPolyline(); //用当前选定的画笔描绘两个或多个多边形首先来看Polygon的函数原型 Private Declare Function Polygon Lib "gdi32" Alias "Polygon" (ByVal hdc As Long, lpPoint

Asp.Net Web API 2第七课——Web API异常处理

前言阅读本文之前,您也可以到Asp.Net Web API 2 系列导航进行查看 http://www.cnblogs.com/aehyok/p/3446289.html 本文主要来讲解Asp.Net Web API中错误和异常的处理,包括以下几点: 1.HttpResponseException——HTTP响应异常 2.Exception Filters——异常过滤器 3.Registering Exception Filters——注册异常过滤器 4.HttpError——HTTP错误 H

VB API 之第十一课绘制矩形

先来介绍几个画矩形的函数: DrawFocusRect():画一个焦点矩形:Rectangle():用当前选定的画笔描绘矩形,并用当前选定的画刷填充:DrawEdge():用指定的样式描绘一个矩形的边框:RoundRect():用当前选定的画笔画一个圆角矩形,并用当前选定的画刷填充. 今天用的是DrawFocusRect()函数,函数原型如下 Private Declare Function DrawFocusRect Lib "user32" Alias "DrawFocu

vB API 之第八课图像编程(一)

画线函数 LineTo(): 画直线 PolyBezier() 画贝塞尔曲线 PolyDraw(): 画多边形曲线 Polyline 画线段 LineTo()函数返回Long类型,返回0表示失败,不为0,则成功参数 hdc: Long //设备的句柄 x和y Long //线段的位置示例 Option Explicit Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Lon

第七课进程通信

unix_c_07.txt================第七课进程通信================一.基本概念------------1. 何为进程间通信~~~~~~~~~~~~~~~~~进程间通信(Interprocess Communication, IPC)是指两个,或多个进程之间进行数据交换的过程.2. 进程间通信分类~~~~~~~~~~~~~~~~~1) 简单进程间通信:命令行参数.环境变量.信号.文件.2) 传统进程间通信:管道(fifo/pipe).3) XSI进程间通信:

BeagleBone Black板第七课：GPIO编程控制

BBB板第七课:GPIO编程控制在一上课我们通过IO函数做了简单的GPIO端口输出高低电平输出,实现对一个LED指示灯的点亮和关闭控制,本节将通过完整的C++程序,实现第四课Shell脚本的全部功能,实现两个LED指示灯的交替闪亮. 直接通过进入功能程序 1.实现echo 44 > export 打开端口功能上一课简单测试中,通过手工在BBB板终端模式下打开gpio44端口可通过以下程序实现: #include <stdio.h> #define GPIO_DIR "/sy

第七课　对前面内容的总结

最近忙些,现在抽出个时间总结一下前面所讲的内容. 对于struts1框架的使用,个人认为不仅仅从细节方面去掌握,需要从整体把握,理解这个框架的意思,细节的东西查查资料一般都能解决,所以真个框架的理解很重要.这个同样适用于其他技术的学习,即整体把握再到细节实现,语言Java,php或是其他的,技术原理,框架上都差不多,主要的区别在于语法使用上,所以精通一门语言是十分必要的,这对于以后的工作或是学习都是非常有帮助的.一些大神经常说的话,理解和掌握思想就行,不必拘泥于细节的东西.当然啦,如果你是一个死

VB API 之 第七课 字体应用四

VB API 之 第七课 字体应用四的相关文章

VB API 之第七课字体应用四

VB API 之第七课字体应用四的相关文章