VB不规则形状窗口详细说明

鼯鼠 · 发表于 2005-9-30 13:53:00

<

>窗口剪切的具体方法
<

>　　能够完成此任务的函数为SetwindowRgn, 其共有三个参数, 第一个指定被剪切的对象的句柄,比如Picture图形框等, 如果指定为Form则即对应用程序窗口本身进行处理,第二个参数指明剪切的形状, 即指定的几何图形特征, 此参数也必须由相应的API 函数提供说明, 第三个参数是一布尔变量, 一般可设置为真(True); 在API 中有多个几何图形的说明函数, 常见的有, 具体说明见文后程序: CreateRectRgn :　　建立矩形区域,其参数分别为矩形的左上角坐标及右下角坐标;
<

>CreateRoundRectRgn:建立圆角矩形区域,其参数分别为左上角及右下角坐标, 还有圆角直径等, 当圆角直径接近或超过矩形的长度时, 将呈现为圆或椭圆形;
<

>CreateEllipticRgn :建立椭圆矩形区域,参数分别为横向与纵向直径的起点和终点;
<

>CreatePolygonRgn :建立多边形区域,参数比较复杂,因为应用的不多, 此处不再详述;
<

>　　要完成一个特殊形状窗口的设置, 需要使用区域设置函数setWindowRgn和一个几何图形说明函数, 比如一个完整的圆形窗口建立命令应该为:
<

>SetWindowRgn form1.hWnd,CreateEllipticRgn(10,0,200,200),True
<

>　　利用此方法得到特殊形状的窗口, 虽然程序运行之后将只显示为剪切后的窗口, 但其不可见部分仍然属于应用程序窗口范围之内; 由于窗口已经被剪切成固定大小和形状,所以该程序界面即使最大化之后仍只显示为有原来的尺寸,只是屏幕位置发生变化; 剪切的尺寸可以小于或大于原窗口的尺寸, 但最终显示结果只是原窗体范围之内的区域;
<

>控制异形窗口的方法
<

>　　由于大部分的异形窗口必须取消标题栏, 相应的标题栏所具有功能已经完全丧失, 比如移动、最大化或最小化等，所以在这样的应用程序中必须加入窗口的控制功能,这里推荐使用WINDOWS 的API 函数SendMessage,此函数实际上是一个WINDOWS 消息处理函数, 当用于向窗口发出控制命令时, 其第一个参数为窗口句柄hwnd, 第二个参数为WM_SYSCOMMAND(&H112), 第三个参数则为发出命令的具体内容, 第四个参数恒为0&, 常用的系统命令为:
SC_MOVE: &HF010 移动窗口 SC_MINMIZE: &HF020 最小化窗口 SC_MAXIMIZE: &HF030 最大化窗口 SC_CLOSE: &HF060 关闭窗口 SC_RESTORE &HF120 恢复窗口到原来状态
　　在无标题栏窗口中, 安排适当的按钮或菜单并使用上述的的函数向窗口发出控制命令, 即可方便地使窗口发生相应变化;
异形窗口鼠标拖动的实现
　　基本原理: 当无标题栏窗口进行鼠标拖动时, 在一个最明显的事实, 就是其鼠标在窗口中的坐标始终不变, 所以如果能够在鼠标移动过程中, 通过改变窗口在桌面上的坐标, 而始终保持鼠标的相对坐标不变, 即可实现鼠标的拖动效果; 在具体的程序设计中, 先在Mousedown() 事件中记录鼠标位置, 而在Mousemove() 事件中根据鼠标的移动距离,实时修改窗体Form的Top及Left值,即可准确无误的实现窗口的鼠标拖动操作。利用此方法实现鼠标拖动,与常规的标题栏鼠标拖动在效果上有一点区别, 因为标题栏拖动时, 鼠标移动过程中不重画窗口, 只有松开鼠标后在固定位置重画窗口, 所以其速度较快, 而采用此方法拖动过程中, 每移动一步都需要重画窗口, 对速度稍有影响,在慢一些的机器上会出现轻微的拖尾现象, 但绝不会影响正常操作,而在586以上机器上或者高速显示系统下会完全克服这种现象。在实际程序设计时,窗口中可能有多种控件,若想使鼠标拖动窗口中的任何位置都可实现窗口移动, 必须对窗口中的所有控件进行上述的鼠标位置记录与移动处理, 即在MouseDown()与MouseMove()事件中加入下面的程序代码, 当然与可以在窗口内设置一个专门用于窗口拖动的区域, 这样只对此一个控件操作即可。
完善措施
　　异形窗口界面在具体的程序编制中有很多特殊性, 这里只着重讲解一例, 在WINDOWS 95中当程序最小化时只在任务条或桌面上显示该程序的标题栏, 用VB编制的程序即使已经置为无标题栏, 但最小化时仍然显示其标题栏, 进行剪切后的窗口最小化时, 将对其标题栏进行剪切, 使标题栏不完整, 为解决这一问题, 必须正确对窗口的当前状态进行判断, 当处于最小化状态时恢复原窗口大小, 否则进行剪切, 如果把动态变化的数据送入form1.caption 之中, 最小化时还可从标题栏中得到这些变化的数据;
编程实例
　　下面是一个有趣的异形窗口程序, 它的功能是显示当前时钟, 其外形就象一个椭圆的电子表, 编制过程: 新建工程, 在窗体中放置三个命令按钮command(1-3), 分别用于移动、最小化窗口及退出程序, 再在中央放置一个标签Lable1, 用于显示当前日期和时间, 可置此标签的背景色为黑, 前景色为高亮度绿色, 并适当加大字体尺寸, 以能够显示全日期和时间为准,同时置form1 的BorderStyle属性为none即无标题栏, 最后再放置一个时间控件Timer1,然后把下述代码加到相应的事件之中, 运行程序之后, 即在椭圆的窗体内显示当前日期和时间, 通过按钮可分别控制移动和最小化等, 最小化之后将在标题栏内显示当前日期和时间, 此程序支持鼠标拖动, 用鼠标拖动窗口的任一部分都可使窗口随鼠标移动。以上方法及程序在WINDOWS 95操作系统及VB5.0环境下调试通过。
附源程序：
'API 函数申明 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 Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long,ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal x1 As Long,ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
'定义变量 Dim x1, x2, y1, y2, cx, cy, dx, dy, i, num
'结束程序 Private Sub Command1_Click() 　End End Sub
'移动窗口 Private Sub Command2_Click() 　i = SendMessage(Form1.hwnd, &H112, &HF010, 0&) End Sub
'最小化窗口 Private Sub Command3_Click() 　i = SendMessage(Form1.hwnd, &H112, &HF020, 0&) End Sub '调入代码, 实现窗口剪切等功能 Private Sub Form_Load() 　Form1.AutoRedraw = True 　Form1.ScaleMode = 3 　x1 = 0 　x2 = Form1.ScaleWidth 　y1 = 0 　y2 = Form1.ScaleHeight 　SetWindowRgn Form1.hwnd, CreateEllipticRgn(x1, y1, x2, y2), True 　cx = Form1.ScaleWidth / 2 　cy = Form1.ScaleHeight / 2 　num = Form1.ScaleHeight / Form1.ScaleWidth 　Form1.ForeColor = RGB(200, 30, 50) 　Form1.DrawWidth = 2 　Form1.Circle (cx, cy), Form1.ScaleWidth / 2 - 2, RGB(55, 220, 255), , , num 　Timer1.Enabled = True 　Timer1.Interval = 10 　Label1.BackColor = 0 　Label1.ForeColor = &HFF00& End Sub
'鼠标拖动窗口 Private Sub form_MouseMove(Button As Integer, Shift As Integer,X As Single, Y As Single) 　Dim mx, myleftDown = (Button And vbLeftButton) > 0 　　　　　rightDown = (Button And vbRightButton) > 0 　If (leftDown Or rightDown) Then 　　mx = X - dx 　　my = Y - dy 　　Form1.Left = Form1.Left + mx 　　Form1.Top = Form1.Top + my 　　Form1.CurrentX = 10 　　Form1.CurrentY = 10 　End If End Sub
' 记录当前鼠标位置 Private Sub Form_MouseDown(Button As Integer, Shift As Integer,X As Single, Y As Single) 　dx = X 　dy = Y End Sub
'实时显示时间并判断当前窗口的状态 Private Sub Timer1_Timer() 　Label1.Caption = Now 　If Form1.WindowState = 1 Then 　　SetWindowRgn Form1.hwnd, CreateRectRgn(0, 0, x2, y2), True 　　Form1.Caption = Now 　Else 　　SetWindowRgn Form1.hwnd, CreateEllipticRgn(x1, y1, x2, y2), True 　End If End Sub

帐号		自动登录	找回密码
密码			立即注册