Userform ohne schliessen Kreuz mit Logo

Tech-Archive recommends: Fix windows errors by optimizing your registry

Hallo NG

ich habe viel gegoogelt und dabei folgende Funktion gefunden:

"Das schliessen Kreuz beim Userform ausblenden ":

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 DrawMenuBar Lib "user32" (ByVal _
     hwnd As Long) As Long

Private Const GWL_STYLE As Long = -16
Private Const WS_SYSMENU As Long = &H80000

Private hWndForm As Long
Private bCloseBtn As Boolean

Private Sub UserForm_Initialize()
 If Val(Application.Version) >= 9 Then
   hWndForm = FindWindow("ThunderDFrame", Me.Caption)
 Else
   hWndForm = FindWindow("ThunderXFrame", Me.Caption)
 End If

 bCloseBtn = False
 SetUserFormStyle

End Sub

Private Sub SetUserFormStyle()
' Unterdrückung des "schließen Kreuzes" in Userform
 Dim frmStyle As Long

 If hWndForm = 0 Then Exit Sub

 frmStyle = GetWindowLong(hWndForm, GWL_STYLE)

 If bCloseBtn Then
   frmStyle = frmStyle Or WS_SYSMENU
 Else
   frmStyle = frmStyle And Not WS_SYSMENU
 End If

 SetWindowLong hWndForm, GWL_STYLE, frmStyle

 DrawMenuBar hWndForm
End Sub

Funktioniert super auch wenn es von einer VB Seite ist !

Nun gibt es eine weitere Funktion: "Eigenes Logo in Userform"

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
Image2.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


Wie bekomme ich die beiden kombiniert ?
Die API Deklarationen scheinen gleich zu sein, dennoch gelingt es mir nicht
die Aufrufe zu kombinieren, oder schliessen sie sich aus ?

Danke im Voraus

Gruß Klaus
.

Relevant Pages

  • Re: Sendmessage using dot net
    ... (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, _ ... ByVal lParam As String) As Integer ... Dim nSize As Integer ... Private Declare Function GetDesktopWindow Lib "user32" As Long ...
    (microsoft.public.dotnet.languages.vb)
  • Re: Multiple Instance of a form limite
    ... ByVal lpString As String, _ ... Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As ... Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd ... Dim strName As String * 255 ...
    (comp.databases.ms-access)
  • Re: Using Hyperlinks within Userforms
    ... (ByVal hWnd As Long, _ ... ByVal lpOperation As String, _ ... Public Sub OpenFile ... Const HWND_NOTOPMOST = -2 ...
    (microsoft.public.excel)
  • Re: eVB coding ways
    ... Public Declare Function GetWindowLong Lib "Coredll" Alias ... "GetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long) As Long ...
    (microsoft.public.pocketpc.developer)
  • Re: defining a range for entered data
    ... (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) ... Public Sub SetTxtBoxNumeric(txtTextBox As TextBox) ... Dim lngHand As Long ...
    (microsoft.public.vb.general.discussion)