VB无控件美化与窗口状态管理

美化皮肤和界面

=====窗体的三种状态===

WindowState = 0 '默认窗体

WindowState = 1 '最小化

WindowState = 2 '最大化

===记录窗体信息====

'定义全体变量

Dim MaxWindow As Boolean, myHeight As Integer, myWidth As Integer

'记录相关信息

If MaxWindow = False Then

myHeight = Form1.Height

myWidth = Form1.Width

WindowState = 2

MaxWindow = True

Else

WindowState = 0

Form1.Height = myHeight

Form1.Width = myWidth

MaxWindow = False

End If

=====按钮的三种状态====

'按下object控件时

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

Image1.Picture = LoadPicture(App.Path & "Down.jpg")

End Sub

'移动object控件时

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

Image1.Picture = LoadPicture(App.Path & "Move.jpg")

End Sub

'弹起object控件时

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

Image1.Picture = LoadPicture(App.Path & "Normal.jpg")

End Sub

====窗口的移动===

'API函数定义

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_SYSCOMMAND = &H112

Private Const SC_MOVE = &HHF010

Private Const WM_NCLBUTTONDOWN = &HA1

Private Const HTCAPTION = 2

'当按下object控件时，开始移动窗口

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

ReleaseCapture

SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0

End Sub

=====半透明窗体====

'API函数定义

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 Const WS_EX_LAYERED = &H80000

Private Const GWL_EXSTYLE = (-20)

Private Const LWA_ALPHA = &H2

Private Const LWA_COLORKEY = &H1

'透明度设定

Private Sub Form_Load()

Dim rtn As Long

rtn = GetWindowLong(hwnd, GWL_EXSTYLE)

rtn = rtn Or WS_EX_LAYERED

SetWindowLong hwnd, GWL_EXSTYLE, rtn

SetLayeredWindowAttributes hwnd, 0, !XXX!, LWA_ALPHA

End Sub

=====窗口的放置===

'API函数定义

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)

'窗口置前

Dim myval = SetWindowPos(Form1.hwnd, -1, 0, 3)

'窗口正常

Dim myval = SetWindowPos(Form1.hwnd, -2, 0, 3)

'窗口置后

Dim myval = SetWindowPos(Form1.hwnd, 1, 0, 3)