从VB 6到VB.NET——窗体特殊应用

李洪根

一、摘要

VB .NET做为VB6的升级版本，具备了许多新的功能，它可以简便快捷地创建 .NET 应用程序（包括 XML Web services 和 ASP.NET Web 应用程序），还是一个功能强大的面向对象的编程语言（如继承、接口和重载）。新的语言功能包括自由线程处理和结构化异常处理。VB.NET 还完全集成了.NET 框架和公共语言运行库，.NET 框架和公共语言运行库共同提供语言互操作性、垃圾回收、增强的安全性和改进的版本支持。可以说是一个划时代的产品！

从VB6到VB.NET的开发过程中，窗体应用始终是一个永恒的话题。任何一个WINDOWS的应用程序，都与窗体密切相关，在许多场合，我们都需要对窗体进行一些特殊的设置或操作，本文用VB6和VB.NET相结合，来说明窗体应用的特殊问题及处理，以及VB.NET给我们带来的新的功能！

二、正文

1、创建特殊形状的窗体

我们还是来看一下在VB6中的实现，VB6中实现（借助API函数）

做一个古怪的窗口必须要用的也是此程序中最重要的一个函数就是SetWindowRgn

它的功能就是对指定的窗口进行重画，把这个窗口你选择的部分留下其余的部分抹掉

参数：hWnd：你所要重画的窗口的句柄，比如你想重画form1则应该让此参数为form1.hWnd

hRgn：你要保留的区域的句柄，这个句柄是关键，你需要通过别的渠道来获得

在这里的区域是由Combinergn合成的新区域

bRedram：是否要马上重画，一般设为true

函数CombineRgn将两个区域组合为一个新区域

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

函数CreateEllipticRgn为创建一个X1，Y1和X2，Y2的椭圆区域

用DeleteObject这个函数可删除GDI对象，比如画笔、刷子、字体、位图、区域以及调色板等等。对象使用的所有系统资源都会被释放

以下是VB6的代码：

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 CreateRectRgn 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

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

Private Const RGN_DIFF = 4

Private Sub Form_Load()

Dim rgn As Long

Dim rgnRect As Long

Dim rgnDest As Long

rgn = CreateEllipticRgn(0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY)

rgnRect = CreateRectRgn((Me.Width / Screen.TwipsPerPixelX - 20) / 2, (Me.Height / Screen.TwipsPerPixelY - 20) / 2, (Me.Width / Screen.TwipsPerPixelX + 20) / 2, (Me.Height / Screen.TwipsPerPixelY + 20) / 2)

rgnDest = CreateRectRgn(0, 0, 1, 1)

CombineRgn rgnDest, rgn, rgnRect, RGN_DIFF

SetWindowRgn Me.hWnd, rgnDest, True

Call DeleteObject(rgnRect)

Call DeleteObject(rgnDest)

End Sub

Private Sub Command1_Click()

End

End Sub

在VB.NET中，我们可以使用.NET 框架类库System.Drawing.Drawing2D的GraphicsPath 类（应用程序使用路径来绘制形状的轮廓、填充形状内部和创建剪辑区域），来绘制图形，

然后通过窗体的Me.Region来设置窗口的可见区域。

以下是VB.NET的代码：

'声明一个布尔型变量,判断窗体是否正常区域

Dim IsNormalRegion As Boolean = True

Private Sub Button2_Click(ByVal sender As System.Object, _

ByVal e As System.EventArgs) Handles Button2.Click

If (IsNormalRegion) Then

'构造一个GraphicsPath对象实例

Dim Graphics As New System.Drawing.Drawing2D.GraphicsPath()

Dim intHeight As Integer = Me.Size.Height

Dim intWidth As Integer = Me.Size.Width

'定义内矩形的左上角坐标

Dim RectTop As Integer = 100

'在窗体上绘制一个大椭圆，左上角的坐标取为（0，0）

Graphics.AddEllipse(0, 0, intWidth, intHeight)

'再绘制一个小矩形

Dim AddRect As New Rectangle(RectTop, RectTop, intHeight - (RectTop * 2), intHeight - (RectTop * 2))

Graphics.AddRectangle(AddRect)

'设置窗口的可见区域

Me.Region = New Region(Graphics)

Else

Me.Region = Nothing

End If

IsNormalRegion = Not IsNormalRegion

End Sub

程序运行的结果如下：

2、使窗体在其他所有窗体之上(Allway On Top)

VB6中实现（借助API函数SetWindowPos）

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _

ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _

ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

---- hWnd变元是窗口的句柄；x，y是窗口的左上角的坐标；cx、cy是窗口宽度和高度；hWndInsertAfter变元是窗口清单中hWnd窗口前面的窗口句柄，有四个可选值：

序号可选值作用

1 HWND_BOTTOM 把窗口放在窗口清单的底部

2 HWND_TOP 把窗口放在窗口清单的字符顺序的顶部

3 HWND_TOPMOST 把窗口放在窗口清单的顶部

4 HWND_NOTOPMOST 把窗口放在窗口清单的顶部，最上层窗口之下

---- WFlags变元为整型值，有八个可选值：

序号可选值作用

1 SWP_DRAWFRAME 在窗口周围画一个方框

2 SWP_HIDEWINDOW 隐藏窗口

3 SWP_NOACTIVATE 不激活窗口

4 SWP_NOMOVE 保持窗口当前位置

5 SWP_NOREDRAW 窗口不自动重画

6 SWP_NOSIZE 保持窗口当前尺寸

7 SWP_NOZORDER 保持窗口在窗口清单中的当前位置

8 SWP_SHOWWINDOW 显示窗口

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _

ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _

ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const SWP_NOMOVE = 2

Private Const SWP_NOSIZE = 1

Private Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE

Private Const HWND_TOPMOST = -1

Private Const HWND_NOTOPMOST = -2

Private Sub Command1_Click()

'把窗体放在最前面：

res% = SetWindowPos(Form1.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)

End Sub

Private Sub Command2_Click()

'使窗体恢复普通模式：

res% = SetWindowPos(Form1.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)

End Sub

在VB.NET中，太简单了！系统为窗体提供了TopMost属性，我们将TopMost属性设置为True，就实现了Allways On Top 的功能，要取消此功能，设置为False即可。

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

Me.TopMost = True

End Sub

3、窗体透明度渐变效果

我们还是来看一下在VB6中的实现，VB6中实现（借助API函数SetLayeredWindowAttributes）

使用这个函数，可以轻松的控制窗体的透明度。按照微软的要求，透明窗体在创建时应使用WS_EX_LAYERED参数（用CreateWindowEx），或者在创建后设置该参数（用SetWindowLong），我选用后者。

SetLayeredWindowAttributes函数,其中hwnd是透明窗体的句柄，crKey为颜色值，bAlpha是透明度，取值范围是[0,255]，dwFlags是透明方式，可以取两个值：当取值为LWA_ALPHA时，crKey参数无效，bAlpha参数有效；当取值为LWA_COLORKEY时，bAlpha参数有效而窗体中的所有颜色为crKey的地方将变为透明。

Const LWA_COLORKEY = &H1

Const LWA_ALPHA = &H2

Const GWL_EXSTYLE = (-20)

Const WS_EX_LAYERED = &H80000

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Private Sub Form_Load()

Dim Ret As Long

'Set the window style to 'Layered'

Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE)

Ret = Ret Or WS_EX_LAYERED

SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret

'Set the opacity of the layered window to 128

'我们可以设置这个数值来控制透明程度

SetLayeredWindowAttributes Me.hWnd, 0, 128, LWA_ALPHA

End Sub

在VB.NET中，太简单了！系统为窗体提供了Opacity属性，来确定窗体的不透明和透明程度，0%为透明，100%为不透明。

以下程序通过循环显示窗体的透明度过程，为了让大家看清楚其变化，在循环过程中使用了System.Threading.Thread.Sleep来停顿。

Private Sub button1_Click(ByVal sender As System.Object, _

ByVal e As System.EventArgs) Handles button1.Click

'窗体的透明度渐变过程

button1.Enabled = False

Dim I As Double

For I = 0.01 To 1 Step 0.01

Me.Opacity = I

System.Windows.Forms.Application.DoEvents()

System.Threading.Thread.Sleep(5)

Me.Opacity = 1

button1.Enabled = True

End Sub

4、使窗体右上角的X无效，禁止Alt+F4关闭窗体

在特殊窗体的应用中，我们有时需要把窗体右上角标题栏上的关闭按钮屏幕，当用户点击其它地方（比如说一个Button）退出，那我们怎么做呢？。

我们还是来看一下在VB6中的实现，VB6中实现（借助API函数）

Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal

bRevert As Long) As Long

Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long

Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

Const MF_BYPOSITION = &H400&

Const MF_REMOVE = &H1000&

Private Sub Form_Load()

Dim hSysMenu As Long, nCnt As Long

' Get handle to our form's system menu

' (Restore, Maximize, Move, close etc.)

hSysMenu = GetSystemMenu(Me.hwnd, False)

If hSysMenu Then

' Get System menu's menu count

nCnt = GetMenuItemCount(hSysMenu)

If nCnt Then

' Menu count is based on 0 (0, 1, 2, 3...)

RemoveMenu hSysMenu, nCnt - 1, MF_BYPOSITION Or MF_REMOVE

RemoveMenu hSysMenu, nCnt - 2, MF_BYPOSITION Or MF_REMOVE ' Remove the seperator

DrawMenuBar(Me.hwnd)

' Force caption bar's refresh. Disabling X button

Me.Caption = "Try to close me!"

End If

End Sub

'如果还要屏蔽Alt+F4，加上

Private Sub Form_QueryUnload(ByVal Cancel As Integer, ByVal UnloadMode As Integer)

Cancel = 1

End Sub

在VB.NET中，这次需要借助API了，因为系统没有提供这样的类，这个例子，同时给大家提供了一个API的使用范例。（因为系统类库包装了绝大部分API，所以不推荐使用）

以下是VB.NET的代码：

'API声明

Private Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Integer, ByVal

bRevert As Long) As Integer

Private Declare Function RemoveMenu Lib "User32" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer

Private Declare Function DrawMenuBar Lib "User32" (ByVal hwnd As Integer) As Integer

Private Declare Function GetMenuItemCount Lib "User32" (ByVal hMenu As Integer) As Integer

Private Const MF_BYPOSITION = &H400&

Private Const MF_DISABLED = &H2&

Private Sub disableX(ByVal wnd As Form)

Dim hMenu As Integer, nCount As Integer

'得到系统Menu

hMenu = GetSystemMenu(wnd.Handle.ToInt32, 0)

'得到系统Menu的个数

nCount = GetMenuItemCount(hMenu)

'去除系统Menu

Call RemoveMenu(hMenu, nCount - 1, MF_BYPOSITION Or MF_DISABLED)

'重画MenuBar

DrawMenuBar(Me.Handle.ToInt32)

End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

'使用X不能用

disableX(Me)

End Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

'关闭窗口

Me.Close()

End Sub

'如果还要屏蔽Alt+F4，加上

Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)

Dim SC_CLOSE As Integer = 61536

Dim WM_SYSCOMMAND As Integer = 274

'判断是系统消息，是不是关闭窗体,使Alt+F4无效

If m.Msg = WM_SYSCOMMAND AndAlso m.WParam.ToInt32 = SC_CLOSE Then

Exit Sub

End If

MyBase.WndProc(m)

End Sub

程序运行的结果如下：

5、无标题栏的窗体的拖动问题

在特殊窗体的应用中，我们有时需要把窗体的标题栏屏蔽掉，以窗体换上自己的外壳。是，当去掉了窗体标题栏后，移动窗体就成了一个问题。

我们还是来看一下在VB6中的实现，VB6中实现（借助API函数SendMessage）

在设计时将窗体的BorderStyle属性设置为0-none

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long

Private Declare Sub ReleaseCapture Lib "User32" ()

Const WM_NCLBUTTONDOWN = &HA1

Const HTCAPTION = 2

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim lngReturnValue As Long

If Button = 1 Then

'Release capture

Call ReleaseCapture()

'Send a 'left mouse button down on caption'-message to our form

lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)

End If

End Sub

Private Sub Form_Paint()

Me.Print("Click on the form, hold the mouse button and drag it")

End Sub

在VB.NET中，这次需要借助API SendMessage 了

在设计时将Form.FormBorderStyle 属性设置为None，然后添加以下代码：

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer

Private Declare Sub ReleaseCapture Lib "User32" ()

Const WM_NCLBUTTONDOWN = &HA1

Const HTCAPTION = 2

Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown

ReleaseCapture()

SendMessage(Me.Handle.ToInt64, WM_NCLBUTTONDOWN, HTCAPTION, 0)

End Sub

三、结束语

以上实例在Windows 2000,VB6,VS.NET环境下运行通过。从以上实例，我们可以看到，以前VB6没有的好多属性和方法，在VB.NET中已经提供了出来，而且.NET提供了许多类库，可以完成在VB6中需要借助大量的API才能实现的操作。比如说构建一个多线程应用程序，用VB.NET就很容易了！更值得一提的就是，VB.NET是完全的面向对象，更加容易封装我们的业务逻辑，构建N层应用程序等企业级应用。我爱VB6，更爱.NET！