Windows API函数调用范例源码大全(一) -- 完全自定义窗体和按钮

来源:互联网 发布:动量交易系统 源码 编辑:程序博客网 时间:2024/05/22 14:20

以前是一直是用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

原创粉丝点击