• Welcome to Powerbasic Museum 2020-B.
 

News:

Forum in repository mode. No new members allowed.

Main Menu

[SDK] 09 - Take control of your TRACKBAR

Started by Patrice Terrier, August 14, 2007, 05:14:12 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Patrice Terrier

WORK IN PROGRESS

This time I will show you how to create a complete control from ground zero (no SUPERCLASS)

Because I am not pleased with the standard Windows trackbar behavior, I choose it as an example.

1 - We start creating a new CLASS

'// Create an image trackbar control
FUNCTION zTrackbar (BYVAL hOwner AS LONG, zFullpathImageName AS ASCIIZ, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL tW AS LONG, BYVAL tH AS LONG, BYVAL ButID AS LONG, BYVAL tMin AS LONG, BYVAL tMax AS LONG, BYVAL tVal AS LONG ) AS LONG
    LOCAL wc  AS WNDCLASSEX
    LOCAL zClass AS ASCIIZ * 10
    LOCAL hCtrl, IsInitialized AS LONG

    IF tMin = tMax THEN EXIT FUNCTION

    zClass = "ZTRACKBAR"
    wc.cbSize = SIZEOF(wc)
    IsInitialized = GetClassInfoEx(zInstance, zClass, wc)
    IF IsInitialized    = 0 THEN
       wc.cbSize        = SIZEOF(wc)
       wc.style         = %CS_HREDRAW OR %CS_VREDRAW OR %CS_DBLCLKS OR %CS_PARENTDC
       wc.lpfnWndProc   = CODEPTR(TrackProc)
       wc.cbClsExtra    = 0
       wc.cbWndExtra    = %EXTEND_EXTRA * 4
       wc.hInstance     = zInstance
       wc.hIcon         = %NULL ' LoadIcon(wc.hInstance, "PROGRAM")
       wc.hCursor       = %NULL
       wc.hbrBackground = %NULL ' Don't paint the class window background
       wc.lpszMenuName  = %NULL
       wc.lpszClassName = VARPTR(zClass)
       wc.hIconSm       = wc.hIcon
       IF RegisterClassEx(wc) THEN IsInitialized = %TRUE
    END IF
'
    IF IsInitialized THEN
       LOCAL Img AS LONG
'      // Create GDIPLUS image from file
       Img = zCreateImageFromFile(zFullpathImageName)
       IF Img THEN
          LOCAL imgW, imgH AS LONG
'         // Get the Thumb GDIPLUS image size
          CALL zGetImageSize(Img, imgW, imgH)
          Style& = %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP ' OR %BS_OWNERDRAW

          hCtrl = CreateWindowEx(%WS_EX_TRANSPARENT, zClass, "", Style&, x, y, tW, tH, hOwner, ButID, zInstance, BYVAL %NULL)
          IF hCtrl THEN
'            // Save new properties
             CALL zSetProperty(hCtrl, %TRACK_IMAGE, Img)
             CALL zSetProperty(hCtrl, %TRACK_MINVAL, tMin)
             CALL zSetProperty(hCtrl, %TRACK_MAXVAL, tMax)
             CALL zSetProperty(hCtrl, %TRACK_VALUE, tVal)
             CALL zSetProperty(hCtrl, %TRACK_WAS_VALUE, tVal)

             FUNCTION = hCtrl
          ELSE
'            // Delete image
             CALL zDisposeImage(Img)
          END IF
       END IF
    END IF
END FUNCTION


To use it, just call it that way:

hBut = zTrackbar(
hMain, _ ' Handle to the parent owner
"BTN_Star13.png", _ ' Full path name to the image being used to draw the THUMB
X, _ ' The control X location
Y, _ ' The control Y location
Width, _ ' The control width
Height, _ ' The control height
Control_ID, _ ' The control unique identifier
MinValue, _  ' The minimum trackbar value (use LONG only)
MaxValue, _ ' The maximum trackbar value (use LONG only)
SeedValue, _ ' The default trackbar value at startup (use LONG only)
ARGB color, _ ' The ARGB color to draw the TRACK of the bar
)

Note: That the control is "intelligent" it understands that if the size of the Width is larger than the Height, then you want an horizontal trackbar, else a vertical ;)
And swapping the Min Max values, means in case of horizontal, draw the track from left to right or from righ to left ; and in case of vertical, draw the track from top to bottom or bottom to top.

When thumb location changes, parent owner is notified with a standard command message, like this:
'// Send message to parent to notify the new value
CALL SendMessage(GetParent(hWnd), %WM_COMMAND, MAKLNG(GetDlgCtrlID(hWnd),0), zGetProperty(hWnd, %TRACK_VALUE))

2 - All the hard work is done is the TrackProc public callback (exported)

'// We handle all our custom trackbar messages there
FUNCTION TrackProc (BYVAL hWnd AS LONG, BYVAL Msg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
    LOCAL rc AS RECT
    LOCAL hDC, graphics AS LONG

    SELECT CASE LONG Msg

    CASE %WM_MOUSEMOVE
         IF zGetProperty(hWnd, %TRACK_THUMB_MOVING) THEN
'           // Check if left mouse button still down
            LOCAL LeftButtonDown AS LONG
            LeftButtonDown = (wParam AND %MK_LBUTTON)
            IF LeftButtonDown = 0 THEN
               CALL zSetToolTipText(hWnd, (zGetCTLText(hWnd)))
'              // Send message to parent to notify the new value         
               CALL SendMessage(GetParent(hWnd), %WM_COMMAND, MAKLNG(GetDlgCtrlID(hWnd),0), zGetProperty(hWnd, %TRACK_VALUE))
            END IF
            CALL zSetProperty(hWnd, %TRACK_THUMB_MOVING, LeftButtonDown)
         END IF
         IF zGetProperty(hWnd, %TRACK_THUMB_MOVING) THEN
            CALL SetThumbLocation(hWnd, LOWRD(lParam), HIWRD(lParam))
         END IF

    CASE %WM_LBUTTONDOWN
         sToolTip$ = zGetToolTipText(hWnd)
         CALL SendMessage(hWnd, %WM_SETTEXT, 0, STRPTR(sToolTip$))
         CALL zSetProperty(hWnd, %TRACK_THUMB_MOVING, %TRUE)
         CALL SetThumbLocation(hWnd, LOWRD(lParam), HIWRD(lParam))

    CASE %WM_LBUTTONUP
         CALL zSetToolTipText(hWnd, (zGetCTLText(hWnd)))
         CALL zSetProperty(hWnd, %TRACK_THUMB_MOVING, %FALSE)
'        // Send message to parent to notify the new value         
         CALL SendMessage(GetParent(hWnd), %WM_COMMAND, MAKLNG(GetDlgCtrlID(hWnd),0), zGetProperty(hWnd, %TRACK_VALUE))

    CASE %WM_ERASEBKGND
         FUNCTION = 1: EXIT FUNCTION

    CASE %WM_PAINT, %WM_PRINT
         LOCAL Img, imgW, imgH, tMin, tMax, tVal, tx, ty, tW, tH, x, y, ImgAttr AS LONG
         LOCAL ARGB AS LONG, A AS BYTE, R AS BYTE, G AS BYTE, B AS BYTE

         Img  = zGetProperty(hWnd, %TRACK_IMAGE)
         tMin = zGetProperty(hWnd, %TRACK_MINVAL)
         tMax = zGetProperty(hWnd, %TRACK_MAXVAL)
         tVal = zGetProperty(hWnd, %TRACK_VALUE)
         ARGB = zGetProperty(hWnd, %TRACK_ARGB)
         IF Img THEN
            LOCAL ps AS PAINTSTRUCT
            CALL GetClientRect(hWnd, rc)
            IF Msg = %WM_PAINT THEN
               hDC = BeginPaint(hWnd, ps)
            ELSE ' // WM_PRINT
               hDC = wParam
            END IF
            IF GdipCreateFromHDC(hDC, graphics) = 0 THEN

               CALL zGetImageSize(Img, imgW, imgH)
               CALL GetThumbTrackLocation(hWnd, tx, ty)

               LOCAL LEFTorTOPfront, LEFTorTOPback, MIDDLEfront AS LONG

               CALL zSplitColorARGB(ARGB, A, R, G, B)

               CALL GdipCreatePen1(zColorARGB(A, RGB(R, G, B)), 1, %UnitPixel, LEFTorTOPfront)
               CALL GdipCreatePen1(zColorARGB(255, RGB(55, 60, 74)), 1, %UnitPixel, LEFTorTOPback)
               CALL GdipCreatePen1(zColorARGB(A, RGB(MAX&(R - 74, 0), MAX&(G - 84, 0), MAX&(B - 28, 0))), 1, %UnitPixel, MIDDLEfront)

               LOCAL MIDDLEback, RIGHTorBOTTOMfront, RIGHTorBOTTOMback AS LONG
               CALL GdipCreatePen1(zColorARGB(255, RGB(0, 0, 0)), 1, %UnitPixel, MIDDLEback)
               CALL GdipCreatePen1(zColorARGB(A, RGB(MIN&(R + 4,255), MAX&(G - 10, 0), MIN&(B + 28, 255))), 1, %UnitPixel, RIGHTorBOTTOMfront)
               CALL GdipCreatePen1(zColorARGB(255, RGB(87, 94, 110)), 1, %UnitPixel, RIGHTorBOTTOMback)

               IF TrackOrientation(hWnd) = %TRACK_HORZ THEN
                   y = rc.nBottom \ 2

                   IF tMin > tMax THEN
                       GdipDrawLineI(graphics, LEFTorTOPback, 0, y - 1, tx + ImgW \ 2, y - 1)
                       GdipDrawLineI(graphics, LEFTorTOPfront, tx + 1 + ImgW \ 2, y - 1, rc.nRight, y - 1)
                       GdipDrawLineI(graphics, MIDDLEback, 0, y, tx + ImgW \ 2, y)
                       GdipDrawLineI(graphics, MIDDLEfront, tx + 1 + ImgW \ 2, y, rc.nRight, y)
                       GdipDrawLineI(graphics, RIGHTorBOTTOMback, 0, y + 1, tx + ImgW \ 2, y + 1)
                       GdipDrawLineI(graphics, RIGHTorBOTTOMfront, tx + 1 + ImgW \ 2, y + 1, rc.nRight, y + 1)
                   ELSE
                       GdipDrawLineI(graphics, LEFTorTOPfront, 0, y - 1, tx + ImgW \ 2, y - 1)
                       GdipDrawLineI(graphics, LEFTorTOPback, tx + 1 + ImgW \ 2, y - 1, rc.nRight, y - 1)
                       GdipDrawLineI(graphics, MIDDLEfront, 0, y, tx + ImgW \ 2, y)
                       GdipDrawLineI(graphics, MIDDLEback, tx + 1 + ImgW \ 2, y, rc.nRight, y)
                       GdipDrawLineI(graphics, RIGHTorBOTTOMfront, 0, y + 1, tx + ImgW \ 2, y + 1)
                       GdipDrawLineI(graphics, RIGHTorBOTTOMback, tx + 1 + ImgW \ 2, y + 1, rc.nRight, y + 1)
                   END IF
               ELSE
                   x = rc.nRight \ 2

                   IF tMin > tMax THEN
                       GdipDrawLineI(graphics, LEFTorTOPback, x - 1, 0, x - 1, ty + ImgH \ 2)
                       GdipDrawLineI(graphics, LEFTorTOPfront, x - 1, ty + 1 + ImgH \ 2, x - 1, rc.nBottom)
                       GdipDrawLineI(graphics, MIDDLEback, x, 0, x, ty + ImgH \ 2)
                       GdipDrawLineI(graphics, MIDDLEfront, x, ty + 1 + ImgH \ 2, x, rc.nBottom)
                       GdipDrawLineI(graphics, RIGHTorBOTTOMback, x + 1, 0, x + 1, ty + ImgH \ 2)
                       GdipDrawLineI(graphics, RIGHTorBOTTOMfront, x + 1, ty + 1 + ImgH \ 2, x + 1, rc.nBottom)
                   ELSE
                       GdipDrawLineI(graphics, LEFTorTOPfront, x - 1, 0, x - 1, ty + ImgH \ 2)
                       GdipDrawLineI(graphics, LEFTorTOPback, x - 1, ty + 1 + ImgH \ 2, x - 1, rc.nBottom)
                       GdipDrawLineI(graphics, MIDDLEfront, x, 0, x, ty + ImgH \ 2)
                       GdipDrawLineI(graphics, MIDDLEback, x, ty + 1 + ImgH \ 2, x, rc.nBottom)
                       GdipDrawLineI(graphics, RIGHTorBOTTOMfront, x + 1, 0, x + 1, ty + ImgH \ 2)
                       GdipDrawLineI(graphics, RIGHTorBOTTOMback, x + 1, ty + 1 + ImgH \ 2, x + 1, rc.nBottom)
                   END IF
               END IF

               '// Draw thumb tracker only during %WM_PAINT
               IF Msg = %WM_PAINT THEN
                  CALL GdipDrawImageRectRectI(graphics, Img, _
                                              tx, ty, ImgW, ImgH, _
                                              0, 0, ImgW, ImgH, %UnitPixel, _
                                              ImgAttr)
               END IF

               '// Release pen resources
               GdipDeletePen(LEFTorTOPfront)
               GdipDeletePen(LEFTorTOPback)
               GdipDeletePen(MIDDLEfront)
               GdipDeletePen(MIDDLEback)
               GdipDeletePen(RIGHTorBOTTOMfront)
               GdipDeletePen(RIGHTorBOTTOMback)

               CALL GdipDeleteGraphics(graphics)
            END IF
            IF Msg = %WM_PAINT THEN
               CALL EndPaint(hWnd, ps)
            END IF
            FUNCTION = 0: EXIT FUNCTION
         END IF

    CASE %WM_DESTROY
'        // Delete the GDIPLUS thumb image
         CALL zDisposeImage(zGetProperty(hWnd, %TRACK_IMAGE))
    END SELECT

    FUNCTION = DefWindowProc(hWnd, Msg, wParam, lParam)

END FUNCTION


Because of the use of our composited double buffer, the drawing is flicker free even while resizing the main form.

3 - To compute THUMB location and current VALUE there are a few extra functions


'// Detect track bar orientation
FUNCTION TrackOrientation(BYVAL hWnd AS LONG) AS LONG
    LOCAL rc AS RECT
    CALL GetClientRect(hWnd, rc): IF rc.nRight > rc.nBottom THEN FUNCTION = %TRACK_HORZ ' -1
END FUNCTION

'// Compute X,Y thumb location based on the current tVal (value)
SUB GetThumbTrackLocation(BYVAL hWnd AS LONG, BYREF tx AS LONG, BYREF ty AS LONG)
    LOCAL rc AS RECT, increment AS DOUBLE, Img, imgW, imgH, tMin, tMax, tVal, range AS LONG

    CALL GetClientRect(hWnd, rc)

    Img  = zGetProperty(hWnd, %TRACK_IMAGE): CALL zGetImageSize(Img, imgW, imgH)
    tMin = zGetProperty(hWnd, %TRACK_MINVAL)
    tMax = zGetProperty(hWnd, %TRACK_MAXVAL)
    tVal = zGetProperty(hWnd, %TRACK_VALUE)

    IF TrackOrientation(hWnd) = %TRACK_HORZ THEN
        ty = (rc.nBottom - imgW) \ 2
        range = rc.nRight - imgW
        increment = (tMax - tMin) / range
        IF increment = 0 THEN
            tx = 0
        ELSE
            tx = (tVal - tMin) / increment
        END IF
    ELSE
        tx = (rc.nRight - imgW) \ 2 + 1
        range = rc.nBottom - imgH
        increment = (tMax - tMin) / range
        IF increment = 0 THEN
            ty = 0
        ELSE
            ty = (tVal - tMin) / increment
        END IF
    END IF
    CALL zSetProperty(hWnd, %TRACK_XY, MAKLNG(tx,ty))
END SUB

'// Update X,Y thumb location
SUB SetThumbLocation(BYVAL hWnd AS LONG, x AS LONG, y AS LONG)
    LOCAL lp AS POINTAPI, rc AS RECT, increment AS DOUBLE, Img, imgW, imgH, tx, ty, tMin, tMax, tVal, range AS LONG
    CALL GetClientRect(hWnd, rc)
    Img  = zGetProperty(hWnd, %TRACK_IMAGE): CALL zGetImageSize(Img, imgW, imgH)
    tMin = zGetProperty(hWnd, %TRACK_MINVAL)
    tMax = zGetProperty(hWnd, %TRACK_MAXVAL)

    IF TrackOrientation(hWnd) = %TRACK_HORZ THEN
       tx = MIN&(MAX&(x - imgW \ 2, 0), rc.nRight - imgW)
       ty = ((rc.nBottom - imgW ) \ 2)
       range = rc.nRight - imgW
       increment = (tMax - tMin) / range
       tVal = (increment * tx) + tMin
    ELSE
       tx = (rc.nRight - imgW) \ 2 + 1
       ty = MIN&(MAX&(y - imgH \ 2, 0), rc.nBottom - imgH)
       range = rc.nBottom - imgH
       increment = (tMax - tMin) / range
       tVal = (increment * ty) + tMin
    END IF
    CALL zSetProperty(hWnd, %TRACK_VALUE, tVal)
    CALL zSetProperty(hWnd, %TRACK_XY, MAKLNG(tx,ty))

    IF tVal <> zGetProperty(hWnd, %TRACK_WAS_VALUE) THEN
       CALL zUpdateWindow(hWnd, 1)
       CALL zSetToolTipText(hWnd, (LTRIM$(STR$(tVal))))
    END IF
    CALL zSetProperty(hWnd, %TRACK_WAS_VALUE, tVal)

END SUB

'// Detect if mouse cursor hover track thumb
FUNCTION CheckOverThumb(BYVAL hWnd AS LONG, BYVAL x AS LONG, y AS LONG) AS LONG
    LOCAL r AS RECT, tx, ty, Img, imgW, imgH AS LONG, lp AS POINTAPI
    tx = LOWRD(zGetProperty(hWnd, %TRACK_XY))
    ty = HIWRD(zGetProperty(hWnd, %TRACK_XY))
    Img  = zGetProperty(hWnd, %TRACK_IMAGE): CALL zGetImageSize(Img, imgW, imgH)
    CALL GetClientRect(hWnd, r)
    CALL SetRect(r, tx, ty, tx + imgW, ty + imgH)
    FUNCTION = PtInRect(r, x, y)
END FUNCTION



For performance issue, the Min Max value and default value must use LONG exclusively, if you need to work with SINGLE (REAL on 4-bit) or DOUBLE (REAL on 8-bit) then you must first convert them to LONG like this:
rMin is real on 4-bit = 12335.44
nMin is int on 4-bit = CLNG(rMin * 100)
And of course reverse the process when you get the WM_COMMAND value notification.

ToolTip
In case of tooltip, the control displays the current value while dragging the track's thumb.

Keyboard support
So far, because I was a little lazy, I didn't put the keyboard handling, that's up to you if you need it ...

And now the screen shot of the result:



I hope you begin to see the unleash power of SDK, over anything else ;)

More to come...

Patrice Terrier
www.zapsolution.com

Patrice Terrier
GDImage (advanced graphic addon)
http://www.zapsolution.com

Edwin Knoppert

Not sure you have an interest but it is possible to write such custom controls with PwrDev, might be useful to PwrDev users.

Or discuss a format we both can use to allow controls into a PwrDev project.

Patrice Terrier

Edwin,

Between GDImage, zDraw and PhotoComposer, I have everything to create a nice graphic form designer, not a code generator like yours or Paul's or Dominic's but just something similar to Borje's PB Winspy that will generate a bare bone SDK template. However the PB's addon market is realy too small, to pay me in return of the time I would spend on it, thus it has been sent to tray.

I coud have done also a gauge package like DunDas, I asked for this on the PB's forum but I didn't get even one answer...

The only real market for addon providers is C++ and C#, because then you can make a living from your work :)
Patrice Terrier
GDImage (advanced graphic addon)
http://www.zapsolution.com

Edwin Knoppert

Will you allow me to use your code as example in PwrDev?
This means i won't really make it a native custom control for selling purposes but i would copy and evt. rewrite your examples in plain PwrDev projects.
While we both like programming in SDK an example in PwrDev would make it much more easy for some of the users.
(And reusable)

Thanks!

Patrice Terrier

'      // paint left side
       Img = zGetProperty(hMain, %FORM_SideLeft): CALL zGetImageSize(Img, ImgW, ImgH)
       'CALL GdipDrawImageRectRectI(graphics, Img, 0, 0, ImgW, rc.nBottom + Wider, _
       '                            0, 0, ImgW, ImgH, %UnitPixel, ImgAttr)
       CALL zTilePaint(graphics, Img, 0, TLH, ImgW, rc.nBottom - (TLH + BLW))


In the last ZIP file, as well as in the others, there is a small typo in
// paint left side
instead of
CALL zTilePaint(graphics, Img, 0, TLH, ImgW, rc.nBottom - (TLH + BLW))
it must be
CALL zTilePaint(graphics, Img, 0, TLH, ImgW, rc.nBottom - (TLH + BLH))

Patrice Terrier
www.zapsolution.com
Patrice Terrier
GDImage (advanced graphic addon)
http://www.zapsolution.com

Patrice Terrier

Edwin

Quoteevt. rewrite your examples in plain PwrDev projects.

Why rewrite, they are already well written, aren't they?  ;D

I put a lot of work in this tutorial, both programming and artwork, thus if you think your users could benefit from what I did, then tell them to come here ;)


Patrice Terrier
GDImage (advanced graphic addon)
http://www.zapsolution.com

Kent Sarikaya

Thanks again, really amazing and beautiful controls!

Patrice Terrier

The first post of this thread has been updated, to fix the ZIP file corruption caused by the "Server Collapse".

...
Patrice Terrier
GDImage (advanced graphic addon)
http://www.zapsolution.com