Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Own buttons on caption

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Own buttons on caption

    This is a fragment from a program, which creates own caption.
    Probably, in future I will post full text by title "own caption" (just now code is too big and not "clean").

    Code:
       #Compile Exe
       #Register None
       #Dim All
       #Include "win32api.INC"
    
       Global DlgProcOld As Long
    
       CallBack Function DlgProcOr
          Static rcCaption As Rect, rcCaptionButtons() As RECT, _
                 StatusCaptionButtons() As Long, nCaptionButtons As Long
                 
          If CbMsg = %WM_USER + 999 Then ' Init
             nCaptionButtons = CbWparam
             ReDim rcCaptionButtons(1 To nCaptionButtons)
             ReDim StatusCaptionButtons(1 To nCaptionButtons)
             Exit Function
          End If
    
          Local hDC As Long, rc As RECT, dStyle As Long, dExStyle As Long
          Local i As Long, j As Long,  k As Long
          Local NeedToRefresh As Long, Pnt As POINTAPI, lResult As Long
          Local cx As Long, cy As Long, cxBtn As Long, cyBtn As Long, dx As Long
    
          lResult = CallWindowProc(DlgProcOld, CbHndl, CbMsg, CbWparam, CbLparam)
          Select Case CbMsg
             Case %WM_NCHITTEST
                If (lResult = %HTCAPTION) Then k = 1
             Case %WM_NCLBUTTONDOWN, %WM_NCLBUTTONUP, %WM_NCMOUSEMOVE, _
                  %WM_NCACTIVATE, %WM_NCPAINT, %WM_SETTEXT
                k = 1
           End Select
           If k Then
             GetWindowRect CbHndl, rc
             Pnt.x = Cvi(Mkl$(CbLparam), 1) - rc.nLeft
             Pnt.y = Cvi(Mkl$(CbLparam), 3) - rc.nTop
             
             dStyle   = GetWindowLong(CbHndl, %GWL_STYLE)
             dExStyle = GetWindowLong(CbHndl, %GWL_EXSTYLE)
    
             If (dStyle And %WS_THICKFRAME) = %WS_THICKFRAME Then
                cx = GetSystemMetrics(%SM_CXSIZEFRAME)
                cy = GetSystemMetrics(%SM_CYSIZEFRAME)
             Else
                cx = GetSystemMetrics(%SM_CXFIXEDFRAME)
                cy = GetSystemMetrics(%SM_CYFIXEDFRAME)
             End If
          
             GetWindowRect CbHndl, rcCaption
             rcCaption.nBottom = rcCaption.nBottom - rcCaption.nTop
             rcCaption.nRight  = rcCaption.nRight - rcCaption.nLeft
             rcCaption.nTop    = cy
             rcCaption.nLeft   = cx
             rcCaption.nRight  = rcCaption.nRight - cx
             rcCaption.nBottom = rcCaption.nTop + GetSystemMetrics(%SM_CYCAPTION) - _
                                                  GetSystemMetrics(%SM_CYBORDER)
             cxBtn = GetSystemMetrics(%SM_CXSIZE)
             cyBtn = GetSystemMetrics(%SM_CYSIZE)
    
             dx = rcCaption.nRight
             If (dStyle And %WS_SYSMENU) = %WS_SYSMENU Then
                dx = dx - cxBtn - 2
                If ((dStyle And %WS_MAXIMIZEBOX) = %WS_MAXIMIZEBOX) Or _
                   ((dStyle And %WS_MINIMIZEBOX) = %WS_MINIMIZEBOX) Then _
                   dx = dx - 2 * cxBtn - 2
             End If
             If (dExStyle And %WS_EX_CONTEXTHELP) = %WS_EX_CONTEXTHELP Then _
                dx = dx - cxBtn - 2
             For i = 1 To nCaptionButtons
                rcCaptionButtons(i).nRight = dx - 2 - (nCaptionButtons - i) * cxBtn
                rcCaptionButtons(i).nLeft = dx - 2 - (nCaptionButtons - i + 1) * cxBtn
                rcCaptionButtons(i).nTop = rcCaption.nTop + 2
                rcCaptionButtons(i).nBottom = rcCaption.nBottom - 2
             Next
             
             For i = 1 To nCaptionButtons
                If PtInRect(rcCaptionButtons(i), Pnt.x, Pnt.y) Then j = i
             Next
          End If
          
          Select Case CbMsg
             Case %WM_DESTROY: SetWindowLong(CbHndl, %GWL_WNDPROC, DlgProcOld
             Case %WM_NCHITTEST
                If j <> 0 And (lResult = %HTCAPTION) Then lResult = 9999
             Case %WM_NCMOUSEMOVE
                For i = 1 To nCaptionButtons
                   If (i <> j) Then If (StatusCaptionButtons(i)) <> 0 Then _
                      StatusCaptionButtons(i) = 0: NeedToRefresh = %True
                Next
             Case %WM_NCLBUTTONDOWN
                For i = 1 To nCaptionButtons
                   If j = i Then
                      If StatusCaptionButtons(i) = 0 Then _
                         StatusCaptionButtons(i) = 1: NeedToRefresh = %True
                   Else
                      If StatusCaptionButtons(i) = 1 Then _
                         StatusCaptionButtons(i) = 0: NeedToRefresh = %True
                   End If
                Next
             Case %WM_NCLBUTTONUP
                For i = 1 To nCaptionButtons
                   If StatusCaptionButtons(i) = 1 Then
                      StatusCaptionButtons(i) = 0: NeedToRefresh = %True
                      If j = i Then PostMessage CbHndl, %WM_USER + 998, i, 0
                   End If
                Next
             Case %WM_NCACTIVATE, %WM_NCPAINT, %WM_SETTEXT
                NeedToRefresh = %True
          End Select
          If NeedToRefresh Then
             ' Draw - this is a sample only
             hDc = GetWindowDC(CbHndl)
             Local hFont As Long
             hFont = CreateFont(cxBtn * 0.8, cyBtn - 2, 0, 0, %FW_NORMAL, 0, 0, 0, _
                       %ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _
                       %DEFAULT_QUALITY, %FF_DONTCARE, "Courier New")
             SelectObject hDC, hFont
             SetBkMode hDC, %Transparent
             SetTextColor hDc, %Black
             For i = 1 To nCaptionButtons
                If StatusCaptionButtons(i) = %False Then j = 0 Else j = %DFCS_PUSHED
                DrawFrameControl hDc, rcCaptionButtons(i), %DFC_BUTTON, %DFCS_BUTTONPUSH Or j
                DrawText hDC, Mid$(Str$(i), 2), -1, rcCaptionButtons(i), _
                   %DT_SINGLELINE Or %DT_CENTER Or %DT_VCENTER
             Next
             ReleaseDC CbHndl, hDC
             DeleteObject hFont
          End If
          Function = lResult
       End Function
    
       CallBack Function DlgProc
          Select Case CbMsg
             Case %WM_INITDIALOG: SendMessage CbHndl, %WM_USER + 999, 5, 0 ' Init
             Case %WM_USER + 998: MsgBox "Button" + Str$(CbWparam)
             Case %WM_COMMAND: If CbCtl = %IDOK Then SetWindowText CbHndl, Time$
           End Select
        End Function
    
        Function PbMain
           Local hDlg As Long
           Dialog New 0, " Own buttons", , , 200, 30, %WS_SYSMENU Or %WS_MINIMIZEBOX Or _
              %WS_MAXIMIZEBOX Or %WS_CAPTION Or %WS_THICKFRAME To hDlg
           Control Add Button, hDlg, %IDOK, "&Change Title", 50, 5, 100, 14
           DlgProcOld = SetWindowLong(hDlg, %GWL_WNDPROC, CodePtr(DlgProcOr))
           Dialog Show Modal hDlg, Call DlgProc
        End Function

  • #2
    My update is found here.

    Comment

    Working...
    X