-
VB中利用API函数实现特殊窗体的两种方法
交通部水运所安全环保工程部
冯新强
---- 在VB集成开发环境(IDE)中,设计程序时所新建、添加的窗体都是矩形的。如果出于某种需要,想让窗体在运行时呈现出特殊的形状,就必须借助API函数编写相应的代码。
---- [方法一]使用区域创建函数
---- 常用的区域创建函数有:
---- CreateEllipticRgn '创建一个椭圆或圆形区域
---- CreateRoundRectRgn '创建一个圆角矩形区域
---- CreatePolygonRgn '创建一个由一系列点围成的区域
---- CombineRgn '将两个区域组合为一个新区域
---- SetWindowRgn '设置新的窗口区域。
---- 通过CombineRgn可以取两个区域的并集、交集等组合,从而创建出复杂形状的窗体。
---- 例程1得到的窗体是两个相连的月牙形:
---- '例程1
Option Explicit
'API声明
Private Declare Function CreateEllipticRgn Lib "gdi32" _
(ByVal x1 As Long, ByVal Y1 As Long, _
ByVal x2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" _
(ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, _
ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" _
(ByVal hWnd As Long, ByVal hRgn As Long, _
ByVal bRedraw As Boolean) As Long
'常数声明
Const RGN_XOR = 3
Private Sub Form_Load()
Dim x1, x2
x1 = CreateEllipticRgn(100, 100, 400, 400)
x2 = CreateEllipticRgn(200, 100, 500, 400)
CombineRgn x1, x1, x2, RGN_XOR
SetWindowRgn hWnd, x1, 1
End Sub
---- [方法二]使用BeginPath、EndPath、TextOut、PathToRegion等函数
---- BeginPath函数调用启动一个路径分支,在这个命令后执行的GDI绘图命令会自动成为路径的一部分,Windows95中合法的路径函数有文本绘图函数TextOut、绘制多边形函数Polygon等。
---- EndPath函数用于结束定义一个路径,如果调用成功,BeginPath函数和它之间发生的所有绘图操作都将在指定设备场景的路径中生效。BeginPath函数一般与EndPath函数成对出现。
---- PathToRegion函数调用将当前选定的路径转换到指定区域中。
---- TextOut函数的声明如下:
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
---- 参数说明如下:
---- hdc :设备场景的句柄 ;
---- x,y :绘图的起点,采用逻辑坐标 ;
---- lpString:欲绘制的字串 ;
---- nCount:字串中要绘制的字符数量,一个汉字的字符数量为2 。
---- 例程2生成一个宋体的“国”字形的窗体:
---- '例程2
Option Explicit
'类型声明
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'API声明
Private Declare Function BeginPath Lib "gdi32" _
(ByVal hdc 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 Declare Function EndPath Lib "gdi32" _
(ByVal hdc As Long) As Long
Private Declare Function PathToRegion Lib "gdi32" _
(ByVal hdc As Long) As Long
Private Declare Function GetRgnBox Lib "gdi32" _
(ByVal hRgn As Long, lpRect As RECT) As Long
Private Declare Function CreateRectRgnIndirect Lib "gdi32" _
(lpRect As RECT) As Long
Private Declare Function CombineRgn Lib "gdi32" _
(ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, _
ByVal hSrcRgn2 As Long, _
ByVal nCombineMode As Long) As Long
Private Const RGN_AND = 1
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" _
(ByVal hwnd As Long, ByVal hRgn As Long, _
ByVal bRedraw As Boolean) As Long
Private Declare Function ReleaseCapture Lib "user32" _
() As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
'窗体代码
Private Sub Form_Load()
Dim hRgn1, hRgn2 As Long
Dim rct As RECT
With Me
.Font.Name = "宋体"
.Font.Size = 200
.FontTransparent=true
'读者可设置为False观察其效果
End With
BeginPath hdc
'为窗体形状产生路径
TextOut hdc, 10, 10, "国", 2
EndPath hdc
hRgn1 = PathToRegion(hdc)
'将指定路径转换为区域
GetRgnBox hRgn1, rct
'获取完全包含指定区域的最小矩形
hRgn2 = CreateRectRgnIndirect(rct)
'创建rct确定的矩形区域
CombineRgn hRgn2, hRgn2, hRgn1, RGN_AND
DeleteObject hRgn1
'删除GDI对象,释放占用的系统资源
SetWindowRgn hwnd, hRgn2, 1
End Sub
Private Sub Form_MouseDown
(Button As Integer, Shift _
As Integer, X As Single, Y As Single)
'移动窗体
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN,
HTCAPTION, 0
End Sub
Private Sub Form_DblClick()
'卸载窗体
Unload Me
End Sub
---- 如果想得到各种图案窗体,可以将窗体字体属性设置为Webdings、Wingdings、Wingdings1、Wingdings2、Wingdings3、Monotype Sorts等,这些字体中包含大量的图形字符,例如,Webdings字体下,代码“TextOut hdc, 10, 10, "J", 1”可以得到风景画轮廓的窗体;Windings字体下,代码“TextOut hdc, 10, 10, "(", 1 ” 可以得到电话形状的窗体。通过Windows附件中的字符映射表能够方便地浏览或选择、复制适用的字符。需要提醒的是,程序运行的机器中必须装有该字体。
---- 对比两种方法,方法一适合于创建几何形状简单的窗体,复杂的窗体理论上虽然可以实现,但操作起来比较困难。方法二简单易行,虽然有一定的局限性,但能够使窗体具有各种字体中各个字符的形状(你甚至可以利用造字程序自己“画”一些图形),还是很令人兴奋的。
---- 创建特殊窗体时,需要注意以下几点: 1.如果窗体的Borderstyle属性没有设置为None,即使运行时标题栏不可见,但相应的键盘操作如“Alt+空格键”、“Alt+F4”等依然有效;如果Borderstyle属性为None,最小化、窗体移动、退出等功能就必须编写相应的代码来实现。当然,使用特殊窗体制做软件封面就不需要考虑那么多了。 2.因为没有常规矩形窗体的立体边框效果,窗体的背景色应尽量采用醒目的颜色。 3.特殊窗体的使用必须得当,用的好自然锦上添花,否则给人以哗众取宠之感。
冯新强
---- 在VB集成开发环境(IDE)中,设计程序时所新建、添加的窗体都是矩形的。如果出于某种需要,想让窗体在运行时呈现出特殊的形状,就必须借助API函数编写相应的代码。
---- [方法一]使用区域创建函数
---- 常用的区域创建函数有:
---- CreateEllipticRgn '创建一个椭圆或圆形区域
---- CreateRoundRectRgn '创建一个圆角矩形区域
---- CreatePolygonRgn '创建一个由一系列点围成的区域
---- CombineRgn '将两个区域组合为一个新区域
---- SetWindowRgn '设置新的窗口区域。
---- 通过CombineRgn可以取两个区域的并集、交集等组合,从而创建出复杂形状的窗体。
---- 例程1得到的窗体是两个相连的月牙形:
---- '例程1
Option Explicit
'API声明
Private Declare Function CreateEllipticRgn Lib "gdi32" _
(ByVal x1 As Long, ByVal Y1 As Long, _
ByVal x2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" _
(ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, _
ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" _
(ByVal hWnd As Long, ByVal hRgn As Long, _
ByVal bRedraw As Boolean) As Long
'常数声明
Const RGN_XOR = 3
Private Sub Form_Load()
Dim x1, x2
x1 = CreateEllipticRgn(100, 100, 400, 400)
x2 = CreateEllipticRgn(200, 100, 500, 400)
CombineRgn x1, x1, x2, RGN_XOR
SetWindowRgn hWnd, x1, 1
End Sub
---- [方法二]使用BeginPath、EndPath、TextOut、PathToRegion等函数
---- BeginPath函数调用启动一个路径分支,在这个命令后执行的GDI绘图命令会自动成为路径的一部分,Windows95中合法的路径函数有文本绘图函数TextOut、绘制多边形函数Polygon等。
---- EndPath函数用于结束定义一个路径,如果调用成功,BeginPath函数和它之间发生的所有绘图操作都将在指定设备场景的路径中生效。BeginPath函数一般与EndPath函数成对出现。
---- PathToRegion函数调用将当前选定的路径转换到指定区域中。
---- TextOut函数的声明如下:
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
---- 参数说明如下:
---- hdc :设备场景的句柄 ;
---- x,y :绘图的起点,采用逻辑坐标 ;
---- lpString:欲绘制的字串 ;
---- nCount:字串中要绘制的字符数量,一个汉字的字符数量为2 。
---- 例程2生成一个宋体的“国”字形的窗体:
---- '例程2
Option Explicit
'类型声明
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'API声明
Private Declare Function BeginPath Lib "gdi32" _
(ByVal hdc 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 Declare Function EndPath Lib "gdi32" _
(ByVal hdc As Long) As Long
Private Declare Function PathToRegion Lib "gdi32" _
(ByVal hdc As Long) As Long
Private Declare Function GetRgnBox Lib "gdi32" _
(ByVal hRgn As Long, lpRect As RECT) As Long
Private Declare Function CreateRectRgnIndirect Lib "gdi32" _
(lpRect As RECT) As Long
Private Declare Function CombineRgn Lib "gdi32" _
(ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, _
ByVal hSrcRgn2 As Long, _
ByVal nCombineMode As Long) As Long
Private Const RGN_AND = 1
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" _
(ByVal hwnd As Long, ByVal hRgn As Long, _
ByVal bRedraw As Boolean) As Long
Private Declare Function ReleaseCapture Lib "user32" _
() As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
'窗体代码
Private Sub Form_Load()
Dim hRgn1, hRgn2 As Long
Dim rct As RECT
With Me
.Font.Name = "宋体"
.Font.Size = 200
.FontTransparent=true
'读者可设置为False观察其效果
End With
BeginPath hdc
'为窗体形状产生路径
TextOut hdc, 10, 10, "国", 2
EndPath hdc
hRgn1 = PathToRegion(hdc)
'将指定路径转换为区域
GetRgnBox hRgn1, rct
'获取完全包含指定区域的最小矩形
hRgn2 = CreateRectRgnIndirect(rct)
'创建rct确定的矩形区域
CombineRgn hRgn2, hRgn2, hRgn1, RGN_AND
DeleteObject hRgn1
'删除GDI对象,释放占用的系统资源
SetWindowRgn hwnd, hRgn2, 1
End Sub
Private Sub Form_MouseDown
(Button As Integer, Shift _
As Integer, X As Single, Y As Single)
'移动窗体
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN,
HTCAPTION, 0
End Sub
Private Sub Form_DblClick()
'卸载窗体
Unload Me
End Sub
---- 如果想得到各种图案窗体,可以将窗体字体属性设置为Webdings、Wingdings、Wingdings1、Wingdings2、Wingdings3、Monotype Sorts等,这些字体中包含大量的图形字符,例如,Webdings字体下,代码“TextOut hdc, 10, 10, "J", 1”可以得到风景画轮廓的窗体;Windings字体下,代码“TextOut hdc, 10, 10, "(", 1 ” 可以得到电话形状的窗体。通过Windows附件中的字符映射表能够方便地浏览或选择、复制适用的字符。需要提醒的是,程序运行的机器中必须装有该字体。
---- 对比两种方法,方法一适合于创建几何形状简单的窗体,复杂的窗体理论上虽然可以实现,但操作起来比较困难。方法二简单易行,虽然有一定的局限性,但能够使窗体具有各种字体中各个字符的形状(你甚至可以利用造字程序自己“画”一些图形),还是很令人兴奋的。
---- 创建特殊窗体时,需要注意以下几点: 1.如果窗体的Borderstyle属性没有设置为None,即使运行时标题栏不可见,但相应的键盘操作如“Alt+空格键”、“Alt+F4”等依然有效;如果Borderstyle属性为None,最小化、窗体移动、退出等功能就必须编写相应的代码来实现。当然,使用特殊窗体制做软件封面就不需要考虑那么多了。 2.因为没有常规矩形窗体的立体边框效果,窗体的背景色应尽量采用醒目的颜色。 3.特殊窗体的使用必须得当,用的好自然锦上添花,否则给人以哗众取宠之感。
栏目列表
最新更新
python爬虫及其可视化
使用python爬取豆瓣电影短评评论内容
nodejs爬虫
Python正则表达式完全指南
爬取豆瓣Top250图书数据
shp 地图文件批量添加字段
爬虫小试牛刀(爬取学校通知公告)
【python基础】函数-初识函数
【python基础】函数-返回值
HTTP请求:requests模块基础使用必知必会
SQL SERVER中递归
2个场景实例讲解GaussDB(DWS)基表统计信息估
常用的 SQL Server 关键字及其含义
动手分析SQL Server中的事务中使用的锁
openGauss内核分析:SQL by pass & 经典执行
一招教你如何高效批量导入与更新数据
天天写SQL,这些神奇的特性你知道吗?
openGauss内核分析:执行计划生成
[IM002]Navicat ODBC驱动器管理器 未发现数据
初入Sql Server 之 存储过程的简单使用
uniapp/H5 获取手机桌面壁纸 (静态壁纸)
[前端] DNS解析与优化
为什么在js中需要添加addEventListener()?
JS模块化系统
js通过Object.defineProperty() 定义和控制对象
这是目前我见过最好的跨域解决方案!
减少回流与重绘
减少回流与重绘
如何使用KrpanoToolJS在浏览器切图
performance.now() 与 Date.now() 对比