formMain.vrf.annotated

#

AVR Classic program to demonstrate a simple subfile for customer selection.

Show controls list and their properties.

The subfile display

The update panel

This program shows a simple page-at-a-time subfile that would be used for navigation through a file. Once a row is located, the user would initiate an action. That action isn't shown in the is example; this example focuses on populating and navigating the subfile. disabled: 90, 88, 89 backcolor: 195, 195, 195

#

Files opened for update aren't blocked like input files are. Therefore it's always best to use input files (which are blocked by default with AVR) for populating lists (such as subfiles and comboboxes). The Prefix is a bit of a hack that provides fully-qualified field names.

DclDiskFile  Name(Cust) +
             Type(*INPUT) +
             Org(*INDEXED) +
             Prefix(Cust_) +
             NetBlockFactor(*Calc) +
             ImpOpen(*Yes) +
             AddRec(*No) +
             FileDesc('Examples/CMastNewL2') +
             DBDesc('*PUBLIC/DG NET Local')

#

This file is opened for update. When reads are made against this file that aren't followed with a (nearly) immediate write, the Unlock opcode is used to unlock the record.

DclDiskFile  Name(CustUpdate) +
             Type(*Update) +
             Org(*INDEXED) +
             Prefix(Cust_) +
             ImpOpen(*Yes) +
             RnmFmt(CUSTU) + 
             FileDesc('Examples/CMastNewL1') +
             DBDesc('*PUBLIC/DG Net Local')

// These data structures aren't used in this program, but provide a 
// potential discussion point.  
// DclDS CustDS  ExtDesc(*Yes) +
//               FileDesc('Examples/CMastNewL2') +
//               DBDesc('*PUBLIC/DG NET Local') +
//               Prefix(Cust_)
 
// DclDS sbfCustDS  ExtDesc(*Yes) +
//                  FileDesc('Examples/CMastNewL2') +
//                  DBDesc('*PUBLIC/DG NET Local') +
//                 Prefix(SbfCust_)

#

This constant controls how many rows are presented in the subfile.

DclConst SUBFILE_ROWS Value(12)

#

This constant idenfies the (zero-based) first row in the subfile.

DclConst TOP_ROW Value(0) 

DclConst REFRESH_FROM_FIRST_ROW Value("")

#

Labels on forms that have empty captions are very hard to work with at designtime. I add bracketed captions to these labels so that they are easy to work with at runtime (for example, [Name]). When the program starts these labels are cleared.

labelName.Caption = ''
labelAddress.Caption = ''
labelCSZ.Caption = ''
labelMessage.Caption = ''

#

Show first page of the subfile.

sbfCust_ShowFirstPage()

#

End of mainline.

#

Naming conventions:

sbfCust.[method name]: Methods provided intrinsically by the subfile.
sbfCust.[property name]: Properties provided intrinsically by the subfile.
sbfCust_[method name]: Methods that manipulate the subfile provided in this program.
sbfCust_[field name]: Fields that describe or control the subfile provided in this program.

#

Notes:

Set sbfCust.Browse to False to be able to edit a subfile row in place. Note that sbfCust.Browse is a design-time property only--you can't change it at runtime.

#

First page requested.

BEGSR imageFirstPage Click
    sbfCust_ShowFirstPage() 
ENDSR

#

Next page requested.

BEGSR imageNextPage Click

#

Read the last populated row of the subfile.

    Chain sbfCust Key(sbfCust.RowCount)

#

Move the file pointer to next record after the one in the last row.

    SetGT Cust Key(sbfCust_CMName)

#

Show the next page.

    sbfCust_ShowPage()
ENDSR

#

Previous page requested.

BEGSR imagePreviousPage Click       
    sbfCust_ShowPreviousPage()
ENDSR

#

Last page requested.

BEGSR imageLastPage Click
    sbfCust_ShowLastPage()  
ENDSR

#

Refresh subfile from top row.

BEGSR imageRefresh Click
    sbfCust_Refresh(TOP_ROW) 
ENDSR

#

Toggle refresh image to show mouse down.

BEGSR imageRefresh MouseDown
    DclSrParm Button TYPE(*INTEGER) LEN(2) 
    DclSrParm Shift TYPE(*INTEGER) LEN(2) 
    DclSrParm X TYPE(*INTEGER) LEN(4) 
    DclSrParm Y TYPE(*INTEGER) LEN(4) 

    LoadPicture File('refresh-disabled.jpg') target(imageRefresh) 
ENDSR

#

Toggle refresh image to show mouse up.

BEGSR imageRefresh MouseUp
    DclSrParm Button TYPE(*INTEGER) LEN(2) 
    DclSrParm Shift TYPE(*INTEGER) LEN(2) 
    DclSrParm X TYPE(*INTEGER) LEN(4) 
    DclSrParm Y TYPE(*INTEGER) LEN(4) 

    LoadPicture File('refresh.jpg') target(imageRefresh) 
ENDSR

#

Watch for ENTER key in the textboxPositionTo textbox.

BegSr textboxPositionTo KeyPress
    DclSrParm KeyAscii TYPE(*INTEGER) LEN(2) BY(*REFERENCE)
 
    DclConst ENTER_KEY Value( 13)
    DclConst EAT_KEY   Value(  0)

#

Watch for an Enter keypress when ioPosition has focus. End the keypress event handler by setting KeyAscii to EAT_KEY (0) and then position the subfile.
EAT_KEY keeps the Windows event loop from further processing this keypress.

    If (KeyAscii = ENTER_KEY)
        KeyAscii = EAT_KEY
        sbfCust_PositionTo(textboxPositionTo.Value)
        textboxPositionTo.Value = *Blanks
    EndIf
EndSr

#

The current row changed in the subfile with either the arrow keys, the mouse cursor, or programatically.

BegSr sbfCust RecSwitch

#

FromRec is the zero-based row number from which the subfile is switching.

    DclSrParm FromRec  Type(*INTEGER) LEN(4)

#

Each time a row position is changed the customer info panel at the top left of the screen is refreshed with customer info for the current subfile record. AVR Classic's subfile reports zero-based Row and Col properties, but the subfile RRN is one based. When chaining to the subfile with the subfile Row property, be sure to add one to it to 'translate' it to the corresponding one-based RRN.

    Chain sbfCust Key(sbfCust.Row + 1) NotFnd(*In50)

#

Populate customer info panel with fields from the just-read subfile row.

    sbfCust_SetInfoDisplay()
EndSr

#

This subfile event handler fires as the subfile row is changing. The subfile heading is a considered a row, just like the data rows. The subfile heading row's ordinal position is -1 and the first data row is zero. If the user moves the current row the entire subfile is selected and that is very jarring to the user. This code looks to see if the user attempted to move into the header and moves the row selected back to the twop row (the zeroth row).

BegSr sbfCust SelChanging

#

Inhibit user moving to heading row of subfile.

    DclConst  HEADING_ROW   Value(-1)

#

Uncomment this LeaveSr and user move the row to the top of the subfile with the up arrow key to see the default behavior arrow key behavior.

    If (sbfCust.Row = HEADING_ROW)
        sbfCust_GoToRow(TOP_ROW)
    EndIf

#

The subfile header is row -1 (go figure!) and that means that at initial program startup subCust.SelStartRow can be less than zero. Leave this routine is that's the case.

    If sbfCust.SelStartRow < 0 
        sbfCust.SetFocus()
        LeaveSr
    EndIf

#

The SelChanging event fires when the user moves the subfile to another row. The subfile.Row property reports the zero-based row the user is moving to (the target row), and the subfile.SelStartRow property reports the zero-based row the user is moving from (the source row).

#

If the source row was changed attempt record edit.

    If sbfCust.RecChanged[sbfCust.SelStartRow]

#

Read the changed row.

        Chain sbfCust Key(sbfCust.SelStartRow + 1)

#

Check for errors here.

        If ValidateInputForCustomer()

#

Attempt file update.

            UpdateCustomer(sbfCust_CMCustNo)

#

Show message.

            SetMessageText('Customer changed: ' + %CHAR(%EDITC(sbfCust_CMCustNo, '1')))

#

Set row RecChanged status to false.

            sbfCust.RecChanged[sbfCust.SelStartRow] = *False

#

Position to the customer name.

            sbfCust_PositionTo(sbfCust_CMName)
        Else

#

If there was a validation error, move back to the source row.

            sbfCust.Row = sbfCust.SelStartRow  
            sbfCust.Col = sbfCust.SelStartCol
        EndIf 
    ENdIf

#

Give the subfile focus.

    sbfCust.SetFocus()
EndSr

#

Double-click on a subfile row to select it for update.

BEGSR sbfCust DoubleClick
    CustomerUpdateWithForm()
EndSr

#

Clear the subfile and set its RRN to zero--making it ready for a a new page.

BegSr sbfCust_Initialize

#

Initialize and clear subfile.

    sbfCust_RRN = 0
    sbfCust.ClearObj()
EndSr

#

Show first page of subfile.

BegSr sbfCust_ShowFirstPage

#

Position file at top of file.

    SetLL Cust Key(*Start)

#

Show the subfile page.

    sbfCust_ShowPage()
EndSr

#

Show a page of subfile.

BegSr sbfCust_ShowPage

#

Fill sbfCust with next group of rows from Cust's current file pointer position. This subroutine is called by all other page operations (first, previous, next, and last) to populate the subfile. Having this one routine to populate the subfile provides one place where all of the housekeeping needed after writing a page to the subfile can be done.

#

Clear the subfile.

    sbfCust_Initialize()

#

This is a page-at-a-time subfile. The SUBFILE_ROWS constants defines how many rows are written to the subfile.

    Do FromVal(1) ToVal(SUBFILE_ROWS)
        Read Cust

#

If %EOF(Cust) then you've run out of records to put in the subfile.

        If (%EOF(Cust))
            Leave
        EndIf

#

Increment the subfile RRN property.

        sbfCust_RRN = sbfCust.RowCount + 1

#

Assign fields to the subfile from the just-read recoord format.

        sbfCust_AssignFields()

#

Write the subfile row.

        Write sbfCust

#

Zebra stripe the subfile.

        SetRowColor(sbfCust_RRN)
    EndDo

#

Set the enabled/disabled status of the image buttons.

    SetLeftButtonsStatus(MoreRecordsBack())
    SetRightButtonsStatus(MoreRecordsForward())

#

Explicitly set the subfile to top row (which implicitly refreshes the customer info at the top of the form.)

    sbfCust_GoToRow(TOP_ROW)

#

Give focus to the subfile so its speed keys are in effect.

    sbfCust.SetFocus()
EndSr

#

Show previous page of subfile.

BegSr sbfCust_ShowPreviousPage

#

Read the first row of the subfile to make that row's fields available.

    Chain sbfCust Key(1)

#

Position the file at the record in the first row.

    SetLL Cust Key(sbfCust_CMName) Err(*Extended)

#

Read backwards from there.

    ReadCustOnePageBackwards()

#

Having read backwards a number of rows and then show the page.

    sbfCust_ShowPage()
EndSr

#

Show last page of subfile.

BegSr sbfCust_ShowLastPage

#

Position file pointer at end of file.

    SetGT Cust Key(*HiVal)

#

Read backwards from there.

    ReadCustOnePageBackwards()

#

Having read backwards a number of rows and then show the page.

    sbfCust_ShowPage()
EndSr 

BegSr sbfCust_AssignFields

#

Assign fields from the Cust file to the subfile.

    sbfCust_CMCustNo = Cust_CMCustNo 
    sbfCust_CMName = Cust_CMName
    sbfCust_CMAddr1 = Cust_CMAddr1
    sbfCust_CMCity = Cust_CMCity
    sbfCust_CMState = Cust_CMState
    sbfCust_CMPostCode = Cust_CMPostCode
EndSr

#

Position populated subfile at top row (the zeroth row).

BegSr sbfCust_GoToRow
    DclSrParm TargetRow Type(*Integer) Len(4) 

    DclConst LEFT_MOST_COLUMN Value(0)

#

The Select method selects the given row of the subfile. If there are no rows in the subfile, the Select method fails. Wrapping it an Eval statement and using Err(*Extended) 'eats' the error letting Select method fail silently.

#

You need to provide a zero-based row and column to the Select method. Zero is the top row and zero is the left-most column. Constants are used to avoid using "magic numbers" that be confusing later.

    Eval F2(sbfCust.Select(TargetRow, LEFT_MOST_COLUMN)) Err(*Extended)
EndSr

#

Position subfile at a new location.

BegFunc sbfCust_PositionTo Type(*Ind) 
    DclSrParm PositionToName Type(*String)

#

DclFld SaveName Type(*String)

#

Is position-to value key in the file

    SetLL Cust Key(PositionToName)
    If (%FOUND(Cust))

#

If so, show the next page from there.

        sbfCust_ShowPage()        
        LeaveSr *True 
    Else

#

Otherwise, reselect the subfile's top row and display a message.

        sbfCust_GoToRow(TOP_ROW)        
        MsgBox Title('Search results') Msg('No records found')
        textboxPositionTo.SetFocus()
        LeaveSr *False 
    EndIf
EndFunc 

BegSr sbfCust_SetFields

#

Move fields from disk file to subfile.

EndSr

#

Assign field values for customer info panel above the subfile.

BegSr sbfCust_SetInfoDisplay    
    labelName.Caption      = sbfCust_CMName
    labelAddress.Caption   = sbfCust_CMAddr1
    labelCSZ.Caption       = %TRIM(sbfCust_CMCity) + ', ' ++
                             sbfCust_CMState + '  ' ++
                             sbfCust_CMPostCode
EndSr

#

Refresh the subfile from a given name.

BegSr sbfCust_Refresh
    DclSrParm CMName Type(*String) 

    DclFld SaveRow Type(*Integer) Len(4)

#

Save the current subfile row for repositioning back to this row after refreshing.

    SaveRow = sbfCust.Row

#

If the name passed is blanks, then refresh from the subfile's first record.

    If CMName = REFRESH_FROM_FIRST_ROW
        Chain sbfCust Key(1) 
        SetLL Cust Key(sbfCust_CMName)         
    Else

#

If a name is provided, refresh from that name.

        SetLL Cust Key(CMName)             
    EndIf

#

Show the page.

    sbfCust_ShowPage()

#

Put the selected row back where it was.

    sbfCust_GoToRow(SaveRow)
EndSr

#

Poll for 'f', 'p', 'n', and 'l' keypresses to behave as accelerator keys for the corresponding subfile page actions.

BEGSR sbfCust KeyPress
    DclSrParm KeyAscii TYPE(*INTEGER) LEN(2) BY(*REFERENCE)

    DclConst ESCAPE_KEY Value(27)   
    DclConst LOWER_F_KEY Value(102)
    DclConst LOWER_N_KEY Value(110)
    DclConst LOWER_P_KEY Value(112)
    DclConst LOWER_L_KEY Value(108)

#

The escape key cancels an inline row edit.

    If KeyAscii = ESCAPE_KEY         
        sbfCust_Refresh(REFRESH_FROM_FIRST_ROW) 
    EndIf

#

The subfile's Browse property controls where the subfile is browse-only (as opposed to being editable. If it is editable, leave the subroutine now because the speed keys don't work with an editable subfile.

    If sbfCust.Browse = *False 
        LeaveSr
    EndIf

#

Speed keys for subfile navigation. Note the subfile needs to be focused for these to work.

    Case Cond(KeyAscii = LOWER_F_KEY) Sr(sbfCust_ShowFirstPage) 
    Case Cond(KeyAscii = LOWER_P_KEY) Sr(sbfCust_ShowPreviousPage) 
    Case Cond(KeyAscii = LOWER_N_KEY) Sr(sbfCust_ShowPage) 
    Case Cond(KeyAscii = LOWER_L_KEY) Sr(sbfCust_ShowLastPage) 
    EndCs
ENDSR

#

Set the first and previous page buttons' enabled status.

BegSr SetLeftButtonsStatus
    DclSrParm Enabled Type(*Ind)

#

AVR Classic doesn't have an image button. This program uses the image control to simulate image buttons. This is a little extra work because you need enabled and disabled images, but it removes dependence on a third-party button control. See the note at the bottom of this page to read about a way to create images for this purpose.

    If (Enabled)
        LoadPicture File('left-end-arrow.jpg') target(imageFirstPage) 
        LoadPicture File('left-arrow.jpg') target(imagePreviousPage) 
        imageFirstPage.Enabled = *True
        imagePreviousPage.Enabled = *True 
    Else
        LoadPicture File('left-end-arrow-disabled.jpg') target(imageFirstPage) 
        LoadPicture File('left-arrow-disabled.jpg') target(imagePreviousPage) 
        imageFirstPage.Enabled = *False
        imagePreviousPage.Enabled = *False
    EndIf  
EndSr

#

Set next and last page buttons' enabled status.

BegSr SetRightButtonsStatus
    DclSrParm Enabled Type(*Ind) 
    
    If (Enabled)
        LoadPicture File('right-end-arrow.jpg') target(imageLastPage) 
        LoadPicture File('right-arrow.jpg') target(imageNextPage) 
        imageLastPage.Enabled = *True
        imageNextPage.Enabled = *True 
    Else
        LoadPicture File('right-end-arrow-disabled.jpg') target(imageLastPage) 
        LoadPicture File('right-arrow-disabled.jpg') target(imageNextPage) 
        imageLastPage.Enabled = *False
        imageNextPage.Enabled = *False 
    EndIf  
EndSr

#

Update the customer record from the currently editable row.

BegFunc UpdateCustomer Type(*Boolean) 
    DclSrParm CustomerNumber Type(*Integer) Len(4) 

    Chain CustUpdate Key(CustomerNumber) Err(*Extended) 
    If %Found() 
        Cust_CMName = sbfCust_CMName
        Cust_CMAddr1 = sbfCust_CMAddr1
        Update CustUpdate    
        LeaveSr *True
    Else 
        Unlock CustUpdate
        LeaveSr *False
    EndIf
EndFunc 

BegFunc ValidateInputForCustomer Type(*Boolean)
    DclFld Valid Type(*Boolean)

    If sbfCust_CMName = *Blanks  
        SetMessageText('Please enter a name')
        LeaveSr *False
    EndIf 

    If sbfCust_CMAddr1 = *Blanks  
        SetMessageText('Please enter an address')
        LeaveSr *False
    EndIf 

    LeaveSr *True 
EndFunc

#

Every page (first, previous, next, and last) are displayed with the sbfCust_ShowNextPage routine. To page through the file backwards, this routine reads backwards through the file SUBFILE_ROWS + 1 rows. It does this to position the file pointer so that sbfCust_ShowNextPage displays the correct page.

BegSr ReadCustOnePageBackwards
    DclFld BegOfFile  Type( *Boolean )

    Do FromVal(1) ToVal(SUBFILE_ROWS + 1)
        ReadP Cust BOF(BegOfFile)
        If BegOfFile
            SetLL Cust Key(*Start) 
        EndIf
    EndDo
EndSr

#

Set subfile row color.

BegSr SetRowColor 
    DclSrParm SubfileRRN   Type(*Integer) Len(4)

    DclFld SubfileRow Type(*Integer) Len(4)

#

The RRN is one-based--so adjust to zero-based to reference a subfile row.

    SubfileRow = SubfileRRN - 1

    If IsEven(SubfileRow)

#

The labelEvenRowColor and labelOddRowColor are purely for the convenience of setting

        sbfCust.RecBackColor[SubfileRow] = labelEvenRowColor.BackColor
    Else
        sbfCust.RecBackColor[SubfileRow] = labelOddRowColor.BackColor
    EndIf
EndSr

#

Return remainder of integer division.

BegFunc IsEven Type(*Ind) 
    DclSrParm Value Type(*Integer) Len(4) 

    DclConst EVEN_DIVISOR Value(2) 

    LeaveSr Value(%REM(Value, EVEN_DIVISOR) = 0)
EndFunc

#

Return true if there are more records backward, given the key value on the first row displayed.

BegFunc MoreRecordsBack Type(*Ind) 
    Chain sbfCust Key(1)  
    SetLL Cust Key(sbfCust_CMName) 
    ReadP Cust Err(*Extended) 
   
    LeaveSr Value(NOT %EOF(Cust)) 
EndFunc

#

Return true if there are more records forward, given the key value on the last row displayed.

BegFunc MoreRecordsForward Type(*Ind) 
    Chain sbfCust Key(sbfCust.RowCount)  
    SetGT Cust Key(sbfCust_CMName) 
    LeaveSr %Found(Cust) 
EndFunc

#

Set the labelMessage control's Caption property and enable the timerMessage timer control. When it expires the message is cleared.

BegSr SetMessageText
    DclSrParm Text Type(*String) 

    labelMessage.Caption = Text 
    timerMessage.Enabled = *True 
EndSr

#

This event handler fires when the timerMessage control's interval (its elaspsed time in milliseconds). This clears the labelMessage control's caption.

BEGSR timerMessage Timer
    labelMessage.Caption = ''
    timerMessage.Enabled = *False  
ENDSR

#

Compare a given name to the name on the given row of the subfile. This is used to determine if the subfile needs to move rows if a name is updated in place.

BegFunc CompareNameToSubfileRowName Type(*Boolean) 
    DclSrParm RRN Type(*Integer) Len(4) 
    DclSrParm CMName Type(*String) 

    Chain sbfCust Key(RRN)

#

Note how the return value is the result of the boolean expression.

    LeaveSr Value(sbfCust_CMname = CMName)
EndFunc

#

Call form to update customer.

BegSr CustomerUpdateWithForm
    DclFld CMName Type(*Char) Len(40) 
    DclFld Updated Type(*Char) Len(1) 
    DclFld CurrentRow Type(*Integer) Len(4)

#

Save the current subfile row to restore the row position after the update operation.

    CurrentRow = sbfCust.Row

#

Call the form passing it three parameters (which are passed by reference).

    Call pgm('formCustCRUD') 
        DclParm sbfCust_CMCustNo 
        DclParm CMName
        DclParm Updated

#

If an update was performed with the form...

    If Updated = RECORD_UPDATED

#

If the name didn't change, refresh the subfile and reposition its row back to its previous position.

        If CompareNameToSubfileRowName(CurrentRow + 1, CMName)

#

Refresh the subfile from its first row.

            sbfCust_Refresh(REFRESH_FROM_FIRST_ROW)

#

Give that first row focus.

            sbfCust_GoToRow(CurrentRow)    
        Else

#

Otherwise, refresh from the given name.

            sbfCust_Refresh(CMName)   
        EndIf 
    EndIf
ENDSR

#

Creating images for AVR class'c image control.

The FontAwesome site provides free SVG images for Web development. SVG images aren't much help to AVR Classic, but the fa2png site freely translates a FontAwesome SVG to a PNG. Create a 32px PNG with the fa2png site, then use MS Paint to save that PNG as a JPG. (AVR Classic's Image control doesn't work with PNG files.