Creating Custom Controls

Ted Roche
Blackstone Incorporated
(617) 641-0400


Enhance your user interface with custom controls beyond those VFP provides. Demonstration and discussion of thermometers, sliders, and other controls which can be added to your palette of tools. Issues involved with developing and integrating controls into VFP applications, including proper documentation, data binding, and limitations of using your own or third-party add-ins.

Slider Bar

A slider bar can be built from a line, an image, a textbox and an invisible shape. The line and image represent the slider, the textbox displays the value, and the shape is used as a sensitive area to detect the mouse movements. Key code snippets are included below. Complete code is provided on disk in SLIDER.VCX and COLORGET.SCX


DEFINE CLASS slider AS container


   *-- Maximum value the slider can display

   nmaxvalue = 100

   *-- The value of the control.

   value = 0

   Name = "slider"


   ADD OBJECT line1 AS line WITH ;


   ADD OBJECT line2 AS line WITH ;


   ADD OBJECT image1 AS image WITH ;

      Picture = "slider1.bmp", ;


   ADD OBJECT shape1 AS shape WITH ;


   ADD OBJECT text1 AS textbox WITH ;

      Value = 0, ;


   *-- Occurs whenever Value changes. Used as a stub - containers don't ;

       have a native InteractiveChange() event nor Value property.

   PROCEDURE InteractiveChange



   PROCEDURE shape1.MouseMove

      LPARAMETERS nButton, nShift, nXCoord, nYCoord

      * if left mouse down, BITTEST() and in the range of the line

      * Calculate the position of the X-coordinate relative to

      * the position of the control on the form.

      * OBJTOCLIENT() is a VFP 3 function which returns the

      * pixel placement of the named object to the form.

      * Subtracting the left value (the 2nd parameter) from

      * the passed form XCoord returns the location to which

      * the slider should be moved relative to the container.


      nXCoord = nXCoord - OBJTOCLIENT(this.parent,2)


      if bittest(nButton,0) AND ;

        nXCoord >= this.left AND ;

        nXCoord <= this.left + this.width

        * center the image on the x-coordinate

        this.parent.image1.left = nXCoord - .5 * this.parent.image1.width

        this.parent.text1.value = ROUND(this.parent.nMaxValue *

                                  (nXCoord-this.parent.line1.left) / ;





   PROCEDURE shape1.MouseDown

      LPARAMETERS nButton, nShift, nXCoord, nYCoord


      nXCoord = nXCoord - OBJTOCLIENT(this.parent,2)


      this.parent.image1.left = nXCoord - .5 * this.parent.image1.width

      this.parent.text1.value = ROUND(this.parent.nMaxValue *

                                  (nXCoord-this.parent.line1.left) / ;




   PROCEDURE text1.ProgrammaticChange




   PROCEDURE text1.InteractiveChange

      * Limit the value to between zero and nMaxValue ;

        Catch a slide off the end of the bar sometimes ;

        MouseMove or Click will overshoot by a pixel or two. ;

        Also prevents keyboarding a value outside the range.


      if this.value > this.parent.nMaxValue

         this.value = this.parent.nMaxValue



      if this.value < 0

         this.value = 0



      * Update the container's value

      this.parent.value = this.value


      * Fire the container's InteractiveChange() event







*-- EndDefine: slider



Thermometers come in all colors, orientations, and fill patterns (up or down, left or right). This example class gives you some ideas of how to produce these effects. The basic thermometer consists of two shapes, one for the outer frame and one to display the "mercury" as it fills or drains, and a label to display the value of the thermometer over time. Obviously, this basic control can be combined with other controls (labels and perhaps timers) on forms to produce the desired effect. Key code fragments are reproduced below. The class library is THRMOMTR.VCX and the demo form THRMDEMO.SCX.


DEFINE CLASS thermometer AS control

   *-- Percentage Complete to be displayed

   PROTECTED npctcomplete

   npctcomplete = (1)

   *-- Size of the frame around the thermometer

   framewidth = 1

   *-- Color Property for a sincle-color thermometer fill.

   mercurycolor = 255

   *-- Percent change which will cause Mercury to be re-drawn.
      Zero causes continual refesh. Default to one.

   interval = (1)

   *-- Property which determines if mercury fills from
      bottom to top or left to right

   orientation = (0)

   *-- Percentage last used to update the thermometer's shape and text.

   *--  Used to test if (Interval) has passed for updating.

   PROTECTED noldpercent

   noldpercent = (1)


   ADD OBJECT shpthermframe1 AS shpthermframe WITH ;


   ADD OBJECT shpmercury1 AS shpmercury WITH ;


   ADD OBJECT lblcomplete AS lblpercent WITH ;


   *-- Method called by external objects with a parameter
   *-- to update the percentage complete

   PROCEDURE updatepct

      lparameters nPctComplete

      this.nPctComplete = nPctComplete


      * redisplay text and shape if "Interval" is exceeded

      if this.nPctComplete >= this.nOldPercent + this.Interval or ;

         this.nPctComplete <= this.nOldPercent - this.Interval or ;

         this.nPctComplete = 100

        this.UpdateText()  && re-display text

        this.UpdateMercury()    && re-display mercury

        this.nOldPercent = this.nPctComplete




   *-- Redraws the fill-in mercury shape. Called by UpdatePct()

   PROTECTED PROCEDURE updatemercury

      * Resize the mercury to show the new complete percentage


      do case

        case this.Orientation = 0  && default left-to-right

          this.shpMercury1.Width=(this.nPctComplete/100) * ;



        case this.Orientation = 1  && bottom-to-top

          this.shpMercury1.Top = this.shpThermFrame1.BorderWidth + ;

            ((100-this.nPctComplete)/100) * ;


          this.shpMercury1.Height = (this.Height - ;

                                     this.shpThermFrame1.BorderWidth) - ;



        case this.Orientation = 99  && top-to-bottom "drain" effect

          this.shpMercury1.Top = this.shpThermFrame1.BorderWidth + ;

            (this.nPctComplete/100) * ;


          this.shpMercury1.Height = (this.Height - ;

                                     this.shpThermFrame1.BorderWidth) - ;



            error 1560




   *-- Redisplays the label on the thermometer. Called by UpdatePct()


      * Refresh the "percent complete" text

      this.lblComplete.Caption=transform(this.nPctComplete,"@R 999%")

      * Recenter the text string.





      * Store an inital 1 percent, because

      * 3-d shapes do funny things with zero widths

      this.nPctComplete = 1


      * But we want the oldpercent to increment each "intervalth"

      * amount (i.e., 5,10,15,... or 2,4,6,...) so it starts at zero

      this.nOldPercent = 0


      * Size the frame to the size of the control on the form





      * Size the Mercury to fit within the borders of the frame



      do case

        case this.Orientation = 0  && default left-to-right


          this.shpMercury1.Height=this.height - ;


        case this.Orientation = 1  && bottom-to-top fill

          this.shpMercury1.Top=this.Height - ;

                 2 * this.shpThermFrame1.BorderWidth

          this.shpMercury1.Height = 1

          this.shpMercury1.Width=this.Width - ;


        case this.Orientation = 99 && top-to-bottom "drain" effect

          this.shpMercury1.Top = this.shpThermFrame1.BorderWidth

          this.shpMercury1.Height = (this.Height - ;

                                     this.shpThermFrame1.BorderWidth) - ;


          this.shpMercury1.Width=this.Width - ;



          && unacceptable property value

          error 1560



      * Center the label horizontally & vertically







*-- EndDefine: thermometer


Always On Top pushpin        

This is probably the simplest class coded. The pushpin is a checkbox with two graphics, one in the Picture property and one, the DownPicture property. Reverse the form's AlwaysOnTop property, swipe a thumbtack bitmap, and you're in business! Microsoft appears to have abandoned this graphical widget in favor of context-sensitive menu options.

WhatsThis? Help 

Unbeknownst to most FoxPro developers, FoxPro has had a context sensitive WhatsThis? Help system available since before the standard was introduced - in fact, since FoxPro/DOS was introduced! KEYBOARD'ing a Shift-F1starts the process.


Forms now (in version 5.0) have a WhatsThisButton property, which will automatically invoke Help with the HelpContextID of the selected control. In order to have a working WhatsThisButton, the form must have a border (BorderStyle not set to 0-None), both Max and MinButtons must be off (set to .F.) and the WhatsThisHelp property set to .T.

Disk ComboBox

This class uses several Windows API calls to detect all legal drives, determine their type, and obtain their volume names. Appropriate bitmaps for each type of drive are displayed, using the Picture property


DEFINE CLASS cbodisk AS cbo  && derivative of baseclass ComboBox




      *** Declare API calls ***

      * GetLogicalDrives() returns a bitmap of "legal" logical drives

      DECLARE INTEGER GetLogicalDrives in win32api


      * GetVolumeInformation() returns volume names, serial numbers, ;

        file sytstems, and other stuff.


      DECLARE short GetVolumeInformation IN Win32API ;

         STRING lpRootPathName,  ;

          STRING  lpVolumeNameBuffer,  ;

         INTEGER  nVolumeNameSize,  ;

          STRING  lpVolumeSerialNumber,   ;

          STRING  lpMaximumComponentLength, ;

          STRING  lpFileSystemFlags,   ;

          STRING  lpFileSystemNameBuffer, ;

          INTEGER  nFileSystemNameSize


      * GetDriveType() returns numeric type of drive


< fo style='mso-tab-count:3'>         STRING lpRootPathName && address of root path


      * GetDriveType RETURN VALUES:

      #DEFINE DRIVE_NONE 0 && The drive type cannot be determined.

      #DEFINE DRIVE_BAD 1     && The root directory does not exist.

      #DEFINE DRIVE_REMOVABLE 2  && The drive can be removed from the drive.

      #DEFINE DRIVE_FIXED  3  && The disk cannot be removed from the drive.

      #DEFINE DRIVE_REMOTE 4  && The drive is a remote (network) drive.

      #DEFINE DRIVE_CDROM  5  && The drive is a CD-ROM drive.

      #DEFINE DRIVE_RAMDISK 6 && The drive is a RAM disk.


      *** Get bitmap of legal drives ***

      nDrive = GetLogicalDrives()


      *** Assign drive letters, icons, and volume names to List ***

      for i = 0 to 25

         if bittest(nDrive,i)  && this is a logical drive

            lcDrive = CHR(ASC("A")+i)+":\" && translate to letter


            IF lcDrive > "B:\"  && 13-Feb-96: skip floppy drives

               * Obtain the Volume Name

               STORE SPACE(255) TO lpRootPathName, ;

                   lpVolumeNameBuffer, ;

                   lpVolumeSerialNumber,  ;

                   lpMaximumComponentLength, ;

                   lpFileSystemFlags,  ;



               STORE 255 TO nVolumeNameSize, ;



               = GetVolumeInformation(lcDrive, ;

                   @lpVolumeNameBuffer, ;

                   @nVolumeNameSize, ;

                   @lpVolumeSerialNumber, ;

                   @lpMaximumComponentLength, ;

                   @lpFileSystemFlags, ;

                   @lpFileSystemNameBuffer,  ;

                   @nFileSystemNameSize )


               * Trim string at terminating 00h

               IF AT(CHR(0),lpVolumeNameBuffer) > 0

                  lpVolumeNameBuffer = LEFT(lpVolumeNameBuffer, ;



                  lpVolumeNameBuffer = ""

          New  ENDIF


               lpVolumeNameBuffer = ""

            ENDIF lcDrive > "B:\"  && 13-Feb-96: skip floppy drives


            * Get the disk drive type

            IF lcDrive > "B:\"  && 13-Feb-96: skip floppy drives

               lnDriveType = GetDriveType(lcDrive)


               lnDriveType = DRIVE_REMOVABLE

            ENDIF lcDrive > "B:\"  && 13-Feb-96: skip floppy drives


            * Add the volume name after the call to GetDriveType

            lcDrive = lcDrive + lpVolumeNameBuffer


            *** Assign bitmaps to list items ***

            DO CASE

            CASE lnDriveType = DRIVE_NONE

               * do nothing

            CASE lnDriveType = DRIVE_BAD

               * do nothing

            CASE lnDriveType = DRIVE_REMOVABLE


               this.Picture[this.ListCount] = "FLOPPY.BMP"

            CASE lnDriveType = DRIVE_FIXED


               this.Picture[this.ListCount] = "HARDDISK.BMP"

            CASE lnDriveType = DRIVE_REMOTE


               this.Picture[this.ListCount] = "NETDISK.BMP"

            CASE lnDriveType = DRIVE_CDROM


               this.Picture(this.ListCount) = "CDROM.BMP"

            CASE lnDriveType = DRIVE_RAMDISK


               this.Picture[this.ListCount] = "RAMDISK.BMP"






      this.value = this.List[1]






*-- EndDefine: cbodisk



Combining the disk combo box above with a few list boxes and text boxes turned out to be more of a design challenge than a typical Foxpro developer would have anticipated. A discussion of dialog boxes with complex                              controls and interactions and the design patterns to solve them.

New Widgets

Visual FoxPro 5.0 ships with a slew of new ActiveX controls.


New ActiveX Controls which ship with Visual FoxPro 5.0

Common Controls: The equivalent of many of the dialogs we have had for years - GETFILE(), GETPRINTER(), GETCOLOR() - but with finer and more detailed control of the dialogs.

Statusbar Control: allows the simple creation of a multiple-panel status bar, with text or graphics in each of the panels.

Slider Control: Similar to the slider above

Toolbar Control: create ActiveX toolbars

Rich Textbox Control: Finally! Rich text displayable within a FoxPro form!

SysInfo: A handy control for testing system settings and receiving alerts to system changes.