📄 skinmodule.bas
字号:
Attribute VB_Name = "SkinModule"
Option Explicit
' xx Used to set the shape of the form
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
' xx Used to create the rounded rectangle region
Public 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
' xx Used to make the form draggable
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
' xx Also used to make the form draggable
Public Declare Function ReleaseCapture Lib "user32" () As Long
' xx Used to make the window always on top
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, Y, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
' xx Used to get the cursor position
Public Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
' xx Various bits and pieces used by the above functions
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
Public Const TOPMOST_FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Public Type PointAPI
X As Long
Y As Long
End Type
Dim m_intResizable As Integer
Public Sub AlwaysOnTop(p_TheForm As Form, p_blnToggle As Boolean)
If p_blnToggle = True Then
SetWindowPos p_TheForm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
Else
SetWindowPos p_TheForm.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
End If
End Sub
Public Sub ChangeState(p_TheForm As Form)
If p_TheForm.WindowState = vbNormal Then
p_TheForm.WindowState = vbMaximized
p_TheForm!imgTitleMaxRestore.Picture = p_TheForm!imgTitleRestore.Picture
MakeWindow p_TheForm, False
Else
p_TheForm.WindowState = vbNormal
p_TheForm!imgTitleMaxRestore.Picture = p_TheForm!imgTitleMaximize.Picture
MakeWindow p_TheForm, IIf(m_intResizable = 1, True, False)
End If
End Sub
Public Sub DoDrag(p_TheForm As Form)
If p_TheForm.WindowState <> vbMaximized Then
ReleaseCapture
SendMessage p_TheForm.hwnd, &HA1, 2, 0&
End If
End Sub
Public Sub DoTransparency(p_TheForm As Form)
Dim alngTempRegions(6) As Long
Dim lngFormWidthInPixels As Long
Dim lngFormHeightInPixels As Long
Dim varA
' Convert the form's height and width from twips to pixels
lngFormWidthInPixels = p_TheForm.Width / Screen.TwipsPerPixelX
lngFormHeightInPixels = p_TheForm.Height / Screen.TwipsPerPixelY
' Make a rounded rectangle shaped region with the dimensions of the form
varA = CreateRoundRectRgn(0, 0, lngFormWidthInPixels, lngFormHeightInPixels, 24, 24)
' Set this region as the shape for "TheForm"
varA = SetWindowRgn(p_TheForm.hwnd, varA, True)
End Sub
Public Sub LoadSkinz(p_FrmSkin As Form)
On Error Resume Next
Dim strSkin As String
Dim ctl As Control
strSkin = GetSetting(App.Title, "Options", "Current Skin", "Blue")
For Each ctl In p_FrmSkin.Controls
If TypeOf ctl Is Image Then
If InStr(1, ctl.Name, "img", vbTextCompare) > 0 Then
'Debug.Print ctl.Name
ctl.Picture = LoadPicture(App.Path & "\Skinz\" & strSkin & "\" & ctl.Name & ".gif")
ctl.Refresh
End If
End If
Next
p_FrmSkin.imgTitleMaxRestore.Picture = p_FrmSkin.imgTitleMaximize.Picture
DoEvents
End Sub
Public Sub MakeWindow(p_TheForm As Form, p_blnIsResizable As Boolean)
Dim lngFormWidth As Long
Dim lngFormHeight As Long
Dim intTemp As Integer
' Set the Resizable variable
m_intResizable = IIf(p_blnIsResizable = True, 1, 0)
' Store the form's width and height in pixels in a variable
lngFormWidth = (p_TheForm.Width / Screen.TwipsPerPixelX)
lngFormHeight = (p_TheForm.Height / Screen.TwipsPerPixelY)
' Set various parameters of the form
p_TheForm.BackColor = RGB(192, 192, 192)
p_TheForm.Caption = p_TheForm!lblTitle.Caption
' Set the position of the title label
p_TheForm!lblTitle.Left = 16
p_TheForm!lblTitle.Top = 7
' Make the form "rounded rectangle" shaped (call to the sub below)
DoTransparency p_TheForm
'' xx Move the image blocks into place and stretch them accordingly
With p_TheForm!imgTitleLeft
.Top = 0
.Left = 0
End With
With p_TheForm!imgTitleRight
.Top = 0
.Left = lngFormWidth - 19
End With
With p_TheForm!imgTitleMain
.Top = 0
.Left = 19
.Width = lngFormWidth - 19
End With
With p_TheForm!imgWindowLeft
.Top = 30
.Left = 0
.Height = lngFormHeight - 60
End With
With p_TheForm!imgWindowBottomLeft
.Top = lngFormHeight - 30
.Left = 0
End With
With p_TheForm!imgWindowBottom
.Top = lngFormHeight - 30
.Left = 19
.Width = lngFormWidth - 38
End With
With p_TheForm!imgWindowBottomRight
.Top = lngFormHeight - 30
.Left = lngFormWidth - 19
End With
With p_TheForm!imgWindowRight
.Top = 30
.Left = lngFormWidth - 19
.Height = lngFormHeight - 38
End With
' Position the title buttons (close, minimize, help)
With p_TheForm!imgTitleClose
.Top = 8
.Left = lngFormWidth - 22
End With
With p_TheForm!imgTitleMaxRestore
.Top = 8
.Left = lngFormWidth - 39
End With
With p_TheForm!imgTitleMinimize
.Top = 8
.Left = lngFormWidth - 56
End With
With p_TheForm!imgTitleHelp
.Top = 8
.Left = lngFormWidth - 73
End With
End Sub
Public Sub ResizeForm(p_TheForm As Form, p_OldCursorPos As PointAPI, p_NewCursorPos As PointAPI, p_intResizeMode As Integer)
On Error Resume Next
Dim varDifferenceX
Dim varDifferenceY
' Put the difference between the first cursor pos and the second into variables
varDifferenceX = (p_NewCursorPos.X - p_OldCursorPos.X) * Screen.TwipsPerPixelX
varDifferenceY = (p_NewCursorPos.Y - p_OldCursorPos.Y) * Screen.TwipsPerPixelY
' Determine which resizing mode (above) has been called and resize accordingly
Select Case p_intResizeMode
Case 0
p_TheForm.Move p_TheForm.Left + varDifferenceX, p_TheForm.Top, p_TheForm.Width - varDifferenceX, p_TheForm.Height
Case 1
p_TheForm.Move p_TheForm.Left, p_TheForm.Top, p_TheForm.Width + varDifferenceX, p_TheForm.Height
Case 2
p_TheForm.Move p_TheForm.Left, p_TheForm.Top + varDifferenceY, p_TheForm.Width, p_TheForm.Height - varDifferenceY
Case 3
p_TheForm.Move p_TheForm.Left, p_TheForm.Top, p_TheForm.Width, p_TheForm.Height + varDifferenceY
Case 4
p_TheForm.Move p_TheForm.Left, p_TheForm.Top, p_TheForm.Width + varDifferenceX, p_TheForm.Height + varDifferenceY
Case 5
p_TheForm.Move p_TheForm.Left + varDifferenceX, p_TheForm.Top, p_TheForm.Width - varDifferenceX, p_TheForm.Height + varDifferenceY
Case 6
p_TheForm.Move p_TheForm.Left, p_TheForm.Top + varDifferenceY, p_TheForm.Width + varDifferenceX, p_TheForm.Height - varDifferenceY
Case 7
p_TheForm.Move p_TheForm.Left + varDifferenceX, p_TheForm.Top + varDifferenceY, p_TheForm.Width - varDifferenceX, p_TheForm.Height - varDifferenceY
End Select
MakeWindow p_TheForm, True
End Sub
Public Sub SetStateBtn(p_TheForm As Form, p_lngNewState As Long)
If p_lngNewState <> vbNormal Then
p_TheForm!imgTitleMaxRestore.Picture = p_TheForm!imgTitleRestore.Picture
Else
p_TheForm!imgTitleMaxRestore.Picture = p_TheForm!imgTitleMaximize.Picture
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -