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

PBDLL6: DDT Toolbar example

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

  • PBDLL6: DDT Toolbar example

    Code:
    ' PowerBASIC PB/DLL 6.0 example of DDT toolbar by Lance C. Edmonds
     
    #COMPILE EXE
    #DIM ALL
    #INCLUDE  "WIN32API.INC"
    #INCLUDE  "COMMCTRL.INC"
      
    $AppTitle    = "DDT Toolbar Example"
      
    %ToolButtons = 10
    %ID_ToolBar  = 998
     
    %ID_Prev  = 101
    %ID_Next  = 102
    %ID_Mode1 = 103
    %ID_Mode2 = 104
     
    '=== Callback Code ====================================================================
     
    CALLBACK FUNCTION DialogCallback
        IF CBMSG = %WM_SIZE THEN
            ' Forward the %WM_SIZE event so that the toolbar resizes itself
            CONTROL SEND CBHNDL, %ID_Toolbar, %WM_SIZE, 0, 0
        ELSEIF CBMSG = %WM_COMMAND THEN
            IF CBCTL = %IDCANCEL THEN
                DIALOG END CBHNDL, %TRUE
            ELSE
                MessageBox CBHNDL, "You clicked on Toolbar ID " & FORMAT$(CBCTL), _
                    $AppTitle, %MB_OK OR %MB_ICONINFORMATION
            END IF
        END IF
    END FUNCTION
     
    '=== Main Code ========================================================================
     
    FUNCTION PBMAIN() AS LONG
        ' General Register variables for speed optimization
        REGISTER x&, y&
     
        ' Dialog variables
        LOCAL hDlg AS LONG, dx AS LONG, dy AS LONG, Rct AS RECT
        LOCAL a$
     
        ' Toolbar & Print Preview equates
        LOCAL Tbb()      AS TBBUTTON
        LOCAL Tabm       AS TBADDBITMAP
        LOCAL ToolHeight AS LONG
        LOCAL Tbb()      AS TBBUTTON
        DIM Tbb(0:%ToolButtons - 1) AS LOCAL TBBUTTON
     
        ' No error trapping, we will handle it ourself
        ON ERROR RESUME NEXT
     
        DIALOG NEW %HWND_DESKTOP, $AppTitle + " - By Lance C. Edmonds", 0, 0, _
            250, 200, %WS_MAXIMIZEBOX OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR _
            %WS_THICKFRAME OR %WS_CLIPCHILDREN OR %WS_CLIPSIBLINGS OR %DS_CENTER _
            TO hDlg
     
        CONTROL ADD "TOOLBARWINDOW32", hDlg, %ID_TOOLBAR, "", 0, 0, 1, 32, %WS_CHILD OR %WS_BORDER OR %WS_VISIBLE OR %CCS_TOP OR %TBSTYLE_TOOLTIPS OR %TB_AUTOSIZE
     
        ' Init Tbb array.
        FOR x& = 0 TO %ToolButtons - 1
            ' Set the initial states for each button
            Tbb(x&).iBitmap = 0
            Tbb(x&).idCommand = 0
            Tbb(x&).fsState = %TBSTATE_ENABLED
            Tbb(x&).fsStyle = %TBSTYLE_BUTTON
            Tbb(x&).dwData = 0
            Tbb(x&).iString = 0
            SELECT CASE x&
                CASE 0,3,6,8
                    ' Gap creation buttons.
                    Tbb(x&).fsStyle = %TBSTYLE_SEP
                CASE 1&
                    Tbb(x&).iBitmap = %STD_UNDO
                    Tbb(x&).idCommand = %ID_Prev
                    Tbb(x&).iString = 0
                    Tbb(x&).fsState = 0    '%TBSTATE_DISABLED
                CASE 2&
                    Tbb(x&).iBitmap = %STD_REDOW
                    Tbb(x&).idCommand = %ID_Next
                    Tbb(x&).iString = 1
                CASE 4&
                    Tbb(x&).iBitmap = %STD_FILENEW
                    Tbb(x&).idCommand = %ID_Mode1
                    Tbb(x&).iString = 2
                    Tbb(x&).fsState = %TBSTATE_ENABLED    OR %TBSTATE_CHECKED
                    Tbb(x&).fsStyle = %TBSTYLE_CHECKGROUP OR %TBSTYLE_BUTTON
                CASE 5&
                    Tbb(x&).iBitmap = %STD_FILESAVE
                    Tbb(x&).idCommand = %ID_Mode2
                    Tbb(x&).iString = 3
                    Tbb(x&).fsStyle = %TBSTYLE_CHECKGROUP OR %TBSTYLE_BUTTON
                CASE 7&
                    Tbb(x&).iBitmap = %STD_PRINT
                    Tbb(x&).idCommand = %IDOK
                    Tbb(x&).iString = 4
                CASE 9&
                    Tbb(x).iBitmap = %STD_DELETE
                    Tbb(x).idCommand = %IDCANCEL
                    Tbb(x).iString = 5
            END SELECT
        NEXT x&
     
        ' Set the imge list for the TB
        Tabm.hInst = %HINST_COMMCTRL    ' Use GetModuleHandle(BYVAL %NULL) if using a bitmap in a linked resource file
        Tabm.nID = %IDB_STD_LARGE_COLOR ' Use the ID of the bitmap image, ie, %ID_TOOLBAR
        CONTROL SEND hDlg, %ID_TOOLBAR, %TB_ADDBITMAP, %ToolButtons, VARPTR(Tabm)
     
        ' Set the buttons
        CONTROL SEND hDlg, %ID_TOOLBAR, %TB_BUTTONSTRUCTSIZE, SIZEOF(Tbb(0)), 0
        CONTROL SEND hDlg, %ID_TOOLBAR, %TB_ADDBUTTONS, %ToolButtons, VARPTR(Tbb(0))
     
        ' Add text descriptions if hi-res screen
        IF GetSystemMetrics(%SM_CXFULLSCREEN) =>1024 THEN
            a$ = "Prev" & $NUL & "Next" & $NUL & "New" & $NUL & "Existing" & $NUL & "Print" & $NUL & "Quit" & $NUL & $NUL
            CONTROL SEND hDlg, %ID_TOOLBAR, %TB_ADDSTRING, 0, STRPTR(a$)
        END IF
     
        ' Force TB to initially resize before we display the dialog
        CONTROL SEND hDlg, %ID_TOOLBAR, %WM_SIZE, 0, 0
     
        DIALOG SHOW MODAL hDlg CALL DialogCallback
     
    END FUNCTION
    '========================================================================================
    -------------
    Lance
    PowerBASIC Support
    mailto:[email protected][email protected]</A>
    Lance
    mailto:[email protected]

  • #2
    Somehow I deleted one line of code from the beginning of PBMAIN:

    Code:
    CALL InitCommonControls()


    ------------------
    Lance
    PowerBASIC Support
    mailto:[email protected][email protected]</A>
    Lance
    mailto:[email protected]

    Comment


    • #3
      Add-on for persons, which prefers rebar's style (raised, when mouse over)

      Add after last #INCLUDE a subroutine, which tests a version of Dll ((comctl32.dll shoud be >= 4.70)

      Code:
         Type DllVersionInfo
            cbSize As Dword
            dwMajorVersion As Dword
            dwMinorVersion As Dword
            dwBuildNumber As Dword
            dwPlatformID As Dword
         End Type
      
         Declare Function pGetDllVersion (dvi As DLLVERSIONINFO) As Double
      
         Sub GetDllVersion(lpszDllName As Asciiz, dvi As DLLVERSIONINFO)
            Dim hInstDll As Dword, hp As Dword, Result As Dword
            Lset dvi = String$(SizeOf(dvi), 0)
            hInstDll = LoadLibrary(lpszDllName)
            If hInstDll  Then
               hp = GetProcAddress(hinstDll, "DllGetVersion")
               If hp Then dvi.cbSize = SizeOf(dvi): _
                  Call Dword hp Using pGetDllVersion(dvi) To Result
               FreeLibrary hinstDll
            End If
         End Sub
      Before Dialog Show
      Code:
         Dim dvi As DllVersionInfo, hToolBar As Long, lStyle As Long
         hToolBar = GetDlgItem(hDlg, %ID_TOOLBAR)
         GetDllVersion "comctl32.dll", dvi
         If (dvi.dwMajorVersion > 4) Or ((dvi.dwMajorVersion = 4) And (dvi.dwMinorVersion >= 70)) Then
            lstyle = SendMessage (hToolbar, %TB_GETSTYLE, 0&, 0&)
            If IsFalse(lstyle And %TBSTYLE_FLAT) Then _
               SendMessage hToolbar, %TB_SETSTYLE, 0, (lstyle Or %TBSTYLE_FLAT)
         End If

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




      [This message has been edited by Semen Matusovski (edited July 15, 2000).]

      Comment


      • #4

        Code:
        CALL InitCommonControls()
        Is obsolete !


        The correct way to initialize the Common controls is :

        Code:
        LOCAL CC1 AS INIT_COMMON_CONTROLSEX
        CC1.dwSize=SIZEOF(CC1)
        CC1.dwICC=%ICC_WIN95_CLASSES
        InitCommonControlsEX CC1
        There may come a time when InitCommonControls no longer works.


        ------------------
        Chris Boss
        Computer Workshop
        Developer of "EZGUI"
        http://cwsof.com
        http://twitter.com/EZGUIProGuy

        Comment


        • #5
          Code:
          '-----------------------------------------------------------------------------
          ' TOPIC:  PBDLL6: DDT Toolbar example
          ' NAME:   Lance Edmonds, Administrator
          ' DATE:   February 03, 2000 03:35 AM
          ' PowerBASIC PB/DLL 6.0 example of DDT toolbar by Lance C. Edmonds
          '
          ' October 10, 2001 
          ' Added %TB_DROPDOWN feature to demo dropdown marker and evoke a popup menu
          ' By: Jules Marchildon  EMAIL: [email protected]
          '
          '-----------------------------------------------------------------------------
          #COMPILE EXE
          #INCLUDE  "WIN32API.INC"
          #INCLUDE  "COMMCTRL.INC"
              
          $AppTitle    = "DDT Toolbar Example"
           
          %ToolButtons = 10
          %ID_ToolBar  = 998
           
          %ID_Prev  = 101
          %ID_Next  = 102
          %ID_Mode1 = 103
          %ID_Mode2 = 104
           
          '----------------------------------------------------------------------------
          ' Create and show the popup menu...
          '----------------------------------------------------------------------------
          FUNCTION ShowPopupMenu() AS LONG
              
            LOCAL hPopup AS LONG
            LOCAL txt    AS STRING
             
            MENU NEW POPUP TO hPopup
            MENU ADD STRING, hPopup, "Hello!", 200, %MF_ENABLED   'note ID =200
            MENU ADD STRING, hPopup, "How", 201, %MF_ENABLED      '     ID =201
            MENU ADD STRING, hPopup, "-", 0, 0                    '---spacer---
            MENU ADD STRING, hPopup, "Are", 203, %MF_ENABLED      '     ID =202
            MENU ADD STRING, hPopup, "You?", 204, %MF_ENABLED     '     ID =203
             
            FUNCTION = hPopup
          END FUNCTION
           
          '------------------------------------------------------------------------------
          ' General Dialog Callback Code:
          '
          '------------------------------------------------------------------------------
          CALLBACK FUNCTION DialogCallback
              
              SELECT CASE CBMSG
                     
                  CASE %WM_SIZE
                      ' Forward the %WM_SIZE event so that the toolbar resizes itself
                      CONTROL SEND CBHNDL, %ID_Toolbar, %WM_SIZE, 0, 0
                      
                  ' trap the dropdown toolbar notification here...
                  CASE %WM_NOTIFY
                      LOCAL nmtb AS TBNOTIFY PTR
                      LOCAL rc   AS RECT
                      
                      nmtb = CBLPARAM
                      
                      SELECT CASE @nmtb.hdr.code
                          CASE %TBN_DROPDOWN
                              SELECT CASE @nmtb.iItem
                                  'display the popup menu for the dropdown button...
                                  CASE %IDOK
                                      Call SendMessage(@nmtb.hdr.hwndFrom, %TB_GETRECT, @nmtb.iItem, VARPTR(rc))
                                      Call MapWindowPoints(@nmtb.hdr.hwndFrom, %HWND_DESKTOP, BYVAL VARPTR(rc), 2)
                                      hPopUp& = ShowPopUpMenu()
                                      Call TrackPopupMenu (hPopUp&, 0, rc.nLeft, rc.nBottom, 0, CBHNDL, BYVAL %NULL)
                              END SELECT
                      END SELECT
                      
                      FUNCTION = 0 : EXIT FUNCTION
                  
                  CASE %WM_COMMAND
                      SELECT CASE  LOWRD(CBWPARAM)
                             CASE %IDCANCEL
                                  DIALOG END CBHNDL, %TRUE
                                  
                             CASE ELSE  'show ID's for toolbar buttons and popup menu...
                                  MessageBox CBHNDL, "You clicked on Toolbar ID " & FORMAT$(CBCTL), _
                              $AppTitle, %MB_OK OR %MB_ICONINFORMATION
                      END SELECT
              END SELECT
          END FUNCTION
          
           
          '------------------------------------------------------------------------------
          '  Main entry point when program starts:
          '
          '------------------------------------------------------------------------------
          FUNCTION PBMAIN() AS LONG
              ' General Register variables for speed optimization
              REGISTER x&, y&
           
              ' Dialog variables
              LOCAL hDlg AS LONG, dx AS LONG, dy AS LONG, Rct AS RECT
              LOCAL a$
           
              ' Toolbar & Print Preview equates
              LOCAL Tbb()      AS TBBUTTON
              LOCAL Tabm       AS TBADDBITMAP
              LOCAL ToolHeight AS LONG
              
              DIM Tbb(0:%ToolButtons - 1) AS LOCAL TBBUTTON
           
              ' No error trapping, we will handle it ourself
              ON ERROR RESUME NEXT
           
              DIALOG NEW %HWND_DESKTOP, $AppTitle + " - By Lance C. Edmonds", 0, 0, _
                  250, 200, %WS_MAXIMIZEBOX OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR _
                  %WS_THICKFRAME OR %WS_CLIPCHILDREN OR %WS_CLIPSIBLINGS OR %DS_CENTER _
                  TO hDlg
           
              ' Initialize common controls...
              Call InitCommonControls()
               
              CONTROL ADD "TOOLBARWINDOW32", hDlg, %ID_TOOLBAR, "", 0, 0, 1, 32, %WS_CHILD OR %WS_BORDER OR %WS_VISIBLE OR %CCS_TOP OR %TBSTYLE_TOOLTIPS OR %TB_AUTOSIZE
           
              ' Init Tbb array.
              FOR x& = 0 TO %ToolButtons - 1
                  ' Set the initial states for each button
                  Tbb(x&).iBitmap = 0
                  Tbb(x&).idCommand = 0
                  Tbb(x&).fsState = %TBSTATE_ENABLED
                  Tbb(x&).fsStyle = %TBSTYLE_BUTTON
                  Tbb(x&).dwData = 0
                  Tbb(x&).iString = 0
                  SELECT CASE x&
                      CASE 0,3,6,8
                          ' Gap creation buttons.
                          Tbb(x&).fsStyle = %TBSTYLE_SEP
                      CASE 1&
                          Tbb(x&).iBitmap = %STD_UNDO
                          Tbb(x&).idCommand = %ID_Prev
                          Tbb(x&).iString = 0
                          Tbb(x&).fsState = 0    '%TBSTATE_DISABLED
                      CASE 2&
                          Tbb(x&).iBitmap = %STD_REDOW
                          Tbb(x&).idCommand = %ID_Next
                          Tbb(x&).iString = 1
                      CASE 4&
                          Tbb(x&).iBitmap = %STD_FILENEW
                          Tbb(x&).idCommand = %ID_Mode1
                          Tbb(x&).iString = 2
                          Tbb(x&).fsState = %TBSTATE_ENABLED    OR %TBSTATE_CHECKED
                          Tbb(x&).fsStyle = %TBSTYLE_CHECKGROUP OR %TBSTYLE_BUTTON
                      CASE 5&
                          Tbb(x&).iBitmap = %STD_FILESAVE
                          Tbb(x&).idCommand = %ID_Mode2
                          Tbb(x&).iString = 3
                          Tbb(x&).fsStyle = %TBSTYLE_CHECKGROUP OR %TBSTYLE_BUTTON
                      CASE 7&
                          Tbb(x&).iBitmap = %STD_PRINT
                          Tbb(x&).idCommand = %IDOK
                          Tbb(x&).iString = 4
                          Tbb(x&).fsStyle = %TBSTYLE_DROPDOWN  '<--MAKE SURE YOU ADD TO EACH
                      CASE 9&                                  '   BUTTON YOU WANT THE DROPDOWN MARKER
                          Tbb(x).iBitmap = %STD_DELETE
                          Tbb(x).idCommand = %IDCANCEL
                          Tbb(x).iString = 5
                  END SELECT
              NEXT x&
           
              ' Set the imge list for the TB
              Tabm.hInst = %HINST_COMMCTRL    ' Use GetModuleHandle(BYVAL %NULL) if using a bitmap in a linked resource file
              Tabm.nID = %IDB_STD_LARGE_COLOR ' Use the ID of the bitmap image, ie, %ID_TOOLBAR
              CONTROL SEND hDlg, %ID_TOOLBAR, %TB_ADDBITMAP, %ToolButtons, VARPTR(Tabm)
           
              ' Set the buttons
              CONTROL SEND hDlg, %ID_TOOLBAR, %TB_BUTTONSTRUCTSIZE, SIZEOF(Tbb(0)), 0
              CONTROL SEND hDlg, %ID_TOOLBAR, %TB_ADDBUTTONS, %ToolButtons, VARPTR(Tbb(0))
           
              ' Add text descriptions if hi-res screen
              IF GetSystemMetrics(%SM_CXFULLSCREEN) =>1024 THEN
                  a$ = "Prev" & $NUL & "Next" & $NUL & "New" & $NUL & "Existing" & $NUL & "Print" & $NUL & "Quit" & $NUL & $NUL
                  CONTROL SEND hDlg, %ID_TOOLBAR, %TB_ADDSTRING, 0, STRPTR(a$)
              END IF
           
              ' Force TB to initially resize before we display the dialog
              CONTROL SEND hDlg, %ID_TOOLBAR, %WM_SIZE, 0, 0
           
              ' Add Hover effect...
              hWndTB& = GetDlgItem(hDlg, %ID_TOOLBAR)
              TBstyle& = SendMessage (hWndTB&, %TB_GETSTYLE, 0&, 0&)
              IF ISFALSE(TBstyle& And %TBSTYLE_FLAT) THEN
                   Call SendMessage( hWndTB&, %TB_SETSTYLE, 0, (TBstyle& OR %TBSTYLE_FLAT) )
              END IF
               
              ' Add dropdown button marker to ALL buttons with TBSTYLE_DROPDOWN style...
              Call SendMessage(hWndTB&, %TB_SETEXTENDEDSTYLE, 0,%TBSTYLE_EX_DRAWDDARROWS)
                  
              DIALOG SHOW MODAL hDlg CALL DialogCallback
           
          END FUNCTION
          '========================================================================================

          Best regards
          Jules
          www.rpmarchildon.com

          Comment

          Working...
          X