UserForm ohne Titelzeile anzeigen

UserForm ohne die Titelzeile anzeigen: FindWindow, GetWindow, GetWindowRect, ReleaseCapture, CreateRectRgn
Das läuft nur in VBA-Excel... Das läuft nur in VB 6.0...
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
lpRect As RECT) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
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 CreateRectRgn Lib "gdi32" (ByVal X1 As Long, _
ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, _
ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private HauptfensterNr&, ClientfensterNr& Public HauptfensterNr&, ClientfensterNr&
Private dummy As Long, FensterRegion&, Region& Public dummy As Long, FensterRegion&, Region&
Private Type RECT Public Type RECT
Left As Long Left As Long
Top As Long Top As Long
Right As Long Right As Long
Bottom As Long Bottom As Long
End Type End Type
Private Const GW_CHILD = 5 Public Const GW_CHILD = 5
Private Const WM_NCLBUTTONDOWN = &HA1 Public Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2 Public Const HTCAPTION = 2
Sub FensterOhneKopf() Sub FensterOhneKopf()
Dim Abmessung As RECT, Abmessung1 As RECT Dim Abmessung As RECT, Abmessung1 As RECT
Dim Pos1x&, Pos1y&, Pos2x&, Pos2y& Dim Pos1x&, Pos1y&, Pos2x&, Pos2y&
UserForm1.BorderStyle = fmBorderStyleSingle frmOhneKopf.BorderStyle = 1
Call FensterNr(UserForm1, Abmessung, Abmessung1) Call FensterNr(frmOhneKopf, Abmessung, Abmessung1)
Pos1x = 0 Pos1x = 0
Pos1y = (Abmessung1.Top - Abmessung.Top) Pos1y = (Abmessung1.Top - Abmessung.Top)
Pos2x = Abmessung.Right - Abmessung.Left Pos2x = Abmessung.Right - Abmessung.Left
Pos2y = Abmessung.Bottom - Abmessung.Top Pos2y = Abmessung.Bottom - Abmessung.Top
Region = CreateRectRgn(Pos1x, Pos1y, Pos2x, Pos2y) Region = CreateRectRgn(Pos1x, Pos1y, Pos2x, Pos2y)
''zum Abschneiden oder Hinzufügen des Formularrandes.. ''zum Abschneiden oder Hinzufügen des Formularrandes...
'Region = CreateRectRgn(Pos1x - 3, Pos1y, Pos2x + 2, Pos2y - 2) 'Region = CreateRectRgn(Pos1x + 5, Pos1y - 10, Pos2x + 5, Pos2y - 10)
FensterRegion = SetWindowRgn(HauptfensterNr, Region, True) FensterRegion = SetWindowRgn(HauptfensterNr, Region, True)
End Sub End Sub
'Fensterhandles und Infos über Fenster holen 'Fensterhandles und Infos über Fenster holen
Sub FensterNr(Form As Object, Abmessung As RECT, _ Sub FensterNr(Form As Object, Abmessung As RECT, _
Abmessung1 As RECT) Abmessung1 As RECT)
Dim Fenstername$, Suchstring$ Dim Fenstername$, Suchstring$
Suchstring = "UserForm ohne Titelzeile" Suchstring = "UserForm ohne Titelzeile"
Fenstername = Form.Caption Fenstername = Form.Caption
Form.Caption = Suchstring Form.Caption = Suchstring
HauptfensterNr = FindWindow(vbNullString, Suchstring) HauptfensterNr = FindWindow(vbNullString, Suchstring)
Form.Caption = Fenstername Form.Caption = Fenstername
ClientfensterNr = GetWindow(HauptfensterNr, GW_CHILD) ClientfensterNr = GetWindow(HauptfensterNr, GW_CHILD)
dummy = GetWindowRect(HauptfensterNr, Abmessung) dummy = GetWindowRect(HauptfensterNr, Abmessung)
dummy = GetWindowRect(ClientfensterNr, Abmessung1) dummy = GetWindowRect(ClientfensterNr, Abmessung1)
End Sub End Sub
Das steht in der UserForm... Das steht in der UserForm...
'Folgendes ist notwendig, um die Form ohne Titelleiste zu verschieben 'Folgendes ist notwendig, um die Form ohne Titelleiste zu verschieben
Sub UserForm_MouseDown(ByVal Button As Integer, _ Sub Form_MouseDown(Button As Integer, Shift As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) X As Single, Y As Single)
If Button = 1 Then If Button = 1 Then
If HauptfensterNr <> 0 Then If HauptfensterNr <> 0 Then
dummy = ReleaseCapture() dummy = ReleaseCapture()
dummy = SendMessage(HauptfensterNr, WM_NCLBUTTONDOWN, _ dummy = SendMessage(HauptfensterNr, WM_NCLBUTTONDOWN, _
HTCAPTION, 0) HTCAPTION, 0)
End If End If
End If End If
End Sub End Sub
Sub CommandButton1_Click() Sub Form_Load()
Unload Me Text1.Visible = True
End Sub End Sub
Sub UserForm_Initialize() Sub lblKopf_MouseDown(Button As Integer, Shift As Integer, _
Call FensterOhneKopf X As Single, Y As Single) 'das geht auch mit dem Label...
End Sub If Button = 1 Then
If HauptfensterNr <> 0 Then
dummy = ReleaseCapture()
dummy = SendMessage(HauptfensterNr, WM_NCLBUTTONDOWN, _
HTCAPTION, 0)
End If
End If
End Sub
Sub Option1_Click()
Unload Me
frmOhneKopf.Show
End Sub
Sub Option2_Click()
Call FensterOhneKopf
Text1.Visible = False
End Sub
Sub Command1_Click()
Unload Me
End Sub

Mehr Tipps: Anzeigen von langen ListBox-Einträgen als ToolTip

Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt