| 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 |
| |
zurück