Код для управления окнами

Секция (General) (Declarations)

Option Explicit 

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 CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3
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 Type POINTAPI 
    X As Long 
    Y As Long 
End Type 
' Ограничение минимального размера окна
Const minWidth = 4800
Const minHeight = 3200

Код управления кнопками

Private Sub cmdClose_Click()
    'Здесь закрываем все, сохраняем все и выход
    End
End Sub
'
Private Sub cmdMax_Click()
    Me.WindowState = 2
    cmdMax.Visible = False
'Меняем кнопку max на resrore
    cmdRest.Visible = True
    Call RedrawMe

End Sub

'
Private Sub cmdMin_Click()
    Me.WindowState = 1

End Sub

'
Private Sub cmdRest_Click()
    Me.WindowState = 0
    cmdRest.Visible = False 'Меняем кнопку resrore на max
    cmdMax.Visible = True
    Call RedrawMe
End Sub
 
' Заставляем форму реагировать на изменение размеров

Private Sub Form_Resize() 
    On Error Resume Next 'Игнорируем встроенные ошибки от Майкрософт. 
    'Ограничиваем минимальный размер окна
    If Me.Width < minWidth Then Me.Width = minWidth 
    If Me.Height < minHeight Then Me.Height = minHeight 
    Dim newRgn As Long 
    'Создаем новый регион для окна, если решили оставить окно прямоугольным, то эта функция не
нужна
    'Можно вообще создавать полигон произвольной формы с помощью функций Api 
    newRgn = CreateRoundRectRgn(0, 0, Width / Screen.TwipsPerPixelX, Height / Screen.TwipsPerPixelY,
1.5 * Screen.TwipsPerPixelX, 1.5 * Screen.TwipsPerPixelY) 
    'параметры: Left, Top, Width, Heigth, width для углового эллипса, higth для углового эллипса
    Call SetWindowRgn(hWnd, newRgn, True) 
    Call RedrawMe 

End Sub


' Таскаем форму по экрану за заголовок

Private Sub imgTopHead_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single) 
    If Me.WindowState <> 0 Then Exit Sub ' Не допускаем
изменение положение окна если оно распахнуто 
    ReleaseCapture
SendMessage Me.hWnd, &H112, &HF012, 0 
    Call RedrawMe 

End Sub 
' Дублирующая процедура если курсор попал на заголовок
Private Sub FormCapt_MouseDown(Button As Integer, Shift As Integer, X As Single, Y
As Single) 
    If Me.WindowState <> 0 Then Exit Sub ' Не допускаем
изменение положение окна если оно распахнуто 
    ReleaseCapture
SendMessage Me.hWnd, &H112, &HF012, 0 
    Call RedrawMe 

End Sub
 


' Изменяем размер и положение окна таская за нижние углы окна и боковые и нижнюю рамку

Private Sub imgDnLt_MouseDown(Button As Integer, Shift As Integer, X As Single, Y
As Single) 
    If Me.WindowState <> 0 Then Exit Sub ' Не допускаем
изменение положение окна если оно распахнуто 
    ReleaseCapture 
    SendMessage Me.hWnd, &H112, &HF008, 0 
    Call RedrawMe 

End Sub 
'
Private Sub imgFrameDn_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    If Me.WindowState <> 0 Then Exit Sub ' Не допускаем
изменение положение окна если оно распахнуто 
    ReleaseCapture 
    SendMessage Me.hWnd, &H112, &HF006, 0 
    Call RedrawMe 

End Sub  
'


Private Sub imgFrameLt_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single) 
    If Me.WindowState <> 0 Then Exit Sub ' Не допускаем
изменение положение окна если оно распахнуто 
    ReleaseCapture 
    SendMessage Me.hWnd, &H112, &HF002, 0 
    Call RedrawMe 

End Sub 
'


Private Sub imgFrameRt_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single) 
    If Me.WindowState <> 0 Then Exit Sub ' Не допускаем
изменение положение окна если оно распахнуто 
    ReleaseCapture 
    SendMessage Me.hWnd, &H112, &HF002, 0 
    Call RedrawMe 

End Sub 
'


Private Sub imgDnRt_MouseDown(Button As Integer, Shift As Integer, X As Single, Y
As Single) 
    If Me.WindowState <> 0 Then Exit Sub ' Не допускаем
изменение положение окна если оно распахнуто 
    ReleaseCapture 
    SendMessage Me.hWnd, &H112, &HF008, 0 
    Call RedrawMe 

End Sub 


'Собственно процедура перерисовывающая окно при изменении размеров

Private Sub RedrawMe() 
    Dim i As Integer, k As Integer 
    'рисуем заголовок 
    imgTopHead.Width = Me.Width 
    imgTopHead.DrawWidth = Screen.TwipsPerPixelX 
    imgTopHead.ScaleWidth = 255
'левый угол если размеры вашей картинки отличается установите свое значение
    ' левый угол
    imgTopLt.Move 0, 0 
    'правый угол 
    imgTopRt.Move Me.Width - imgTopRt.Width - Screen.TwipsPerPixelX, 0 
    'Кнопки в заголовке 
    cmdMin.Move imgTopHead.Width - 1060, 60 
    cmdMax.Move imgTopHead.Width - 750, 60 
    cmdRest.Move cmdMax.Left, cmdMax.Top 
    cmdClose.Move imgTopHead.Width - 390, 60 
    'левый нижний угол 
    imgDnLt.Move 0, Me.Height - imgDnLt.Height - Screen.TwipsPerPixelY 
    'правый нижний угол 
    imgDnRt.Move Me.Width - imgDnRt.Width - Screen.TwipsPerPixelX, Me.Height - imgDnRt.Height 
    'левая граница 
    imgFrameLt.Move 0, imgTopHead.Height, 5 * Screen.TwipsPerPixelX, Me.Height - imgTopHead.Height - imgDnLt.Height 
    imgFrameLt.Line (0, 0)-(0, imgFrameLt.Height), RGB(223, 223, 223) 
    imgFrameLt.Line (Screen.TwipsPerPixelX, 0)-(Screen.TwipsPerPixelX, imgFrameLt.Height),
RGB(255, 255, 255) 
    'правая граница 
    imgFrameRt.Move Me.Width - 5 * Screen.TwipsPerPixelX, imgTopHead.Height, 5 *
Screen.TwipsPerPixelX, Me.Height - imgTopHead.Height - imgDnRt.Height 
    imgFrameRt.Line (2 * Screen.TwipsPerPixelX, 0)-(2 * Screen.TwipsPerPixelX, imgFrameRt.Height),
RGB(127, 127, 127)    
    imgFrameRt.Line (3 * Screen.TwipsPerPixelX, 0)-(3 * Screen.TwipsPerPixelX, imgFrameRt.Height),
RGB(0, 0, 0) 
    'нижняя граница 
    imgFrameDn.Move imgDnLt.Width, Me.Height - imgFrameDn.Height - Screen.TwipsPerPixelY, Me.Width - imgDnLt.Width - imgFrameRt.Width, 5 * Screen.TwipsPerPixelY 
    imgFrameDn.Line (0, imgFrameDn.Height - Screen.TwipsPerPixelY)-(imgFrameDn.Width, imgFrameDn.Height - Screen.TwipsPerPixelY), RGB(0, 0, 0) 
    imgFrameDn.Line (0, imgFrameDn.Height - 2 * Screen.TwipsPerPixelY)-(imgFrameDn.Width, imgFrameDn.Height - 2 *
Screen.TwipsPerPixelY), RGB(127, 127, 127) 
    'область меню 
    imgMenu.Move imgFrameLt.Width, imgTopHead.Height, Me.Width - imgFrameLt.Width - imgFrameRt.Width, 800 
    'Клиетская область 
    ClientArea.Move imgFrameLt.Width, imgMenu.Top + imgMenu.Height, Me.Width - imgFrameLt.Width - imgFrameRt.Width, Me.Height - imgTopHead.Height - imgMenu.Height - imgDnRt.Height - imgButt.Height 
    'Функциональные кнопки 
    imgButt.Move imgFrameLt.Width, ClientArea.Top + ClientArea.Height, Me.Width - imgFrameLt.Width - imgFrameRt.Width 
    'border 
    imgTopHead.DrawWidth = 1 
    imgTopHead.ScaleWidth = imgTopHead.Width
imgTopHead.Line (0, 0)-(0, imgTopHead.Height), RGB(223, 223, 223) 
    imgTopHead.Line (Screen.TwipsPerPixelX, Screen.TwipsPerPixelY)-(Screen.TwipsPerPixelX, imgTopHead.Height),
RGB(255, 255, 255) 
    imgTopHead.Line (imgTopHead.Width - 2 * Screen.TwipsPerPixelX, Screen.TwipsPerPixelY)-(imgTopHead.Width -
2 * Screen.TwipsPerPixelX, imgTopHead.Height), RGB(127, 127, 127) 
    imgTopHead.Line (imgTopHead.Width - Screen.TwipsPerPixelX, 0)-(imgTopHead.Width - Screen.TwipsPerPixelX, imgTopHead.Height),
RGB(0, 0, 0) 
    imgTopHead.Line (0, 0)-(imgTopHead.Width, 0), RGB(223, 223, 223) 
    imgTopHead.Line (Screen.TwipsPerPixelX, Screen.TwipsPerPixelY)-(imgTopHead.Width - Screen.TwipsPerPixelX, Screen.TwipsPerPixelY), RGB(255, 255,
255) 
    imgTopHead.Line (Screen.TwipsPerPixelX, imgTopHead.Height - Screen.TwipsPerPixelY)-(imgTopHead.Width -
Screen.TwipsPerPixelX, imgTopHead.Height - Screen.TwipsPerPixelY), RGB(191,
0, 63) 
   'left lines 
    imgTopHead.Line (375, 120)-(750, 120), RGB(223, 223, 223) 
    imgTopHead.Line (375, 135)-(750, 135), RGB(127, 127, 127) 
    imgTopHead.Line (375, 180)-(750, 180), RGB(223, 223, 223) 
    imgTopHead.Line (375, 195)-(750, 195), RGB(127, 127, 127) 
    imgTopHead.Line (375, 240)-(750, 240), RGB(223, 223, 223) 
    imgTopHead.Line (375, 255)-(750, 255), RGB(127, 127, 127) 
    FormCapt.Move 850, 60 
    'right lines 
    imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 120)-(imgTopHead.Width - 1200, 120), RGB(223,
223, 223) 
    imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 135)-(imgTopHead.Width - 1200, 135), RGB(127,
127, 127) 
    imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 180)-(imgTopHead.Width - 1200, 180), RGB(223,
223, 223) 
    imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 195)-(imgTopHead.Width - 1200, 195), RGB(127, 127,
127) 
    imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 240)-(imgTopHead.Width - 1200, 240), RGB(223,
223, 223) 
    imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 255)-(imgTopHead.Width - 1200, 255), RGB(127,
127, 127) 
End Sub