2002-03-23 17:47

' This program demonstrates how to add a button to form's
' title bar (near where minimize, maximize and close buttons).
' It adds a button with dot on it, which, when clicked,
' minimizes the form to tray. Note that it calculates size
' of the button and dot based on system settings; try to change
' height of windows title bar (Control Panel -> Display ->
' Settings) and see how the button resizes properly.

     $TYPECHECK ON
     $INCLUDE "rapidq.inc"

' WinAPI constants
     CONST GWL_WNDPROC = -4

     CONST BDR_RAISEDOUTER = &H0001
     CONST BDR_RAISEDINNER = &H0004
     CONST BDR_SUNKENOUTER = &H0002
     CONST BDR_SUNKENINNER = &H0008
     CONST BDR_RAISED = BDR_RAISEDOUTER OR BDR_RAISEDINNER
     CONST BDR_SUNKEN = BDR_SUNKENOUTER OR BDR_SUNKENINNER

     CONST BF_LEFT = &H0001
     CONST BF_TOP = &H0002
     CONST BF_RIGHT = &H0004
     CONST BF_BOTTOM = &H0008
     CONST BF_RECT = BF_LEFT OR BF_TOP OR BF_RIGHT OR BF_BOTTOM
     CONST BF_MIDDLE = &H0800
     CONST BF_SOFT = &H1000

     CONST SM_CXFRAME = 32
     CONST SM_CYFRAME = 33
     CONST SM_CXSIZE = 30
     CONST SM_CYSIZE = 31

     CONST PS_SOLID = 0

     CONST NIM_ADD = 0
     CONST NIM_MODIFY = 1
     CONST NIM_DELETE = 2
     CONST NIM_MESSAGE = 1
     CONST NIM_ICON = 2
     CONST NIM_TIP = 4

     CONST WM_PAINT = &H000F
     CONST WM_LBUTTONDOWN = &H201
     CONST WM_NCACTIVATE = &H0086
     CONST WM_NCPAINT = &H0085
     CONST WM_NCLBUTTONDOWN = &H00A1
     CONST WM_NCLBUTTONUP = &H00A2
     CONST WM_USER = &H400
     CONST WM_TRAYICON = WM_USER + 400

' WinAPI functions
     DECLARE FUNCTION SetForegroundWindow LIB "user32" ALIAS "SetForegroundWindow" _
      (HWnd AS LONG) AS LONG
     DECLARE FUNCTION SetWindowLong LIB "user32" ALIAS "SetWindowLongA" _
      (hWnd AS LONG, nIndex AS LONG, dwNewLong AS LONG) AS LONG
     DECLARE FUNCTION CallWindowProc LIB "user32" ALIAS "CallWindowProcA" _
      (lpPrevWndFunc AS LONG, hWnd AS LONG, uMsg AS LONG, _
      wParam AS LONG, lParam AS LONG) AS LONG
     DECLARE FUNCTION GetSystemMetrics LIB "user32" ALIAS "GetSystemMetrics" _
      (nIndex AS LONG) AS LONG
     DECLARE FUNCTION GetWindowRect LIB "user32" ALIAS "GetWindowRect" _
      (hWnd AS LONG, lpRect AS QRECT) AS LONG
     DECLARE FUNCTION GetWindowDC LIB "user32" ALIAS "GetWindowDC" _
      (hWnd AS LONG) AS LONG
     DECLARE FUNCTION DrawEdge LIB "user32" ALIAS "DrawEdge" _
      (hDC AS LONG, qrc AS QRECT, edge AS LONG, grfFlags AS LONG) AS LONG
     DECLARE FUNCTION CreatePen LIB "gdi32" ALIAS "CreatePen" _
      (fnPenStyle AS LONG, nWidth AS LONG, crColor AS LONG) AS LONG
     DECLARE FUNCTION SelectObject LIB "gdi32" ALIAS "SelectObject" _
      (hDC AS LONG, hGDIObj AS LONG) AS LONG
     DECLARE FUNCTION MoveToEx LIB "gdi32" ALIAS "MoveToEx" _
      (hDC AS LONG, x AS LONG, y AS LONG, lpPoint AS LONG) AS LONG
     DECLARE FUNCTION LineTo LIB "gdi32" ALIAS "LineTo" _
      (hDC AS LONG, x AS LONG, y AS LONG) AS LONG
     DECLARE SUB Shell_NotifyIcon LIB "shell32" ALIAS "Shell_NotifyIconA" _
      (dwMessage AS LONG, NIData AS QNOTIFYICONDATA)


     DECLARE FUNCTION Form_WndProc _
      (hWnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG

     DIM NI AS QNOTIFYICONDATA	' tray icon

     CREATE Form AS QFORM
      CAPTION = "Title bar button demo"
      CREATE Panel AS QPANEL
       Align = alClient
       BevelOuter = bvNone
       CAPTION = "Click on the dot button to minimize window to tray"
      END CREATE
      Center
     END CREATE

' WndProc event is not powerful enough for our case,
' so we have to subclass the window by WinAPI calls
     DEFINT OldWndProc
     OldWndProc = SetWindowLong(Form.Handle, GWL_WNDPROC, CODEPTR(Form_WndProc))

     Form.SHOWMODAL


     FUNCTION Form_WndProc(hWnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
      STATIC Pushed AS LONG	' state of the dot button
      DIM Rect AS QRECT
      SELECT CASE uMsg
      CASE WM_NCLBUTTONDOWN
       GetWindowRect(Form.Handle, Rect)
    	' Extract cursor position
       DEFINT x = (lParam AND &HFFFF)
       DEFINT y = (lParam SHR 16)
    	' Calculate position of the button
    	' and check whether it was clicked
       Rect.Left = Rect.Right - GetSystemMetrics(SM_CXFRAME) - _
        GetSystemMetrics(SM_CXSIZE) * 4 + 1
       Rect.Top = Rect.Top + GetSystemMetrics(SM_CYFRAME) + 2
       Rect.Right = Rect.Left + GetSystemMetrics(SM_CXSIZE) - 1
       Rect.Bottom = Rect.Top + GetSystemMetrics(SM_CYSIZE) - 4
       IF x >= Rect.Left AND x <= Rect.Right AND _
        y >= Rect.Top AND y <= Rect.Bottom THEN
			' OK, so it was; change the state
			' and redraw the button
        Pushed = True
        SendMessage(Form.Handle, WM_NCPAINT, 0, 0)
        result = 0
       ELSE
			' If it wasn't, let Windows handle the message
        result = CallWindowProc(OldWndProc, hWnd, uMsg, wParam, lParam)
       END IF
      CASE WM_NCLBUTTONUP
		' Let Windows handle it...
       result = CallWindowProc(OldWndProc, hWnd, uMsg, wParam, lParam)
		' If mouse button was pressed and then released...
       IF Pushed THEN
			' ... we've got a click, so let's hide the form
			' and put an icon in the tray
        Pushed = False
        Form.Visible = False
        NI.hWnd = Form.Handle
        NI.uID = Application.hInstance
        NI.uFlags = NIM_ICON OR NIM_MESSAGE OR NIM_TIP
        NI.hIcon = Application.Icon
        NI.uCallbackMessage = WM_TRAYICON
        NI.szTip = "Click to show window"
        Shell_NotifyIcon(NIM_ADD, NI)
       END IF
      CASE WM_TRAYICON
       IF (lParam AND &HFFFF) = WM_LBUTTONDOWN THEN
			' Tray icon was clicked, so show the
			' window and put it on top
        Shell_NotifyIcon(NIM_DELETE, NI)
        Form.Visible = True
        SetForegroundWindow(Form.Handle)
       END IF
      CASE WM_NCPAINT, WM_NCACTIVATE
		' Let Windows draw everything first
       result = CallWindowProc(OldWndProc, hWnd, uMsg, wParam, lParam)
       DEFINT DC = GetWindowDC(Form.Handle)
		' Calculate position of the button
		' and draw 3D-frame around it
       GetWindowRect(Form.Handle, Rect)
       Rect.Left = Rect.Right - Rect.Left - GetSystemMetrics(SM_CXFRAME) - _
        GetSystemMetrics(SM_CXSIZE) * 4 + 1
       Rect.Top = GetSystemMetrics(SM_CYFRAME) + 2
       Rect.Right = Rect.Left + GetSystemMetrics(SM_CXSIZE) - 1
       Rect.Bottom = Rect.Top + GetSystemMetrics(SM_CYSIZE) - 4
       DEFINT Border
		' Depending on whether the button is pushed or not,
		' draw raised or sunken border
       IF Pushed THEN Border = BDR_SUNKEN ELSE Border = BDR_RAISED
       DrawEdge(DC, Rect, Border, BF_RECT OR BF_SOFT OR BF_MIDDLE)
		' Draw the dot
       DEFINT PenSize = GetSystemMetrics(SM_CXSIZE) / 7
       DEFINT Pen = CreatePen(PS_SOLID, PenSize, 0)
       Pen = SelectObject(DC, Pen)
       MoveToEx(DC, Rect.Right - PenSize - 3, Rect.Bottom - PenSize - 2, 0)
       LineTo(DC, Rect.Right - PenSize - 3, Rect.Bottom - PenSize - 2)
       SelectObject(DC, Pen)
      CASE ELSE
		' Other messages are handled by Windows
       result = CallWindowProc(OldWndProc, hWnd, uMsg, wParam, lParam)
      END SELECT
     END FUNCTION

2002-03-23 17:47