********************************************************************************
*  FILE:         Vcr.cc
*
*  WRITTEN BY:   Borland Samples Group
*
*  DATE:         3/95
*
*  UPDATED:      7/95
*
*  REVISION:     $Revision:   1.15  $
*
*  VERSION:      Visual dBASE
*
*  DESCRIPTION:  This files contains a VCR custom control that can be used
*                for table navigation.  The control consists of 6 buttons
*                with the following functions:
*
*                VCRFirstButton    -- Go to first record
*                VCRPrevPageButton -- Move back a page of records
*                VCRPrevButton     -- Move back one record
*                VCRNextButton     -- Move forward one record
*                VCRNextPageButton -- Move forward one page of records
*                VCRLastButton     -- Go to last record
*
*                Custom Properties
*                -----------------
*                Speedbar (logical) -- if set to .T. will cause buttons to
*                                      behave as if they were on the speedbar,
*                                      i.e. they will not get focus, and you
*                                      will not be able to TAB to them.
*                                      Default -- .F.
*
*                Etched (logical)   -- if set to .T. will define a lowered
*                                      rectangle underneath the buttons to
*                                      give the whole control an "etched" look
*                                      Default -- .F.
*
*                The above names are not the actual names of the buttons.
*                The actual names will be VCRFirstButton1, ... etc.  With
*                the last character being a digit incremented for each
*                instance of the control on the current form.
*                The first button, which is also the container control has
*                have properties that reference each of the other controls.
*                Those references are constant.  For example, the current
*                nextButton control is referenced by this.VcrNextButton.
*                Each of the sub controls, in turn, has a containerControl
*                reference, which refers back to the first button.  These
*                references are all generated in the DefineVCRButton procedure.
*
*
*                Custom Methods
*                --------------
*                You can define routines to be executed before and after the
*                OnClick routine for each of the VCR buttons.  To execute
*                these routines, you would assign an appropriate function
*                pointer to one of the following custom properties:
*
*                   BeforeFirstOnClick
*                   AfterFirstOnClick
*                   BeforePrevPageOnClick
*                   AfterPrevPageOnClick
*                   BeforePrevOnClick
*                   AfterPrevOnClick
*                   BeforeNextOnClick
*                   AfterNextOnClick
*                   BeforeNextPageOnClick
*                   AfterNextPageOnClick
*                   BeforeLastOnClick
*                   AfterLastOnClick
*
*
*  PARAMETERS:   None
*
*  CALLS:        None
*
*  USAGE:        When creating a form, select the "Set Up Custom Controls"
*                menu from the "File" menu.  Select this file from the
*                "dBASE Custom Controls" page of the "Set Up Custom
*                Controls" dialog and then select "Add".  The custom
*                control in this file will be available on the
*                "Custom" page of the "Controls" window.
*
********************************************************************************


*******************************************************************************
class VCRButtons(f,n) of Rectangle(f,n) custom

*  CONTROL:      VCR table traversing buttons
*
*  DESCRIPTION:  This control is a Rectangle, which defines 6 buttons for
*                traversing a table in different directions.
*                You can go to the beginning of a table, go back a
*                page of records (whatever you define a page to be
*                -- it is defined as 5 records by default), go back
*                one record, go forward one record, forward a page, or
*                go to the end of the table.
*                All buttons are defined in the constructor for the first
*                button.
*
*******************************************************************************
   #include <Messdlg.h>

   #define PAGE_OF_RECORDS           5
   #define VCR_BUTTON_HEIGHT         1.41
   #define VCR_BUTTON_WIDTH          4
   #define NUM_VCR_BUTTONS           6

   *** Constructor

   local curRec

   this.border = .F.
   this.borderStyle = 2
   this.left = 0
   this.top = 0
   this.height = VCR_BUTTON_HEIGHT + .15
   this.width = VCR_BUTTON_WIDTH * 6 + .6

   *** Custom Properties for External use
   this.etched = .F.    && Add etched look around buttons?
   this.speedbar = .T.  && Treat buttons as if they are on speedbar?

   *** Routines to be executed along with button clicks
   this.BeforeFirstOnClick = {;}
   this.AfterFirstOnClick = {;}
   this.BeforePrevPageOnClick = {;}
   this.AfterPrevPageOnClick = {;}
   this.BeforePrevOnClick = {;}
   this.AfterPrevOnClick = {;}
   this.BeforeNextOnClick = {;}
   this.AfterNextOnClick = {;}
   this.BeforeNextPageOnClick = {;}
   this.AfterNextPageOnClick = {;}
   this.BeforeLastOnClick = {;}
   this.AfterLastOnClick = {;}

   *** Events
   this.OnOpen = CLASS::VCRButtons_OnOpen
   this.OnDesignOpen = CLASS::VCRButtons_OnDesignOpen
   this.OnClose = {;close procedure program(1)}

   *** Internally Used Custom Properties (for bounds checks)
   curRec = recno()
   go top
   this.firstRec = recno()   && Property for storing first record
   go bottom
   this.lastRec = recno()    && Property for storing last record
   if .not. eof() .and. curRec > 0
      go curRec
   endif


   ****************************************************************************
   Procedure VCRButtons_OnOpen
   ****************************************************************************

   * Define VCR Buttons, if they haven't been defined yet
   if type("this.VCRFirstButton") = "U"
      CLASS::SetUpControl()
   endif



   ****************************************************************************
   Procedure VCRButtons_OnDesignOpen(bFromPalette)

   * This procedure is called whenever the control is being designed in the
   * Forms Designer.  It does the exact same thing as the OnOpen -- i.e.
   * defines all the VCR Button controls.
   ****************************************************************************

   CLASS::SetUpControl()


   ****************************************************************************
   procedure SetUpControl

   * Defines VCR Buttons, and sets custom properties based on
   * control definition in the form.
   ****************************************************************************

   * Temporary variable
   private saveTalk

   * Don't want extraneous info on screen when creating control
   if set("talk") = "ON"
      set talk off
      saveTalk = "ON"
   else
      saveTalk = "OFF"
   endif

   *** Rest of buttons
   CLASS::DefineVCRButton("VCRFirstButton",;
                              CLASS::VCRFirstButton_OnClick, "851", 1,;
                              "First Record", this.BeforeFirstOnClick,;
                              this.AfterFirstOnClick)
   CLASS::DefineVCRButton("VCRPrevPageButton",;
                              CLASS::VCRPrevPageButton_OnClick, "852", 2,;
                              "Previous Page", this.BeforePrevPageOnClick,;
                              this.AfterPrevPageOnClick)
   CLASS::DefineVCRButton("VCRPrevButton",;
                              CLASS::VCRPrevButton_OnClick, "853", 3,;
                              "Previous Record", this.BeforePrevOnClick,;
                              this.AfterPrevOnClick)
   CLASS::DefineVCRButton("VCRNextButton",;
                              CLASS::VCRNextButton_OnClick, "854", 4,;
                              "Next Record", this.BeforeNextOnClick,;
                              this.AfterNextOnClick)
   CLASS::DefineVCRButton("VCRNextPageButton",;
                              CLASS::VCRNextPageButton_OnClick, "855", 5,;
                              "Next Page", this.BeforeNextPageOnClick,;
                              this.AfterNextPageOnClick)
   CLASS::DefineVCRButton("VCRLastButton",;
                              CLASS::VCRLastButton_OnClick, "856", 6,;
                              "Bottom Record", this.BeforeLastOnClick,;
                              this.AfterLastOnClick)

   * Create references to above buttons from this container control
   CLASS::CreateButtonReferences()

   * Size and move this control to surround buttons
   *this.top = this.VCRFirstButton.top - .1
   *this.left = this.VCRFirstButton.left - .4
   this.height = this.VCRFirstButton.height + .25
   this.width = this.VCRFirstButton.width * 6 + .6

   *** Handle custom properties, if they are assigned
   this.border = this.etched

   protect VCRFirstButton, VCRPrevPageButton, VCRPrevButton, VCRNextButton,;
              VCRNextPageButton, VCRLastButton

   set talk &saveTalk


   Function FindFirstVCRButton
      local name
      private control

      *control = form.first
      control = this

      name = control.name
      bFound = .F.
      do
         if (type("control.bIsVCRButton") <> 'U')
            bFound = .T.
         else
            control = control.before
         endif
      until (control.name == name .or. bFound)

      return(control)

   ****************************************************************************
   Procedure CreateButtonReferences

   * Creates references to all vcr buttons from this container control.
   ****************************************************************************
   private i, vcrButton

   vcrButton = this.FindFirstVCRButton()


   for i = 1 to NUM_VCR_BUTTONS
      do case
         case i = 1
            this.VCRFirstButton = vcrButton
         case i = 2
            this.VCRPrevPageButton = vcrButton
         case i = 3
            this.VCRPrevButton = vcrButton
         case i = 4
            this.VCRNextButton = vcrButton
         case i = 5
            this.VCRNextPageButton = vcrButton
         case i = 6
            this.VCRLastButton = vcrButton
      endcase
      vcrButton = vcrButton.before
   next i

   ****************************************************************************
   Procedure DefineVCRButton

   * Defines a single VCR Button.
   ****************************************************************************
   parameters buttonName, OnClickRoutine, resourceNum, buttonNum,;
              speedTipText, BeforeOnClickRoutine, AfterOnClickRoutine


   * Using the class name of the control as its name in control definition
   * will create a unique name for that control
   DEFINE PUSHBUTTON PUSHBUTTON OF FORM;
      PROPERTY;
         OnClick OnClickRoutine,;
         Top this.top + .1,;
         PageNo this.pageNo,;
         UpBitmap "Resource #" + resourceNum,;
         Width VCR_BUTTON_WIDTH,;
         ColorNormal "BtnText/BtnFace",;
         Text "",;
         Group .T.,;
         Height VCR_BUTTON_HEIGHT,;
         Left this.left + VCR_BUTTON_WIDTH * (buttonNum - 1) + .4,;
         SpeedBar this.speedBar,;
         TabStop this.speedBar,;
         SpeedTip speedTipText;
      CUSTOM;
         containerControl this,;
         BeforeOnClick BeforeOnClickRoutine,;
         AfterOnClick AfterOnClickRoutine,;
         bIsVCRButton .T.


   ****************************************************************************
   Procedure VCRFirstButton_OnClick

   * OnClick routine for First button.
   ****************************************************************************

   this.BeforeOnClick()
   if CLASS::IsTableOpen()
      if recno() = this.containerControl.firstRec
         AlertMessage("At the first record","Alert")
      else
         go top
      endif
   endif
   this.AfterOnClick()


   ****************************************************************************
   Procedure VCRPrevPageButton_OnClick

   * OnClick routine for PrevPage button.
   ****************************************************************************

   this.BeforeOnClick()
   if CLASS::IsTableOpen()
      skip -PAGE_OF_RECORDS
      CLASS::CheckBOF()
   endif
   this.AfterOnClick()


   ****************************************************************************
   Procedure VCRPrevButton_OnClick

   * OnClick routine for Prev button.
   ****************************************************************************

   this.BeforeOnClick()
   if CLASS::IsTableOpen()
      skip - 1
      CLASS::CheckBOF()
   endif
   this.AfterOnClick()


   ****************************************************************************
   Procedure VCRNextButton_OnClick

   * OnClick routine for Next button.
   ****************************************************************************

   this.BeforeOnClick()
   if CLASS::IsTableOpen()
      skip
      CLASS::CheckEOF()
   endif
   this.AfterOnClick()


   ****************************************************************************
   Procedure VCRNextPageButton_OnClick

   * OnClick routine for NextPage button.
   ****************************************************************************

   this.BeforeOnClick()
   if CLASS::IsTableOpen()
      skip PAGE_OF_RECORDS
      CLASS::CheckEOF()
   endif
   this.AfterOnClick()


   ****************************************************************************
   Procedure VCRLastButton_OnClick

   * OnClick routine for Last button.
   ****************************************************************************

   this.BeforeOnClick()
   if CLASS::IsTableOpen()
      if recno() = this.containerControl.lastRec
         AlertMessage("At the last record","Alert")
      else
         go bottom
      endif
   endif
   this.AfterOnClick()


   **************************** Support Functions *****************************

   ****************************************************************************
   Function IsTableOpen
   ****************************************************************************
   private tableOpen

   if empty(dbf())      && if a table is not open in the current workarea
      InformationMessage("There is no table open in the current workarea.",;
         "Info")
      tableOpen = .F.
   else
      tableOpen = .T.
   endif

   return tableOpen


   ****************************************************************************
   Procedure CheckEOF
   ****************************************************************************

   if eof()
      go bottom
      AlertMessage("At the last record","Alert")
   endif


   ****************************************************************************
   Procedure CheckBOF
   ****************************************************************************

   if bof()
      go top
      AlertMessage("At the first record","Alert")
   endif


   ****************************************************************************
   Procedure Release

   * Redefinition of built in Release() method.
   * Release all subcontrols, and then call the built in Release() method.
   ****************************************************************************

   if type("this.VCRFirstButton") <> "U"        && Subcontrols defined in
      this.VCRFirstButton.Release()             && OnOpen, so if control is
      this.VCRPrevPageButton.Release()          && released before form is open
      this.VCRPrevButton.Release()              && they will be undefined.
      this.VCRNextButton.Release()
      this.VCRNextPageButton.Release()
      this.VCRLastButton.Release()
   endif
   SUPER::Release()


endclass


