Announcement

Collapse
No announcement yet.

Add a Button to the Title Bar (Discussion)

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

  • Add a Button to the Title Bar (Discussion)

    This thread is for discussion of the post started by Peter Redei, about putting a button onto a dialog's caption.

    ===================================================================================

    Hi Peter,

    the code works fine on Win98 but on my WinXP Pro box the additional button does not appear.

    Stefan

    ------------------
    Last edited by Gary Beene; 21 May 2012, 07:04 PM.

  • #2
    I wrote it in '98 and I have not tried it in any other OS. I have no clue at the moment what makes the difference. I have also not succeeded to add tooltip to the button. So guys, the project is open for enhancements.

    Regards,

    Peter Redei

    ------------------

    Comment


    • #3
      No button shows up under Win NT4SP6 either!

      Regards,

      Henk


      ------------------
      Henk Broekhuizen,
      pbforums@henkhenk.com
      The Netherlands
      Henk Broekhuizen, PA3BLP
      powerbasicforum -at- doorhet.net
      Sexbierum, The Netherlands
      ========================

      Comment


      • #4
        Has anyone worked out a more current version of Peter's code? The point of his code is to put a button in the caption, something like this:



        The code in Peter's post#5 seems to work (with some issues):



        But a first pass test of it is as far as I've gotten tonight. I've not yet tested his other postings in the thread. Just wondered if anyone had something more recent to that I could start with.

        For that matter, is there a better approach to doing it?

        I can see drawing my own button in WM_NCPaint. That would seem pretty straight-forward. But if I could simply move a button, especially an ImgButton, into the caption, then that would be better yet.

        Comment


        • #5
          Hi Gary,

          It is tricky when Aero is in play!

          See an earlier query from Adam here

          Potentialy useful links:
          http://msdn.microsoft.com/en-us/libr....aspx#removing
          http://delphihaven.wordpress.com/201...STOM-titlebar/
          http://www.codeproject.com/Articles/...on-Client-Area

          (I didn't revisit it since back then)
          Rgds, Dave

          Comment


          • #6
            Hi Dave,
            Thanks, headed that way now.

            And by tricky, I assume you don't mean impossible (the old code from Peter worked to some extent on my Aero-themed Win7 machine), but that you mean there are details to be worked out to get the best/acceptable results.

            Comment


            • #7
              Hi Gary,

              By 'tricky' I mean "a substantial challenge for a monkey-see monkey-do novice like me"!
              Best I have so far is this test code..
              Code:
              #COMPILE EXE 'PBwin 10
              #DIM ALL
              #INCLUDE "WIN32API.INC"
              #RESOURCE MANIFEST, 1, "C:\PBWin10\WinAPI\xptheme.xml"
               
              TYPE MARGINS
                cxLeftWidth    AS LONG
                cxRightWidth   AS LONG
                cyTopHeight    AS LONG
                cyBottomHeight AS LONG
              END TYPE
               
              %LEFTEXTENDWIDTH    = 8
              %RIGHTEXTENDWIDTH   = 8
              %TOPEXTENDWIDTH     = 30
              %BOTTOMEXTENDWIDTH  = 8
               
              %BTN_Test      = 102
              %LBL_LABEL1    = 101
              %TXT_TEXTBOX1  = 100
              ' See Jose's headers 
              DECLARE FUNCTION IsDwmEnabled(IsEnabled AS LONG) AS LONG
              DECLARE FUNCTION pbDwmExtendFrameIntoClientArea(BYVAL hWnd AS DWORD, BYVAL pMarInset AS MARGINS PTR) AS LONG
              Declare Function pbDwmDefWindowProc (BYVAL hWnd AS DWORD, BYVAL msg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG, BYREF lResult AS LONG) As Long
              '------------------/
               
              FUNCTION IsVistaPlus() AS LONG
               LOCAL vi AS OSVERSIONINFO
               
                vi.dwOsVersionInfoSize = SIZEOF(vi)
                GetVersionEx vi
                IF ISTRUE (vi.dwPlatformId = %VER_PLATFORM_WIN32_NT) AND vi.dwMajorVersion >= 6 THEN FUNCTION = %TRUE
               
              END FUNCTION
              '------------------/IsVistaPlus
               
              FUNCTION IsAero() AS LONG
               LOCAL lRet, IsEnabled AS LONG
               LOCAL hLib, pAddr AS DWORD
               
                hLib = LoadLibrary("dwmapi.dll")
                pAddr = GetProcAddress(hLib, "DwmIsCompositionEnabled")
               
                IF pAddr <> 0 THEN
                  CALL DWORD pAddr USING IsDwmEnabled(IsEnabled) TO lRet
                  FreeLibrary hLib
                ELSE
                  FreeLibrary hLib
                  FUNCTION = %FALSE
                  EXIT FUNCTION
                END IF
                IF lRet <> %S_OK THEN
                  FUNCTION = %FALSE
                  EXIT FUNCTION
                ELSE
                  FUNCTION = IsEnabled
                END IF
               
              END FUNCTION
              '------------------/IsAero
               
              CALLBACK FUNCTION DlgProc()
               LOCAL hr           AS LONG
               LOCAL hLib, pAddr  AS DWORD
               LOCAL dwmMargins   AS Margins
               LOCAL rcClient     AS RECT
                SELECT CASE AS LONG CBMSG
                  CASE %WM_INITDIALOG
                    IF IsVistaPlus = 0 THEN
                      MSGBOX ">=Vista only ", %MB_ICONMASK, "" : DIALOG POST CBHNDL, %WM_SYSCOMMAND, %SC_CLOSE, 0
                    END IF
                    IF IsAero = 0 THEN
                      MSGBOX "Aero only", %MB_ICONMASK, "" : DIALOG POST CBHNDL, %WM_SYSCOMMAND, %SC_CLOSE, 0
                    END IF
               
                    DIALOG POST CBHNDL, %WM_USER + 1000, 0, 0
               
                  CASE %WM_USER + 1000   ' Extend the frame into the client area.
                    DIALOG REDRAW CBHNDL
               
                    dwmMargins.cxLeftWidth    = %LEFTEXTENDWIDTH
                    dwmMargins.cxRightWidth   = %RIGHTEXTENDWIDTH
                    dwmMargins.cyTopHeight    = %TOPEXTENDWIDTH
                    dwmMargins.cyBottomHeight = %BOTTOMEXTENDWIDTH
               
                    hLib = LoadLibrary("dwmapi.dll")
                    pAddr = GetProcAddress(hLib, "DwmExtendFrameIntoClientArea")
               
                    IF pAddr <> 0 THEN
                      CALL DWORD pAddr USING pbDwmExtendFrameIntoClientArea(CBHNDL, VARPTR(dwmMargins)) TO hr
                      FreeLibrary hLib
                    ELSE
                      FreeLibrary hLib
                      FUNCTION = %FALSE
                      EXIT FUNCTION
                    END IF
                    IF hr <> %S_OK THEN
                      FUNCTION = %FALSE
                      EXIT FUNCTION
                    END IF
               
                    GetWindowRect(CBHNDL, BYVAL VARPTR(rcClient))
                    SetWindowPos(CBHNDL, %HWND_TOP, rcClient.nLeft, rcClient.nTop, _
                               rcClient.nRight - rcClient.nLeft, rcClient.nBottom - rcClient.nTop, _
                               %SWP_FRAMECHANGED)
               
                  CASE %WM_NCCALCSIZE
                    IF CBWPARAM = %True THEN FUNCTION = 1' : Exit Function
                    DIALOG POST CBHNDL, %WM_USER + 1002, 0, 0
               
                  CASE %WM_USER + 1002
                    CONTROL ADD BUTTON,  CBHNDL, 1002, "New", 150, 1, 45, 20
                    Control set Color cbhndl, 1002, -1, %Black
               
               '    CASE %WM_PAINT
               '     Local hDC As Dword
               '     Local ps As PaintStruct
               '      hdc = BeginPaint(CbHndl, ps)
               '      PaintCustomCaption(hWnd, hdc)
               '      EndPaint(CbHndl, ps)
               
                  CASE %WM_COMMAND
                    SELECT CASE AS LONG CBCTL
                      CASE %BTN_Test
                        IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                          Dialog End Cbhndl
                        END IF
                      CASE 1002
                        IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                          MSGBOX "New Test!"
                        END IF
                    END SELECT
               
                  CASE %WM_NCHITTEST       ' enable DWM hit-testing in NC area
                   Local lRet, HitRes As Long
                    hLib = LoadLibrary("dwmapi.dll")
                    pAddr = GetProcAddress(hLib, "DwmDefWindowProc")
                      IF pAddr <> 0 THEN
                        CALL DWORD pAddr USING pbDwmDefWindowProc(CbHndl, CbMsg, CbWparam, CbLparam, HitRes) TO lRet
                        FreeLibrary hLib
                        If lRet <> %S_OK Then   ' Notcaption buttons
                          Function = HitRes : Exit Function
                        End If
                      END IF
                      Function = %HTCAPTION : Exit Function    ' test
               '      lRet = HitTestNCA(hWnd, wParam, lParam)  ' cursor position   ToDo
               
                  CASE %WM_SYSCOMMAND
                    IF (CBWPARAM AND &HFFF0) = %SC_CLOSE THEN
                      DIALOG END CBHNDL
                    END IF
                  CASE %WM_CLOSE
               
                  CASE %WM_DESTROY
               
                END SELECT
              END FUNCTION
              '------------------/DlgProc
               
              FUNCTION PBMAIN()
               LOCAL hDlg  AS DWORD
               
                DIALOG  NEW PIXELS, 0, "AeroTest", , , 300, 200, %WS_POPUP OR %WS_CAPTION OR %WS_SYSMENU _
                  OR %WS_THICKFRAME Or %WS_MINIMIZEBOX Or %WS_MAXIMIZEBOX TO hDlg
                DIALOG  SET COLOR    hDlg, -1, %BLACK
                CONTROL ADD LABEL,   hDlg, %LBL_LABEL1, "Test Dialog", 75, 40, 180, 30
                CONTROL ADD BUTTON,  hDlg, %BTN_Test, "Quit", 110, 100, 50, 20
                 Control Set Color hDlg, %BTN_Test, -1, %Black
                CONTROL ADD TEXTBOX, hDlg, %TXT_TEXTBOX1, "TextBox1", 70, 145, 150, 25
                CONTROL ADD LABEL,   hDlg, 201, "Caption Text", 5, 5, 100, 16
                Control Set Color hDlg, 201, %Red, %BLACK
                DIALOG SHOW MODAL hDlg, CALL DlgProc
               
              END FUNCTION
              '------------------/PbMain
              Still a lot of ToDos - like figure out how to use DrawThemeTextEx() for the caption and button text as well as the rest of the hit testing logic...
              Last edited by Dave Biggs; 22 May 2012, 06:48 PM. Reason: Modified swapped defeatist "bl**dy difficult" for something more optimistic..
              Rgds, Dave

              Comment


              • #8
                Latest version of the test code.. effectively a PBWin translation of the sample on MSDN
                It does work but I'm not sure it's a technique that's useful for production code as it stands.?

                Using an image button / icon on the title bar seems ok, but a 'regular' button with text on it is strange - the text becomes 'transparent' and I didn't find a fix for that.

                It might be interesting to try a toolbar with imagelists for different states later (when the brain cell stops aching!)

                Most noticable issue remaining with this sample is that the window's 'client area' background is black (might be fixable by changing the PaintCustomCaption function?)
                Code:
                #Compile Exe  'PBwin 10    ' Vista, Win7
                #Dim All
                #Include "WIN32API.INC"
                #Include "UxTheme.inc"
                #Include "VsSym32.inc"
                #Resource Manifest, 1, "C:\PBWin10\samples\DDT\treeview\xptheme.xml"
                #Resource Icon, ImgBut, "C:\PBWin10\samples\DDT\treeview\icons\australia.ico"
                 
                Type MARGINS
                  cxLeftWidth    As Long
                  cxRightWidth   As Long
                  cyTopHeight    As Long
                  cyBottomHeight As Long
                End Type
                 
                %LEFTEXTENDWIDTH    = 8
                %RIGHTEXTENDWIDTH   = 8
                %TOPEXTENDWIDTH     = 30
                %BOTTOMEXTENDWIDTH  = 8
                 
                %BTN_Test      = 102
                %LBL_LABEL1    = 101
                %TXT_TEXTBOX1  = 100
                 
                Declare Function IsDwmEnabled(IsEnabled As Long) As Long
                Declare Function pbDwmExtendFrameIntoClientArea(ByVal hWnd As Dword, ByVal pMarInset As MARGINS Ptr) As Long
                Declare Function pbDwmDefWindowProc (ByVal hWnd As Dword, ByVal msg As Dword, ByVal wParam As Dword, ByVal lParam As Long, ByRef lResult As Long) As Long
                '------------------/
                 
                Function IsVistaPlus() As Long
                 Local vi As OSVERSIONINFO
                   vi.dwOsVersionInfoSize = SizeOf(vi)
                  GetVersionEx vi
                  If IsTrue (vi.dwPlatformId = %VER_PLATFORM_WIN32_NT) And vi.dwMajorVersion >= 6 Then Function = %TRUE
                End Function
                '------------------/IsVistaPlus
                 
                Function IsAero() As Long
                 Local lRet, IsEnabled As Long
                 Local hLib, pAddr As Dword
                  hLib = LoadLibrary("dwmapi.dll")
                  pAddr = GetProcAddress(hLib, "DwmIsCompositionEnabled")
                   If pAddr <> 0 Then
                    Call Dword pAddr Using IsDwmEnabled(IsEnabled) To lRet
                    FreeLibrary hLib
                  Else
                    FreeLibrary hLib
                    Function = %FALSE
                    Exit Function
                  End If
                  If lRet <> %S_Ok Then
                    Function = %FALSE
                    Exit Function
                  Else
                    Function = IsEnabled
                  End If
                 End Function
                '------------------/IsAero
                 
                CallBack Function DlgProc()
                 Local hr           As Long
                 Local hLib, pAddr  As Dword
                 Local dwmMargins   As Margins
                 Local rcClient     As RECT
                 Local hDC    As Dword
                 Local ps     As PaintStruct
                 Local hCtrl  As Dword
                  Select Case As Long CbMsg
                    Case %WM_InitDialog
                      If IsVistaPlus = 0 Then
                        MsgBox ">=Vista only ", %MB_IconMask, "" : Dialog Post CbHndl, %WM_SYSCOMMAND, %SC_Close, 0
                      End If
                      If IsAero = 0 Then
                        MsgBox "Aero only", %MB_IconMask, "" : Dialog Post CbHndl, %WM_SYSCOMMAND, %SC_Close, 0
                      End If
                 
                      Dialog Post CbHndl, %WM_User + 1000, 0, 0
                 
                    Case %WM_User + 1000
                      Dialog ReDraw CbHndl        ' * Extend the frame into the client area when GUI ready.
                 
                      dwmMargins.cxLeftWidth    = %LEFTEXTENDWIDTH
                      dwmMargins.cxRightWidth   = %RIGHTEXTENDWIDTH
                      dwmMargins.cyTopHeight    = %TOPEXTENDWIDTH
                      dwmMargins.cyBottomHeight = %BOTTOMEXTENDWIDTH
                      hLib  = LoadLibrary("dwmapi.dll")
                      pAddr = GetProcAddress(hLib, "DwmExtendFrameIntoClientArea")
                      If pAddr <> 0 Then
                        Call Dword pAddr Using pbDwmExtendFrameIntoClientArea(CbHndl, VarPtr(dwmMargins)) To hr
                        FreeLibrary hLib
                      Else
                        FreeLibrary hLib
                        Function = %FALSE
                        Exit Function
                      End If
                      If hr <> %S_Ok Then
                        Function = 1
                        Exit Function
                      End If
                                                  ' * Remove the standard frame (client area now = entire window)
                      GetWindowRect(CbHndl, ByVal VarPtr(rcClient))
                      SetWindowPos(CbHndl, %HWND_TOP, rcClient.nLeft, rcClient.nTop, _
                                 rcClient.nRight - rcClient.nLeft, rcClient.nBottom - rcClient.nTop, _
                                 %SWP_FRAMECHANGED)
                 
                    Case %WM_NCCalcsize
                      If CbWParam = %True Then Function = 1
                 
                    Case %WM_Paint
                      hdc = BeginPaint(CbHndl, ps)
                      PaintCustomCaption(CbHndl, hdc, "Test caption that is too long to fit", "Window")
                      EndPaint(CbHndl, ps)
                 
                    Case %WM_Command
                      Select Case As Long CbCtl
                        Case %BTN_Test
                          If CbCtlMsg = %BN_Clicked Or CbCtlMsg = 1 Then
                 '            Control Add Button,  CBHNDL, 1001, "New", 100, 1, 45, 21  ' see thru text??!
                            Control Add ImgButton, CbHndl, 1002, "ImgBut", 150, 1, 45, 21, _
                              %WS_Child Or %WS_Visible Or %WS_TabStop Or %BS_Icon Or %BS_PushButton Or %BS_Center Or _
                              %BS_VCenter, %WS_Ex_Left Or %WS_Ex_LtrReading
                            Control Set Color CbHndl, 1002, -1, %Black
                 '            Dialog Set Text cbhndl, "Not likely!"    ' 
                          End If
                        Case 1002
                          If CbCtlMsg = %BN_Clicked Or CbCtlMsg = 1 Then
                            MsgBox "ImgButton Test!"
                          End If
                      End Select
                 
                    Case %WM_NCHitTest
                     Local lRet, HitRes As Long
                      hLib = LoadLibrary("dwmapi.dll")
                      pAddr = GetProcAddress(hLib, "DwmDefWindowProc")      ' enable DWM hit-testing in NC area
                        If pAddr <> 0 Then
                          Call Dword pAddr Using pbDwmDefWindowProc(CbHndl, CbMsg, CbWParam, CbLParam, HitRes) To lRet
                          FreeLibrary hLib
                          If lRet <> %S_Ok Then                             ' eg Notcaption buttons?
                            Function = HitRes : Exit Function
                          End If
                        Else
                          FreeLibrary hLib
                          Function = %FALSE
                          Exit Function
                        End If
                        ' Hit test the frame for resizing and moving.
                        Function = HitTestNCA(CbHndl, CbWParam, CbLParam)  ' cursor position
                        Exit Function
                 
                    Case %WM_SYSCOMMAND
                      If (CbWParam And &HFFF0) = %SC_Close Then
                        Dialog End CbHndl
                      End If
                    Case %WM_Close
                 
                    Case %WM_Destroy
                 
                  End Select
                End Function
                '------------------/DlgProc
                 
                Function PBMain()
                 Local hDlg  As Dword
                 Local rcClient As RECT
                  Dialog  New Pixels, 0, "AeroTest", , , 300, 200, %WS_Popup Or %WS_Caption Or %WS_SysMenu _
                    Or %WS_ThickFrame Or %WS_MinimizeBox Or %WS_MaximizeBox To hDlg
                  Control Add Label,   hDlg, %LBL_LABEL1, "Long custom title finishes w/ elipsis", 75, 40, 180, 30
                  Control Add Button,  hDlg, %BTN_Test, "Test", 90, 100, 50, 20
                  Control Set Color hDlg, %BTN_Test, -1, %Black
                  Control Add TextBox, hDlg, %TXT_TEXTBOX1, "TextBox1", 70, 145, 150, 25
                 
                  Dialog Show Modal hDlg, Call DlgProc
                 
                End Function
                '------------------/PbMain
                 
                Function PaintCustomCaption(hWnd As Dword, hDC As Dword, sText As String, sClass As String ) As Long
                 Local rcClient, rcPaint As RECT, cx, cy As Long
                 Local hTheme, hdcPaint, hBM, hbmOld As Dword
                 Local dib As BITMAPINFO
                 Local lDttOpts As DTTOPTS
                 Local lgFontw As LOGFONTW
                 Local hFont, hFontOld As Dword
                 Local wszTitle, wszClass As WStringZ * 100
                 
                  wszTitle = sText                                  ' New Caption
                  wszClass = sClass
                  GetClientRect(hWnd, rcClient)
                   hTheme = OpenThemeData(%NULL, wszClass)          ' "Window"
                   If (hTheme) Then
                      hdcPaint = CreateCompatibleDC(hdc)
                      If (hdcPaint)<>0 Then
                          cx = rcClient.right - rcClient.left
                          cy = rcClient.bottom - rcClient.top
                 
                          ' Define the BITMAPINFO structure used to draw text.  ' note black rect
                          ' Note that biHeight is negative as DrawThemeTextEx() needs bitmap in top-to-bottom order.
                          dib.bmiHeader.biSize            = SizeOf(BITMAPINFOHEADER)
                          dib.bmiHeader.biWidth           = cx          ' size of client rect
                          dib.bmiHeader.biHeight          = -cy         ' now includes NC area
                          dib.bmiHeader.biPlanes          = 1
                          dib.bmiHeader.biBitCount        = 32          ' BIT_COUNT
                          dib.bmiHeader.biCompression     = %BI_RGB     ' not compressed
                 
                          hBM = CreateDIBSection(hdc, dib, %DIB_RGB_COLORS, %NULL, %NULL, 0)
                          If (hBM) Then
                              hbmOld = SelectObject(hdcPaint, hBM)
                 
                              ' Setup the theme drawing options.
                              lDttOpts.dwSize = SizeOf(DTTOPTS)
                              lDttOpts.dwFlags = %DTT_COMPOSITED Or %DTT_GLOWSIZE Or %DTT_TEXTCOLOR' OR %DTT_APPLYOVERLAY
                              lDttOpts.iGlowSize = 15
                              lDttOpts.crText = %rgb_DarkBlue
                 '              lDttOpts.fApplyOverlay = %True
                 
                              ' Select a font.
                              If GetThemeSysFont(hTheme, %TMT_CAPTIONFONT, lgFontw) = %S_Ok Then      ' Sergio UI ??
                                  hFont = CreateFontIndirectw(lgFontw)
                                  hFontOld = SelectObject(hdcPaint, hFont)
                              End If
                 
                              ' Draw the title.
                              rcPaint = rcClient
                              rcPaint.top += 8
                              rcPaint.right -= 170                                ' limit length of title
                              rcPaint.left += 8
                              rcPaint.bottom -= 50
                              DrawThemeTextEx(hTheme, _
                                              hdcPaint, _
                                              0, 0, _                             ' iPartId, iStateId
                                              wszTitle, _
                                              -1, _
                                              %DT_LEFT Or %DT_WORD_ELLIPSIS, _    ' ellipsis when Title too long
                                              rcPaint, _
                                              lDttOpts)
                 
                              ' Blit text to the frame.
                              BitBlt(hdc, 0, 0, cx, cy, hdcPaint, 0, 0, %SRCCOPY)
                 
                '--Housekeeping
                              SelectObject(hdcPaint, hbmOld)
                            If (hFontOld) Then
                              SelectObject(hdcPaint, hFontOld)
                            End If
                          DeleteObject(hbm)
                          End If
                      DeleteDC(hdcPaint)
                      End If
                    CloseThemeData(hTheme)
                   End If
                End Function
                '------------------/PaintCustomCaption
                 
                Function HitTestNCA(hWnd As Dword, wParam As Dword, lParam As Long) As Long
                 Local ptMouse As Point
                 Local rcWindow, rcFrame As Rect
                 Dim   hitTests(2,2) As Long
                 Local uRow, uCol, fOnResizeBorder As Long
                 
                    ' Get the point coordinates for the hit test.
                 '    xPos = LOWORD(lParam);  // horizontal position of cursor
                 '    yPos = HIWORD(lParam);  // vertical position of cursor
                    ptMouse.x = Lo(Integer, lParam) : ptMouse.y = Hi(Integer, lParam)
                 
                    ' Get the window rectangle.
                    GetWindowRect(hWnd, rcWindow)
                    ' Get the frame rectangle, adjusted for the style without a caption.
                    AdjustWindowRectEx(rcFrame, %WS_OverlappedWindow And Not %WS_Caption, %FALSE, %NULL)
                    ' Determine if the hit test is for resizing. Default middle (1,1).
                    uRow = 1
                    uCol = 1
                    fOnResizeBorder = %false
                 
                    ' Determine if the point is at the top or bottom of the window.
                    If (ptMouse.y >= rcWindow.top) And (ptMouse.y < (rcWindow.top + %TOPEXTENDWIDTH)) Then
                      fOnResizeBorder = (ptMouse.y < (rcWindow.top - rcFrame.top))
                      uRow = 0
                    ElseIf (ptMouse.y < rcWindow.bottom) And (ptMouse.y >= (rcWindow.bottom - %BOTTOMEXTENDWIDTH)) Then
                      uRow = 2
                    End If
                 
                    ' Determine if the point is at the left or right of the window.
                    If (ptMouse.x >= rcWindow.left) And (ptMouse.x < (rcWindow.left + %LEFTEXTENDWIDTH)) Then
                      uCol = 0  ' left side
                    ElseIf (ptMouse.x < rcWindow.right) And (ptMouse.x >= (rcWindow.right - %RIGHTEXTENDWIDTH)) Then
                      uCol = 2  ' right side
                    End If
                 
                    ' Hit test results(HTTOPLEFT, ... HTBOTTOMRIGHT)
                      hitTests(0,0)=%HTTOPLEFT    : hitTests(0,1)=IIf(fOnResizeBorder, %HTTOP, %HTCAPTION)
                                                                                    : hitTests(0,2)=%HTTOPRIGHT
                      hitTests(1,0)=%HTLEFT       : hitTests(1,1)=%HTNOWHERE : hitTests(1,2)=%HTRIGHT
                      hitTests(2,0)=%HTBOTTOMLEFT : hitTests(2,1)=%HTBOTTOM  : hitTests(2,2)=%HTBOTTOMRIGHT
                 
                 Function = hitTests(uRow,uCol)
                End Function
                '------------------/HitTestNCA
                Attached Files
                Rgds, Dave

                Comment


                • #9
                  the code works fine on Win98 but on my WinXP Pro box the additional button does not appear
                  I had that exact same problem... a button control appeared on the screen and worked perfectly on Windows 9x, but never even appeared on the screen under XP.

                  That problem I traced to incorrect superclassing on my part: I forgot to move the "window extra bytes" of the source class ("button") to the new class.

                  Just thinking about it, it's almost a miracle it worked under 9x.

                  Look for something like a 'bad combination' of window styles/ex styles.

                  Comment


                  • #10
                    Slight Update to Dave's fine work. Thank you Dave.

                    Code:
                    #COMPILE EXE  'PBwin 10    ' Vista, Win7
                    #DIM ALL
                    #INCLUDE "WIN32API.INC"
                    '#Include "UxTheme.inc"
                    '#Include "VsSym32.inc"
                    #RESOURCE MANIFEST, 1, "C:\PBWin10\samples\DDT\treeview\xptheme.xml"
                    #RESOURCE ICON, ImgBut, "C:\PBWin10\samples\DDT\treeview\icons\australia.ico"
                    
                    'Updated by Jim Fritts on 12 MAR 2019
                    'works with PBWIN10.4 and Jose' includes
                    
                    ' // Size = 16 bytes
                    TYPE MARGINS DWORD
                       cxLeftWidth    AS LONG  ' int // width of left border that retains its size
                       cxRightWidth   AS LONG  ' int // width of right border that retains its size
                       cyTopHeight    AS LONG  ' int // height of top border that retains its size
                       cyBottomHeight AS LONG  ' int // height of bottom border that retains its size
                    END TYPE
                    
                    %LEFTEXTENDWIDTH    = 8
                    %RIGHTEXTENDWIDTH   = 8
                    %TOPEXTENDWIDTH     = 30
                    %BOTTOMEXTENDWIDTH  = 8
                    
                    %BTN_Test      = 102
                    %LBL_LABEL1    = 101
                    %TXT_TEXTBOX1  = 100
                    
                    DECLARE FUNCTION DwmIsCompositionEnabled IMPORT "DWMAPI.DLL" ALIAS "DwmIsCompositionEnabled" ( _
                       BYREF pfEnabled AS LONG _                            ' __out BOOL* pfEnabled
                     ) AS LONG                                              ' HRESULT
                    
                    'Declare Function IsDwmEnabled(IsEnabled As Long) As Long
                    DECLARE FUNCTION pbDwmExtendFrameIntoClientArea(BYVAL hWnd AS DWORD, BYVAL pMarInset AS MARGINS PTR) AS LONG
                    DECLARE FUNCTION pbDwmDefWindowProc (BYVAL hWnd AS DWORD, BYVAL msg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG, BYREF lResult AS LONG) AS LONG
                    '------------------/
                    
                    FUNCTION IsVistaPlus() AS LONG
                     LOCAL vi AS OSVERSIONINFO
                       vi.dwOsVersionInfoSize = SIZEOF(vi)
                      GetVersionEx vi
                      IF ISTRUE (vi.dwPlatformId = %VER_PLATFORM_WIN32_NT) AND vi.dwMajorVersion >= 6 THEN FUNCTION = %TRUE
                    END FUNCTION
                    '------------------/IsVistaPlus
                    
                    FUNCTION IsAero() AS LONG        'could also use IsCompositionActive
                    
                        LOCAL bRes      AS LONG
                        LOCAL IsEnabled AS LONG
                        LOCAL hLib      AS DWORD
                        LOCAL pProc     AS DWORD
                    
                        hLib = LoadLibraryA("dwmapi.dll")
                        pProc = GetProcAddress(hLib, "DwmIsCompositionEnabled")
                        IF pProc <> 0 THEN
                            CALL DWORD pProc USING DwmIsCompositionEnabled(IsEnabled) TO bRes
                            FreeLibrary hLib
                        ELSE
                            FreeLibrary hLib
                            FUNCTION = %FALSE
                            EXIT FUNCTION
                        END IF
                        IF bRes <> %S_OK THEN
                            FUNCTION = %FALSE
                            EXIT FUNCTION
                        ELSE
                            FUNCTION = IsEnabled
                        END IF
                        'Note %S_OK = 0 and %S_FALSE = 1
                    
                    END FUNCTION
                    
                    
                    CALLBACK FUNCTION DlgProc()
                     LOCAL hr           AS LONG
                     LOCAL hLib, pAddr  AS DWORD
                     LOCAL dwmMargins   AS Margins
                     LOCAL rcClient     AS RECT
                     LOCAL hDC    AS DWORD
                     LOCAL ps     AS PaintStruct
                     LOCAL hCtrl  AS DWORD
                      SELECT CASE AS LONG CBMSG
                        CASE %WM_INITDIALOG
                          IF IsVistaPlus = 0 THEN
                            MSGBOX ">=Vista only ", %MB_ICONMASK, "" : DIALOG POST CBHNDL, %WM_SYSCOMMAND, %SC_CLOSE, 0
                          END IF
                          IF IsAero = 0 THEN
                            MSGBOX "Aero only", %MB_ICONMASK, "" : DIALOG POST CBHNDL, %WM_SYSCOMMAND, %SC_CLOSE, 0
                          END IF
                    
                          DIALOG POST CBHNDL, %WM_USER + 1000, 0, 0
                    
                        CASE %WM_USER + 1000
                          DIALOG REDRAW CBHNDL        ' * Extend the frame into the client area when GUI ready.
                    
                          dwmMargins.cxLeftWidth    = %LEFTEXTENDWIDTH
                          dwmMargins.cxRightWidth   = %RIGHTEXTENDWIDTH
                          dwmMargins.cyTopHeight    = %TOPEXTENDWIDTH
                          dwmMargins.cyBottomHeight = %BOTTOMEXTENDWIDTH
                          hLib  = LoadLibrary("dwmapi.dll")
                          pAddr = GetProcAddress(hLib, "DwmExtendFrameIntoClientArea")
                          IF pAddr <> 0 THEN
                            CALL DWORD pAddr USING pbDwmExtendFrameIntoClientArea(CBHNDL, VARPTR(dwmMargins)) TO hr
                            FreeLibrary hLib
                          ELSE
                            FreeLibrary hLib
                            FUNCTION = %FALSE
                            EXIT FUNCTION
                          END IF
                          IF hr <> %S_OK THEN
                            FUNCTION = 1
                            EXIT FUNCTION
                          END IF
                                                      ' * Remove the standard frame (client area now = entire window)
                          GetWindowRect(CBHNDL, BYVAL VARPTR(rcClient))
                          SetWindowPos(CBHNDL, %HWND_TOP, rcClient.nLeft, rcClient.nTop, _
                                     rcClient.nRight - rcClient.nLeft, rcClient.nBottom - rcClient.nTop, _
                                     %SWP_FRAMECHANGED)
                    
                        CASE %WM_NCCALCSIZE
                          IF CBWPARAM = %True THEN FUNCTION = 1
                    
                        CASE %WM_PAINT
                          hdc = BeginPaint(CBHNDL, ps)
                          PaintCustomCaption(CBHNDL, hdc, "Test caption that is too long to fit", "Window")
                          EndPaint(CBHNDL, ps)
                    
                        CASE %WM_COMMAND
                          SELECT CASE AS LONG CBCTL
                            CASE %BTN_Test
                              IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                     '            Control Add Button,  CBHNDL, 1001, "New", 100, 1, 45, 21  ' see thru text??!
                                CONTROL ADD IMGBUTTON, CBHNDL, 1002, "ImgBut", rcClient.nRight - rcClient.nLeft + 217, 1, 45, 28, _
                                  %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_ICON OR %BS_PUSHBUTTON OR %BS_CENTER OR _
                                  %BS_VCENTER, %WS_EX_LEFT OR %WS_EX_LTRREADING
                                CONTROL SET COLOR CBHNDL, 1002, -1, %BLACK
                     '            Dialog Set Text cbhndl, "Not likely!"    '
                              END IF
                            CASE 1002
                              IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                                MSGBOX "ImgButton Test!"
                              END IF
                          END SELECT
                    
                        CASE %WM_NCHITTEST
                         LOCAL lRet, HitRes AS LONG
                          hLib = LoadLibrary("dwmapi.dll")
                          pAddr = GetProcAddress(hLib, "DwmDefWindowProc")      ' enable DWM hit-testing in NC area
                            IF pAddr <> 0 THEN
                              CALL DWORD pAddr USING pbDwmDefWindowProc(CBHNDL, CBMSG, CBWPARAM, CBLPARAM, HitRes) TO lRet
                              FreeLibrary hLib
                              IF lRet <> %S_OK THEN                             ' eg Notcaption buttons?
                                FUNCTION = HitRes : EXIT FUNCTION
                              END IF
                            ELSE
                              FreeLibrary hLib
                              FUNCTION = %FALSE
                              EXIT FUNCTION
                            END IF
                            ' Hit test the frame for resizing and moving.
                            FUNCTION = HitTestNCA(CBHNDL, CBWPARAM, CBLPARAM)  ' cursor position
                            EXIT FUNCTION
                    
                        CASE %WM_SYSCOMMAND
                          IF (CBWPARAM AND &HFFF0) = %SC_CLOSE THEN
                            DIALOG END CBHNDL
                          END IF
                        CASE %WM_CLOSE
                    
                        CASE %WM_DESTROY
                    
                      END SELECT
                    END FUNCTION
                    '------------------/DlgProc
                    
                    FUNCTION PBMAIN()
                     LOCAL hDlg  AS DWORD
                     LOCAL rcClient AS RECT
                      DIALOG  NEW PIXELS, 0, "AeroTest", , , 390, 200, %WS_POPUP OR %WS_CAPTION OR %WS_SYSMENU _
                        OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX TO hDlg
                      CONTROL ADD LABEL,   hDlg, %LBL_LABEL1, "Long custom title finishes w/ elipsis", 75, 40, 180, 30
                      CONTROL ADD BUTTON,  hDlg, %BTN_Test, "Test", 90, 100, 50, 20
                      CONTROL SET COLOR hDlg, %BTN_Test, -1, %BLACK
                      CONTROL ADD TEXTBOX, hDlg, %TXT_TEXTBOX1, "TextBox1", 70, 145, 150, 25
                    
                      DIALOG SHOW MODAL hDlg, CALL DlgProc
                    
                    END FUNCTION
                    '------------------/PbMain
                    
                    FUNCTION PaintCustomCaption(hWnd AS DWORD, hDC AS DWORD, sText AS STRING, sClass AS STRING ) AS LONG
                     LOCAL rcClient, rcPaint AS RECT, cx, cy AS LONG
                     LOCAL hTheme, hdcPaint, hBM, hbmOld AS DWORD
                     LOCAL dib AS BITMAPINFO
                     LOCAL lDttOpts AS DTTOPTS
                     LOCAL lgFontw AS LOGFONTW
                     LOCAL hFont, hFontOld AS DWORD
                     LOCAL wszTitle, wszClass AS WSTRINGZ * 100
                    
                      wszTitle = sText                                  ' New Caption
                      wszClass = sClass
                      GetClientRect(hWnd, rcClient)
                       hTheme = OpenThemeData(%NULL, wszClass)          ' "Window"
                       IF (hTheme) THEN
                          hdcPaint = CreateCompatibleDC(hdc)
                          IF (hdcPaint)<>0 THEN
                              cx = rcClient.right - rcClient.left
                              cy = rcClient.bottom - rcClient.top
                    
                              ' Define the BITMAPINFO structure used to draw text.  ' note black rect
                              ' Note that biHeight is negative as DrawThemeTextEx() needs bitmap in top-to-bottom order.
                              dib.bmiHeader.biSize            = SIZEOF(BITMAPINFOHEADER)
                              dib.bmiHeader.biWidth           = cx          ' size of client rect
                              dib.bmiHeader.biHeight          = -cy         ' now includes NC area
                              dib.bmiHeader.biPlanes          = 1
                              dib.bmiHeader.biBitCount        = 32          ' BIT_COUNT
                              dib.bmiHeader.biCompression     = %BI_RGB     ' not compressed
                    
                              hBM = CreateDIBSection(hdc, dib, %DIB_RGB_COLORS, %NULL, %NULL, 0)
                              IF (hBM) THEN
                                  hbmOld = SelectObject(hdcPaint, hBM)
                    
                                  ' Setup the theme drawing options.
                                  lDttOpts.dwSize = SIZEOF(DTTOPTS)
                                  lDttOpts.dwFlags = %DTT_COMPOSITED OR %DTT_GLOWSIZE OR %DTT_TEXTCOLOR' OR %DTT_APPLYOVERLAY
                                  lDttOpts.iGlowSize = 15
                                  lDttOpts.crText = %RGB_DARKBLUE
                     '              lDttOpts.fApplyOverlay = %True
                    
                                  ' Select a font.
                                  IF GetThemeSysFont(hTheme, %TMT_CAPTIONFONT, lgFontw) = %S_OK THEN      ' Sergio UI ??
                                      hFont = CreateFontIndirectw(lgFontw)
                                      hFontOld = SelectObject(hdcPaint, hFont)
                                  END IF
                    
                                  ' Draw the title.
                                  rcPaint = rcClient
                                  rcPaint.top += 8
                                  rcPaint.right -= 170                                ' limit length of title
                                  rcPaint.left += 8
                                  rcPaint.bottom -= 50
                                  DrawThemeTextEx(hTheme, _
                                                  hdcPaint, _
                                                  0, 0, _                             ' iPartId, iStateId
                                                  wszTitle, _
                                                  -1, _
                                                  %DT_LEFT OR %DT_WORD_ELLIPSIS, _    ' ellipsis when Title too long
                                                  rcPaint, _
                                                  lDttOpts)
                    
                                  ' Blit text to the frame.
                                  BitBlt(hdc, 0, 0, cx, cy, hdcPaint, 0, 0, %SRCCOPY)
                    
                    '--Housekeeping
                                  SelectObject(hdcPaint, hbmOld)
                                IF (hFontOld) THEN
                                  SelectObject(hdcPaint, hFontOld)
                                END IF
                              DeleteObject(hbm)
                              END IF
                          DeleteDC(hdcPaint)
                          END IF
                        CloseThemeData(hTheme)
                       END IF
                    END FUNCTION
                    '------------------/PaintCustomCaption
                    
                    FUNCTION HitTestNCA(hWnd AS DWORD, wParam AS DWORD, lParam AS LONG) AS LONG
                     LOCAL ptMouse AS POINT
                     LOCAL rcWindow, rcFrame AS Rect
                     DIM   hitTests(2,2) AS LONG
                     LOCAL uRow, uCol, fOnResizeBorder AS LONG
                    
                        ' Get the point coordinates for the hit test.
                     '    xPos = LOWORD(lParam);  // horizontal position of cursor
                     '    yPos = HIWORD(lParam);  // vertical position of cursor
                        ptMouse.x = LO(INTEGER, lParam) : ptMouse.y = HI(INTEGER, lParam)
                    
                        ' Get the window rectangle.
                        GetWindowRect(hWnd, rcWindow)
                        ' Get the frame rectangle, adjusted for the style without a caption.
                        AdjustWindowRectEx(rcFrame, %WS_OVERLAPPEDWINDOW AND NOT %WS_CAPTION, %FALSE, %NULL)
                        ' Determine if the hit test is for resizing. Default middle (1,1).
                        uRow = 1
                        uCol = 1
                        fOnResizeBorder = %false
                    
                        ' Determine if the point is at the top or bottom of the window.
                        IF (ptMouse.y >= rcWindow.top) AND (ptMouse.y < (rcWindow.top + %TOPEXTENDWIDTH)) THEN
                          fOnResizeBorder = (ptMouse.y < (rcWindow.top - rcFrame.top))
                          uRow = 0
                        ELSEIF (ptMouse.y < rcWindow.bottom) AND (ptMouse.y >= (rcWindow.bottom - %BOTTOMEXTENDWIDTH)) THEN
                          uRow = 2
                        END IF
                    
                        ' Determine if the point is at the left or right of the window.
                        IF (ptMouse.x >= rcWindow.left) AND (ptMouse.x < (rcWindow.left + %LEFTEXTENDWIDTH)) THEN
                          uCol = 0  ' left side
                        ELSEIF (ptMouse.x < rcWindow.right) AND (ptMouse.x >= (rcWindow.right - %RIGHTEXTENDWIDTH)) THEN
                          uCol = 2  ' right side
                        END IF
                    
                        ' Hit test results(HTTOPLEFT, ... HTBOTTOMRIGHT)
                          hitTests(0,0)=%HTTOPLEFT    : hitTests(0,1)=IIF(fOnResizeBorder, %HTTOP, %HTCAPTION)
                                                                                        : hitTests(0,2)=%HTTOPRIGHT
                          hitTests(1,0)=%HTLEFT       : hitTests(1,1)=%HTNOWHERE : hitTests(1,2)=%HTRIGHT
                          hitTests(2,0)=%HTBOTTOMLEFT : hitTests(2,1)=%HTBOTTOM  : hitTests(2,2)=%HTBOTTOMRIGHT
                    
                     FUNCTION = hitTests(uRow,uCol)
                    END FUNCTION
                    '------------------/HitTestNCA

                    Comment


                    • #11
                      Hi Jim,

                      You might find these comments from Juergen interesting too.
                      Rgds, Dave

                      Comment

                      Working...
                      X