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 Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_HWNDPARENT = (-8)
Private Const SM_CXICON = 11
Private Const SM_CYICON = 12
Private Const SM_CXSMICON = 49
Private Const SM_CYSMICON = 50
Private Const LR_DEFAULTCOLOR = &H0
Private Const LR_MONOCHROME = &H1
Private Const LR_COLOR = &H2
Private Const LR_COPYRETURNORG = &H4
Private Const LR_COPYDELETEORG = &H8
Private Const LR_LOADFROMFILE = &H10
Private Const LR_LOADTRANSPARENT = &H20
Private Const LR_DEFAULTSIZE = &H40
Private Const LR_VGACOLOR = &H80
Private Const LR_LOADMAP3DCOLORS = &H1000
Private Const LR_CREATEDIBSECTION = &H2000
Private Const LR_COPYFROMRESOURCE = &H4000
Private Const LR_SHARED = &H8000&
Private Const IMAGE_ICON = 1
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0
Private Const ICON_BIG = 1
Private Const GW_OWNER = 4
Private Declare Function LoadImageAsString Lib "user32" 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
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Sub SetIcon(ByVal hwnd As Long, ByVal sIconFileName As String, Optional ByVal bSetAsAppIcon As Boolean = True)
Dim lhWndTop As Long
Dim lhWnd As Long
Dim cx As Long
Dim cy As Long
Dim hIconLarge As Long
Dim hIconSmall As Long
If (bSetAsAppIcon) Then
' Find VB＇s hidden parent window:
lhWnd = hwnd
lhWndTop = lhWnd
Do While Not (lhWnd = 0)
lhWnd = GetWindow(lhWnd, GW_OWNER)
If Not (lhWnd = 0) Then
lhWndTop = lhWnd
End If
Loop
End If
cx = GetSystemMetrics(SM_CXICON)
cy = GetSystemMetrics(SM_CYICON)
hIconLarge = LoadImageAsString(App.hInstance, sIconFileName, IMAGE_ICON, cx, cy, LR_LOADFROMFILE)
If (bSetAsAppIcon) Then
SendMessageLong lhWndTop, WM_SETICON, ICON_BIG, hIconLarge
End If
SendMessageLong hwnd, WM_SETICON, ICON_BIG, hIconLarge
cx = GetSystemMetrics(SM_CXSMICON)
cy = GetSystemMetrics(SM_CYSMICON)
hIconSmall = LoadImageAsString(App.hInstance, sIconFileName, IMAGE_ICON, cx, cy, LR_LOADFROMFILE)
If (bSetAsAppIcon) Then
SendMessageLong lhWndTop, WM_SETICON, ICON_SMALL, hIconSmall
End If
SendMessageLong hwnd, WM_SETICON, ICON_SMALL, hIconSmall
End Sub
Private Sub Command1_Click()
Dim IconPath As Variant
Dim hIcon As Long
IconPath = App.Path + "\Vector.ico"
If IconPath = False Then Exit Sub
If IconPath = "" Then
hIcon = 0
ElseIf Dir(IconPath) = "" Then
hIcon = 0
ElseIf Err.Number <> 0 Then
hIcon = 0
Else
hIcon = ExtractIcon(0, IconPath, 0)
End If
Form2.Show
SetIcon Form2.hwnd, IconPath
End Sub 作者:
explor28 时间: 2008-3-15 21:34
附件:
更改图标.rar (2008-3-13 15:30, 11.14 KB) / 该附件被下载次数 452