Current News Archived News Search News Discussion Forum Old Forum Install Programs More Downloads... Troubleshooting Source Code Format Specs. Misc. Information Non-SF Stuff Links Small banner for links to this site: |
1 Attribute VB_Name = "FixWindowIcon"\r
2 Option Explicit\r
3 \r
4 Private Const WM_SETICON = &H80\r
5 Private Const ICON_SMALL = 0\r
6 Private Const IMAGE_ICON = 1\r
7 Private Const LR_DEFAULTSIZE = &H40\r
8 \r
9 Private Declare Function GetModuleHandle Lib "Kernel32.dll" _\r
10 Alias "GetModuleHandleA" _\r
11 (ByRef lpModuleName As Any) As Long\r
12 Private Declare Function LoadImage Lib "User32.dll" _\r
13 Alias "LoadImageA" ( _\r
14 ByVal hinst As Long, _\r
15 ByRef lpszName As Any, _\r
16 ByVal uType As Long, _\r
17 ByVal cxDesired As Long, _\r
18 ByVal cyDesired As Long, _\r
19 ByVal fuLoad As Long) As Long\r
20 Private Declare Function SendMessageA Lib _\r
21 "User32.dll" _\r
22 (ByVal hWnd As Long, _\r
23 ByVal Msg As Long, _\r
24 ByVal Wp As Long, _\r
25 Lp As Any) As Long\r
26 \r
27 Sub FixIcon(hWnd As Long, lpszName)\r
28 Dim hModule As Long, hIcon As Long, szName As String, nName As Long, Width As Long, Height As Long\r
29 hModule = GetModuleHandle(ByVal 0&)\r
30 If hModule = 0 Then Exit Sub\r
31 Width = Abs(GetReg("HKEY_USERS\.Default\Control Panel\Desktop\WindowMetrics\CaptionWidth", -270)) / Screen.TwipsPerPixelX - 2\r
32 Height = Abs(GetReg("HKEY_USERS\.Default\Control Panel\Desktop\WindowMetrics\CaptionHeight", -270)) / Screen.TwipsPerPixelY - 2\r
33 If VarType(lpszName) = vbString Then\r
34 szName = lpszName\r
35 hIcon = LoadImage(hModule, szName, IMAGE_ICON, Width, Height, LR_DEFAULTSIZE)\r
36 ElseIf VarType(lpszName) = vbByte Or VarType(lpszName) = vbInteger Or VarType(lpszName) = vbLong Then\r
37 nName = lpszName\r
38 hIcon = LoadImage(hModule, ByVal nName, IMAGE_ICON, Width, Height, LR_DEFAULTSIZE)\r
39 End If\r
40 If hIcon = 0 Then Exit Sub\r
41 SendMessageA hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon\r
42 End Sub\r
|