回顾:1、DC就是我们所说DC,在DC上画会即时在窗体上画出。它就象一个画布,我们操作它也即时发生变化,别人操作它也即时发生变化。
缺点:如果被挡住,或最小化后,所画的东西就消失了。“别人”操作就是被其它窗体挡住。
2、后台DC,相当于备份DC。只有内存DC复制到前台DC才会即时显示,否则,起不了作用。所以后台DC一般用于备份。当恢复窗体时,
内存DC就起到了作用,复制到前台DC,窗体中图形就恢复了。
3、无论何种DC,它只是一个画布,一个被别人任意“蹂躏”的画面。它还需要其它东西才能成一个画面,比如用笔(Pen)来画线(包括线的粗细,
线的宽度等),Brush来涂抹(怎么涂,涂什么)。所以我们需要指定,前面很多没有指定,是因为用了“默认”的Pen,Brush等。只有Bitmap用到
指定,指定了图的大小,色位等。这个指定就是选择对象。SelectObject
可以发现一个奇妙处,返回值都是以前的对象,这是便于恢复以前的对象。
例对笔刷的操作:
hOldBrush=SelectObject(hDC,hBrush)
上面的对象Pen,Brush,Bitmap等就是GDI对象。
一、笔
Private Declare Function CreatePen _ Lib "gdi32" (ByVal nPenStyle As Long,_ ByVal nWidth As Long,_ ByVal crColor As Long) As Long建立笔对象: 返回值0失败,非0成功
nPenStyle 画笔样式
vbSolid 0 实线
vbDash 1 破折线
vbDot 2 点线
vbDashDot 3 破折-点线
vbDashDotDot 4 破折-点-点线
vbInvisible 5 透明
vbInsideSolid 6 内实线
nWidth 画笔线宽(0为单点)
crColor 线色
二、实心笔刷
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
crColor 实心笔刷的颜色。
hBrush=CreateSolidBrush(RGB(255,0))
点线蓝色外框,背景涂红的矩形:
上面建立了花色笔刷PatternBrush,实际上就是由较小的Bitmap组成
Private Declare Function CreatePatternBrush Lib "gdi32" Alias "CreatePatternBrush" (ByVal hBitmap As Long) As Long
除了花色笔刷、实心笔刷,下面一个条纹笔刷
Private Declare Function CreateHatchBrush Lib "gdi32" Alias "CreateHatchBrush" (ByVal nIndex As Long,ByVal crColor As Long) As Long
nIndex: 条纹笔刷样式
HS_Horizontal=0 水平线
HS_Vertical=1 垂直线
HS_Fdiagonal=2 左上到右下斜线 ,diagonal斜线
HS_Bdiagonal=3 左下到右上斜线
HS_Cross=4 垂直交叉线
HS_DiagCross=5 对角交叉线
crColor 笔刷颜色
Private Sub Command1_Click() Dim hPen As Long,hBrush As Long Dim hOldPen As Long,hOldBrush As Long hPen = CreatePen(vbDashDot,1,vbBlue) hBrush = CreateHatchBrush(HS_DIAGCROSS,vbRed) hOldPen = SelectObject(Me.hdc,hPen) hOldBrush = SelectObject(Me.hdc,hBrush) Rectangle Me.hdc,10,200,100 DeleteObject hOldPen DeleteObject hOldBrush End Sub
Bezier 贝赛尔曲线
lppt: 数组传入地址,由第一元素代替
cPoints 传入点数。至少4点,如图,1,4表示起始与终止点,2,3决定曲线弯曲情况。每次递增3个点。
故总点数应为:3*N+1个
注意最后参数是传址,省略会发生错误,因为会被认为是传递是地址4处的值。
回顾:画多边形:Polygon
Private Declare Function Polygon _
Lib "gdi32" (ByVal hdc As Long,_
lpPoint As POINTAPI,_
ByVal nCount As Long) As Long
这里面点的顺序会造成图的交错,如果用笔刷时就会有交错地方
Private Declare Function SetPolyFillMode _
Lib "gdi32" (ByVal hdc As Long,_
ByVal nPolyFillMode As Long) As Long
Alternate=1 不涂抹交错区域
Winding=2 涂抹交错区域(全涂)
Private Declare Function Polygon _ Lib "gdi32" (ByVal hdc As Long,_ lpPoint As POINTAPI,_ ByVal nCount As Long) As Long Private Declare Function SetPolyFillMode _ Lib "gdi32" (ByVal hdc As Long,_ ByVal nPolyFillMode As Long) As Long Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function SelectObject _ Lib "gdi32" (ByVal hdc As Long,_ ByVal hObject As Long) As Long Private Type POINTAPI x As Long y As Long End Type Private Const ALTERNATE = 1 Private Const WINDING = 2 Private Sub Command1_Click() Dim p(4) As POINTAPI Dim hBrush As Long,hOldBrush As Long,hOldFillMode As Long p(0).x = 0 p(0).y = 100 p(1).x = 300 p(1).y = 100 p(2).x = 100 p(2).y = 200 p(3).x = 100 p(3).y = 10 p(4).x = 200 p(4).y = 200 hBrush = CreateSolidBrush(RGB(255,0)) hOldBrush = SelectObject(Me.hdc,hBrush) hOldFillMode = SetPolyFillMode(Me.hdc,ALTERNATE) Polygon Me.hdc,p(0),ByVal 5& SetPolyFillMode Me.hdc,hOldFillMode '恢复原填充模式 DeleteObject hOldBrush '删除原笔刷 End Sub
填充颜色:FloodFill
就象发怒似地把一桶全倒出来,只有有围栏(边框)的才能被拦住。
即把颜色填充到一个指定的区域
Private Declare Function FloodFill _
Lib "gdi32" (ByVal hdc As Long,_
ByVal x As Long,_
ByVal y As Long,_
ByVal crColor As Long) As Long
(x,y) 是指定区域内的任意一点
crColor 指定区域内边框的颜色。
注意,这个填充色并不在这个API中,它只是指明了范围。颜色在笔刷中需笔刷API来指定。
同时,这个API是一个“动作”,只有边框确定后,再执行这个动作,才能正确的填充
回顾:矩形Rectangle
Private Declare Function Rectangle _
Lib "gdi32" (ByVal hdc As Long,_
ByVal X1 As Long,_
ByVal Y1 As Long,_
ByVal X2 As Long,_
ByVal Y2 As Long) As Long
再看: 圆角矩形 RoundRect
Private Declare Function RoundRect _
Lib "gdi32" (ByVal hdc As Long,_
ByVal Y2 As Long,_
ByVal X3 As Long,_
ByVal Y3 As Long) As Long
多了最后一个(X3,Y3),这不是一个点的坐标,而是一个椭圆的实际宽、高,用它来确定圆角的“程度”
下面,确定笔刷后,画区域,再倒颜色。
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) 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 Declare Function RoundRect _ Lib "gdi32" (ByVal hdc As Long,_ ByVal X1 As Long,_ ByVal Y1 As Long,_ ByVal X2 As Long,_ ByVal Y2 As Long,_ ByVal X3 As Long,_ ByVal Y3 As Long) As Long Private Declare Function FloodFill _ Lib "gdi32" (ByVal hdc As Long,_ ByVal x As Long,_ ByVal y As Long,_ ByVal crColor As Long) As Long Private Declare Function CreatePen _ Lib "gdi32" (ByVal nPenStyle As Long,_ ByVal crColor As Long) As Long Private Const PS_SOLID = 0 Private Sub Command1_Click() Dim hBrush As Long,hOldBrush As Long Dim hPen As Long,hOldPen As Long hPen = CreatePen(PS_SOLID,RGB(0,0)) hOldPen = SelectObject(Me.hdc,hPen) hBrush = CreateSolidBrush(RGB(255,hBrush) '选择实心笔刷 RoundRect Me.hdc,150,100,50 '这句须在下句前,先画一个区域(圆形矩形) FloodFill Me.hdc,60,0) '指定范围填充,这句:然后对某点倒颜色。 SelectObject Me.hdc,hOldBrush '恢复 SelectObject Me.hdc,hOldPen DeleteObject hPen '删除 DeleteObject hBrush End Sub
====================================
(一)判断点是否在一条线段上
回调函数:CallBack
一般调用函数是在主程序中A处,调用B函数。但有时不想改变已经成型的B模块,想加入自己的一些功能。
比如,调用B文件返回的是一组数组,但这次我想它返回“已经排好序”的数组。这个排序可能是从大到小,
也可能是由小到大,等等,实现的排序的方法又各自不同。这都是用户自己来决定。
这时已经编好的模块B就没法完成这样的功能。我们又不想破坏它的(多人编程,大家都知道B是不变的)
于是,在调用B函数时,我们传一个函数C的地址,C完成我们自定的排序及排序方法。这个地址便于B函数
相当于我打了你一拳,你回打了我一拳。
==========================================================================
判断一个点是不是在一条线段上,用数学的方法比较直接直观,但不高效。
用API,直接枚举线段上各点,再判断该点是否在枚举中,比较快。
枚举线段各点:LineDDA
Declare Function LineDDA _
Lib "gdi32" (ByVal n1 As Long,_
ByVal n2 As Long,_
ByVal n3 As Long,_
ByVal n4 As Long,_
ByVal lpLineDDAProc As Long,_
ByVal lParam As Long) As Long
(n1,n2) 线段起点
(n3,4) 线段终点
lpLineDDAProc 回调函数。返回线段上各点,自定义处理
IParam 回调函数参数不够时,用这个补充。无补充时用0
因此我们须自定义回调函数,因为这个要用到函数地址,须在模块中(否则,过程模块的Addressof会出错)。添加模块定义如下:
Option Explicit Declare Function LineDDA _ Lib "gdi32" (ByVal n1 As Long,_ ByVal n2 As Long,_ ByVal n3 As Long,_ ByVal n4 As Long,_ ByVal lpLineDDAProc As Long,_ ByVal lParam As Long) As Long Public px(2048) As Long Public py(2048) As Long Public npoint As Long Sub LineDDAProc(ByVal X As Long,ByVal Y As Long,ByVal lpData As Long) px(npoint) = X py(npoint) = Y npoint = npoint + 1 End Sub
过程模块:
Private Sub Form_MouseDown(Button As Integer,Shift As Integer,X As Single,Y As Single) Dim i As Long npoint = 0 LineDDA 20,20,AddressOf LineDDAProc,0 '枚举线段上每一个点 For i = 0 To npoint - 1 '对比各点是否与点击处相等,相等,说明该点在线上 If X = px(i) And Y = py(i) Then MsgBox "OK" End If Next End Sub Private Sub Form_Paint() Me.ScaleMode = vbPixels Line (20,20)-(200,200) End Sub
=================================================
(二)判断点是否在一个区域内
应用:是否在某行政区域地图中;创建不规则按钮时,当在其内时显示不同的效果
PtInRegion : Point In Region
Private Declare Function PtInRegion _
Lib "gdi32" (ByVal hRgn As Long,_
ByVal y As Long) As Long
hRgn: Handle of Region 区域句柄。需要建立和取得
(x,y) : 点的位置
返回值:(x,y)在区域hRgn内,为真,值不为0;否则为假为0
建立区域和返回区域句柄:
CreateRectRgn 建立矩形区域,并传回hRegion
CreateRoundRectRgn 建立圆角矩形区域,并传回hRegion
CreateEllipiseRgn 建立圆形(椭圆)区域,并传回hRegion
CreatePolygonRgn 建立多边开区域,并传回hRegion
具体看一下:
1、CreateRectRgn
Private Declare Function CreateRectRgn _
Lib "gdi32" (ByVal X1 As Long,_
ByVal Y2 As Long) As Long
对比一下建立矩形图形:
Private Declare Function Rectangle _
Lib "gdi32" (ByVal hdc As Long,_
ByVal Y2 As Long) As Long
只是少了一个hdc。
2、CreateRoundRectRgn
Private Declare Function CreateRoundRectRgn _
Lib "gdi32" (ByVal X1 As Long,_
ByVal Y3 As Long) As Long
同样对比一下建立圆角矩形“图形”的API
Private Declare Function RoundRect _
Lib "gdi32" (ByVal hdc As Long,_
ByVal Y3 As Long) As Long
也是少了一个hdc,圆角处都是(x3,y3)来控制
3、CreateEllipiseRgn
Private Declare Function CreateEllipticRgn _
Lib "gdi32" (ByVal X1 As Long,_
ByVal Y2 As Long) As Long
对比Ellipise
Private Declare Function Ellipse _
Lib "gdi32" (ByVal hdc As Long,_
ByVal Y2 As Long) As Long
嗯,仍少了hdc
4、CreatePolygonRgn
Private Declare Function CreatePolygonRgn _
Lib "gdi32" (lpPoint As POINTAPI,_
ByVal nCount As Long,_
ByVal nPolyFillMode As Long) As Long
对比Polygon
Private Declare Function Polygon _
Lib "gdi32" (ByVal hdc As Long,_
ByVal nCount As Long) As Long
噫,有点花样,除了少了hdc外,还多了一个nPolyFillMode
实际上并没有啥新的,nPolyFillMode就是SetPolyFillMode中的填充模式,
Alternate=1 不涂抹交错区域
Winding=2 涂抹交错区域(全涂)
上面建立成功后,返回区域句柄hRegion;否则返回0值
Option Explicit Private Declare Function PtInRegion _ Lib "gdi32" (ByVal hRgn As Long,_ ByVal X As Long,_ ByVal Y As Long) As Long Private Declare Function CreateEllipticRgn _ Lib "gdi32" (ByVal X1 As Long,_ ByVal Y2 As Long) As Long Private Declare Function Ellipse _ Lib "gdi32" (ByVal hdc As Long,_ ByVal Y2 As Long) As Long Private Declare Function CreatePolygonRgn _ Lib "gdi32" (lpPoint As POINTAPI,_ ByVal nCount As Long,_ ByVal nPolyFillMode As Long) As Long Private Declare Function Polygon _ Lib "gdi32" (ByVal hdc As Long,_ ByVal nCount As Long) As Long Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) 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 ALTERNATE = 1 Private Const WINDING = 2 Private Type POINTAPI X As Long Y As Long End Type Dim p(4) As POINTAPI Dim hPolyRgn As Long Private Sub Command1_Click() Dim hBrush As Long,hOldBrush As Long hBrush = CreateSolidBrush(vbRed) hOldBrush = SelectObject(Me.hdc,hBrush) Polygon Me.hdc,ByVal 5& hPolyRgn = CreatePolygonRgn(p(0),ByVal 5&,ALTERNATE) SelectObject Me.hdc,hOldBrush DeleteObject hBrush End Sub Private Sub Form_Load() p(0).X = 10 p(0).Y = 100 p(2).X = 100 p(2).Y = 10 p(4).X = 200 p(4).Y = 100 p(1).X = 150 p(1).Y = 200 p(3).X = 50 p(3).Y = 200 End Sub Private Sub Form_MouseUp(Button As Integer,Y As Single) Me.ScaleMode = vbPixels '改变X,Y为像素 If PtInRegion(hPolyRgn,X,Y) Then MsgBox "在内" Else MsgBox "不在其中" End If End Sub
如果一个区域表示一个集合,另一个区域也表示一个集合。
那么两个区域之间就会产生:交集、并集、Xor集,差集
这些行会都会因组合方式的不同而成为新的实心部分,形成另一个新的区域
CombineRgn 组合形成新区域
Private Declare Function CombineRgn _
Lib "gdi32" (ByVal hDestRgn As Long,_
ByVal hSrcRgn1 As Long,_
ByVal hSrcRgn2 As Long,_
ByVal nCombineMode As Long) As Long
hDestRgn 目的区域(最后形成的新区域)。这个必须先存在(可建立一个“空”区域,目的是获取句柄)。D
hSrcRgn 来源区域一。S1
hSrcRgn 来源区域二。S2
nCombineMode 组合方式:
Rgn_And=1 D=S1 And S2
Rgn_Or=2 D=S1 Or S2
Rgn_Xor=3 D=S1 Xor S2
Rgn_Diff=4 D=S1 - S2
Rgn_Copy=5 D=S1
返回值:0失败,非0成功即:
NullRegion=1 空集(没有交集的求交集
SimplerRegion=2 单一区域(组合后,只有一“块”区域)
ComplexRegion=3 复杂区域(多块区域,有多块区域组成一个集合)
==========================================================================
文字也作为GDI绘图的对象,如同笔刷一样。
Private Declare Function CreateFontIndirect _ Lib "gdi32" _ Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long '字型结构 Private Type LOGFONT lfHeight As Long '与VB转换,字型高度=(Font.Size*20)/Screen.TwipPerPixelY lfWidth As Long '字宽,常设置0,与高度的比例值===========等号为效果常用 lfEscapement As Long '旋转角度,1/10度为一单位。90度设置数值900。=========. lfOrientation As Long '每个字符的旋转角度。 lfWeight As Long '字体粗细,400正常,700粗体 lfItalic As Byte '斜体。0正常,非0斜体 lfUnderline As Byte '下划线。0正常,非0加下划线 lfStrikeOut As Byte '删除线。0正常,非0加删除线 lfCharSet As Byte '字符集。Default_Charset=1,由windows来决定;0英文字型 lfOutPrecision As Byte '输出精准度,0,由windows自行决定 lfClipPrecision As Byte '描绘区边缘的准确度,0,由windows自行决定 lfQuality As Byte '输出品质,0,由windows自行决定 lfPitchAndFamily As Byte '是否为等宽字体。无作用,常由下面字型名参数决定 lfFaceName(1 To LF_FACESIZE) As Byte '字型名字。 End Type 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 Declare Sub RtlMoveMemory _ Lib "KERNEL32" (lpvDest As Any,_ lpvSource As Any,_ ByVal cbCopy As Long) Private Const LF_FACESIZE = 32 Private Const DEFAULT_CHARSET = 1 Private Sub Command1_Click() Dim font As LOGFONT Dim hOldFont As Long,hFont As Long '字符转到字节数组中 RtlMoveMemory font.lfFaceName(1),ByVal CStr(cmbFontName),LenB(StrConv(cmbFontName,vbFromUnicode)) + 1 '字体各属性设置 font.lfHeight = (Val(txtHeight) * -20) / Screen.TwipsPerPixelY '高度 font.lfWidth = (Val(txtWidth) * -20) / Screen.TwipsPerPixelY '宽度 font.lfEscapement = Val(txtRotate) * 10 '旋转角度 font.lfWeight = IIf(chkBold,700,400) '粗体 font.lfItalic = chkItalic '斜体 font.lfUnderline = chkUnderline '下划线 font.lfStrikeOut = chkStrikeThrough '删除线 font.lfCharSet = DEFAULT_CHARSET '创建字体对象并选用 hFont = CreateFontIndirect(font) hOldFont = SelectObject(Picture1.hDC,hFont) Picture1.Cls '定位 Picture1.CurrentX = Picture1.ScaleWidth / 2 Picture1.CurrentY = Picture1.ScaleHeight / 2 Picture1.Print txtString.Text SelectObject Picture1.hDC,hOldFont DeleteObject hFont End Sub Private Sub Form_Load() Dim i As Integer For i = 0 To Screen.FontCount - 1 cmbFontName.AddItem Screen.Fonts(i) '加入本机字体 Next cmbFontName.Text = "Times New Roman" End Sub
----------------------------------------------
类似Print功能
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 'nCount字串的长度,以字节计算 Private Sub Command1_Click() Dim s As String s = "中国人民解放军" TextOut Me.hdc,s,LenB(StrConv(s,vbFromUnicode)) '须转换 End Sub
注意:文字是当作一幅“画”在看侍
'在指定区域内输出文字。 '如果指定区域设置小了,文字超过后就不会显示出来 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 'wFormat文字输出格式,DT即Draw Text Private Const DT_BOTTOM = &H8 '靠底输出,必须与DT_SINGLELINE配合(用OR) Private Const DT_CENTER = &H1 '居中 Private Const DT_CALCRECT = &H400 '自动计算(调整)输出区域的大小 Private Const DT_EXPANDTABS = &H40 '将Tab字符视为定位点 Private Const DT_EXTERNALLEADING = &H200 '包含行间距 Private Const DT_LEFT = &H0 '居左 Private Const DT_NOCLIP = &H100 '文字输出不受限于输出区域 Private Const DT_NOPREFIX = &H800 '不处理前导字符&。若不指定,会把紧跟的字母加下划线(类似定义菜单快捷键) Private Const DT_RIGHT = &H2 '居右 Private Const DT_SINGLELINE = &H20 '单行输出 Private Const DT_TABSTOP = &H80 '设置定位点,wFormat中高字节8-15位表示定位点的宽度(默认8) Private Const DT_TOP = &H0 '居上,须与DT_SINGLELINE配合 Private Const DT_VCENTER = &H4 '垂直居中,须与DT_SINGLELINE配合 Private Const DT_WORDBREAK = &H10 '超过右边界时,自动换行 Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Sub Command1_Click() Dim s As String,r As RECT s = "API(ApplicationProgrammingInterface,应用程序编程接口)是一些预先定义的函数,目的是" r.Left = 10 r.Top = 10 r.Bottom = 100 r.Right = 100 '下面会显示不全,可用DT_WORDBREAK代替wFormat自动换行,可用DT_NOCLIP不受矩形区域限制直接输出 DrawText Me.hdc,vbFromUnicode)),r,DT_BOTTOM Or DT_SINGLELINE End Sub
区域的大小判断时,可用API: GetTextExtentPoint32 来取得文字输出区域的宽和高,从而为设置区域定下标准
'计算字串所点区域大小, Private Declare Function GetTextExtentPoint32 _ Lib "gdi32" _ Alias "GetTextExtentPoint32A" (ByVal hdc As Long,_ ByVal lpsz As String,_ ByVal cbString As Long,_ lpSize As Size) As Long '取得值在最后一个参数,它指明区域范围。cbString是以字节为单位计算字串长度 Private Type Size cx As Long '宽 cy As Long '高 End Type
比较有意思的是:DrawText含 有一个自动计算功能。只要告诉某些参数,就可以计算出相应的区域大小,进行自动填写。
dim r as rect
r.top=10
r.left=10
DrawText me.hdc,len(s),DT_CALCRECT
这样,区域只定了左上角点,但它会自动计算S得出右下角点,并填充到R相应值中。注意这是假定单行时。
若要多行,则需再指定一个值。如果我们再指定一个右边R.right,则会自动计算下界并填充。同理,再指定下界,会自动计算右界并填充。
原文链接:https://www.f2er.com/vb/258849.html