如何做一个窗体，实现类似Office助手或者瑞星助手那样的透明、不规则窗体的效果？

[lily0000000]

如题

[threenewbee]

窗口剪切的具体方法

　　能够完成此任务的函数为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

[threenewbee]

仿瑞星小狮子界面源代码！

Option Explicit '函数声明
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
'GetPixel
'VB声明
'Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
'说明
'在指定的设备场景中取得一个像素的RGB值
'返回值Long，指定点的RGB颜色。如指定的点位于设备场景的剪切区之外，则返回CLR_INVALID
'参数 类型及说明
'hdc Long，一个设备场景的句柄
'x,y Long，逻辑坐标中要检查的点
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
'SetWindowRgn
'VB声明
'Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
'说明
'这是那些很难有人注意到的对编程者来说是个巨大的宝藏的隐含的API函数中的一个?本函数允许您改变窗口的区域?
'通常所有窗口都是矩形的——窗口一旦存在就含有一个矩形区域。本函数允许您放弃该区域。这意味着您可以创建圆的、星形的窗口，也可以将它分为两个或许多部分——实际上可以是任何形状
'返回值Long，执行成功为非零值，失败为0
'参数表
'参数 类型及说明
'hWnd Long，将设置其区域的窗口
'hRgn Long，将设置的区域的句柄，一旦设置了该区域，就不能使用或修改该区域句柄，也不要删除它
'bRedraw Boolean，若为TRUE，则立即重画窗口
'注解
'为区域指定的所有坐标都以窗口坐标（不是客户坐标）表示，它们以整个窗口（包括标题栏和边框）的左上角为起点

Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
'CreateRectRgn
'VB声明
'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和X2，Y2描述的矩形区域
'返回值Long，执行成功为区域句柄，失败则为零
'参数表
'参数 类型及说明
'X1,Y1 Long，矩形左上角X，Y坐标
'X2,Y2 Long，矩形右下角X，Y坐标
'注解
'不用时一定要用DeleteObject函数删除该区域
'这个矩形的下边和右边不包含在区域之内
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
'CombineRgn

'VB声明
'Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
'说明
'将两个区域组合为一个新区域
'返回值Long，下列常数之一：
'COMPLEXREGION: 区域有互相交叠的边界
'SIMPLEREGION: 区域边界没有互相交叠
'NULLREGION: 区域为空
'ERRORAPI: 不能创建组合区域
'参数表
'参数 类型及说明
'hDestRgn Long，包含组合结果的区域句柄
'hSrcRgn1 Long，源区域1
'hSrcRgn2 Long，源区域2
'nCombineMode Long，组合两区域的方法。可设为下述常数
'RGN_AND hDestRgn被设置为两个源区域的交集
'RGN_COPY hDestRgn被设置为hSrcRgn1的拷贝
'RGN_DIFF hDestRgn被设置为hSrcRgn1中与hSrcRgn2不相交的部分
'RGN_OR hDestRgn被设置为两个区域的并集
'RGN_XOR hDestRgn被设置为除两个源区域OR之外的部分


Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'DeleteObject

'VB声明
'Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'说明
'用这个函数删除GDI对象，比如画笔、刷子、字体、位图、区域以及调色板等等。对象使用的所有系统资源都会被释放
'返回值Long，非零表示成功，零表示失败
'参数表
'参数 类型及说明
'hObject Long，一个GDI对象的句柄
'注解
'不要删除一个已选入设备场景的画笔、刷子或位图。如删除以位图为基础的阴影（图案）刷子，位图不会由这个函数删除——只有刷子被删掉

Const RGN_OR = 2
Dim I As Integer, j, myint, linex As Integer
Dim Fullr, myColor, crn As Long
Dim Region, PicWidth, PicHeight As Long
Dim mystart, mybool As Boolean
Private Sub Form_Load()
Dim hdc As Long
Me.Width = Picture1.Width '设置窗体宽度等于图形宽度
Me.Height = Picture1.Height '设置窗体宽度等于图形宽度
Picture1.ScaleMode = vbPixels '设置Picture1度量单位为像素
Picture1.AutoRedraw = True '设置Picture1自动重绘有效
Picture1.AutoSize = True '设置Picture1自动调整大小
Picture1.BorderStyle = vbBSNone '设置Picture1的边框样式
Me.BorderStyle = vbBSNone '设置窗体的边框样式
hdc = Picture1.hdc
mystart = True
mybool = False
I = 0
j = 0
PicWidth = Picture1.ScaleWidth
PicHeight = Picture1.ScaleHeight
linex = 0
myColor = GetPixel(hdc, 0, 0) '获取picture1指定像素的rgb值
For j = 0 To PicHeight - 1
For I = 0 To PicWidth - 1
If GetPixel(hdc, I, j) = myColor Or I = PicWidth Then '透明像素
If mybool Then
mybool = False
crn = CreateRectRgn(linex, j, I, j - 1) '创建矩形区域
If mystart Then
Fullr = crn
mystart = False
Else
CombineRgn Fullr, Fullr, crn, RGN_OR '合并区域
DeleteObject CreateRectRgn(linex, j, I, j - 1) '删除透明区域
End If
End If
Else '非透明像素
If Not mybool Then
mybool = True
linex = I
End If
End If
Next
Next
Region = Fullr
SetWindowRgn Me.hWnd, Region, True '设置窗体区域
myint = 0
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
MsgBox "拖动还没做好！你做一下，试试看！"
Else
MsgBox "帮助还没做好！你做一下，试试看！"
End If
End Sub

Private Sub Timer1_Timer() '形成动画
Dim hdc As Long
myint = myint + 1
If myint = 1 Then Set Picture1.Picture = LoadPicture(App.Path & "\sz3.bmp")
If myint = 2 Then Set Picture1.Picture = LoadPicture(App.Path & "\sz4.bmp")
If myint = 3 Then Set Picture1.Picture = LoadPicture(App.Path & "\sz5.bmp")
If myint = 4 Then Set Picture1.Picture = LoadPicture(App.Path & "\sz6.bmp")
If myint = 5 Then myint = 0
hdc = Picture1.hdc
mystart = True
mybool = False
I = 0
j = 0
Me.Width = Picture1.Width
Me.Height = Picture1.Height
PicWidth = Picture1.ScaleWidth
PicHeight = Picture1.ScaleHeight
linex = 0
myColor = GetPixel(hdc, 0, 0) '获取picture1指定像素的rgb值
For j = 0 To PicHeight - 1
For I = 0 To PicWidth - 1
If GetPixel(hdc, I, j) = myColor Or I = PicWidth Then '透明像素
If mybool Then
mybool = False
crn = CreateRectRgn(linex, j, I, j - 1) '创建矩形区域
If mystart Then
Fullr = crn
mystart = False
Else
CombineRgn Fullr, Fullr, crn, RGN_OR '合并区域
DeleteObject CreateRectRgn(linex, j, I, j - 1) '删除透明区域
End If
End If
Else '非透明像素
If Not mybool Then
mybool = True
linex = I
End If
End If
Next
Next
Region = Fullr
SetWindowRgn Me.hWnd, Region, True '设置窗体区域
End Sub
'Private Sub Picture1_Click()
'End
'End Sub

[sdrcxzy]

如果想实现动画的效果，一般借助microsoft agent来做的。
至于图形窗体有很多例子。

[jpsr]

xp下面窗口透明用
SetLayerWindowAttrib
另外一个
SetWindowRgn