Продовжуємо прикрашати створений MsgBox, MS Office, Програмні керівництва, статті

 

У цій статті я описав або, можна сказати, перевів створення власних діалогових вікон повідомлень.


Все б там добре, але не подобається мені ця синя панель діалогового вікна – ну прямо кричуще контрастує з тематичною гамою програмою. Виглядає це все непрофесійно …. розпадається єдине стильове оформлення, дратує, якась незавершеність залишається. В, загалом, багато про це можна говорити ;), але зараз ми будемо вирізати цю синю смужку, залишаючи вікно модальним.


В модуль форми frmMsgBox необхідно додати ще трохи коду.


Додаємо в розділ оголошення змінних модуля декілька декларацій API і констант:


“Для перетягування форми мишкою за псевдозаголовок
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 Sub ReleaseCapture Lib “user32” ()

Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
 


“Для управління станом вікна


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 GetWindowLong Lib “user32” Alias “GetWindowLongA” _
    (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowPos Lib “user32” _
    (ByVal Hwnd As Long, _
    ByVal hWndInsertAfter As Long, _
    ByVal X As Long, ByVal Y As Long, _
    ByVal cx As Long, _
    ByVal cy As Long, _
    ByVal wFlags As Long) As Long
Private Declare Function SPIGetWorkArea Lib “user32” Alias “SystemParametersInfoA” _
    (ByVal uAction As Long, _
    ByVal uParam As Long, _
    lpvParam As Rect, _
    ByVal fuWinIni As Long) As Long

Private Const GWL_STYLE = (-16)
Private Const WS_OVERLAPPED = &H0&
Private Const WS_CAPTION = &HC00000
Private Const WS_SYSMENU = &H80000
Private Const WS_THICKFRAME = &H40000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or _
              WS_CAPTION Or _
              WS_SYSMENU Or _
              WS_THICKFRAME Or _
              WS_MINIMIZEBOX Or _
              WS_MAXIMIZEBOX)
Private Const WS_POPUP = &H80000000
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_NOZORDER = &H4
Private Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Private Const SPI_GETWORKAREA = 48

Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 


Додамо саму процедуру видалення заголовка у форми подробиці см. Приховування рядка заголовка програми.


“Видалення заголовка у форми, але все одно відкриття форми як модальної
Private Function NoCaption()
Dim Hwnd As Long
Dim Style As Long
Dim rc As Rect

Hwnd = Me.Hwnd
Style = GetWindowLong(Hwnd, GWL_STYLE)
Style = Style And (Not WS_OVERLAPPEDWINDOW)
Style = Style Or WS_POPUP
SetWindowLong Hwnd, GWL_STYLE, Style
SPIGetWorkArea SPI_GETWORKAREA, 0, rc, 0
SetWindowPos Hwnd, 0, _
(rc.Right – 462) / 2, (rc.Bottom – 174) / 2, _
462, 174, _
SWP_NOZORDER Or SWP_DRAWFRAME
End Function
 


Діалогове віконце MBox у мене має розміри 462 пікселя по ширині і 174 по висоті і з’являється в середині екрану. Зрозуміло, що Ви можете змінити ці розміри на свій розсуд.


Також намалюємо напис lblInfoTips по верхній межі форми також як описано в Створення “фальшивої” рядка заголовка у форми. Встановимо її шрифт жирним і білим. За замовчуванням задамо написи назва програми, в разі, якщо не буде переданий параметр Title, буде відображатися цей рядок. Для події “Переміщення покажчика” написи додамо наступний код:


Private Sub lblInfoTips_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long

If Button = 1 Then
    Call ReleaseCapture
    lngReturnValue = SendMessage(Me.Hwnd, WM_NCLBUTTONDOWN, _
    HTCAPTION, 0&)
End If
End Sub
 


Якщо Ви вже використовуєте код для перетягування інших форм за псевдозаголовок, то, найімовірніше Ви задекларували необхідні API і константи до цієї процедури в окремому модулі, як Public. Якщо так, то додавання їх в розділ оголошень змінних модуля не є необхідним. Хоча …. нічого протизаконного немає, можна просто залишити їх в модулі як Private, як описано вище.


Додамо ще кілька невеликих доповнень до код:


If Not (StrComp(Me.OpenArgs & vbNullString, “MBox”, vbBinaryCompare) = 0) Then
    Cancel = True
    Exit Sub
End If
“Виклик процедури обрізання заголовка
Call NoCaption


Додамо код зміни кольору заголовка:


Select Case MBoxIconStyle
Case vbCritical
    Me.picCritical.Visible = True
    Me.recBorder.BorderColor = RGB(230, 70, 30)
    Me.lblFakeButton1.BackColor = RGB(230, 70, 30)
    Me.lblFakeButton2.BackColor = RGB(230, 70, 30)
    Me.lblInfoTips.BackColor = RGB(230, 70, 30)
Case vbExclamation
    Me.picExclamation.Visible = True
    Me.recBorder.BorderColor = RGB(230, 190, 20)
    Me.lblFakeButton1.BackColor = RGB(230, 190, 20)
    Me.lblFakeButton2.BackColor = RGB(230, 190, 20)
    Me.lblInfoTips.BackColor = RGB(230, 190, 20)
Case vbInformation
    Me.picInformation.Visible = True
    Me.recBorder.BorderColor = RGB(150, 200, 50)
    Me.lblFakeButton1.BackColor = RGB(150, 200, 50)
    Me.lblFakeButton2.BackColor = RGB(150, 200, 50)
    Me.lblInfoTips.BackColor = RGB(150, 200, 50)
End Select
 


і змінимо рядок присвоєння заголовка:


If Len(MBoxTitle) > 0 Then Me.lblInfoTips.Caption = ” ” & MBoxTitle
 


Тепер можна милуватися безкомпромісно допрацьованим MBox “ом.

Схожі статті:


Сподобалася стаття? Ви можете залишити відгук або підписатися на RSS , щоб автоматично отримувати інформацію про нові статтях.

Коментарів поки що немає.

Ваш отзыв

Поділ на параграфи відбувається автоматично, адреса електронної пошти ніколи не буде опублікований, допустимий HTML: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

*

*