'Aero Style Classes, Parts, and States - http://msdn.microsoft.com/en-us/library/windows/desktop/ee453680%28v=vs.85%29.aspx 'DrawThemeBackground - http://msdn.microsoft.com/en-us/library/windows/desktop/bb773289%28v=vs.85%29.aspx #COMPILE EXE 'Using José's includes... #INCLUDE "Win32Api.inc" '#RESOURCE "Resource.pbr" GLOBAL hDlg AS DWORD %ButtonExit = 101 %LabelWindowMinimizeButton = 201 %LabelWindowMaximizeButton = 202 %LabelWindowRestoreButton = 203 %LabelWindowCloseButton = 204 %WindowButtonAction = %WM_APP '_____________________________________________________________________________ CALLBACK FUNCTION DlgProc() AS LONG LOCAL pDrawItemStruct AS DRAWITEMSTRUCT POINTER STATIC rc AS RECT LOCAL sClassList AS STRING STATIC hWinMinimizeButton AS DWORD STATIC hWinMaximizeButton AS DWORD STATIC hWinRestoreButton AS DWORD STATIC hWinCloseButton AS DWORD STATIC hOkButton AS DWORD STATIC hTheme AS DWORD STATIC hWinButton AS DWORD STATIC hWinButtonPrev AS DWORD STATIC WinButtonType AS DWORD STATIC CursorOnButton AS DWORD STATIC WinButtonStatus AS LONG STATIC LeftClickDown AS LONG SELECT CASE CBMSG CASE %WM_INITDIALOG hOkButton = GetDlgItem(hDlg, %ButtonExit) hWinMinimizeButton = GetDlgItem(hDlg, %LabelWindowMinimizeButton) hWinMaximizeButton = GetDlgItem(hDlg, %LabelWindowMaximizeButton) hWinRestoreButton = GetDlgItem(hDlg, %LabelWindowRestoreButton ) hWinCloseButton = GetDlgItem(hDlg, %LabelWindowCloseButton) sClassList = UCODE$("Window") hTheme = OpenThemeData(hWinCloseButton, BYVAL STRPTR(sClassList)) CASE %WM_COMMAND SELECT CASE CBCTL CASE %WindowButtonAction 'Action on button push SELECT CASE CBLPARAM CASE hWinMinimizeButton : WinBeep(1500, 100) CASE hWinMaximizeButton : WinBeep(2000, 100) CASE hWinRestoreButton : WinBeep(2500, 100) CASE hWinCloseButton : WinBeep(3000, 100) END SELECT CASE %IDCANCEL, %ButtonExit DIALOG END CBHNDL END SELECT CASE %WM_DRAWITEM 'Sent to the parent window of an owner-drawn static, button, combo box, list box, 'or menu when a visual aspect of the static button, combo box, list box, or menu has changed. 'wParam Specifies the identifier of the control that sent the WM_DRAWITEM message. ' If the message was sent by a menu, this parameter is zero. 'lParam Pointer to a DRAWITEMSTRUCT structure containing information ' about the item to be drawn and the type of drawing required. hWinButton = GetDlgItem(hDlg, CBWPARAM) SELECT CASE hWinButton CASE hWinMinimizeButton : WinButtonType = %WP_MINBUTTON CASE hWinMaximizeButton : WinButtonType = %WP_MAXBUTTON CASE hWinRestoreButton : WinButtonType = %WP_RESTOREBUTTON CASE hWinCloseButton : WinButtonType = %WP_CLOSEBUTTON CASE ELSE : WinButtonType = 0 END SELECT IF WinButtonType THEN 'Mouse cursor is on a button GetClientRect(hWinButton, rc) pDrawItemStruct = CBLPARAM DrawThemeBackground(hTheme, @pDrawItemStruct.hDC, WinButtonType, %CBS_NORMAL, rc, BYVAL 0) WinButtonStatus = %CBS_NORMAL FUNCTION = %TRUE 'If an application processes this message, it should return TRUE. END IF CASE %WM_SETCURSOR 'Sent to a window if the mouse causes the cursor to move within a window and mouse input is not captured. 'wParam A handle to the window that contains the cursor. 'lParam The low-order word of lParam specifies the hit-test code. %HTCLIENT %HTMENU HTCAPTION HTGROWBOX HTTOP etc ' The high-order word of lParam specifies the identifier of the mouse message. WM_MOUSEMOVE WM_LBUTTONDOWN %WM_RBUTTONUP WM_XBUTTONDOWN (no wheel) 'Possible state for WindowButton: %CBS_HOT, %CBS_NORMAL, %CBS_PUSHED, %CBS_DISABLED CursorOnButton = %TRUE hWinButton = CBWPARAM SELECT CASE hWinButton CASE hWinMinimizeButton : WinButtonType = %WP_MINBUTTON CASE hWinMaximizeButton : WinButtonType = %WP_MAXBUTTON CASE hWinRestoreButton : WinButtonType = %WP_RESTOREBUTTON CASE hWinCloseButton : WinButtonType = %WP_CLOSEBUTTON CASE ELSE : CursorOnButton = %FALSE END SELECT IF CursorOnButton THEN 'Mouse cursor is on a button hWinButtonPrev = hWinButton GetClientRect(hWinButton, rc) SELECT CASE HI(WORD, CBLPARAM) CASE %WM_LBUTTONDOWN 'Left button up to down transition LeftClickDown = %TRUE IF WinButtonStatus <> %CBS_PUSHED THEN DrawThemeBackground(hTheme, GetDC(hWinButton), WinButtonType, %CBS_PUSHED, rc, BYVAL %NULL) WinButtonStatus = %CBS_PUSHED END IF CASE %WM_LBUTTONUP 'Left button down to up transition IF LeftClickDown THEN LeftClickDown = %FALSE DrawThemeBackground(hTheme, GetDC(hWinButton), WinButtonType, %CBS_HOT, rc, BYVAL %NULL) WinButtonStatus = %CBS_HOT PostMessage(CBHNDL, %WM_COMMAND, MAKDWD(%WindowButtonAction, %BN_CLICKED), hWinButton) END IF CASE ELSE 'Mouse moving on control IF LeftClickDown THEN IF WinButtonStatus <> %CBS_PUSHED THEN DrawThemeBackground(hTheme, GetDC(hWinButton), WinButtonType, %CBS_PUSHED, rc, BYVAL %NULL) WinButtonStatus = %CBS_PUSHED END IF ELSE IF WinButtonStatus = %CBS_NORMAL THEN DrawThemeBackground(hTheme, GetDC(hWinButton), WinButtonType, %CBS_HOT, rc, BYVAL %NULL) WinButtonStatus = %CBS_HOT END IF END IF END SELECT ELSE 'Mouse is not over a window button IF HI(WORD, CBLPARAM) = %WM_LBUTTONDOWN OR HI(WORD, CBLPARAM) = %WM_LBUTTONUP THEN LeftClickDown = %FALSE END IF IF WinButtonStatus <> %CBS_NORMAL THEN DrawThemeBackground(hTheme, GetDC(hWinButtonPrev), WinButtonType, %CBS_NORMAL, rc, BYVAL %NULL) WinButtonStatus = %CBS_NORMAL END IF END IF CASE %WM_DESTROY CloseThemeData(hTheme) 'Clean up END SELECT END FUNCTION '____________________________________________________________________________ FUNCTION PBMAIN () AS LONG LOCAL hIcon AS DWORD hIcon = ExtractIcon(GetModuleHandle(""), "Shell32.dll", 294) 'o DIALOG FONT "Segoe UI", 9 DIALOG NEW PIXELS, %HWND_DESKTOP, "Aero button", , , 250, 150, _ %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU, 0 TO hDlg SetClassLong(hDlg, %GCL_HICONSM, hIcon) SetClassLong(hDlg, %GCL_HICON, hIcon) CONTROL ADD "Static", hDlg, -1, "DrawThemeBackground", 50, 10, 150, 15, _ %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER CONTROL ADD "Static", hDlg, %LabelWindowMinimizeButton, "Static", 040, 50, 28, 18, _ %WS_CHILD OR %WS_VISIBLE OR %SS_LEFT OR %SS_NOTIFY OR %SS_OWNERDRAW, %WS_EX_TRANSPARENT CONTROL ADD "Static", hDlg, %LabelWindowMaximizeButton, "Static", 111, 50, 28, 18, _ %WS_CHILD OR %WS_VISIBLE OR %SS_LEFT OR %SS_NOTIFY OR %SS_OWNERDRAW, %WS_EX_TRANSPARENT CONTROL ADD "Static", hDlg, %LabelWindowRestoreButton, "Static", 111, 90, 28, 18, _ %WS_CHILD OR %WS_VISIBLE OR %SS_LEFT OR %SS_NOTIFY OR %SS_OWNERDRAW, %WS_EX_TRANSPARENT CONTROL ADD "Static", hDlg, %LabelWindowCloseButton, "Static", 182, 50, 45, 18, _ %WS_CHILD OR %WS_VISIBLE OR %SS_LEFT OR %SS_NOTIFY OR %SS_OWNERDRAW, %WS_EX_TRANSPARENT CONTROL ADD BUTTON, hDlg, %ButtonExit, "E&xit", 190, 120, 50, 25, _ %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, %WS_EX_NOPARENTNOTIFY DIALOG SHOW MODAL hDlg, CALL DlgProc DestroyIcon(hIcon) END FUNCTION '____________________________________________________________________________ '
#COMPILE EXE #DIM ALL #INCLUDE "Win32Api.inc" %WM_GETTITLEBARINFOEX = &H033F??? TYPE TITLEBARINFOEX DWORD cbSize AS DWORD rcTitleBar AS RECT rgstate(%CCHILDREN_TITLEBAR) AS DWORD 'CCHILDREN_TITLEBAR = 5 rgrect(%CCHILDREN_TITLEBAR) AS RECT END TYPE GLOBAL hDlg AS DWORD %LabelInfo = 101 '______________________________________________________________________________ FUNCTION StateInfo(s AS DWORD) AS STRING '0 The title bar itself, 1 Reserved, 2 Minimize button, 3 Maximize button, 4 Help button, 5 Close button. 'STATE_SYSTEM_OFFSCREEN mean the element has no visible representation. FUNCTION = $TAB & "(" & HEX$(s, 8) & ") " & _ IIF$((s AND %STATE_SYSTEM_PRESSED), "PRESSED", "unPressed") & ", " & _ IIF$((s AND %STATE_SYSTEM_UNAVAILABLE), "UNAVAILABLE", "available") & ", " & _ IIF$((s AND %STATE_SYSTEM_OFFSCREEN), "OFFSCREEN", "onScreen") & ", " & _ IIF$((s AND %STATE_SYSTEM_INVISIBLE), "INVISIBLE", "visible") & ", " & _ IIF$((s AND %STATE_SYSTEM_FOCUSABLE), "FOCUSABLE", "unFocusable") END FUNCTION '______________________________________________________________________________ FUNCTION RectInfo(r AS RECT) AS STRING MapWindowPoints(%HWND_DESKTOP, hDlg, BYVAL VARPTR(r), 2) 'Relative to client area instead of desktop area '.rgrect(0) and .rgrect(1) are reserved. FUNCTION = $TAB & " " & STR$(r.nRight - r.nLeft) & " x" & _ STR$(r.nBottom - r.nTop) & _ $TAB & " at " & STR$(r.nLeft) & "," & STR$(r.nTop) END FUNCTION '______________________________________________________________________________ CALLBACK FUNCTION DlgProc LOCAL TBI AS TITLEBARINFOEX LOCAL sTitleInfo AS STRING STATIC sTitleInfoPrev AS STRING SELECT CASE CBMSG CASE %WM_SETCURSOR 'hwnd, nHittest = LOWORD(lParam), wMouseMsg = HIWORD(lParam). TBI.cbSize = SIZEOF(TITLEBARINFOEX) IF SendMessage(hDlg, %WM_GETTITLEBARINFOEX, 0, VARPTR(TBI)) THEN sTitleInfo = "TitleBar " & RectInfo(TBI.rcTitleBar) & $CRLF & _ "Minimize button" & RectInfo(TBI.rgrect(2)) & $CRLF & _ "Maximize button" & RectInfo(TBI.rgrect(3)) & $CRLF & _ "Help button " & RectInfo(TBI.rgrect(4)) & $CRLF & _ "Close button " & RectInfo(TBI.rgrect(5)) & $CRLF & _ "" & $CRLF & _ "TitleBar state " & StateInfo(TBI.rgstate(0)) & $CRLF & _ "Minimize button state " & StateInfo(TBI.rgstate(2)) & $CRLF & _ "Maximize button state " & StateInfo(TBI.rgstate(3)) & $CRLF & _ "Help button state " & StateInfo(TBI.rgstate(4)) & $CRLF & _ "Close button state " & StateInfo(TBI.rgstate(5)) IF sTitleInfo <> sTitleInfoPrev THEN CONTROL SET TEXT hDlg, %LabelInfo, sTitleInfo END IF sTitleInfoPrev = sTitleInfo END IF END SELECT END FUNCTION '______________________________________________________________________________ FUNCTION PBMAIN() LOCAL hIcon AS DWORD DIALOG NEW %HWND_DESKTOP, "WM_GetTitleBarInfoEx", , , 350, 100, %WS_CAPTION OR _ %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_SYSMENU OR %WS_THICKFRAME, 0 TO hDlg hIcon = ExtractIcon(GetModuleHandle(""), "Shell32.dll", 294) 'o SetClassLong(hDlg, %GCL_HICON, hIcon) SendMessage(hDlg, %WM_SETICON, %ICON_SMALL, hIcon) CONTROL ADD LABEL, hDlg, %LabelInfo, "TITLEBARINFOEX", 5, 5, 340, 90 DIALOG SHOW MODAL hDlg CALL DlgProc DestroyIcon(hIcon) END FUNCTION '______________________________________________________________________________ '
'==================================================================== ' Dialog with own caption bar and buttons '-------------------------------------------------------------------- #Compile Exe #Dim All #Include "WIN32API.INC" %ID_CAPTIONBAR = 110 %ID_MINBUTN = 120 %ID_MAXRESTORE = 130 Global RButton, XBUTTON, MBUTTON As Dword Global oldBarProc As Long Global FC, BC, B As Long '==================================================================== ' Main entrance '-------------------------------------------------------------------- Function PBMain Local Hdlg, hFont As Long Dialog New 0, "My sample",,, 155, 138, %WS_POPUP Or %WS_DLGFRAME To Hdlg ' Caption bar label - must not cover buttons next to it. Control Add Label, Hdlg, %ID_CAPTIONBAR, " My sample Dialog", 11, 0, 125, 10, %SS_NOTIFY Control Set Color Hdlg, %ID_CAPTIONBAR,%red, %Green ' GetSysColor(%COLOR_CAPTIONTEXT), _ ' GetSysColor(%COLOR_ACTIVECAPTION) '------------------------------------------------------------------ 'adding a meaningless button style to aviod tabbing to these buttons Control Add Button, Hdlg, %ID_MINBUTN, "---", 135, 0, 10, 10, %BS_VCENTER Or %BS_OWNERDRAW Control Add Button, Hdlg, %IDCANCEL, "X", 145, 0, 10, 10, %BS_VCENTER Or %BS_OWNERDRAW Control Add Button, Hdlg, %ID_MAXRESTORE, "M", 1,0,10,10,%BS_VCENTER Or %BS_OWNERDRAW '------------------------------------------------------------------ Font New "Arial", 10, 1 To hFont Control Set Font Hdlg, %ID_CAPTIONBAR, hFont Control Set Font Hdlg, %ID_MINBUTN, hFont Control Set Font Hdlg, %IDCANCEL, hFont Control Set Font Hdlg, %ID_MAXRESTORE, hfont '------------------------------------------------------------------ B = 0 Dialog Show Modal Hdlg Call DlgProcedure Font End hFont End Function '==================================================================== ' Main dialog procedure '-------------------------------------------------------------------- CallBack Function DlgProcedure() Static hCaptionBar As Long Select Case CB.Msg Case %WM_INITDIALOG Control Handle CB.Hndl, %ID_CAPTIONBAR To hCaptionBar 'sub-class captionbar label and let BarProc handle it oldBarProc = SetWindowLong(hCaptionBar, %GWL_WNDPROC, CodePtr(BarProc)) Control Handle CB.Hndl, %ID_MINBUTN To RButton Control Handle CB.Hndl, %IDCANCEL To XButton Control Handle CB.Hndl, %ID_MAXRESTORE To MButton Case %WM_COMMAND Select Case CbCtl Case %ID_MINBUTN : ShowWindow(CB.Hndl, %SW_MINIMIZE) ' click taskbar icon to restore Case %IDCANCEL : Dialog End CbHndl Case %ID_MAXRESTORE If B = 0 Then B = 1 ShowWindow(CB.Hndl, %sw_MAXIMIZE) ElseIf B = 1 Then ShowWindow(CB.Hndl, %sw_RESTORE) B = 0 End If End Select Case %WM_DRAWITEM 'time to draw ownerdrawn button FC = %White BC = %Black If CB.wParam = %ID_MINBUTN Then DrawButton RButton, CB.lParam,FC , BC End If FC = %White BC = %Red If CB.wParam = %IDCANCEL Then DrawButton xButton, CB.lParam,FC , BC End If FC = %Gray BC = %White If CB.wParam = %ID_MAXRESTORE Then DrawButton MButton, CB.lParam,FC , BC End If ' NEED A FRAME IN BUTTON OR AN ICON BMP Case %WM_DESTROY If oldBarProc Then 'un-subclass captionbar label at exit SetWindowLong hCaptionBar, %GWL_WNDPROC, oldBarProc End If End Select End Function '==================================================================== ' Sub-classed captionbar label procedure ' Handle moving dialog with the mouse '-------------------------------------------------------------------- CallBack Function BarProc() Select Case CbMsg Case %WM_LBUTTONDOWN 'do dragging if mouse down on caption bar label SendMessage GetParent(CbHndl), %WM_NCLBUTTONDOWN, %HTCAPTION, ByVal %Null Function = 0 : Exit Function End Select Function = CallWindowProc(oldBarProc, CbHndl, CbMsg, CbWParam, CbLParam) End Function Sub DrawButton (hButton As Long, lParam As Long, bgColor As Long, txtColor As Long) Local hBrush As Dword, lpDis As DRAWITEMSTRUCT Ptr, zTxt As Asciiz * 200 lpDis = lParam hBrush = CreateSolidBrush(bgColor) ' create brush SetBkColor @lpDis.hDC, bgColor 'text background color SetTextColor @lpDis.hDC, txtColor 'text color GetWindowText hButton, zTxt, SizeOf(zTxt) 'grab text If (@lpDis.itemState And %ODS_SELECTED) Then DrawFrameControl @lpDis.hDC, @lpDis.rcItem, %DFC_BUTTON, %DFCS_BUTTONPUSH Or %DFCS_PUSHED OffsetRect @lpDis.rcItem, 1, 1 'pressed button - move text rect some Else DrawFrameControl @lpDis.hDC, @lpDis.rcItem, %DFC_BUTTON, %DFCS_BUTTONPUSH End If InflateRect @lpDis.RcItem, -2, -2 'smaller rect to avoid FillRect paint over borders FillRect @lpDis.hDc, @lpDis.rcItem, hBrush 'fill surface, then draw text @lpDis.RcItem.nTop -= 2 'adjust text rect a little DrawText @lpDis.hDC, zTxt, -1, @lpDis.rcItem, %DT_SINGLELINE Or %DT_CENTER Or %DT_VCENTER Or %DT_TABSTOP @lpDis.RcItem.nTop += 2 'restore rect If (@lpDis.itemState And %ODS_FOCUS) Then 'if button has focus SetTextColor @lpDis.hDC, GetSysColor(%COLOR_BTNTEXT) 'reset text color for focus rect InflateRect @lpDis.RcItem, -1, -1 'adjust focus rect some DrawFocusRect @lpDis.hDC, @lpDis.rcItem End If DeleteObject hBrush ' delete what we created End Sub
Tweet
Comment