[推荐]为VBA窗体添加最大化,最小化,图标

王咣生

5. '/                                     /'
6. '///////////////////////////////////////'
7. '
8. 'Written: Jan. 30, 2007
9. 'Author: Leith Ross
11. 'Returns an Icon from a File (.ico)
12.  Private Declare Function LoadImage _
13.   Lib "user32.dll" _
14.    Alias "LoadImageA" _
15.     (ByVal hInst As Long, _
16.      ByVal lpsz As String, _
17.      ByVal uType As Long, _
18.      ByVal cxDesired As Long, _
19.      ByVal cyDesired As Long, _
20.      ByVal fuLoad As Long) As Long
22. 'Direct System what to do with the Window
23.  Private Declare Function SendMessage _
24.   Lib "user32.dll" _
25.    Alias "SendMessageA" _
26.     (ByVal hWnd As Long, _
27.      ByVal wMsg As Long, _
28.      ByVal wParam As Long, _
29.      lParam As Long) As Long
31. 'Constants for SendMessage
32.  Const WM_GETICON As Long = &H7F
33.  Const WM_SETICON As Long = &H80
34.  Const ICON_SMALL As Long = &H0
35.  Const ICON_BIG As Long = &H1
37. 'Constants for Load Image's fuLoad Parameter (Load Resource)
38.  Const LR_DEFAULTCOLOR As Long = &H0
39.  Const LR_MONOCHROME As Long = &H1
40.  Const LR_COLOR As Long = &H2
41.  Const LR_COPYRETURNORG As Long = &H4
42.  Const LR_COPYDELETEORG As Long = &H8
43.  Const LR_LOADFROMFILE As Long = &H10
44.  Const LR_LOADTRANSPARENT As Long = &H20
45.  Const LR_DEFAULTSIZE As Long = &H40
46.  Const LR_VGACOLOR As Long = &H80
47.  Const LR_LOADMAP3DCOLORS As Long = &H1000
48.  Const LR_CREATEDIBSECTION As Long = &H2000
49.  Const LR_COPYFROMRESOURCE As Long = &H4000
50.  Const LR_SHARED As Long = &H8000
52. 'Constants for Load Image's uType Parameter
53.  Const IMAGE_BITMAP As Long = &H0
54.  Const IMAGE_ICON As Long = &H1
55.  Const IMAGE_CURSOR As Long = &H2
57. 'Constants for ShowWindow (nCmdShow)
58.  Const SW_HIDDEN As Long = 0
59.  Const SW_NORMAL As Long = 1
60.  Const SW_MINIMIZED As Long = 2
61.  Const SW_MAXIMIZED As Long = 3
62.  Const SW_NOTACTIVE As Long = 4
63.  Const SW_UNHIDDEN As Long = 5
64.  Const SW_MINWITHFOCUS As Long = 6
65.  Const SW_MINNOTACTIVE As Long = 7
66.  Const SW_RESTORE As Long = 9
68. 'Constants for GetWindow
69.  Const GW_HWNDFIRST As Long = &H0
70.  Const GW_HWNDLAST As Long = &H1
71.  Const GW_HWNDNEXT As Long = &H2
72.  Const GW_HWNDPREV As Long = &H3
73.  Const GW_OWNER As Long = &H4
74.  Const GW_CHILD As Long = &H5
76. 'Window Style constants
77.  Const WS_DISABLE As Long = 0
78.  Const WS_MAXIMIZEBOX As Long = &H10000
79.  Const WS_MINIMIZEBOX As Long = &H20000
80.  Const WS_THICKFRAME As Long = &H40000    'Style to add a sizable frame
81.  Const WS_SYSMENU As Long = &H80000
82.  Const WS_ENABLE As Long = &HFFFFFFFF
83.  
84. 'Get Window Long constants
85.  Const GWL_HINSTANCE As Long = (-6)
86.  Const GWL_HWNDPARENT As Long = (-8)
87.  Const GWL_ID As Long = (-12)
88.  Const GWL_STYLE As Long = (-16)
89.  Const GWL_EXSTYLE As Long = (-20)
91. Private Declare Function GetWindowLong _
92.   Lib "user32.dll" _
93.    Alias "GetWindowLongA" _
94.     (ByVal hWnd As Long, ByVal nIndex As Long) As Long
95.                
96.  Private Declare Function SetWindowLong _
97.   Lib "user32.dll" _
98.    Alias "SetWindowLongA" _
99.     (ByVal hWnd As Long, _
100.      ByVal nIndex As Long, _
101.      ByVal dwNewLong As Long) As Long
103. 'Function to Change how Window is Displayed
104.  Private Declare Function ShowWindow _
105.   Lib "user32.dll" _
106.    (ByVal hWnd As Long, _
107.     ByVal nCmdShow As Long) As Long
109. 'Returns the Window Handle of the Active Window
110.  Private Declare Function GetActiveWindow _
111.   Lib "user32.dll" () As Long
113. 'Redraw the Icons on the Window's Title Bar
114.  Private Declare Function DrawMenuBar _
115.   Lib "user32.dll" _
116.    (ByVal hWnd As Long) As Long
118. Public Sub MinimizeWindow(Optional ByVal Window_Handle As Long, Optional ByVal With_Focus As Boolean)
119.  
120.  Dim RetVal
121.  
122.   If With_Focus = True Then
123.     RetVal = ShowWindow(Window_Handle, SW_MINWITHFOCUS)
124.   Else
125.     RetVal = ShowWindow(Window_Handle, SW_MINNOTACTIVE)
126.   End If
127.  
128. End Sub
130. Public Sub RestoreWindow(Optional ByVal Window_Handle As Long)
131.  
132.  Dim RetVal
133.  
134.   RetVal = ShowWindow(Window_Handle, SW_NORMAL)
136. End Sub
139. Public Sub AddMinBox(Optional Window_Handle As Long)
141.  Dim hWnd As Long
142.  Dim BitMask As Long
143.  Dim WindowStyle As Long
145.    If Window_Handle = 0 Then
146.       hWnd = GetActiveWindow()
147.    Else
148.       hWnd = Window_Handle
149.    End If
150.  
151.    WindowStyle = GetWindowLong(hWnd, GWL_STYLE)
152.    BitMask = WindowStyle Or WS_MINIMIZEBOX
153.  
154.    Call SetWindowLong(hWnd, GWL_STYLE, BitMask)
155.    Call DrawMenuBar(hWnd)
157. End Sub
159. Public Sub AddMaxBox(Optional Window_Handle As Long)
161.  Dim hWnd As Long
162.  Dim BitMask As Long
163.  Dim WindowStyle As Long
165.    If Window_Handle = 0 Then
166.       hWnd = GetActiveWindow()
167.    Else
168.       hWnd = Window_Handle
169.    End If
170.  
171.    WindowStyle = GetWindowLong(hWnd, GWL_STYLE)
172.    BitMask = WindowStyle Or WS_MAXIMIZEBOX
174.    Call SetWindowLong(hWnd, GWL_STYLE, BitMask)
175.    Call DrawMenuBar(hWnd)
177. End Sub
178.      
179. Public Function ChangeIcon(ByVal Icon_File_Path As String, Optional ByVal Window_Handle As Long)
181.   Dim hWnd As Long
182.   Dim hIcon As Long
183.   Dim LoadMask As Long
185.     If Window_Handle = 0 Then
186.        hWnd = GetActiveWindow()
187.     Else
188.        hWnd = Window_Handle
189.     End If
190.     
191.      LoadMask = LR_LOADFROMFILE Or LR_DEFAULTSIZE Or LR_SHARED
192.      hIcon = LoadImage(0&, Icon_File_Path, IMAGE_ICON, 32, 32, LoadMask)
194.      Call SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
195.      Call DrawMenuBar(hWnd)
197. End Function
200. Private Sub UserForm_Activate()
202.     AddMinBox
203.     AddMaxBox
204.     ChangeIcon "C:\ndpsetup.ico"    '图标路径
205.     
206. End Sub

'/                                     /' '///////////////////////////////////////' ' 'Written: Jan. 30, 2007 'Author: Leith Ross 'Returns an Icon from a File (.ico)  Private Declare Function LoadImage _   Lib "user32.dll" _    Alias "LoadImageA" _     (ByVal hInst As Long, _      ByVal lpsz As String, _      ByVal uType As Long, _      ByVal cxDesired As Long, _      ByVal cyDesired As Long, _      ByVal fuLoad As Long) As Long 'Direct System what to do with the Window  Private Declare Function SendMessage _   Lib "user32.dll" _    Alias "SendMessageA" _     (ByVal hWnd As Long, _      ByVal wMsg As Long, _      ByVal wParam As Long, _      lParam As Long) As Long 'Constants for SendMessage  Const WM_GETICON As Long = &H7F  Const WM_SETICON As Long = &H80  Const ICON_SMALL As Long = &H0  Const ICON_BIG As Long = &H1 'Constants for Load Image's fuLoad Parameter (Load Resource)  Const LR_DEFAULTCOLOR As Long = &H0  Const LR_MONOCHROME As Long = &H1  Const LR_COLOR As Long = &H2  Const LR_COPYRETURNORG As Long = &H4  Const LR_COPYDELETEORG As Long = &H8  Const LR_LOADFROMFILE As Long = &H10  Const LR_LOADTRANSPARENT As Long = &H20  Const LR_DEFAULTSIZE As Long = &H40  Const LR_VGACOLOR As Long = &H80  Const LR_LOADMAP3DCOLORS As Long = &H1000  Const LR_CREATEDIBSECTION As Long = &H2000  Const LR_COPYFROMRESOURCE As Long = &H4000  Const LR_SHARED As Long = &H8000 'Constants for Load Image's uType Parameter  Const IMAGE_BITMAP As Long = &H0  Const IMAGE_ICON As Long = &H1  Const IMAGE_CURSOR As Long = &H2 'Constants for ShowWindow (nCmdShow)  Const SW_HIDDEN As Long = 0  Const SW_NORMAL As Long = 1  Const SW_MINIMIZED As Long = 2  Const SW_MAXIMIZED As Long = 3  Const SW_NOTACTIVE As Long = 4  Const SW_UNHIDDEN As Long = 5  Const SW_MINWITHFOCUS As Long = 6  Const SW_MINNOTACTIVE As Long = 7  Const SW_RESTORE As Long = 9 'Constants for GetWindow  Const GW_HWNDFIRST As Long = &H0  Const GW_HWNDLAST As Long = &H1  Const GW_HWNDNEXT As Long = &H2  Const GW_HWNDPREV As Long = &H3  Const GW_OWNER As Long = &H4  Const GW_CHILD As Long = &H5 'Window Style constants  Const WS_DISABLE As Long = 0  Const WS_MAXIMIZEBOX As Long = &H10000  Const WS_MINIMIZEBOX As Long = &H20000  Const WS_THICKFRAME As Long = &H40000    'Style to add a sizable frame  Const WS_SYSMENU As Long = &H80000  Const WS_ENABLE As Long = &HFFFFFFFF   'Get Window Long constants  Const GWL_HINSTANCE As Long = (-6)  Const GWL_HWNDPARENT As Long = (-8)  Const GWL_ID As Long = (-12)  Const GWL_STYLE As Long = (-16)  Const GWL_EXSTYLE As Long = (-20) Private Declare Function GetWindowLong _   Lib "user32.dll" _    Alias "GetWindowLongA" _     (ByVal hWnd As Long, ByVal nIndex As Long) As Long                  Private Declare Function SetWindowLong _   Lib "user32.dll" _    Alias "SetWindowLongA" _     (ByVal hWnd As Long, _      ByVal nIndex As Long, _      ByVal dwNewLong As Long) As Long 'Function to Change how Window is Displayed  Private Declare Function ShowWindow _   Lib "user32.dll" _    (ByVal hWnd As Long, _     ByVal nCmdShow As Long) As Long 'Returns the Window Handle of the Active Window  Private Declare Function GetActiveWindow _   Lib "user32.dll" () As Long 'Redraw the Icons on the Window's Title Bar  Private Declare Function DrawMenuBar _   Lib "user32.dll" _    (ByVal hWnd As Long) As Long Public Sub MinimizeWindow(Optional ByVal Window_Handle As Long, Optional ByVal With_Focus As Boolean)    Dim RetVal     If With_Focus = True Then     RetVal = ShowWindow(Window_Handle, SW_MINWITHFOCUS)   Else     RetVal = ShowWindow(Window_Handle, SW_MINNOTACTIVE)   End If   End Sub Public Sub RestoreWindow(Optional ByVal Window_Handle As Long)    Dim RetVal     RetVal = ShowWindow(Window_Handle, SW_NORMAL) End Sub Public Sub AddMinBox(Optional Window_Handle As Long)  Dim hWnd As Long  Dim BitMask As Long  Dim WindowStyle As Long    If Window_Handle = 0 Then       hWnd = GetActiveWindow()    Else       hWnd = Window_Handle    End If      WindowStyle = GetWindowLong(hWnd, GWL_STYLE)    BitMask = WindowStyle Or WS_MINIMIZEBOX      Call SetWindowLong(hWnd, GWL_STYLE, BitMask)    Call DrawMenuBar(hWnd) End Sub Public Sub AddMaxBox(Optional Window_Handle As Long)  Dim hWnd As Long  Dim BitMask As Long  Dim WindowStyle As Long    If Window_Handle = 0 Then       hWnd = GetActiveWindow()    Else       hWnd = Window_Handle    End If      WindowStyle = GetWindowLong(hWnd, GWL_STYLE)    BitMask = WindowStyle Or WS_MAXIMIZEBOX    Call SetWindowLong(hWnd, GWL_STYLE, BitMask)    Call DrawMenuBar(hWnd) End Sub       Public Function ChangeIcon(ByVal Icon_File_Path As String, Optional ByVal Window_Handle As Long)   Dim hWnd As Long   Dim hIcon As Long   Dim LoadMask As Long     If Window_Handle = 0 Then        hWnd = GetActiveWindow()     Else        hWnd = Window_Handle     End If           LoadMask = LR_LOADFROMFILE Or LR_DEFAULTSIZE Or LR_SHARED      hIcon = LoadImage(0&, Icon_File_Path, IMAGE_ICON, 32, 32, LoadMask)      Call SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)      Call DrawMenuBar(hWnd) End Function Private Sub UserForm_Activate()     AddMinBox     AddMaxBox     ChangeIcon "C:\ndpsetup.ico"    '图标路径      End Sub

jxlsp

没想到还比较麻烦.

makelovew123

不错!!!!!!!!!!

兰州人

用了API技术

robbin840311

很好，谢谢分享！

jxphklibin

程序很好，支持了！！！

dxj958

不能运行啊，运行后没反应