Announcement

Collapse
No announcement yet.

Borje Progress Control - How to Set Font

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

  • Borje Progress Control - How to Set Font

    Hey Borje!

    I'm playing again with your progress control but haven't yet figured out how to change the font size. Can you clarify?

  • #2
    Create a font of the wanted type and size and pass the handle using SendMesage <handle of the control>, PGB_SETFONT, <handle of the new font>, 0.
    Forum: http://www.jose.it-berater.org/smfforum/index.php

    Comment


    • #3
      Don't remember PGB_SETFONT - did I do that later? Can't remember - else from last update I can find:
      ' LOG:
      ' Feb 7, 2003: Added %WM_SETFONT handling.

      Comment


      • #4
        Never mind. PGB_SETFONT and PGB_GETFONT are two messages that I added when I translated your control to another language.
        Forum: http://www.jose.it-berater.org/smfforum/index.php

        Comment


        • #5
          Jose!
          Yes, when you wrote the message I knew I'd gone through the include file and did not see the two messages you added. So, I went of looking on the web for it too - came up empty handed. Thanks for the clarication.

          Borje,
          I'll go give that a try. When I looked at one of the examples, I didn't see the use of WM_SetFont. What I did see was some other code that I didn't quite understand, so I'l glad to hear of the option to use WM_SetFont option. I'll go give it a try.

          Comment


          • #6
            I don't see any support for WM_SETFONT in the control. Anyway, implementing PFB_SETFONT is easy.

            1. Add m_hFont AS DWORD to the PGB3DDATA structure

            2. Create a default font in WM_CREATE and store its handle in m_hFont.

            3. Add %PGB_SETFONT = %WM_USER + 162

            4. In the callback function, process the %PGB_SETFONT message

            Code:
            CASE %PGB_SETFONT
               DeleteObject @pgb.m_hFont
               @pgb.m_hFont = wParam
               SendMessage hWnd, %PGB_REFRESH, 0, 0
            Forum: http://www.jose.it-berater.org/smfforum/index.php

            Comment


            • #7
              Thank you, José.

              Comment


              • #8
                Howdy, Borje,

                My copy of your include is dated 1/14/2003. I got it from http://www.reonis.com/POFFS/

                Is the 7 Feb 2003 version available for download?

                Comment


                • #9
                  I had to chuckle ...

                  ... is easy.
                  Anytime Jose tells me that, I know I'm in for an hour of work!

                  Comment


                  • #10
                    There are tasks that are easy, but take time.

                    You must also do:

                    Code:
                    IF @pgb.hRotateFont THEN
                       hFontOld = SelectObject(@pgb.memDC, @pgb.hRotateFont)  'store original font for later use
                       hFontOld = SelectObject(@pgb.barDC2, @pgb.hRotateFont) 'is same in both DC's
                       ....
                       ....
                    ELSE
                       hFontOld = SelectObject(@pgb.memDC, @pgb.m_hFont)  'store original font for later use
                       hFontOld = SelectObject(@pgb.barDC2, @pgb.m_hFont) 'is same in both DC's
                    END IF
                    [code]
                    CASE %WM_DESTROY 'clean up, to avoid nasty memory leaks
                    IF @pgb.hRotateFont THEN DeleteObject @pgb.m_hFont
                    [/code
                    Forum: http://www.jose.it-berater.org/smfforum/index.php

                    Comment


                    • #11
                      Jose,
                      I attempted to modify the INC files as you suggested but it fails to display the created font in the progress bar. Would you confirm that the 4 lines (commented with 'Jose) are a correct interpretation of your suggestion? This doesn't incorporate the rotatefont changes.

                      Code:
                      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                      ' Progressbar include file, PGBAR3D.INC, version 2, for PB/DLL
                      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                      ' Public Domain, by Borje Hagsten, September 2001
                      ' (first released in March 2001 - this is version 2)
                      ' Feel free to use and enhance, but as always - use at own risk..
                      ' NOTE: save this file as PGBAR3D.INC in your PBDLL6\WINAPI folder.
                      '       See sample program, PGBAR3D.BAS, for tips on how to use it.
                      '
                      ' NEW IN VERSION 2
                      ' Now control looks good in 256 color mode too, thanks to own palette.
                      ' New message, PGB_SETBARCOL replaces previous PGB_SETBARCOLMID and
                      ' PGB_SETBARCOLEDGE. Makes it easier to set bar colors via color table,
                      ' see messages below. New way to create control. No need to initialize
                      ' control, just use CreatePGBar3D message directly. See sample on how
                      ' to use it. Otherwise, trimmed code and improved some DC handling.
                      '
                      ' COMMENTS:
                      ' PGBAR3D is pretty advanced. Can also be used as label, with possibility to
                      ' set separate text on bar/background for nice "fade in/out" effects.
                      ' If you have been using an older version of this control, I'm sorry if new
                      ' the barcol message and way to create breaks old code. Should be quite easy
                      ' to make changes according to the news in this version though.
                      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                      
                      '$IF NOT %DEF(%WINAPI)
                      '  #INCLUDE "WIN32API.INC"
                      '#ENDIF
                      
                      ' wParam colors for %PGB_SETBARCOL message
                      ' @pgb.barCol = wParam * 24 + 1
                      %PGB_SILVER = 0
                      %PGB_RED    = 1
                      %PGB_GREEN  = 2
                      %PGB_BLUE   = 3
                      %PGB_CYAN   = 4 'blue-green
                      %PGB_VIOLET = 5 'red-blue
                      %PGB_GOLD   = 6 'yellow
                      %PGB_BRONZE = 7 'brown
                      
                      %PGB_SetFont = %WM_User+162  'Jose
                      
                      'custom control messages
                      %PGB_SETMAX         = %WM_User + 100 'wParam sets max number of steps
                      %PGB_STEPUP         = %WM_User + 103 'increases step while < max - wParam and lParam shall be 0
                      %PGB_STEPDN         = %WM_User + 104 'decreases step while > 0   - wParam and lParam shall be 0
                      %PGB_SETVALUE       = %WM_User + 105 'wParam sets progessbar value, lParam controls redraw
                      %PGB_BUILDBARS      = %WM_User + 109 'build/rebuild the scrollbars, lParam controls redraw
                      %PGB_REFRESH        = %WM_User + 110 'redraw the control - wParam and lParam shall be 0
                      
                      %PGB_GETMAX         = %WM_User + 120 'returns max number of steps
                      %PGB_GETVALUE       = %WM_User + 121 'returns step value
                      %PGB_GETTXTON       = %WM_User + 122 'returns txtOnOff value
                      %PGB_GETTXTPOS      = %WM_User + 123 'returns text position in control
                      %PGB_GETTXTCOLBAR   = %WM_User + 124 'returns bar text color
                      %PGB_GETTXTCOLBKG   = %WM_User + 125 'returns background text color
                      %PGB_GETCOLBKG      = %WM_User + 126 'returns background color
                      
                      %PGB_SETTXTON       = %WM_User + 150 'lParam sets: 0 = no text, 1 = auto text (%), 2 = custom text
                      %PGB_SETTXTBAR      = %WM_User + 151 'wParam points to text text for bar, lParam controls redraw
                      %PGB_SETTXTBKG      = %WM_User + 152 'wParam points to text text for background, lParam controls redraw
                      %PGB_SETTXTPOS      = %WM_User + 153 'wParam sets text position in control
                      %PGB_SETTXTCOLBAR   = %WM_User + 154 'wParam sets bar text color
                      
                      %PGB_SETTXTCOLBKG   = %WM_User + 155 'wParam sets background text color
                      %PGB_SETCOLBKG      = %WM_User + 156 'wParam sets background color, lParam controls rebuild of control
                      %PGB_SETBARCOL      = %WM_User + 157 'wParam sets bar color scheme, lParam controls rebuild of control
                      %PGB_SETBARDIR      = %WM_User + 159 'wParam sets bar direction, 0:left/right 1:upside down 2:bottom/top 3:top/bottom, lParam controls rebuild of control
                      %PGB_SETGRADIENTDIR = %WM_User + 160 'wParam sets gradient direction - 0:horizontal, 1:vertical, lParam controls rebuild of control
                      %PGB_SETTXTANGLE    = %WM_User + 161 'wParam sets set rotated font, lParam controls rebuild of control
                      
                      Type PGB3DDATA             'for storing control specific data in memory block
                        pStep       As Long         'for tracking what step we are on
                        pMax        As Long         'for storing max number of steps, usually 100 (%)
                        hbBack      As Long         'handle for background brush
                        barDC       As Long         'memCD for Progressbar
                        barBit      As Long         'handle to Progressbar bitmap
                        barDC2      As Long         'memCD for Progressbar buffer
                        barBit2     As Long         'handle to Progressbar buffer bitmap
                        memDc       As Long         'memCD for main buffer
                        hBit        As Long         'handle to main buffer bitmap
                        hRotateFont As Long         'handle to rotated font style
                        hImageBar   As Long         'bar image handle
                        hImageBkg   As Long         'background image handle
                        direction   As Long         'bar direction - left to right, or right to left?
                        gradientDir As Long         'gradient direction - left to right, or right to left?
                        bkgColor    As Long         'background color
                        barCol      As Long         'bar color scheme
                        txtColBar   As Long         'custom text color in bar
                        txtColBkg   As Long         'custom text color on background
                        txtOnOff    As Long         '0 = no text, 1 = auto text (%), 2 = custom text
                        txtPos      As Long         'text position in control, see DrawText API..
                        txtBkg      As WStringZ * 255 'text to be painted on background, increase/decrease size to suit your needs
                        txtBar      As WStringZ * 255 'text to be painted on bar, increase/decrease size to suit your needs
                        PalClr(192) As Long         'array for color sceme used by the control
                        m_hFont As Dword  'Jose
                      End Type
                      
                      Declare Function CreateGradientBars(ByVal hWnd As Long) As Long
                      Declare Function CreatePGBar3D(ByVal hParent As Long, ByVal Id As Long, ByVal Txt As String, _
                                                     ByVal vLeft As Long, ByVal vTop As Long, _
                                                     ByVal vWidth As Long, ByVal vHeight As Long, _
                                                     ByVal wStyle As Long, ByVal wStyleEx As Long, _
                                                     ByVal DDTstyle As Long) As Long
                      
                      Declare Function PgbWndProc (ByVal hWnd As Long, ByVal wMsg As Long, _
                                                   ByVal wParam As Long, ByVal lParam As Long) As Long
                      
                      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                      ' Create PGBAR3D control
                      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                      Function CreatePGBar3D(ByVal hParent As Long, ByVal Id As Long, ByVal Txt As String, _
                                             ByVal vLeft As Long, ByVal vTop As Long, _
                                             ByVal vWidth As Long, ByVal vHeight As Long, _
                                             ByVal wStyle As Long, ByVal wStyleEx As Long, _
                                             ByVal DDTstyle As Long) As Long
                      
                        Local hBar As Long, wc As WNDCLASSEX, szClassName As WStringZ * 10
                      
                        szClassName      = "PGBAR3D"
                        If GetClassInfoEx(GetModuleHandle(ByVal %NULL), (szClassName), wc) = 0 Then
                           wc.cbSize        = SizeOf(wc)
                           wc.lpfnWndProc   = CodePtr(PgbWndProc)
                           wc.cbWndExtra    = 4  'for pointer to user defined TYPE with control-specific data
                           wc.hInstance     = GetModuleHandle (ByVal 0)
                           wc.hCursor       = LoadCursor(%NULL, ByVal %IDC_ARROW )
                           wc.lpszClassName = VarPtr(szClassName)
                      
                           Call RegisterClassEx(wc)          'register PGBAR3D Class
                           If Err Then Exit Function         'something went wrong, so bail out
                        End If
                      
                        If DDTstyle Then 'create control using dialog units measurements (DDT)
                           Control Add "PGBAR3D", hParent, Id, "", vLeft, vTop, vWidth, vHeight, wStyle, wStyleEx
                           Control Handle hParent, Id To hBar
                      
                        Else             'create control using pixels measurements (SDK/API..)
                           hBar = CreateWindowEx(wStyleEx, "PGBAR3D", ByVal 0, wStyle, _
                                                   vLeft, vTop, vWidth, vHeight, _
                                                   hParent, Id, GetModuleHandle(ByVal %NULL), ByVal 0)
                        End If
                      
                        If hBar And Len(Txt) Then SetWindowText hBar, ByVal StrPtr(Txt)
                      
                        Function = hBar 'return handle
                      
                      End Function
                      
                      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                      ' Progressbar procedure
                      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                      Function PgbWndProc (ByVal hWnd As Long, ByVal wMsg As Long, _
                                           ByVal wParam As Long, ByVal lParam As Long) As Long
                        Local pgb As PGB3DDATA Ptr
                        If wMsg <> %WM_Create Then pgb = GetWindowLong(hWnd, 0) 'Get control specific data
                      
                        Select Case wMsg
                           Case %WM_Create  'store control specific data, PGB3DDATA structure, in memory
                      
                              pgb = HeapAlloc(GetProcessHeap(), %HEAP_ZERO_MEMORY, SizeOf(@pgb))
                              If pgb Then
                                 SetWindowLong hWnd, 0, pgb     'Store the pointer for later use
                              Else
                                 Function = -1 : Exit Function  'failed to allocate memory, so return -1 to break the action
                              End If
                      
                              Local hDC As Long, xPos As Long, yPos As Long, _
                                    hFontOld As Long, rc As RECT, rcTxt As RECT, _
                                    ps As PAINTSTRUCT, lpSize As SIZEL, tp As AsciiZ Ptr
                      
                              @pgb.txtOnOff   = 0  'some initial values - can be changed via custom messages
                              @pgb.txtPos     = %DT_SINGLELINE Or %DT_CENTER Or %DT_VCENTER Or %DT_NOCLIP Or %DT_NOPREFIX
                              @pgb.txtColBar  = RGB(0, 0, 0)
                              @pgb.txtColBkg  = RGB(255, 255, 0)
                              @pgb.bkgColor   = RGB(128, 128, 128)              'Background color
                              @pgb.barCol     = 0
                              @pgb.hbBack     = CreateSolidBrush(@pgb.bkgColor) 'Background brush
                              @pgb.m_hFont = pbMakeFont("Tahoma",48)   'Jose
                              Exit Function
                      
                      'CUSTOM CONTROL MESSAGES
                           Case %PGB_SetFont        'Jose
                              DeleteObject @pgb.m_hFont
                              @pgb.m_hFont = wParam
                              SendMessage hWnd, %PGB_Refresh,0,0
                      
                           Case %PGB_STEPUP
                              If @pgb.pStep < @pgb.pMax Then                    'step up while < max
                                 Incr @pgb.pStep
                                 SendMessage hWnd, %PGB_REFRESH, 0, 0           'repaint window (bar)
                              End If
                      
                            Case %PGB_STEPDN
                              If @pgb.pStep > 0 Then                              'step down while above 0
                                 Decr @pgb.pStep
                                 SendMessage hWnd, %PGB_REFRESH, 0, 0             'repaint window (bar)
                              End If
                      
                            Case %PGB_SETVALUE
                              @pgb.pStep = wParam
                              If lParam Then SendMessage hWnd, %PGB_REFRESH, 0, 0 'refresh if lParam says so
                      
                           Case %PGB_BUILDBARS
                              Call CreateGradientBars(hWnd)                       'build the scrollbars
                              If lParam Then SendMessage hWnd, %PGB_REFRESH, 0, 0 'refresh if lParam says so
                      
                           Case %PGB_REFRESH                                      'redraw control
                              InvalidateRect hWnd, ByVal %NULL, 0 : UpdateWindow hWnd
                      
                      'BAR SETTINGS
                           Case %PGB_SETMAX
                              @pgb.pMax = wParam                                'set max number of steps
                      
                           Case %PGB_GETMAX
                              Function = @pgb.pMax : Exit Function              'Get max number of steps
                      
                           Case %PGB_GETVALUE
                              Function = @pgb.pStep : Exit Function             'return current step value
                      
                           Case %PGB_SETCOLBKG
                              @pgb.bkgColor = wParam                            'Set background color via wParam
                              If @pgb.hbBack Then DeleteObject @pgb.hbBack      'delete old brush, if any
                              @pgb.hbBack = CreateSolidBrush(@pgb.bkgColor)     'create background color brush
                              If lParam Then SendMessage hWnd, %PGB_BUILDBARS, 1, 0 'refresh if lParam says so
                      
                           Case %PGB_SETBARCOL
                              @pgb.barCol = wParam * 24 + 1                       'Set bar color
                              If lParam Then SendMessage hWnd, %PGB_BUILDBARS, 0, 1 'rebuild and refresh if lParam says so
                      
                           Case %PGB_SETBARDIR
                              @pgb.direction = wParam                             'left to right = 0, default
                              If lParam Then SendMessage hWnd, %PGB_BUILDBARS, 0, 1 'rebuild and refresh if lParam says so
                      
                           Case %PGB_SETGRADIENTDIR
                              @pgb.gradientDir = wParam                           'horizontal = 0, default
                              If lParam Then SendMessage hWnd, %PGB_BUILDBARS, 0, 1 'rebuild and refresh if lParam says so
                      
                      'TEXT MESSAGES
                           Case %PGB_SETTXTON
                              @pgb.txtOnOff = lParam                            'set text on/off
                      
                           Case %PGB_GETTXTON
                              Function = @pgb.txtOnOff : Exit Function          'return txtOnOff setting
                      
                           Case %PGB_SETTXTPOS
                              @pgb.txtPos = wParam                              'set text position in control
                      
                           Case %PGB_GETTXTPOS
                              Function = @pgb.txtPos : Exit Function            'return txtPos setting
                      
                           Case %PGB_SETTXTBAR
                              tp = wParam
                              @pgb.txtBar = @tp
                              If lParam Then SendMessage hWnd, %PGB_REFRESH, 0, 0 'refresh if lParam says so
                      
                           Case %PGB_SETTXTBKG
                              tp = wParam
                              @pgb.txtBkg = @tp
                              If lParam Then SendMessage hWnd, %PGB_REFRESH, 0, 0 'refresh if lParam says so
                      
                           Case %PGB_SETTXTCOLBAR
                              @pgb.txtColBar = wParam                           'set bar's text color
                      
                           Case %PGB_SETTXTCOLBKG
                              @pgb.txtColBkg = wParam                           'set background's text color
                      
                           Case %PGB_SETTXTANGLE
                              Local lf As LOGFONT, tFont As Long
                      
                              tFont = SendMessage(hWnd, %WM_GETFONT, 0, 0)
                              If tFont = %NULL Then tFont = GetStockObject(%ANSI_VAR_FONT) 'null if system font..
                              Call GetObject(tFont, SizeOf(lf), ByVal VarPtr(lf) )
                      
                              lf.lfescapement  = wParam * 10   'angle is given in tenths of degrees
                              lf.lforientation = wParam * 10   'both should be same
                              lf.lfWeight = %FW_BOLD           'whatever, this one looks something like system font..
                              lf.lfFaceName = "Arial"          'must be True Type font for rotation purposes
                              @pgb.hRotateFont = CreateFontIndirect(lf) 'create the font and store its handle
                      
                              If lParam Then SendMessage hWnd, %PGB_BUILDBARS, 0, 1 'rebuild and refresh if lParam says so
                      
                      'STANDARD CONTROL MESSAGES
                           Case %WM_ERASEBKGND: Function = 1: Exit Function     'we handle background redraw ourselves
                      
                           Case %WM_Paint                                       'time to paint bar
                              GetClientRect hWnd, rc                            'get size of control
                              FillRect @pgb.memDC, rc, @pgb.hbBack              'clear background
                              xPos = @pgb.pStep * rc.nright / @pgb.pMax         'pre-calculate, since often used
                              yPos = @pgb.pStep * rc.nBottom / @pgb.pMax        'pre-calculate, since often used
                      
                              If @pgb.txtOnOff Then                             'WITH TEXT
                                 If @pgb.txtOnOff = 1 Then
                                    @pgb.txtBar = Format$(@pgb.pStep) + "%"     'auto text to paint on bar
                                    @pgb.txtBkg = @pgb.txtBar                   'auto text to paint on background
                                 End If
                                 rcTxt = rc                                          'copy rect for drawtext
                      
                                 If @pgb.hRotateFont Then
                                    hFontOld = SelectObject(@pgb.memDC, @pgb.hRotateFont)  'store original font for later use
                                    hFontOld = SelectObject(@pgb.barDC2, @pgb.hRotateFont) 'is same in both DC's
                      
                                    If @pgb.direction = 1 Then     'upside down
                                       @pgb.txtPos = %DT_SINGLELINE Or %DT_CENTER Or %DT_VCENTER Or %DT_NOCLIP Or %DT_NOPREFIX
                                       Call GetTextExtentPoint32(@pgb.memDC, @pgb.txtBar, Len(@pgb.txtBar), lpSize)
                                       rcTxt.nBottom = rcTxt.nBottom + lpSize.cy * 2
                                       rcTxt.nRight  = rcTxt.nRight + lpSize.cx * 2
                      
                                    ElseIf @pgb.direction = 2 Then 'bottom to top
                                       @pgb.txtPos = %DT_SINGLELINE Or %DT_LEFT Or %DT_VCENTER Or %DT_NOCLIP Or %DT_NOPREFIX
                                       Call GetTextExtentPoint32(@pgb.memDC, @pgb.txtBar, Len(@pgb.txtBar), lpSize)
                                       rcTxt.nLeft    = (rcTxt.nRight - lpSize.cy) / 2
                                       rcTxt.nBottom = rcTxt.nBottom + lpSize.cx * 1.25
                      
                                    ElseIf @pgb.direction = 3 Then 'top to bottom
                                       @pgb.txtPos = %DT_SINGLELINE Or %DT_LEFT Or %DT_VCENTER Or %DT_NOCLIP Or %DT_NOPREFIX
                                       Call GetTextExtentPoint32(@pgb.memDC, @pgb.txtBar, Len(@pgb.txtBar), lpSize)
                                       rcTxt.nLeft = (rcTxt.nRight + lpSize.cy) / 2
                                       rcTxt.nTop = rcTxt.nTop - lpSize.cx / 1.35
                                    End If
                      
                                 End If
                      
                                 BitBlt @pgb.barDC2, 0, 0, rc.nright, rc.nbottom, _
                                        @pgb.barDC, 0, 0, %SRCCOPY                   'paint original bar to buffer
                      
                                 SetTextColor @pgb.barDC2, @pgb.txtColBar                  'set color on bar
                                 DrawText @pgb.barDC2, @pgb.txtBar, -1, rcTxt, @pgb.txtPos 'draw text on bar
                      
                                 SetTextColor @pgb.memDC, @pgb.txtColBkg                   'set color on background
                                 DrawText @pgb.memDC, @pgb.txtBkg, -1, rcTxt, @pgb.txtPos  'draw text on background
                      
                                 If @pgb.direction = 0 Then 'LEFT TO RIGHT - WITH TEXT
                                    BitBlt @pgb.memDC, 0, 0, xPos, rc.nbottom, _
                                           @pgb.barDC2, 0, 0, %SRCCOPY               'paint proper part of gradiate bar
                      
                                 ElseIf @pgb.direction = 1 Then  'RIGHT TO LEFT - WITH TEXT
                                    BitBlt @pgb.memDC, rc.nright - xPos, 0, xPos, rc.nbottom, _
                                           @pgb.barDC2, rc.nright - xPos, 0, %SRCCOPY
                      
                                 ElseIf @pgb.direction = 2 Then  'BOTTOM TO TOP - WITH TEXT
                                    BitBlt @pgb.memDC, 0, rc.nbottom - yPos, rc.nright, rc.nbottom, _
                                           @pgb.barDC2, 0, rc.nbottom - yPos, %SRCCOPY
                      
                                 ElseIf @pgb.direction = 3 Then  'TOP TO BOTTOM - WITH TEXT
                                    BitBlt @pgb.memDC, 0, 0, rc.nright, yPos, _
                                           @pgb.barDC2, 0, 0, %SRCCOPY
                      
                                 End If
                      
                              Else                                               'WITHOUT TEXT
                                 If @pgb.direction = 0 Then      'LEFT TO RIGHT - NO TEXT
                                    BitBlt @pgb.memDC, 0, 0, xPos, rc.nbottom, _
                                           @pgb.barDC, 0, 0, %SRCCOPY                'paint proper part of gradiate bar
                      
                                 ElseIf @pgb.direction = 1 Then  'RIGHT TO LEFT - NO TEXT
                                    BitBlt @pgb.memDC, rc.nright - xPos, 0, xPos, rc.nbottom, _
                                           @pgb.barDC, rc.nright - xPos, 0, %SRCCOPY
                      
                                 ElseIf @pgb.direction = 2 Then  'BOTTOM TO TOP - NO TEXT
                                    BitBlt @pgb.memDC, 0, rc.nbottom - yPos, rc.nright, rc.nbottom, _
                                           @pgb.barDC, 0, rc.nbottom - yPos, %SRCCOPY
                      
                                 ElseIf @pgb.direction = 3 Then  'TOP TO BOTTOM - NO TEXT
                                    BitBlt @pgb.memDC, 0, 0, rc.nright, yPos, _
                                           @pgb.barDC, 0, 0, %SRCCOPY
                      
                                 End If
                      
                              End If
                      
                              BeginPaint hWnd, ps                               'begin screen painting
                              If @pgb.PalClr(0) Then                            'if we have palette (256 color mode)
                                 SelectPalette ps.hDC, @pgb.PalClr(0), 0        'then use it in DC..
                                 RealizePalette ps.hDC
                              End If
                      
                              BitBlt ps.hDC, 0, 0, rc.nright, rc.nbottom, _
                                     @pgb.memDC, 0, 0, %SRCCOPY                 'paint it all to screen
                      
                              If hFontOld Then
                                  Call SelectObject(@pgb.memDC, hFontOld)       'select the original font back
                                  Call SelectObject(@pgb.barDC2, hFontOld)      'was the same in both DC's
                              End If
                      
                              EndPaint hWnd, ps                                 'finish up
                              Function = 0 : Exit Function
                      
                           Case %WM_Destroy                                     'clean up, to avoid nasty memory leaks
                              If @pgb.hRotateFont Then DeleteObject @pgb.hRotateFont 'may be a stockobject, but doesn't matter
                              If @pgb.hbBack      Then DeleteObject @pgb.hbBack          'delete brush
                              If @pgb.hbit        Then DeleteObject SelectObject(@pgb.memDC, @pgb.hbit)
                              If @pgb.memDC       Then DeleteDC @pgb.memDC               'and memory DC's + bitmaps
                              If @pgb.barBit      Then DeleteObject SelectObject(@pgb.barDC, @pgb.barBit)
                              If @pgb.barDC       Then DeleteDC @pgb.barDC
                              If @pgb.barBit2     Then DeleteObject SelectObject(@pgb.barDC2, @pgb.barBit2)
                              If @pgb.barDC2      Then DeleteDC @pgb.barDC2
                              If @pgb.PalClr(0)   Then DeleteObject @pgb.PalClr(0)
                              Call HeapFree(GetProcessHeap(), 0, ByVal pgb)          'free memory
                              Function = 0 : Exit Function
                      
                        End Select
                      
                        Function = DefWindowProc(hWnd, wMsg, wParam, lParam)
                      End Function
                      
                      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                      ' Create actual ProgressBar, based on previously made settings
                      ' Note: one could also load a couple of bitmaps here instead,
                      ' for some terrific effects.. :-)
                      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                      Function CreateGradientBars(ByVal hWnd As Long) As Long
                        Local hDC As Long, ic As Long, J As Long, hPen As Long, _
                              K As Single, L As Single, rc As RECT, pgb As PGB3DDATA Ptr
                        pgb = GetWindowLong(hWnd, 0)                        'Get control specific data
                      
                        If @pgb.hbit    Then DeleteObject SelectObject(@pgb.memDC, @pgb.hbit)
                        If @pgb.memDC   Then DeleteDC @pgb.memDC            'delete old memDC's and bitmaps, if any
                        If @pgb.barBit  Then DeleteObject SelectObject(@pgb.barDC, @pgb.barBit)
                        If @pgb.barDC   Then DeleteDC @pgb.barDC
                        If @pgb.barBit2 Then DeleteObject SelectObject(@pgb.barDC2, @pgb.barBit2)
                        If @pgb.barDC2  Then DeleteDC @pgb.barDC2
                      
                        GetClientRect hWnd, rc                               'get control height and width
                      
                        hDC = GetDc(hWnd)
                        If hDC Then                                          'create 3 compatible memory DC's based on
                           @pgb.memDC   = CreateCompatibleDC(hDC)             'control's DC, for faster action in WM_PAINT
                           @pgb.hbit    = CreateCompatibleBitmap(hDC, rc.nRight, rc.nBottom)
                           @pgb.hbit    = SelectObject(@pgb.memDC, @pgb.hbit)
                           @pgb.barDC   = CreateCompatibleDC(hDC)
                           @pgb.barBit  = CreateCompatibleBitmap(hDC, rc.nRight, rc.nBottom)
                           @pgb.barBit  = SelectObject(@pgb.barDC, @pgb.barBit)
                           @pgb.barDC2  = CreateCompatibleDC(hDC)
                           @pgb.barBit2 = CreateCompatibleBitmap(hDC, rc.nRight, rc.nBottom)
                           @pgb.barBit2 = SelectObject(@pgb.barDC2, @pgb.barBit2)
                           SetBkMode @pgb.memDC, %TRANSPARENT                  'set text background modes
                           SetBkMode @pgb.barDC2, %TRANSPARENT
                      
                      '------------------------------------------------------------------------------
                      ' 'need own palette if in 256 color mode
                      '------------------------------------------------------------------------------
                           J = 1
                           For ic = 117 To 255 Step 6         '0, gray table 1-24
                              @pgb.PalClr(J) = RGB(ic, ic, ic) : Incr J
                           Next
                           For ic = 117 To 255 Step 6         '1, red table 25-48
                              @pgb.PalClr(J) = RGB(ic, ic - 117, ic - 117) : Incr J
                           Next
                           For ic = 117 To 255 Step 6         '2, green table 49-72
                              @pgb.PalClr(J) = RGB(ic - 117, ic, ic - 117) : Incr J
                           Next
                           For ic = 117 To 255 Step 6         '3, blue table 73-96
                              @pgb.PalClr(J) = RGB(ic - 117, ic - 117, ic) : Incr J
                           Next
                           For ic = 117 To 255 Step 6         '4, blue-green table 97-120
                              @pgb.PalClr(J) = RGB(ic - 117, ic, ic) : Incr J
                           Next
                           For ic = 117 To 255 Step 6         '5, violet table 121-144
                              @pgb.PalClr(J) = RGB(ic, ic - 117, ic) : Incr J
                           Next
                           For ic = 117 To 255 Step 6         '6, gold table 145-168
                              @pgb.PalClr(J) = RGB(Min&(ic + 64, 255), ic, ic - 117) : Incr J
                           Next
                           For ic = 117 To 255 Step 6         '7, brown table 169-192
                              @pgb.PalClr(J) = RGB(Min&(ic + 16, 255), ic - 48, ic - 117) : Incr J
                           Next
                           Decr J
                      
                           If GetDeviceCaps(hDC, %NUMCOLORS) > -1 And _ 'if needed, create own palette
                           (GetDeviceCaps(hDC, %RASTERCAPS) And %RC_PALETTE) = %RC_PALETTE Then
                              If @pgb.PalClr(0) Then DeleteObject @pgb.PalClr(0)
                              @pgb.PalClr(0) = MakLng(&H0300, J)
                              @pgb.PalClr(0) = CreatePalette (ByVal VarPtr(@pgb.PalClr(0)))
                              For ic = 1 To J
                                 @pgb.PalClr(ic) = @pgb.PalClr(ic) + &H02000000
                              Next
                           End If
                           ReleaseDc hWnd, hDC                                   'release the temporary DC
                      
                           If @pgb.PalClr(0) Then 'if we have palette (256 color mode), then use it in memDCs..
                              SelectPalette @pgb.barDC, @pgb.PalClr(0), 0
                              RealizePalette @pgb.barDC
                              SelectPalette @pgb.barDC2, @pgb.PalClr(0), 0
                              RealizePalette @pgb.barDC2
                           End If
                      
                      '------------------------------------------------------------------------------
                           If @pgb.gradientDir = 0 Then 'HORIZONTAL BAR
                              J = rc.nBottom - 1
                           Else                         'VERTICAL BAR
                              J = rc.nRight - 1
                           End If
                           K = @pgb.barCol
                           L = 1 / ((J / 2) / 24)       'calculate steps for color
                      
                           For ic = 0 To J                                      'draw the whole gradient bar
                              hPen = CreatePen(%PS_SOLID, 1, @pgb.PalClr(Int(K))) 'create pen
                              hPen = SelectObject(@pgb.barDC, hPen)             'select pen into DC, store original pen
                              If @pgb.gradientDir = 0 Then                      'HORIZONTAL BAR
                                 MoveTo(@pgb.barDC, 0, ic)                      'move into position
                                 LineTo @pgb.barDC, rc.nRight, ic               'and draw a line from left to right
                              Else                                              'VERTICAL BAR
                                 MoveTo(@pgb.barDC, ic, 0)                      'move into position
                                 LineTo @pgb.barDC, ic, rc.nBottom              'and draw a line from top to bottom
                              End If
                              DeleteObject SelectObject(@pgb.barDC, hPen)       'delete pen to avoid memory leaks
                      
                              If ic < J / 2 -1 Then
                                 K = Min(@pgb.barCol + 23, K + L)
                              Else
                                 K = Max(@pgb.barCol, K - L)
                              End If
                           Next
                      
                           Function = %TRUE                                      'return true on success
                        End If
                      
                      End Function
                      I also used this function to create the font ..

                      Code:
                      Function pbMakeFont(ByVal FontName As String, ByVal PointSize As Long) As Long
                         Local hDC As Long, CyPixels As Long
                      
                         hDC = GetDC(%HWND_Desktop)
                         CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
                         ReleaseDC %HWND_Desktop, hDC
                         PointSize = (PointSize * CyPixels) \ 72
                      
                         Function = CreateFont(0 - PointSize, 0, 0, 0, %FW_NORMAL, 0, 0, 0, _
                            %ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _
                            %DEFAULT_QUALITY, %FF_DONTCARE, ByCopy FontName)
                      
                      End Function

                      Comment


                      • #12
                        I have used hFont instead of m_hFont for consistency with the other variable names.

                        Code:
                        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                        ' Progressbar include file, PGBAR3D.INC, version 2, for PB/DLL
                        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                        ' Public Domain, by Borje Hagsten, September 2001
                        ' (first released in March 2001 - this is version 2)
                        ' Feel free to use and enhance, but as always - use at own risk..
                        ' NOTE: save this file as PGBAR3D.INC in your PBWIN70\WINAPI folder. (or PBDLL6..)
                        '       See sample program, PGBAR3D.BAS, for tips on how to use it.
                        '
                        ' LOG:
                        ' Jan 14, 2003: Changed to DWORD for handles in some places and
                        '               now use GetWindowLong(hParent, %GWL_HINSTANCE)
                        '               to get proper instance handle at creation.
                        '
                        ' NEW IN VERSION 2
                        ' Now control looks good in 256 color mode too, thanks to own palette.
                        ' New message, PGB_SETBARCOL replaces previous PGB_SETBARCOLMID and
                        ' PGB_SETBARCOLEDGE. Makes it easier to set bar colors via color table,
                        ' see messages below. New way to create control. No need to initialize
                        ' control, just use CreatePGBar3D message directly. See sample on how
                        ' to use it. Otherwise, trimmed code and improved some DC handling. 
                        '
                        ' COMMENTS:
                        ' PGBAR3D is pretty advanced. Can also be used as label, with possibility to
                        ' set separate text on bar/background for nice "fade in/out" effects.
                        ' If you have been using an older version of this control, I'm sorry if new
                        ' the barcol message and way to create breaks old code. Should be quite easy
                        ' to make changes according to the news in this version though.
                        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                        
                        ' wParam colors for %PGB_SETBARCOL message
                        %PGB_SILVER = 0
                        %PGB_RED    = 1
                        %PGB_GREEN  = 2
                        %PGB_BLUE   = 3
                        %PGB_CYAN   = 4 'blue-green
                        %PGB_VIOLET = 5 'red-blue
                        %PGB_GOLD   = 6 'yellow
                        %PGB_BRONZE = 7 'brown
                        
                        'custom control messages
                        %PGB_SETMAX         = %WM_USER + 100 'wParam sets max number of steps
                        %PGB_STEPUP         = %WM_USER + 103 'increases step while < max - wParam and lParam shall be 0
                        %PGB_STEPDN         = %WM_USER + 104 'decreases step while > 0   - wParam and lParam shall be 0
                        %PGB_SETVALUE       = %WM_USER + 105 'wParam sets progessbar value, lParam controls redraw
                        %PGB_BUILDBARS      = %WM_USER + 109 'build/rebuild the scrollbars, lParam controls redraw
                        %PGB_REFRESH        = %WM_USER + 110 'redraw the control - wParam and lParam shall be 0
                        
                        %PGB_GETMAX         = %WM_USER + 120 'returns max number of steps
                        %PGB_GETVALUE       = %WM_USER + 121 'returns step value
                        %PGB_GETTXTON       = %WM_USER + 122 'returns txtOnOff value
                        %PGB_GETTXTPOS      = %WM_USER + 123 'returns text position in control
                        %PGB_GETTXTCOLBAR   = %WM_USER + 124 'returns bar text color
                        %PGB_GETTXTCOLBKG   = %WM_USER + 125 'returns background text color
                        %PGB_GETCOLBKG      = %WM_USER + 126 'returns background color
                        %PGB_GETBARCOL      = %WM_USER + 127 'returns bar color scheme
                        %PGB_GETBARDIR      = %WM_USER + 128 'returns bar direction, 0:left/right 1:upside down 2:bottom/top 3:top/bottom
                        %PGB_GETGRADIENTDIR = %WM_USER + 129 'returns gradient direction - 0:horizontal, 1:vertical
                        %PGB_GETTXTANGLE    = %WM_USER + 130 'returns rotated font
                        
                        %PGB_SETTXTON       = %WM_USER + 150 'lParam sets: 0 = no text, 1 = auto text (%), 2 = custom text
                        %PGB_SETTXTBAR      = %WM_USER + 151 'wParam points to text text for bar, lParam controls redraw
                        %PGB_SETTXTBKG      = %WM_USER + 152 'wParam points to text text for background, lParam controls redraw
                        %PGB_SETTXTPOS      = %WM_USER + 153 'wParam sets text position in control
                        %PGB_SETTXTCOLBAR   = %WM_USER + 154 'wParam sets bar text color
                        
                        %PGB_SETTXTCOLBKG   = %WM_USER + 155 'wParam sets background text color
                        %PGB_SETCOLBKG      = %WM_USER + 156 'wParam sets background color, lParam controls rebuild of control
                        %PGB_SETBARCOL      = %WM_USER + 157 'wParam sets bar color scheme, lParam controls rebuild of control
                        %PGB_SETBARDIR      = %WM_USER + 159 'wParam sets bar direction, 0:left/right 1:upside down 2:bottom/top 3:top/bottom, lParam controls rebuild of control
                        %PGB_SETGRADIENTDIR = %WM_USER + 160 'wParam sets gradient direction - 0:horizontal, 1:vertical, lParam controls rebuild of control
                        %PGB_SETTXTANGLE    = %WM_USER + 161 'wParam sets set rotated font, lParam controls rebuild of control
                        %PGB_SETFONT        = %WM_USER + 162 'wParam sets the font
                        
                        TYPE PGB3DDATA             'for storing control specific data in memory block
                          pStep       AS LONG         'for tracking what step we are on
                          pMax        AS LONG         'for storing max number of steps, usually 100 (%)
                          hbBack      AS DWORD        'handle for background brush
                          barDC       AS DWORD        'memCD for Progressbar
                          barBit      AS DWORD        'handle to Progressbar bitmap
                          barDC2      AS DWORD        'memCD for Progressbar buffer
                          barBit2     AS DWORD        'handle to Progressbar buffer bitmap
                          memDc       AS DWORD        'memCD for main buffer
                          hBit        AS DWORD        'handle to main buffer bitmap
                          hFont       AS DWORD        'handle of the font
                          hRotateFont AS DWORD        'handle to rotated font style
                          hImageBar   AS DWORD        'bar image handle
                          hImageBkg   AS DWORD        'background image handle
                          direction   AS LONG         'bar direction - left to right, or right to left?
                          gradientDir AS LONG         'gradient direction - left to right, or right to left?
                          txtAngle    AS LONG         'store given text angle
                          bkgColor    AS LONG         'background color
                          barCol      AS LONG         'bar color scheme
                          txtColBar   AS LONG         'custom text color in bar
                          txtColBkg   AS LONG         'custom text color on background
                          txtOnOff    AS LONG         '0 = no text, 1 = auto text (%), 2 = custom text
                          txtPos      AS LONG         'text position in control, see DrawText API..
                          txtBkg      AS ASCIIZ * 255 'text to be painted on background, increase/decrease size to suit your needs
                          txtBar      AS ASCIIZ * 255 'text to be painted on bar, increase/decrease size to suit your needs
                          PalClr(192) AS LONG         'array for color sceme used by the control
                        END TYPE
                        
                        DECLARE FUNCTION CreateGradientBars(BYVAL hWnd AS DWORD) AS LONG
                        DECLARE FUNCTION CreatePGBar3D(BYVAL hParent AS DWORD, BYVAL id AS LONG, BYVAL txt AS STRING, _
                                                       BYVAL vLeft AS LONG, BYVAL vTop AS LONG, _
                                                       BYVAL vWidth AS LONG, BYVAL vHeight AS LONG, _
                                                       BYVAL wStyle AS LONG, BYVAL wStyleEx AS LONG, _
                                                       BYVAL DDTstyle AS LONG) AS DWORD
                        
                        DECLARE FUNCTION PgbWndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
                                                     BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
                        
                        Function pbMakeFont(ByVal FontName As String, ByVal PointSize As Long) As Long
                           Local hDC As Long, CyPixels As Long
                        
                           hDC = GetDC(%HWND_Desktop)
                           CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
                           ReleaseDC %HWND_Desktop, hDC
                           PointSize = (PointSize * CyPixels) \ 72
                        
                           Function = CreateFont(0 - PointSize, 0, 0, 0, %FW_NORMAL, 0, 0, 0, _
                              %ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _
                              %DEFAULT_QUALITY, %FF_DONTCARE, ByCopy FontName)
                        
                        End Function
                        
                        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                        ' Create PGBAR3D control
                        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                        FUNCTION CreatePGBar3D(BYVAL hParent AS DWORD, BYVAL id AS LONG, BYVAL txt AS STRING, _
                                               BYVAL vLeft AS LONG, BYVAL vTop AS LONG, _
                                               BYVAL vWidth AS LONG, BYVAL vHeight AS LONG, _
                                               BYVAL wStyle AS LONG, BYVAL wStyleEx AS LONG, _
                                               BYVAL DDTstyle AS LONG) AS DWORD
                        
                          LOCAL hBar AS DWORD, wc AS WNDCLASSEX, szClassName AS ASCIIZ * 10
                        
                          szClassName      = "PGBAR3D"
                          IF GetClassInfoEx(GetModuleHandle(BYVAL %NULL), szClassName, wc) = 0 THEN
                             wc.cbSize        = SIZEOF(wc)
                             wc.lpfnWndProc   = CODEPTR(PgbWndProc)
                             wc.cbWndExtra    = 4  'for pointer to user defined TYPE with control-specific data
                             wc.hInstance     = GetWindowLong(hParent, %GWL_HINSTANCE)
                             wc.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW )
                             wc.lpszClassName = VARPTR(szClassName)
                        
                             CALL RegisterClassEx(wc)          'register PGBAR3D Class
                             IF ERR THEN EXIT FUNCTION         'something went wrong, so bail out
                          END IF
                        
                          IF DDTstyle THEN 'create control using dialog units measurements (DDT)
                             CONTROL ADD "PGBAR3D", hParent, id, "", vLeft, vTop, vWidth, vHeight, wStyle, wStyleEx
                             CONTROL HANDLE hParent, id TO hBar
                        
                          ELSE             'create control using pixels measurements (SDK/API..)
                             hBar = CreateWindowEx(wStyleEx, "PGBAR3D", BYVAL 0, wStyle, _
                                                     vLeft, vTop, vWidth, vHeight, _
                                                     hParent, id, GetWindowLong(hParent, %GWL_HINSTANCE), BYVAL 0)
                          END IF
                        
                          IF hBar AND LEN(txt) THEN SetWindowText hBar, BYVAL STRPTR(txt)
                        
                          FUNCTION = hBar 'return handle
                        
                        END FUNCTION
                        
                        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                        ' Progressbar procedure
                        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                        FUNCTION PgbWndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
                                             BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
                          LOCAL pgb AS PGB3DDATA PTR
                          IF wMsg <> %WM_CREATE THEN pgb = GetWindowLong(hWnd, 0) 'Get control specific data
                        
                          SELECT CASE wMsg
                             CASE %WM_CREATE  'store control specific data, PGB3DDATA structure, in memory
                                pgb = HeapAlloc(GetProcessHeap(), %HEAP_ZERO_MEMORY, SIZEOF(@pgb))
                                IF pgb THEN
                                   SetWindowLong hWnd, 0, pgb     'Store the pointer for later use
                                ELSE
                                   FUNCTION = -1 : EXIT FUNCTION  'failed to allocate memory, so return -1 to break the action
                                END IF
                        
                                LOCAL hDC AS DWORD, xPos AS LONG, yPos AS LONG, _
                                      hFontOld AS DWORD, rc AS RECT, rcTxt AS RECT, _
                                      ps AS PAINTSTRUCT, lpSize AS SIZEL, tp AS ASCIIZ PTR
                        
                                @pgb.txtOnOff   = 0  'some initial values - can be changed via custom messages
                                @pgb.txtPos     = %DT_SINGLELINE OR %DT_CENTER OR %DT_VCENTER OR %DT_NOCLIP OR %DT_NOPREFIX
                                @pgb.txtColBar  = RGB(0, 0, 0)
                                @pgb.txtColBkg  = RGB(255, 255, 0)
                                @pgb.bkgColor   = RGB(128, 128, 128)              'Background color
                                @pgb.barCol     = 0
                                @pgb.hbBack     = CreateSolidBrush(@pgb.bkgColor) 'Background brush
                                @pgb.hFont      = pbMakeFont("Tahoma", 48)   'Jose
                                EXIT FUNCTION
                        
                        'CUSTOM CONTROL MESSAGES
                             CASE %PGB_STEPUP
                                IF @pgb.pStep < @pgb.pMax THEN                    'step up while < max
                                   INCR @pgb.pStep
                                   SendMessage hWnd, %PGB_REFRESH, 0, 0           'repaint window (bar)
                                END IF
                        
                             CASE %PGB_STEPDN
                                IF @pgb.pStep > 0 THEN                              'step down while above 0
                                   DECR @pgb.pStep
                                   SendMessage hWnd, %PGB_REFRESH, 0, 0             'repaint window (bar)
                                END IF
                        
                             CASE %PGB_SETVALUE
                                @pgb.pStep = MIN&(@pgb.pMax, wParam)
                                IF lParam THEN SendMessage hWnd, %PGB_REFRESH, 0, 0 'refresh if lParam says so
                        
                             CASE %PGB_BUILDBARS
                                CALL CreateGradientBars(hWnd)                       'build the scrollbars
                                IF lParam THEN SendMessage hWnd, %PGB_REFRESH, 0, 0 'refresh if lParam says so
                        
                             CASE %PGB_REFRESH                                      'redraw control
                                InvalidateRect hWnd, BYVAL %NULL, 0 : UpdateWindow hWnd
                        
                        'BAR SETTINGS
                             CASE %PGB_SETMAX
                                @pgb.pMax = wParam                                'set max number of steps
                        
                             CASE %PGB_GETMAX
                                FUNCTION = @pgb.pMax : EXIT FUNCTION              'Get max number of steps
                        
                             CASE %PGB_GETVALUE
                                FUNCTION = @pgb.pStep : EXIT FUNCTION             'return current step value
                        
                             CASE %PGB_SETCOLBKG
                                @pgb.bkgColor = wParam                            'Set background color via wParam
                                IF @pgb.hbBack THEN DeleteObject @pgb.hbBack      'delete old brush, if any
                                @pgb.hbBack = CreateSolidBrush(@pgb.bkgColor)     'create background color brush
                                IF lParam THEN SendMessage hWnd, %PGB_BUILDBARS, 1, 0 'refresh if lParam says so
                        
                             CASE %PGB_SETBARCOL
                                @pgb.barCol = wParam * 24 + 1                       'Set bar color
                                IF lParam THEN SendMessage hWnd, %PGB_BUILDBARS, 0, 1 'rebuild and refresh if lParam says so
                        
                             CASE %PGB_GETBARCOL
                                FUNCTION = @pgb.barCol / 24 : EXIT FUNCTION         'return bar color scheme
                        
                             CASE %PGB_SETBARDIR
                                @pgb.direction = wParam                             'left to right = 0, default
                                IF lParam THEN SendMessage hWnd, %PGB_BUILDBARS, 0, 1 'rebuild and refresh if lParam says so
                        
                             CASE %PGB_GETBARDIR
                                FUNCTION = @pgb.direction : EXIT FUNCTION           'return bar direction
                        
                             CASE %PGB_SETGRADIENTDIR
                                @pgb.gradientDir = wParam                           'horizontal = 0, default
                                IF lParam THEN SendMessage hWnd, %PGB_BUILDBARS, 0, 1 'rebuild and refresh if lParam says so
                        
                             CASE %PGB_GETGRADIENTDIR
                                FUNCTION = @pgb.gradientDir : EXIT FUNCTION         'return gradient direction
                        
                        'TEXT MESSAGES
                             CASE %PGB_SETTXTON
                                @pgb.txtOnOff = lParam                            'set text on/off
                        
                             CASE %PGB_GETTXTON
                                FUNCTION = @pgb.txtOnOff : EXIT FUNCTION          'return txtOnOff setting
                        
                             CASE %PGB_SETTXTPOS
                                @pgb.txtPos = wParam                              'set text position in control
                        
                             CASE %PGB_GETTXTPOS
                                FUNCTION = @pgb.txtPos : EXIT FUNCTION            'return txtPos setting
                        
                             CASE %PGB_GETTXTCOLBAR
                                FUNCTION = @pgb.txtColBar : EXIT FUNCTION         'return bar text color
                        
                             CASE %PGB_GETTXTCOLBKG
                                FUNCTION = @pgb.txtColBkg : EXIT FUNCTION         'return background text color
                        
                             CASE %PGB_GETCOLBKG
                                FUNCTION = @pgb.bkgColor : EXIT FUNCTION            'return background color
                        
                             CASE %PGB_SETTXTBAR
                                tp = wParam
                                @pgb.txtBar = @tp
                                IF lParam THEN SendMessage hWnd, %PGB_REFRESH, 0, 0 'refresh if lParam says so
                        
                             CASE %PGB_SETFONT
                                DeleteObject @pgb.hFont
                                @pgb.hFont = wParam
                                SendMessage hWnd, %PGB_REFRESH, 0, 0
                        
                             CASE %PGB_SETTXTBKG
                                tp = wParam
                                @pgb.txtBkg = @tp
                                IF lParam THEN SendMessage hWnd, %PGB_REFRESH, 0, 0 'refresh if lParam says so
                        
                             CASE %PGB_SETTXTCOLBAR
                                @pgb.txtColBar = wParam                           'set bar's text color
                        
                             CASE %PGB_SETTXTCOLBKG
                                @pgb.txtColBkg = wParam                           'set background's text color
                        
                             CASE %PGB_SETTXTANGLE
                                LOCAL logF AS LOGFONT, tFont AS DWORD
                                @pgb.txtAngle = wParam
                                tFont = SendMessage(hWnd, %WM_GETFONT, 0, 0)
                                IF tFont = %NULL THEN tFont = GetStockObject(%ANSI_VAR_FONT) 'null if system font..
                                CALL GetObject(tFont, SIZEOF(logF), BYVAL VARPTR(logF) )
                        
                                logF.lfescapement  = wParam * 10   'angle is given in tenths of degrees
                                logF.lforientation = wParam * 10   'both should be same
                                logF.lfWeight = %FW_BOLD           'whatever, this one looks something like system font..
                                logF.lfFaceName = "Arial"          'must be True Type font for rotation purposes
                                @pgb.hRotateFont = CreateFontIndirect(logF) 'create the font and store its handle
                        
                                IF lParam THEN SendMessage hWnd, %PGB_BUILDBARS, 0, 1 'rebuild and refresh if lParam says so
                        
                             CASE %PGB_GETTXTANGLE
                                FUNCTION = @pgb.txtAngle : EXIT FUNCTION          'return eventual text angle
                        
                        'STANDARD CONTROL MESSAGES
                             CASE %WM_ERASEBKGND: FUNCTION = 1: EXIT FUNCTION     'we handle background redraw ourselves
                        
                             CASE %WM_PAINT                                       'time to paint bar
                                GetClientRect hWnd, rc                            'get size of control
                                FillRect @pgb.memDC, rc, @pgb.hbBack              'clear background
                                xPos = @pgb.pStep * rc.nright / @pgb.pMax         'pre-calculate, since often used
                                yPos = @pgb.pStep * rc.nBottom / @pgb.pMax        'pre-calculate, since often used
                        
                                IF @pgb.txtOnOff THEN                             'WITH TEXT
                                   IF @pgb.txtOnOff = 1 THEN
                                      @pgb.txtBar = FORMAT$(@pgb.pStep) + "%"     'auto text to paint on bar
                                      @pgb.txtBkg = @pgb.txtBar                   'auto text to paint on background
                                   END IF
                                   rcTxt = rc                                          'copy rect for drawtext
                        
                                   IF @pgb.hRotateFont THEN
                                      hFontOld = SelectObject(@pgb.memDC, @pgb.hRotateFont)  'store original font for later use
                                      hFontOld = SelectObject(@pgb.barDC2, @pgb.hRotateFont) 'is same in both DC's
                        
                                      IF @pgb.direction = 1 THEN     'upside down
                                         @pgb.txtPos = %DT_SINGLELINE OR %DT_CENTER OR %DT_VCENTER OR %DT_NOCLIP OR %DT_NOPREFIX
                                         CALL GetTextExtentPoint32(@pgb.memDC, @pgb.txtBar, LEN(@pgb.txtBar), lpSize)
                                         rcTxt.nBottom = rcTxt.nBottom + lpSize.cy * 2
                                         rcTxt.nRight  = rcTxt.nRight + lpSize.cx * 2
                        
                                      ELSEIF @pgb.direction = 2 THEN 'bottom to top
                                         @pgb.txtPos = %DT_SINGLELINE OR %DT_LEFT OR %DT_VCENTER OR %DT_NOCLIP OR %DT_NOPREFIX
                                         CALL GetTextExtentPoint32(@pgb.memDC, @pgb.txtBar, LEN(@pgb.txtBar), lpSize)
                                         rcTxt.nLeft    = (rcTxt.nRight - lpSize.cy) / 2
                                         rcTxt.nBottom = rcTxt.nBottom + lpSize.cx * 1.25
                        
                                      ELSEIF @pgb.direction = 3 THEN 'top to bottom
                                         @pgb.txtPos = %DT_SINGLELINE OR %DT_LEFT OR %DT_VCENTER OR %DT_NOCLIP OR %DT_NOPREFIX
                                         CALL GetTextExtentPoint32(@pgb.memDC, @pgb.txtBar, LEN(@pgb.txtBar), lpSize)
                                         rcTxt.nLeft = (rcTxt.nRight + lpSize.cy) / 2
                                         rcTxt.nTop = rcTxt.nTop - lpSize.cx / 1.35
                                      END IF
                                   ELSE
                                       hFontOld = SelectObject(@pgb.memDC, @pgb.hFont)  'store original font for later use
                                       hFontOld = SelectObject(@pgb.barDC2, @pgb.hFont) 'is same in both DC's           END IF
                                   END IF
                        
                                   BitBlt @pgb.barDC2, 0, 0, rc.nright, rc.nbottom, _
                                          @pgb.barDC, 0, 0, %SRCCOPY                   'paint original bar to buffer
                        
                                   SetTextColor @pgb.barDC2, @pgb.txtColBar                  'set color on bar
                                   DrawText @pgb.barDC2, @pgb.txtBar, -1, rcTxt, @pgb.txtPos 'draw text on bar
                        
                                   SetTextColor @pgb.memDC, @pgb.txtColBkg                   'set color on background
                                   DrawText @pgb.memDC, @pgb.txtBkg, -1, rcTxt, @pgb.txtPos  'draw text on background
                        
                                   IF @pgb.direction = 0 THEN 'LEFT TO RIGHT - WITH TEXT
                                      BitBlt @pgb.memDC, 0, 0, xPos, rc.nbottom, _
                                             @pgb.barDC2, 0, 0, %SRCCOPY               'paint proper part of gradiant bar
                        
                                   ELSEIF @pgb.direction = 1 THEN  'RIGHT TO LEFT - WITH TEXT
                                      BitBlt @pgb.memDC, rc.nright - xPos, 0, xPos, rc.nbottom, _
                                             @pgb.barDC2, rc.nright - xPos, 0, %SRCCOPY
                        
                                   ELSEIF @pgb.direction = 2 THEN  'BOTTOM TO TOP - WITH TEXT
                                      BitBlt @pgb.memDC, 0, rc.nbottom - yPos, rc.nright, rc.nbottom, _
                                             @pgb.barDC2, 0, rc.nbottom - yPos, %SRCCOPY
                        
                                   ELSEIF @pgb.direction = 3 THEN  'TOP TO BOTTOM - WITH TEXT
                                      BitBlt @pgb.memDC, 0, 0, rc.nright, yPos, _
                                             @pgb.barDC2, 0, 0, %SRCCOPY
                        
                                   END IF
                        
                                ELSE                                               'WITHOUT TEXT
                                   IF @pgb.direction = 0 THEN      'LEFT TO RIGHT - NO TEXT
                                      BitBlt @pgb.memDC, 0, 0, xPos, rc.nbottom, _
                                             @pgb.barDC, 0, 0, %SRCCOPY                'paint proper part of gradiant bar
                        
                                   ELSEIF @pgb.direction = 1 THEN  'RIGHT TO LEFT - NO TEXT
                                      BitBlt @pgb.memDC, rc.nright - xPos, 0, xPos, rc.nbottom, _
                                             @pgb.barDC, rc.nright - xPos, 0, %SRCCOPY
                        
                                   ELSEIF @pgb.direction = 2 THEN  'BOTTOM TO TOP - NO TEXT
                                      BitBlt @pgb.memDC, 0, rc.nbottom - yPos, rc.nright, rc.nbottom, _
                                             @pgb.barDC, 0, rc.nbottom - yPos, %SRCCOPY
                        
                                   ELSEIF @pgb.direction = 3 THEN  'TOP TO BOTTOM - NO TEXT
                                      BitBlt @pgb.memDC, 0, 0, rc.nright, yPos, _
                                             @pgb.barDC, 0, 0, %SRCCOPY
                        
                                   END IF
                        
                                END IF
                        
                                BeginPaint hWnd, ps                               'begin screen painting
                                IF @pgb.PalClr(0) THEN                            'if we have palette (256 color mode)
                                   SelectPalette ps.hDC, @pgb.PalClr(0), 0        'then use it in DC..
                                   RealizePalette ps.hDC
                                END IF
                        
                                BitBlt ps.hDC, 0, 0, rc.nright, rc.nbottom, _
                                       @pgb.memDC, 0, 0, %SRCCOPY                 'paint it all to screen
                        
                                IF hFontOld THEN
                                    CALL SelectObject(@pgb.memDC, hFontOld)       'select the original font back
                                    CALL SelectObject(@pgb.barDC2, hFontOld)      'was the same in both DC's
                                END IF
                        
                                EndPaint hWnd, ps                                 'finish up
                                FUNCTION = 0 : EXIT FUNCTION
                        
                             CASE %WM_DESTROY                                     'clean up, to avoid nasty memory leaks
                                IF @pgb.hFont       THEN DeleteObject @pgb.hFont
                                IF @pgb.hRotateFont THEN DeleteObject @pgb.hRotateFont 'may be a stockobject, but doesn't matter
                                IF @pgb.hbBack      THEN DeleteObject @pgb.hbBack          'delete brush
                                IF @pgb.hbit        THEN DeleteObject SelectObject(@pgb.memDC, @pgb.hbit)
                                IF @pgb.memDC       THEN DeleteDC @pgb.memDC               'and memory DC's + bitmaps
                                IF @pgb.barBit      THEN DeleteObject SelectObject(@pgb.barDC, @pgb.barBit)
                                IF @pgb.barDC       THEN DeleteDC @pgb.barDC
                                IF @pgb.barBit2     THEN DeleteObject SelectObject(@pgb.barDC2, @pgb.barBit2)
                                IF @pgb.barDC2      THEN DeleteDC @pgb.barDC2
                                IF @pgb.PalClr(0)   THEN DeleteObject @pgb.PalClr(0)
                                CALL HeapFree(GetProcessHeap(), 0, BYVAL pgb)          'free memory
                                FUNCTION = 0 : EXIT FUNCTION
                        
                          END SELECT
                        
                          FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
                        END FUNCTION
                        
                        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                        ' Create actual ProgressBar, based on previously made settings
                        ' Note: one could also load a couple of bitmaps here instead,
                        ' for some terrific effects.. :-)
                        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                        FUNCTION CreateGradientBars(BYVAL hWnd AS DWORD) AS LONG
                          LOCAL hDC AS DWORD, ic AS LONG, jj AS LONG, hPen AS DWORD, _
                                kk AS SINGLE, L AS SINGLE, rc AS RECT, pgb AS PGB3DDATA PTR
                          pgb = GetWindowLong(hWnd, 0)                        'Get control specific data
                        
                          IF @pgb.hbit    THEN DeleteObject SelectObject(@pgb.memDC, @pgb.hbit)
                          IF @pgb.memDC   THEN DeleteDC @pgb.memDC            'delete old memDC's and bitmaps, if any
                          IF @pgb.barBit  THEN DeleteObject SelectObject(@pgb.barDC, @pgb.barBit)
                          IF @pgb.barDC   THEN DeleteDC @pgb.barDC
                          IF @pgb.barBit2 THEN DeleteObject SelectObject(@pgb.barDC2, @pgb.barBit2)
                          IF @pgb.barDC2  THEN DeleteDC @pgb.barDC2
                        
                          GetClientRect hWnd, rc                               'get control height and width
                        
                          hDC = GetDc(hWnd)
                          IF hDC THEN                                          'create 3 compatible memory DC's based on
                             @pgb.memDC   = CreateCompatibleDC(hDC)            'control's DC, for faster action in WM_PAINT
                             @pgb.hbit    = CreateCompatibleBitmap(hDC, rc.nRight, rc.nBottom)
                             @pgb.hbit    = SelectObject(@pgb.memDC, @pgb.hbit)
                             @pgb.barDC   = CreateCompatibleDC(hDC)
                             @pgb.barBit  = CreateCompatibleBitmap(hDC, rc.nRight, rc.nBottom)
                             @pgb.barBit  = SelectObject(@pgb.barDC, @pgb.barBit)
                             @pgb.barDC2  = CreateCompatibleDC(hDC)
                             @pgb.barBit2 = CreateCompatibleBitmap(hDC, rc.nRight, rc.nBottom)
                             @pgb.barBit2 = SelectObject(@pgb.barDC2, @pgb.barBit2)
                             SetBkMode @pgb.memDC, %TRANSPARENT                  'set text background modes
                             SetBkMode @pgb.barDC2, %TRANSPARENT
                        
                        '------------------------------------------------------------------------------
                        ' 'need own palette if in 256 color mode
                        '------------------------------------------------------------------------------
                             jj = 1
                             FOR ic = 117 TO 255 STEP 6         '0, gray table 1-24
                                @pgb.PalClr(jj) = RGB(ic, ic, ic) : INCR jj
                             NEXT
                             FOR ic = 117 TO 255 STEP 6         '1, red table 25-48
                                @pgb.PalClr(jj) = RGB(ic, ic - 117, ic - 117) : INCR jj
                             NEXT
                             FOR ic = 117 TO 255 STEP 6         '2, green table 49-72
                                @pgb.PalClr(jj) = RGB(ic - 117, ic, ic - 117) : INCR jj
                             NEXT
                             FOR ic = 117 TO 255 STEP 6         '3, blue table 73-96
                                @pgb.PalClr(jj) = RGB(ic - 117, ic - 117, ic) : INCR jj
                             NEXT
                             FOR ic = 117 TO 255 STEP 6         '4, blue-green table 97-120
                                @pgb.PalClr(jj) = RGB(ic - 117, ic, ic) : INCR jj
                             NEXT
                             FOR ic = 117 TO 255 STEP 6         '5, violet table 121-144
                                @pgb.PalClr(jj) = RGB(ic, ic - 117, ic) : INCR jj
                             NEXT
                             FOR ic = 117 TO 255 STEP 6         '6, gold table 145-168
                                @pgb.PalClr(jj) = RGB(MIN&(ic + 64, 255), ic, ic - 117) : INCR jj
                             NEXT
                             FOR ic = 117 TO 255 STEP 6         '7, brown table 169-192
                                @pgb.PalClr(jj) = RGB(MIN&(ic + 16, 255), ic - 48, ic - 117) : INCR jj
                             NEXT
                             DECR jj
                        
                             IF GetDeviceCaps(hDC, %NUMCOLORS) > -1 AND _ 'if needed, create own palette
                             (GetDeviceCaps(hDC, %RASTERCAPS) AND %RC_PALETTE) = %RC_PALETTE THEN
                                IF @pgb.PalClr(0) THEN DeleteObject @pgb.PalClr(0)
                                @pgb.PalClr(0) = MAKLNG(&H0300, jj)
                                @pgb.PalClr(0) = CreatePalette (BYVAL VARPTR(@pgb.PalClr(0)))
                                FOR ic = 1 TO jj
                                   @pgb.PalClr(ic) = @pgb.PalClr(ic) + &H02000000
                                NEXT
                             END IF
                             ReleaseDc hWnd, hDC                                   'release the temporary DC
                        
                             IF @pgb.PalClr(0) THEN 'if we have palette (256 color mode), then use it in memDCs..
                                SelectPalette @pgb.barDC, @pgb.PalClr(0), 0
                                RealizePalette @pgb.barDC
                                SelectPalette @pgb.barDC2, @pgb.PalClr(0), 0
                                RealizePalette @pgb.barDC2
                             END IF
                        
                        '------------------------------------------------------------------------------
                             IF @pgb.gradientDir = 0 THEN 'HORIZONTAL BAR
                                jj = rc.nBottom - 1
                             ELSE                         'VERTICAL BAR
                                jj = rc.nRight - 1
                             END IF
                             kk = @pgb.barCol
                             L = 1 / ((jj / 2) / 24)       'calculate steps for color
                        
                             FOR ic = 0 TO jj                                      'draw the whole gradient bar
                                hPen = CreatePen(%PS_SOLID, 1, @pgb.PalClr(INT(kk))) 'create pen
                                hPen = SelectObject(@pgb.barDC, hPen)             'select pen into DC, store original pen
                                IF @pgb.gradientDir = 0 THEN                      'HORIZONTAL BAR
                                   MoveTo @pgb.barDC, 0, ic                       'move into position
                                   LineTo @pgb.barDC, rc.nRight, ic               'and draw a line from left to right
                                ELSE                                              'VERTICAL BAR
                                   MoveTo @pgb.barDC, ic, 0                       'move into position
                                   LineTo @pgb.barDC, ic, rc.nBottom              'and draw a line from top to bottom
                                END IF
                                DeleteObject SelectObject(@pgb.barDC, hPen)       'delete pen to avoid memory leaks
                        
                                IF ic < jj / 2 -1 THEN
                                   kk = MIN(@pgb.barCol + 23, kk + L)
                                ELSE
                                   kk = MAX(@pgb.barCol, kk - L)
                                END IF
                             NEXT
                        
                             FUNCTION = %TRUE                                      'return true on success
                          END IF
                        
                        END FUNCTION
                        Forum: http://www.jose.it-berater.org/smfforum/index.php

                        Comment


                        • #13
                          Usage example:

                          Code:
                          CONTROL SEND hDlg, %ID_BARMID, %PGB_SETFONT, pbMakeFont("Times New Roman", 12), 0
                          Easy, as I said.
                          Forum: http://www.jose.it-berater.org/smfforum/index.php

                          Comment


                          • #14
                            Jose!
                            I appreciate your post. My first pass at using it does not show the progressbar, but I'll spend more time with it before asking any further questions. Things always seem much simpler in the morning!

                            Comment


                            • #15
                              I have used this example and it works:

                              Code:
                              '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                              ' Test program for custom control Progressbar include file, PGBAR3D.INC
                              ''¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                              #COMPILE EXE
                              #INCLUDE "WIN32API.INC"
                              #INCLUDE "PGBAR3D.INC"  '<- Progressbar include file
                              '------------------------------------------------------------------------------
                              DECLARE CALLBACK FUNCTION DlgMainProc
                              '------------------------------------------------------------------------------
                              %ID_BUTNSTART   = 101
                              %ID_BUTNREVERSE = 102
                              %ID_CHKTXT      = 110
                              %ID_OPTFAST     = 120
                              %ID_OPTSLOW     = 121
                              %ID_BARLEFT     = 201
                              %ID_BARTOP      = 202
                              %ID_BARRIGHT    = 203
                              %ID_BARBOTTOM   = 204
                              %ID_BARMID      = 205
                              
                              '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                              ' Main entrance - build dialog, controls and set some initial data
                              '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                              FUNCTION PBMAIN () AS LONG
                                LOCAL hDlg AS DWORD
                                DIALOG NEW 0, "PGBAR3D v2 demo", ,, 200, 138, %WS_CAPTION OR %WS_SYSMENU TO hDlg
                              
                                CONTROL ADD BUTTON,   hDlg, %ID_BUTNSTART,   "Start",      100, 52, 75, 14
                                CONTROL ADD BUTTON,   hDlg, %ID_BUTNREVERSE, "Reverse",     25, 52, 75, 14
                                CONTROL ADD OPTION,   hDlg, %ID_OPTFAST,     "Fast",        30, 28, 40, 10
                                CONTROL ADD OPTION,   hDlg, %ID_OPTSLOW,     "Slow",        30, 38, 40, 10
                                CONTROL ADD CHECKBOX, hDlg, %ID_CHKTXT,      "Text on/off", 97, 28, 50, 10
                                CONTROL SET CHECK     hDlg, %ID_OPTFAST, 1
                                CONTROL DISABLE hDlg, %ID_BUTNREVERSE
                              
                                CreatePGBar3D hDlg, %ID_BARLEFT, "", 5, 20, 14, 98, _
                                              %WS_CHILD OR %WS_VISIBLE, %WS_EX_CLIENTEDGE, 1                 'LEFT BAR, VERTICAL
                                      CONTROL SEND hDlg, %ID_BARLEFT, %PGB_SETMAX, 100, 0                      'max number of steps
                                      CONTROL SEND hDlg, %ID_BARLEFT, %PGB_SETBARDIR, 2, 0                     'bar direction, bottom - top
                                      CONTROL SEND hDlg, %ID_BARLEFT, %PGB_SETGRADIENTDIR, 1, 0                'vertical gradient
                                      CONTROL SEND hDlg, %ID_BARLEFT, %PGB_SETBARCOL, %PGB_GOLD, 0             'bar color scheme
                                      CONTROL SEND hDlg, %ID_BARLEFT, %PGB_SETTXTCOLBKG, RGB(255, 255, 0), 0   'backgound text color
                                      CONTROL SEND hDlg, %ID_BARLEFT, %PGB_SETTXTCOLBAR, RGB(0, 0, 255), 0     'bar text color
                                      CONTROL SEND hDlg, %ID_BARLEFT, %PGB_SETTXTANGLE, 90, 0                  'text angle, vertical up
                              
                                CreatePGBar3D hDlg, %ID_BARTOP, "", 5, 4, 190, 14, _
                                              %WS_CHILD OR %WS_VISIBLE, %WS_EX_CLIENTEDGE, 1                  'TOP BAR, HORIZONTAL
                                      CONTROL SEND hDlg, %ID_BARTOP, %PGB_SETMAX, 100, 0                       'max number of steps
                                      CONTROL SEND hDlg, %ID_BARTOP, %PGB_SETBARDIR, 0, 0                      'bar direction, left - right
                                      CONTROL SEND hDlg, %ID_BARTOP, %PGB_SETGRADIENTDIR, 0, 0                 'horizontal gradient
                                      CONTROL SEND hDlg, %ID_BARTOP, %PGB_SETBARCOL, %PGB_CYAN, 0              'bar color scheme
                                      CONTROL SEND hDlg, %ID_BARTOP, %PGB_SETTXTCOLBKG, RGB(0,255,255), 0      'backgound text color
                                      CONTROL SEND hDlg, %ID_BARTOP, %PGB_SETTXTCOLBAR, RGB(0,0,0), 0          'bar text color
                              
                                CreatePGBar3D hDlg, %ID_BARRIGHT, "", 181, 20, 14, 98, _
                                              %WS_CHILD OR %WS_VISIBLE, %WS_EX_CLIENTEDGE, 1                  'RIGHT BAR, VERTICAL
                                      CONTROL SEND hDlg, %ID_BARRIGHT, %PGB_SETMAX, 100, 0                     'max number of steps
                                      CONTROL SEND hDlg, %ID_BARRIGHT, %PGB_SETBARDIR, 3, 0                    'bar direction, top - bottom
                                      CONTROL SEND hDlg, %ID_BARRIGHT, %PGB_SETGRADIENTDIR, 1, 0               'vertical gradient
                                      CONTROL SEND hDlg, %ID_BARRIGHT, %PGB_SETBARCOL, %PGB_RED, 0             'bar edge color
                                      CONTROL SEND hDlg, %ID_BARRIGHT, %PGB_SETCOLBKG, RGB(191,191,191), 0     'background color
                                      CONTROL SEND hDlg, %ID_BARRIGHT, %PGB_SETTXTCOLBKG, RGB(255,0,0), 0      'backgound text color
                                      CONTROL SEND hDlg, %ID_BARRIGHT, %PGB_SETTXTCOLBAR, RGB(255,255,0), 0    'bar text color
                                      CONTROL SEND hDlg, %ID_BARRIGHT, %PGB_SETTXTANGLE, 270, 0                'text angle, vertical down
                              
                                CreatePGBar3D hDlg, %ID_BARBOTTOM, "", 5, 120, 190, 14, _
                                              %WS_CHILD OR %WS_VISIBLE, %WS_EX_CLIENTEDGE, 1                  'BOTTOM BAR, HORIZONTAL
                                      CONTROL SEND hDlg, %ID_BARBOTTOM, %PGB_SETMAX, 100, 0                    'max number of steps
                                      CONTROL SEND hDlg, %ID_BARBOTTOM, %PGB_SETBARDIR, 1, 0                   'bar direction, right - left
                                      CONTROL SEND hDlg, %ID_BARBOTTOM, %PGB_SETGRADIENTDIR, 0, 0              'horizontal gradient
                                      CONTROL SEND hDlg, %ID_BARBOTTOM, %PGB_SETCOLBKG, RGB(191,191,191), 0    'background color
                                      CONTROL SEND hDlg, %ID_BARBOTTOM, %PGB_SETBARCOL, %PGB_BLUE, 0           'bar mid color
                                      CONTROL SEND hDlg, %ID_BARBOTTOM, %PGB_SETTXTCOLBKG, RGB(0,0,196), 0     'backgound text color
                                      CONTROL SEND hDlg, %ID_BARBOTTOM, %PGB_SETTXTCOLBAR, RGB(255,255,255), 0 'bar text color
                                      CONTROL SEND hDlg, %ID_BARBOTTOM, %PGB_SETTXTANGLE, 180, 0               'text angle, upside down
                              
                                CreatePGBar3D hDlg, %ID_BARMID, "", 22, 70, 157, 48, _
                                              %WS_CHILD OR %WS_VISIBLE, %WS_EX_CLIENTEDGE, 1               'MID BAR, HORIZONTAL
                                   CONTROL SEND hDlg, %ID_BARMID, %PGB_SETMAX, 100, 0                       'max number of steps
                                   CONTROL SEND hDlg, %ID_BARMID, %PGB_SETBARDIR, 2, 0                      'bar direction, bottom - top
                                   CONTROL SEND hDlg, %ID_BARMID, %PGB_SETGRADIENTDIR, 0, 0                 'horizontal gradient
                                   CONTROL SEND hDlg, %ID_BARMID, %PGB_SETCOLBKG, RGB(0,0,0), 0             'background color
                                   CONTROL SEND hDlg, %ID_BARMID, %PGB_SETBARCOL, %PGB_SILVER, 0            'bar edge color
                                   CONTROL SEND hDlg, %ID_BARMID, %PGB_SETTXTCOLBKG, RGB(0,255,255), 0      'backgound text color
                              
                                   LOCAL txt AS STRING
                                   txt = "Click Start to see action"                    'set background text in middle progressbar
                                   CONTROL SEND hDlg, %ID_BARMID, %PGB_SETTXTBKG, STRPTR(txt), 0
                                   txt = "Hope you'll find it useful!"                  'set bar text in middle progressbar
                                   CONTROL SEND hDlg, %ID_BARMID, %PGB_SETTXTBAR, STRPTR(txt), 0
                                   CONTROL SEND hDlg, %ID_BARMID, %PGB_SETTXTON, 0, 2   'tell control to use custom text
                              
                                   CONTROL SEND hDlg, %ID_BARMID, %PGB_SETFONT, pbMakeFont("Times New Roman", 12), 0
                              
                                CONTROL SEND hDlg, %ID_BARLEFT,   %PGB_BUILDBARS, 0, 0  'finally, build the bars - IMPORTANT!
                                CONTROL SEND hDlg, %ID_BARTOP,    %PGB_BUILDBARS, 0, 0
                                CONTROL SEND hDlg, %ID_BARRIGHT,  %PGB_BUILDBARS, 0, 0
                                CONTROL SEND hDlg, %ID_BARBOTTOM, %PGB_BUILDBARS, 0, 0
                                CONTROL SEND hDlg, %ID_BARMID,    %PGB_BUILDBARS, 0, 0
                              
                                DIALOG SHOW MODAL hDlg, CALL DlgMainProc
                              END FUNCTION
                              
                              '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                              ' Main dialog callback procedure
                              '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
                              CALLBACK FUNCTION DlgMainProc
                                LOCAL I AS LONG, J AS LONG, K AS LONG, txt AS STRING
                                STATIC slow AS LONG, allSteps AS LONG
                              
                                SELECT CASE CBMSG
                                   CASE %WM_COMMAND
                                      IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                                         SELECT CASE CBCTL
                                            CASE %ID_BUTNSTART
                                               CONTROL GET CHECK CBHNDL, %ID_OPTSLOW TO slow   '<- check settings for slow/fast
                                               CONTROL SEND CBHNDL, %ID_BARTOP, %PGB_GETMAX, 0, 0 TO allSteps 'get number of steps, usually 100
                                               CONTROL DISABLE CBHNDL, %ID_BUTNSTART      '<- disable start button
                                               txt = "Please wait.."                      '<- set new text in middle progressbar
                                               CONTROL SEND CBHNDL, %ID_BARMID, %PGB_SETTXTBKG, STRPTR(txt), 1
                                               FOR K = 0 TO 4                             '<- run one control at the time
                                                  FOR I = 1 TO allSteps
                                                     CONTROL SEND CBHNDL, %ID_BARLEFT + K, %PGB_STEPUP, 0, 0
                                                     IF I MOD 2 = 0 THEN DIALOG DOEVENTS  '<- to avoid dialog "freeze" in loop..
                                                     IF slow THEN SLEEP 40                '<- if "slow" has been selected
                                                  NEXT
                                               NEXT
                                               CONTROL ENABLE CBHNDL, %ID_BUTNREVERSE     '<- enable reverse button
                              
                                            CASE %ID_BUTNREVERSE
                                               CONTROL DISABLE CBHNDL, %ID_BUTNREVERSE
                                               FOR K = 0 TO 4
                                                  FOR I = 1 TO allSteps
                                                     CONTROL SEND CBHNDL, %ID_BARMID - K, %PGB_STEPDN, 0, 0
                                                     IF I MOD 2 = 0 THEN DIALOG DOEVENTS
                                                     IF slow THEN SLEEP 40   'if "slow" has been selected
                                                  NEXT
                                               NEXT
                                               txt = "Click Start to see action"     'set new text in middle progressbar
                                               CONTROL SEND CBHNDL, %ID_BARMID, %PGB_SETTXTBKG, STRPTR(txt), 1
                                               CONTROL ENABLE CBHNDL, %ID_BUTNSTART
                              
                                            CASE %ID_OPTSLOW, %ID_OPTFAST
                                               CONTROL GET CHECK CBHNDL, %ID_OPTSLOW TO slow  '<- set slow/fast mode
                              
                                            CASE %ID_CHKTXT 'text on/off
                                               CONTROL GET CHECK CBHNDL, %ID_CHKTXT TO J      '<- set auto text (%) on/off
                                               FOR K = 0 TO 3
                                                  CONTROL SEND CBHNDL, %ID_BARLEFT + K, %PGB_SETTXTON, 0, J
                                                  CONTROL SEND CBHNDL, %ID_BARLEFT + K, %PGB_REFRESH, 0, 0
                                               NEXT
                              
                                         END SELECT
                                      END IF
                              
                                   CASE %WM_PALETTECHANGED
                                      'if in 256 color mode, switching between app's with different palettes
                                      'can cause weird results. Trapping %WM_PALETTECHANGED and redrawing
                                      'entire dialog helps some. Maybe not the best solution, but..
                                      IF CBWPARAM <> CBHNDL THEN
                                         RedrawWindow CBHNDL, BYVAL 0, BYVAL 0, %RDW_INVALIDATE OR %RDW_UPDATENOW
                                      END IF
                              
                                END SELECT
                              END FUNCTION
                              Attached Files
                              Forum: http://www.jose.it-berater.org/smfforum/index.php

                              Comment


                              • #16
                                Also, if you want to work with text angle, you could replace %PGB_SETTXTANGLE section...
                                Code:
                                CASE %PGB_SETTXTANGLE
                                  LOCAL logF AS LOGFONT
                                  GetObject(@pgb.hFont, SIZEOF(logF), BYVAL VARPTR(logF))
                                  logF.lfescapement  = wParam * 10 'Angle is given in tenths of degrees
                                  logF.lforientation = wParam * 10 'Both should be same
                                  @pgb.hRotateFont = CreateFontIndirect(logF) 'Create the font and store its handle
                                  IF lParam THEN SendMessage hWnd, %PGB_BUILDBARS, 0, 1 'Rebuild and refresh if lParam says so

                                Comment

                                Working...
                                X