Windows API函數調用範例源碼大全(一) -- 完全自定義窗體和按鈕

以前是一直是用Dephi的,後來因爲公司緣故,改用了vb,好久才習慣過來, 使用的時候遇到一個問題,每次要調用不熟悉的API函數時,都要搜索很久用法和格式, 於是有了一個想法,寫一個實用的程序,在程序中將所有常用的API函數都囊括進去,分享出來, 讓大家也省去很多時間.

不過自己很懶也很忙,寫了一半沒了興趣,把其中一些源碼實例分享出來,留給後人去做吧,先看一個自定義窗體和按鈕的實例, 代碼很簡單, 我都註釋好了,一看就明白,下面是界面,附件裏是源代碼,直接用就是了.

self-defined windows and buttons

這裏是參考,主要看附件裏的源碼http://download1.csdn.net/down3/20070604/04153259905.zip

Option Explicit
  '-----------------------------------------------------
  'For Round Windows

  '-----------------------------------------------------
  Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
  Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
  '-----------------------------------------------------
  '獲得用戶區大小
  '-----------------------------------------------------
  Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  Private Type RECT
          Left   As Long
          Top   As Long
          Right   As Long
          Bottom   As Long
  End Type
 
  '-------------------------
'Here is for Form Drag
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 udtRect     As RECT
GetClientRect Me.hwnd, udtRect
 
Dim lngRegion     As Long
Dim lngReturn     As Long
 
lngRegion = CreateRoundRectRgn(udtRect.Left, udtRect.Top, udtRect.Right, udtRect.Bottom, 20, 20)
lngReturn = SetWindowRgn(Me.hwnd, lngRegion, True)

End Sub


'實現窗體可拖拉

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

If Button = 1 Then

Call ReleaseCapture

Call SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)

End If

End Sub

Private Sub Image4_Click()
    MsgBox "Thanks for using this programe"
End Sub

'改變按鈕圖片
Private Sub Image4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Image4.Picture = LoadPicture(App.Path + "/bb62.gif")
End Sub

'類似可實現mouseup, mousemove事件

Private Sub Image6_Click()
   Unload Me
End Sub

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章