Userform ohne schliessen Kreuz mit Logo

[Klaus Heinrich]

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

[Klaus Heinrich]

Hallo NG,

ich konnte das Problem weiter eingrenzen, bin aber noch nicht am Ziel:

Es wird offensichtlich zwei Mal "DrawMenuBar" aufgerufen, daher überschreibt
der eine den anderen.

- Die Deklaration paßt nun für beide
- Handle-Abfrage ist nun auch vereinheitlicht

Es geht nun nur noch darum im Sub "SetUserFormStyle" sowohl das
"Schließen Kreuz"
auszublenden, als auch das eigene Logo zu setzen:

Original 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

Zusätzliche Zeilen für das Logo:

hIcon = Image3.Picture
SendMessage hWndForm, &H80, True, hIcon
SendMessage hWndForm, &H80, False, hIcon
frm = GetWindowLong(hWndForm, -20)

frm = frm And Not &H1

SetWindowLong hWndForm, -20, frm
DrawMenuBar hWndForm

Wie bekomme ich die Zeilen in den Sub eingebaut ?

Danke im Voraus für Hinweise.

Gruß Klaus

[Reiner Wolff]

Moin Klaus,

*Klaus Heinrich* schrieb:

> Es wird offensichtlich zwei Mal "DrawMenuBar" aufgerufen, daher überschreibt
> der eine den anderen.

> Es geht nun nur noch darum im Sub "SetUserFormStyle" sowohl das

> "Schließen Kreuz"
> auszublenden, als auch das eigene Logo zu setzen:

Würde ich auch vermuten.

> Original 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
>
> Zusätzliche Zeilen für das Logo:
>
> hIcon = Image3.Picture
> SendMessage hWndForm, &H80, True, hIcon
> SendMessage hWndForm, &H80, False, hIcon
> frm = GetWindowLong(hWndForm, -20)
> frm = frm And Not &H1
> SetWindowLong hWndForm, -20, frm

Beide Informationen werden wohl als letzter Parameter von SetWindowLong
übergeben. Dat heißt, wenn Du in der hier letzten Zeile in der Variablen
'frm' den Schalter 'WS_SYSMENU' wieder setzt, den Du oben mit 'frmStyle'
ausgeschaltet hattest, dürfte das SystemMenü wieder angezeigt werden.

> Wie bekomme ich die Zeilen in den Sub eingebaut ?

Sorge dafür, dass die Aufrufe nicht doppelt durchgeführt werden, sondern
zusammen.

Greetinx aus Kiel
Reiner
--
Ein Programm, das du Freitags ablieferst, siehst du Montag wieder.

[Klaus Heinrich]

Hallo Reiner

danke für Dein Feedback. Es gab noch einen zweiten Fehler:
Eine Anweisung hat das Menü total ausgeschaltet, daher konnte
kein Logo dargestellt werden.

Ich hab nen coding aus Frankreich bekommen, viel weniger Zeilen
und funktioniert super. Kann ich bei Bedarf hier posten.

Schönes WE aus dem Sauerland

Gruß Klaus

Reiner Wolff schrieb:

[Reiner Wolff]

Moin Klaus,

*Klaus Heinrich* schrieb:

> Ich hab nen coding aus Frankreich bekommen, viel weniger Zeilen
> und funktioniert super. Kann ich bei Bedarf hier posten.

Ich kann's zwar grad nicht gebrauchen, aber so Du Deiner Beiträge von
Google archivieren lässt, hilft es vielleicht auch anderen in naher oder
ferner Zukunft, wenn Du Deine Lösung hier postest ;-)

Greetinx aus Kiel
Reiner
--

if (2.0 = = 1.999999963) printf("Pentium inside!\n")

[Michael Schwimmer]

Hallo Klaus,

Klaus Heinrich schrieb:

> danke für Dein Feedback. Es gab noch einen zweiten Fehler:
> Eine Anweisung hat das Menü total ausgeschaltet, daher konnte
> kein Logo dargestellt werden.

wenn das Systemmenü ausgeblendet wird, indem das Stilbit gelöscht wird,
wird auch kein Icon dargestellt.
Man kann aber auch nur einen Menüpunkt löschen, in dem Fall "Schließen".

lngSysMenu = GetSystemMenu(mlngForm, 0&)
DeleteMenu lngSysMenu, 6, MF_BYPOSITION

Das Kreuz wird dann ausgegraut dargestellt.
Das Schließen mit der Tastenkombination Alt-F4 muss aber in allen Fällen
gesondert behandelt werden, denn weder das Ausblenden des Systemmenüs,
noch eines einzelnen Punktes verhindert das.

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub

> Ich hab nen coding aus Frankreich bekommen, viel weniger Zeilen
> und funktioniert super. Kann ich bei Bedarf hier posten.

Würde mich auch interessieren.
Wenn du nicht immer ein Anzeige-Steuerelement mit einem Bild
mitschleifen willst, bietet sich die API ExtractIcon an.

strPath = Environ$("systemroot") & "\system32" & "\moricons.dll"
lngIcon = ExtractIcon(lngInst, strPath, 0)

Damit kannst du neben normalen .Ico Dateien auch die in Bibliotheken und
ausführbaren Dateien enthaltenen Icons nutzen

MfG
Michael

--
Michael Schwimmer http://michael-schwimmer.de
Excel VBA ISBN 3-8273-2183-2
Excel Programmierung - Das Handbuch ISBN 3-8606-3548-4