從VB 6到VB.NET——窗體特殊應用 (轉)

從VB 6到VB.NET——窗體特殊應用 (轉)[@more@]

從6到——窗體特殊應用:namespace prefix = o ns = "urn:schemas--com::office" />

李洪根

一、  摘要

  VB做為的升級版本，具備了許多新的功能，它可以簡便快捷地建立 .NET 應用（包括 XML services 和 .NET Web 應用程式），還是一個功能強大的面向的語言（如繼承、介面和過載）。新的語言功能包括自由執行緒處理和結構化異常處理。VB.NET 還完全整合了.NET 和公共語言執行庫，.NET 框架和公共語言執行庫共同提供語言互操作性、垃圾回收、增強的性和改進的版本支援。可以說是一個劃時代的產品！

從VB6到VB.NET的開發過程中，窗體應用始終是一個永恆的話題。任何一個的應用程式，都與窗體密切相關，在許多場合，我們都需要對窗體進行一些特殊的設定或操作，本文用VB6和VB.NET相結合，來說明窗體應用的特殊問題及處理，以及VB.NET給我們帶來的新的功能！

二、正文

1、  建立特殊形狀的窗體

我們還是來看一下在VB6中的實現，VB6中實現（藉助）

做一個古怪的視窗必須要用的也是此程式中最重要的一個函式就是SetWindowRgn

它的功能就是對指定的視窗進行重畫，把這個視窗你選擇的部分留下其餘的部分抹掉

引數：hWnd：你所要重畫的視窗的控制程式碼，比如你想重畫form1則應該讓此引數為form1.hWnd

  hRgn：你要保留的區域的控制程式碼，這個控制程式碼是關鍵，你需要透過別的渠道來獲得

在這裡的區域是由Combinergn合成的新區域

  bRedram：是否要馬上重畫，一般設為true

函式CombineRgn將兩個區域組合為一個新區域

函式Createrectrgn為建立一個由點X1，Y1和X2，Y2描述的矩形區域

函式CreateEllipticRgn為建立一個X1，Y1和X2，Y2的橢圓區域

用Delete這個函式可刪除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的 類（應用程式使用路徑來繪製形狀的輪廓、填充形狀內部和建立剪輯區域），來繪製圖形，

然後透過窗體的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 SetWindowPLib "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_HWINDOW 隱藏視窗
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)

  Next

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

三、結束語

以上例項在,VB6,VS.NET環境下執行透過。從以上例項，我們可以看到，以前VB6沒有的好多屬性和方法，在VB.NET中已經提供了出來，而且.NET提供了許多類庫，可以完成在VB6中需要藉助大量的API才能實現的操作。比如說構建一個多執行緒應用程式，用VB.NET就很容易了！更值得一提的就是，VB.NET是完全的物件導向，更加容易封裝我們的業務邏輯，構建N層應用程式等企業級應用。我愛VB6，更愛.NET！