Parent | Child | Previous | Next

User Defined Controls

IN THIS PAGE

Writing a Slider Control
The OnInit Event
The OnDraw Event
The OnKey Event
The OnMouse Event
Writing a Clock Control
OnCreate Event
OnDestroy Event
OnDraw Event
OnExit Event
OnInit Event
OnSize Event
OnTimer Event

Description

The following section gives examples of User Defined Controls (UDCs) on a form. The sample forms and Xbasic scripts can be found in the Samples\Xbasic directory off the directory in which Alpha Anywhere was installed. Open the Xbasic database in this directory.

This approach for creating user defined controls is deprecated. DECLARE and DECLARESTRUCT are deprecated and slated for removal in a future release.

Writing a Slider Control

This example shows a simple slider control -It sets a value in a variable based on the position of the slider.

This example is contained in the form called "Slider" in the Samples\Xbasic directory.

The OnInit Event

Declares all the external windows API calls used.

' Declare a structure for a rectangle
' Long integer values left, top, right and bottom
declarestruct rect L1left, L1top, L1right, L1bottom
'--------------------------------------------------------
' Declare rectangle GDI function - draw a rectangle
declare gdi32 Rectangle LLLLLL
'--------------------------------------------------------
' Windows SelectObject function - sets a Pen, Brush, Bitmap etc
' for a windows HDC
declare gdi32 SelectObject LLL
'--------------------------------------------------------
' Windows DeleteObject function - deletes a Pen, Brush, Bitmap etc
' It is important to release objects when you are done
declare gdi32 DeleteObject LL
'--------------------------------------------------------
' Windows CreateSolidBrush function
' Creates a brush object of the specified color
declare gdi32 CreateSolidBrush LL
'--------------------------------------------------------
' Windows InvalidateRect function Used to tell windows
' that a particular window needs to be repainted
' the second argument could be a (rect) i.e.
' InvalidateRect LL(rect)L , but windows wants to see a
' pointer value of 0 if we want to invalidate the entire window,
' so we declare that argument as a long integer (same amount of
' memory as a pointer' so we can pass in a zero
declare user32 InvalidateRect LLLL
'--------------------------------------------------------
' Windows GetFocus function Returns the handle of the window
' that has focus
declare user32 GetFocus L
'--------------------------------------------------------
' Windows SetCapture function The window handle specified
' gets all the mouse events after SetCapture is called
' (until a ReleaseCapture is done)
declare user32 SetCapture LL
'--------------------------------------------------------
' Windows ReleaseCapture function, Inform the system that
' we are done tracking the mouse
declare user32 ReleaseCapture L
'--------------------------------------------------------
' Windows DrawEdge function - take a rectangle and border
' style and edge parameters (defined below)
' This function is used to draw a button-style border
declare user32 DrawEdge LL(rect)LL
'--------------------------------------------------------
' Windows DrawFocusRect function - takes a rectangle argument
' and is used to draw a broken line 'focus rectangle'
declare user32 DrawFocusRect LL(rect)
'--------------------------------------------------------
' shared variables to position and scale the slider
dim shared xpos as N
dim shared xmax as N
'--------------------------------------------------------
' constants that are used by the DrawEdge function to
' specify the edges to draw.
constant BF_LEFT    = 1
constant BF_TOP     = 2
constant BF_RIGHT   = 4
constant BF_BOTTOM  = 8
constant BF_ALL     = 15
'--------------------------------------------------------
' constant defined to specify a border style
constant BDR_RAISED = 5
'--------------------------------------------------------
' Initialize the variables
xpos = 0
if xmax < = 0 then
    xmax = 1
end if

The OnDraw Event

Draws the Slider control.

'-------------------------------------
' An XBASIC function that deletes the
' last color brush created
FUNCTION cleanup_color_brush( hdc as N )
   dim shared color_hbrush as N
   dim shared oldbrush as N
   ' if the color brush is defined (nonzero)
   if color_hbrush <> 0
        ' then select the previous brush into the HDC
        ' it is important to do this BEFORE we delete
        ' the color brush because the HDC will most likely
        ' be using the brush we are about to delete
        SelectObject(hdc, oldbrush)
        ' and delete the color brush
        DeleteObject(color_hbrush)
   end if
end FUNCTION
'-------------------------------------
' A function that creates a brush of a
' particular color and applies it to a
' windows display context
FUNCTION SET_brush_color( hdc as N, color as N )
    dim shared color_hbrush as N
    dim shared oldbrush as N
    ' cleanup previously defined brush
    cleanup_color_brush( hdc )
    ' Use windows API call the create a brush of the specified color
    color_hbrush = CreateSolidBrush(color)
    ' Select the created brush into the display context
    ' and remember the old brush
    oldbrush    = SelectObject(hdc, color_hbrush)
end FUNCTION
' Our shared position and extent variables
dim shared xpos as N
dim shared xmax as N
' Sizes we calculate
dim xthumbwidth as N
dim physical_width as N
' shared color brush handle
dim shared color_hbrush as N
' color brush = 0 means color brush is undefined
color_hbrush = 0
' do a sanity check on xmax to avoid a divide by zero error
if xmax < = 0 then
    xmax = 1
end if   
physical_width = a_USER.draw.width
' the width of the 'thumb' we calculate to be 1/8 the
' width of the slider control
xthumbwidth   = physical_width / 8
' calculate the width we have to set the thumbnail at as the
' width of the slider minus the width of the thumbnail
physical_width = physical_width - xthumbwidth
' We set the brush color to be light grey
' the components of a color are Red, Green and Blue values,
' where 255 is brightest, 0 is darkest - a multiply 256 will
' get us the value of the next byte up. .i.e.
' in a 4 byte long value - if we want to set a byte to a value of
' '7'
' value = 7              ' sets the first byte
' value = 7 * 256        ' sets the second byte
' value = 7 * 256 * 256  ' sets the third byte
' For RGB color values, these are the only bytes that are used
SET_brush_color( a_USER.draw.hdc , (((192*256) + 192)*256) + 192 )
' determine where to draw the thumbnail
pxpos = (xpos * physical_width)/xmax
' Initailize the rectangle to be the thumbnail
rect.left  = pxpos
rect.top   = a_USER.draw.top
rect.right = pxpos + xthumbwidth
rect.bottom = a_USER.draw.bottom
' Draw the thumbnail background
Rectangle(a_USER.draw.hdc, rect.left, rect.top, rect.right, rect.bottom)
' Draw the thumbnail border
DrawEdge(a_USER.draw.hdc , rect , BDR_RAISED , BF_ALL)
' Set the background brush to Grey
SET_brush_color( a_USER.draw.hdc , (((128*256) + 128)*256) + 128 )
if a_USER.draw.left < rect.left
  ' Draw the slider rectangle area before the thumbnail
  Rectangle(a_USER.draw.hdc, a_USER.draw.left, a_USER.draw.top, rect.left, a_USER.draw.bottom)
end if
if rect.right < a_USER.draw.right
  ' Draw the slider rectangle area after the thumbnail
  Rectangle(a_USER.draw.hdc, rect.right, a_USER.draw.top, a_USER.draw.right, a_USER.draw.bottom)
end if
if a_USER.draw.hasfocus
   ' If the control has focus, then draw a focus rectangle
   DrawFocusRect(a_USER.draw.hdc, a_USER.draw)
end if
' Release any brushes we created
cleanup_color_brush( a_USER.draw.hdc )

The OnKey Event

When the right and left arrow keys are pressed (when the control has focus) the slider will change. Notice that the slider accelerates slowly if the user holds down the key.

' IS_down_for is a counter
dim IS_down_for as N
' If key is Right or Left arrow key
if a_USER.key.VALUE = "{Left}" .or. a_USER.key.VALUE = "{Right}"
    a_USER.key.handled = .T.
    if a_USER.key.event = "down"
        ' Keep track of how long we hold down the key
        IS_down_for = IS_down_for + 1
        ' determine the displayed position
        xpos = (xpos * physical_width)/xmax
        if a_USER.key.VALUE = "{Left}"
            ' move left N pixels - note that we
            ' speed up the number of pixels we move the
            ' longer we hold down the key
            xpos = xpos - (IS_down_for + 1)/2
        else
            ' move right N pixels - note that we
            ' speed up the number of pixels we move the
            ' longer we hold down the key
            xpos = xpos + (IS_down_for + 1)/2
        end if
        ' Check that position is in range, if out of
        ' range, then set to the nearest endpoint
        if xpos < 0
            xpos = 0
        else if xpos > = physical_width
            xpos = physical_width-1
        end if
        ' convert back from displayed to logical value for xpos
        xpos = (xpos * xmax)/physical_width
        ' invalidate the rectangle - force a repaint
        InvalidateRect(a_USER.hwnd, 0, 0)
    else if a_USER.key.event = "up"
        ' Reset the 'holding-key-down' counter
        IS_down_for = 0
    end if
end if

The OnMouse Event

Allows the user to grab the slider and drag it to a new position.

' Variable to remember that mouse is 'down'
dim mouse_down as L
dim xthumbwidth as N
' physical_width is initialized by OnDraw event
dim physical_width as N
dim shared xpos as N
dim shared xmax as N
xthumbwidth = physical_width / 8
' If the left mouse button was released
if a_USER.mouse.event = "left up"
    ' and we were tracking it
    if mouse_down
        ' stop tracking the mouse
        mouse_down = .F.
        ReleaseCapture()
    end if
else if mouse_down .or. a_USER.mouse.event = "left down"
    ' If we are tracking the mouse, or the mouse button
    ' was pressed while above our slider control
    if .not. mouse_down
        ' If mouse not captured, capture it now
        mouse_down = .T.
        SetCapture(a_USER.hwnd)
    end if
    ' Sanity check the maximum value
    if xmax < = 0 then
        xmax = 1
    end if
    ' move the middle of thumbnail to the current mouse
    ' 'x' (horizontal displacement) position
    xpos = a_USER.mouse.x - (xthumbwidth/2)
    ' range check the position of the thumbnail
    if xpos < 0
        xpos = 0
    else if xpos > = physical_width
        xpos = physical_width-1
    end if
    xpos = (xpos * xmax)/ physical_width
    ' Force the slider window to repaint
    InvalidateRect(a_USER.hwnd, 0, 0)
end if

Writing a Clock Control

This example is contained in the form called "Clock" in the Samples\Xbasic directory. This control is implemented using a User Defined Control. It makes use of a lot of GDI functions as well as the timer event.
OnCreate Event
The OnCreate event fires when the window for the control is created. The SetTimer call is a windows API call that is declared in the OnInit event.
When the window is created, we add a timer to that window which goes off every 1, 000 milliseconds (that is once a second) - the ID that we give is is '1' - the '0' that is the last parameter is a NULL callback function. Currently, callback functions are not supported by XBASIC.
```
' when window is created, create a timer that goes off every second
timer_id = SetTimer(a_USER.hwnd, 1, 1000, 0)
```
OnDestroy Event
The OnDestroy event fires when the window for the control is destroyed. The KillTimer call is also a windows API call (declared in the OnInit event). When we destroy the window for the control, we must also destroy the associated timer.
```
' when the window is destroyed, throw the timer away
KillTimer( a_USER.hwnd , timer_id )
```

OnDraw Event

This event is called whenever the control is repainted. The OnDraw event shown here uses all sorts of windows API calls (mostly GDI calls - for graphics routines).

' Paint the display - uses temporary bitmaps & caches the background
FUNCTION calcx as N(X as N)
    ' Trignometry to convert a position along the circumference
    ' of the circle to a 'x' position ranging from -1 to 1
    calcx = sinx * 3.141516*2?
end FUNCTION
FUNCTION calcy as N(Y as N)
    ' Trignometry to convert a position along the circumference
    ' of the circle to a 'y' position ranging from -1 to 1
    calcy = -cosy * 3.141516*2?
end FUNCTION
' Function that draws a hand on the clock
FUNCTION drawhand as N(HDC as N, factor as N, sx as N, sy as N, length as N, pivlength as N, cx as N, cy as N, red as N, green as N, blue as N)
    ' Factor is the value 0-1 that describes the orientation of the
    ' hand (f represents to 'inverse' or orientation of the other
    ' facet of the hand)
    if factor > 0.75 then
        f = (1.0-factor)/2
        fade1 = 0.75 - f
        fade2 = 0.5 + f
    else if factor > 0.50 then
        f = (0.75-factor)/2
        fade1 = 0.5 + f
        fade2 = 0.75 - f
    else if factor > 0.25 then
        f = (0.5 - factor)/2
        fade1 = 0.5 + f
        fade2 = 0.75 - f
    else
        f = factor/2
        fade1 = 0.75 - f
        fade2 = 0.5 + f
    end if
    ' determine the shading of the hands facets given the
    ' 'pure' color of the hands + the angle the handle is at
    face1color = (int(blue*fade1)*256) + int(green*fade1?*256) + int(red*fade1)
    face2color = (int(blue*fade2)*256) + int(green*fade2?*256) + int(red*fade2)
    ' Draw a polygon for the first facet of the handle
    ' this involves initializing the array of facets that are
    ' passed to the polygon function
    dim pts.points4 as P
    f = factor - 0.50
    pts.points1.x = cx + calcx(f) * pivlength * sx
    pts.points1.y = cy + calcy(f) * pivlength * sy
    f = factor - 0.25
    pts.points2.x = cx + calcx(f) * pivlength * sx
    pts.points2.y = cy + calcy(f) * pivlength * sy
    pts.points3.x = cx + calcx(factor) * length * sx
    pts.points3.y = cy + calcy(factor) * length * sy
    pts.points4.x = pts.points1.x
    pts.points4.y = pts.points1.y
    hbrush = CreateSolidBrush(face1color)
    oldbrush = SelectObject(HDC, hbrush)
    Polygon(HDC, pts, 4)
    SelectObject(HDC, oldbrush)
    DeleteObject(hbrush)
    ' Draw the second facet of the clock hand
    f = factor + 0.25
    pts.points2.x = cx + calcx(f) * pivlength * sx
    pts.points2.y = cy + calcy(f) * pivlength * sy
    hbrush = CreateSolidBrush(face2color)
    oldbrush = SelectObject(HDC, hbrush)
    Polygon(HDC, pts, 4)
    SelectObject(HDC, oldbrush)
 DeleteObject(hbrush)
end FUNCTION
' XBASIC Function that draws the clock dial
FUNCTION drawdial as N(DRAW as P)
    hbrush = CreateSolidBrush((((128*256) + 128)*256) + 128)
    oldbrush = SelectObject(DRAW.HDC, hbrush)
    ' Clear the controls background rectangle
    Rectangle( DRAW.HDC , DRAW.LEFT , DRAW.TOP, DRAW.RIGHT , DRAW.BOTTOM )
        SelectObject(DRAW.HDC, oldbrush)
    DeleteObject(hbrush)
    ' Draw the ellipse of the clock face
    Ellipse( DRAW.HDC , DRAW.LEFT , DRAW.TOP, DRAW.RIGHT , DRAW.BOTTOM )
    ' calculate x and y radius of the ellipse
    sx = (((DRAW.RIGHT - DRAW.LEFT) + 1) / 2) -1
    sy = (((DRAW.BOTTOM - DRAW.TOP) + 1) / 2) -1
    ' calculate center point of the ellipse
    cx = (DRAW.LEFT + DRAW.RIGHT) / 2
    cy = (DRAW.TOP + DRAW.BOTTOM) / 2
    ' create a dummy 'point' structure
    pt.dummy = 1
    ' Draw the minute/second ticks along the edge
    for i = 0 to 59
        MoveToEx( DRAW.HDC , cx + calcx(i/60) * sx , cy + calcy(i/60) * sy , pt )
        Lineto( DRAW.HDC , cx + calcx(i/60) * sx * 0.95 , cy + calcy(i/60) * sy * 0.95 )
    next
    ' Draw the Hour ticks + the hour text along the edge
    for i = 0 to 11
    MoveToEx( DRAW.HDC , cx + calcx(i/12) * sx , cy + calcy(i/12) * sy , pt )
    Lineto( DRAW.HDC , cx + calcx(i/12) * sx * 0.9 , cy + calcy(i/12) * sy * 0.9 )
    digit = alltrimiif(i = 0, 12, i?)
    ' Get the size of the text - use size to determine how to
    ' center the text at a point
    GetT
    entPointA( DRAW.HDC , digit , len(digit) , pt )
    ' Draw the text for the 'hour' centered on a point inside the
    ' dial next to the hour 'tick'
    TextOutA( DRAW.HDC , cx + calcx(i/12) * sx * 0.8 - pt.x/2 , cy + calcy(i/12) * sy * 0.8 - pt.y/2, digit , len(digit) )
    next
end FUNCTION
sizex = ((A_USER.DRAW.RIGHT - A_USER.DRAW.LEFT) + 1)
sizey = ((A_USER.DRAW.BOTTOM - A_USER.DRAW.TOP) + 1)
' If no background bitmap defined, define a bitmap that
' is the size of the clock face
if backgroundhbitmap = 0 then
    ' Windows 'createBitmap' function uses the colors
    ' supported by the HDC, plus a size to create a
    ' bitmap
    backgroundhbitmap = CreateCompatibleBitmap(A_USER.DRAW.HDC, sizex, sizey)
    ' Create a HDC for the bitmap
    draw.hdc   = CreateCompatibleDC(A_USER.DRAW.HDC)
    ' Select the bitmap into the HDC. This makes any
    ' calls that use the HDC to draw scribble to the
    ' bitmap instead of the screen.
    SelectObject( draw.hdc , backgroundhbitmap )
    ' Draw the clock dial into the background bitmap
    draw.top   = 0
    draw.left  = 0
    draw.bottom = A_USER.DRAW.BOTTOM - A_USER.DRAW.TOP
    draw.right = A_USER.DRAW.RIGHT - A_USER.DRAW.LEFT
    drawdial(draw)
    DeleteDC(draw.hdc)
end if
' If not defined, Create a bitmap for the 'cached' clock display.
' We write to a bitmap, then write the bitmap to the screen to get
' smooth repaints
if hbitmap = 0 then
    hbitmap = CreateCompatibleBitmap(A_USER.DRAW.HDC, sizex, sizey)
end if
' Create a HDC for the background bitmap (to read from)
backmemhdc = CreateCompatibleDC(A_USER.DRAW.HDC)
' Create a HDC for the 'cache' bitmap (to write to)
memhdc    = CreateCompatibleDC(A_USER.DRAW.HDC)
SelectObject( backmemhdc , backgroundhbitmap )
SelectObject( memhdc    , hbitmap )
' Copy the background bitmap to the bitmap we are creating
' to show the current time
BitBlt( memhdc , 0 , 0 , sizex , sizey , backmemhdc , 0 , 0 , BITMAP_SRC_COPY )
' set up the x & y center
hsx = sizex/2
hsy = sizey/2
' draw the hours hand to the bitmap
drawhand(memhdc, hours/12, hsx, hsy, 1/2, 1/8, hsx, hsy, 255, 255, 255)
' draw the minutes hand to the bitmap
drawhand(memhdc, minutes/60, hsx, hsy, 3/4, 1/10, hsx, hsy, 0, 0, 255)
' draw the seconds hand to the bitmap
drawhand(memhdc, seconds/60, hsx, hsy, 5/6, 1/16, hsx, hsy, 255, 0, 0)
' Now that the bitmap is drawn, copy it to the screen
BitBlt( A_USER.DRAW.HDC , A_USER.DRAW.LEFT , A_USER.DRAW.TOP , sizex , sizey , memhdc , 0 , 0 , BITMAP_SRC_COPY )
' Cleanup the display contexts that we created
DeleteDC(backmemhdc)
DeleteDC(memhdc)

OnExit Event

This event is called when the control is deleted. The OnDraw events creates bitmaps to cache the repaints. We delete these in the OnExit method.

' Cleanup bitmaps that were created
if hbitmap <> 0
    DeleteObject(hbitmap)
    hbitmap = 0
end if
if backgroundhbitmap <> 0
    DeleteObject(backgroundhbitmap)
    backgroundhbitmap = 0
end if

OnInit Event

This event is called when setting up the control. This performs all the declaration and initialization of variables for all the functions we will use.

'Initialize - declare all the API functions that we use,
' init variables
'** Declare a windows point structure on long integer X,
'** one long integer Y
declarestruct point L1X, L1Y
'** Declare a windows array that can store up to 100 points
declarestruct points point100points
'** Declare a windows rectangle
declarestruct rect L1left, L1top, L1right, L1bottom
'** Declare windows MoveToEx (move to a point) function
declare gdi32 MoveToEx LLLL(point)
'** Declare windows draw line to a point function
declare gdi32 LineTo  LLLL
'** Declare windows draw ellipse function
declare gdi32 Ellipse LLLLLL
'** Declare windows draw rectangle function
declare gdi32 Rectangle LLLLLL
'** Declare windows draw text function
declare gdi32 TextOutA LLLLCL
'** Declare windows get size of drawn text function
declare gdi32 GetT
entPointA LLCL(point)
'** Declare windows mark window as invalid (repaint) function
declare user32 InvalidateRect LLLL
'** Declare widows GetFocus function - gets the active window
declare user32 GetFocus L
'** Declare windows CreateSolidBrush function - create a brush
declare gdi32 CreateSolidBrush LL
'** Declare windows DeleteObject function delete Brush, Pen, Bitmap
declare gdi32 DeleteObject LL
'** Declare windows SelectObject function - select brush pen etc
'** into a windows display context
declare gdi32 SelectObject LLL
'----------------------------------------------------------------
'** Declare windows polygon drawing function. Here we pass an
' Array of 100 points, we can use less than 100 points - windows
' polygon function only reads the number of points we report that
' we are passing to it (using the number_of_points parameter)
'. If you need to draw polygons with more than 100 points,
' than you must make points dimension (declared above) -
' bigger - i.e. point500points would allow up to 500
' points to be passed to the polygon function
declare gdi32 Polygon LL(points)L
'** Declare windows SetTimer function - causes window to get
' called back on an interval with a timer message + timer id
declare user32 SetTimer LLLLL
'** Declare windows KillTimer function - causes window timer to
' cease
declare user32 KillTimer LLL
'------------------------------------------------------
' windows CreateCompatibleBitmap Function - creates a bitmap
' using the attributes of the display context passed in, and
' the width and height provided
declare gdi32 CreateCompatibleBitmap LLLL
'------------------------------------------------------
' windows function to create a display context that
' is like another (i.e. same color settings pens brushes etc)
declare gdi32 CreateCompatibleDC LL
'** declare windows function to delete display context that was
' created using CreateCompatibleDC
declare gdi32 DeleteDC LL
'** declare windows function Draw pixels from one display context
' into another display context
declare gdi32 BitBlt LLLLLLLLLL
' Constant argument to BitBlt for 'copy bits' mode - there are
' several modes (subtracting pixels, logically or-ing or and-ing
' pixels etc) - this is the only BitBlt operation we use in this
' sample program
CONSTANT BITMAP_SRC_COPY = 13369376
' Initialize the hand values, and bitmaps
seconds = 0
minutes = 0
hours = 0
hbitmap = 0
backgroundhbitmap = 0

OnSize Event

This event is called when the control is sized. This forces the cached bitmaps to be recalculated (so that on the next draw the image will be resized).

' throw away the bitmaps whenever we resize
if hbitmap <> 0 then
    DeleteObject(hbitmap)
    hbitmap = 0
end if
if backgroundhbitmap <> 0 then
    DeleteObject(backgroundhbitmap)
    backgroundhbitmap = 0
end if

OnTimer Event

This event is called whenever a timer event occurs. We track the seconds, minutes and hours here:

' when timer goes off, recalculate the time & cause a repaint
seconds = inttoseconds?, 60?
minutes = modtime(?/60, 60)
hours  = modtime(?/(60*60), 12)
?causes the control to repaint
InvalidateRect(a_USER.hwnd, 0, 0)

Report an issue with this page