Userform mit Icon in der Titelleiste

30.05.2002


Wenige Zeilen Code verhelfen Ihnen dazu in einer Userform
ein Icon in der Titelleiste anzeigen zu lassen.
Dazu wird lediglich eine das Image-Steuerelement benötigt,
welchem ein entsprechendes Icon zugewiesen wurde.

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 wHandle As Long
Private Sub UserForm_Initialize()
    On Error Resume Next
    Me.Caption = "Userform mit Icon"
    Image1.Visible = False
    If Val(Application.Version) >= 9 Then
        wHandle = FindWindow("ThunderDFrame", Me.Caption)
    Else
        wHandle = FindWindow("ThunderXFrame", Me.Caption)
    End If
    If wHandle = 0 Then Exit Sub
    hIcon = Image1.Picture
    SendMessage wHandle, &H80, True, hIcon
    SendMessage wHandle, &H80, False, hIcon
    frm = GetWindowLong(wHandle, -20)
    frm = frm And Not &H1
    SetWindowLong wHandle, -20, frm
    DrawMenuBar wHandle
End Sub
Beispieldatei - 12 KB