|
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal _
lpWindowName As String) As Long
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 SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal _
hWnd As Long) As Long
Private Const GWL_STYLE As Long = -16
Private Const GWL_EXSTYLE As Long = (-20)
Private Const WS_EX_DLGMODALFRAME As Long = &H1
Private Const WM_SETICON = &H80
Private hWndForm As Long
Private bIcon As Boolean
Private Sub UserForm_Initialize()
imgIcon.Visible = False
If Val(Application.Version) >= 9 Then
hWndForm = FindWindow("ThunderDFrame", Me.Caption)
Else
hWndForm = FindWindow("ThunderXFrame", Me.Caption)
End If
bIcon = True
ChangeIcon
SetUserFormStyle
End Sub
Private Sub SetUserFormStyle()
Dim frmStyle As Long
If hWndForm = 0 Then Exit Sub
frmStyle = GetWindowLong(hWndForm, GWL_EXSTYLE)
If bIcon Then
frmStyle = frmStyle And Not WS_EX_DLGMODALFRAME
Else
frmStyle = frmStyle Or WS_EX_DLGMODALFRAME
End If
SetWindowLong hWndForm, GWL_EXSTYLE, frmStyle
DrawMenuBar hWndForm
End Sub
Private Sub ChangeIcon()
Dim hIcon As Long
On Error Resume Next
If hWndForm <> 0 Then
If bIcon Then
hIcon = imgIcon.Picture
Else
hIcon = 0
End If
SendMessage hWndForm, WM_SETICON, True, hIcon
SendMessage hWndForm, WM_SETICON, False, hIcon
End If
End Sub
Private Sub optIconOn_Click()
bIcon = True
ChangeIcon
SetUserFormStyle
End Sub
Private Sub optIconOff_Click()
bIcon = False
ChangeIcon
SetUserFormStyle
End Sub
|
|