program model1,1.0(101) ! Program Name: model1 ! Description: Test SBXINP.SBX, event handling model #1 ! Author: Jack McGregor ! Date: 19-11-2006 !--------------------------------------------------------------------- !Notes: ! Simple example or program model using SBXINP and EVENTWAIT. ! Most of this program could be turned into a stock template; ! the parts that clearly are custom to each screen are the ! actual field parameters (read in via load'field'params()) ! and any lines marked [generator]. The idea is that with ! further study/refinement, this might lead to a program model ! that could integrate with the LEO screen designer/program ! generator. ! !Overview of the program features / components: ! !- Field edit/display handled by SBXINP.SBX. Other GUI controls ! (dialog, buttons) generated by AUI_CONTROL statements ! !- Field parameters read in via DATA statements into a global array ! !- There is no file I/O (we're keeping it simple) ! !- Simple EVENTWAIT loop with intermediate event handler to ! call the individual field handler routines. User can navigate ! through the fields as for a 'normal' Windows program ! !- Individual field handler routines do not need to know anything ! about screen design, field order, etc. See the actual ! routines (search for !{Field Handlers}) for examples of simple ! validation logic that might be performed by such field routines. ! !- Some use of procedures and functions to limit global variable use ! !- There are several Debug.Print statements to help clarify how the ! events are handled. (Use SET DEBUG before running program to see ! them in the debug window). ! !Things to do: !- Fine-tune details of field editing (a bit sloppy right now) ! !- Figure how to insert file handling into the model !-------------------------------------------------------------------- !Edit History !VEDIT=101 ![100] November 20, 2006 03:03 PM Edited by jack ! Created ![101] January 10, 2011 10:59 AM Edited by jack ! Convert city to combo to test problem !--------------------------------------------------------------------- !{end history} ++pragma ERROR_IF_NOT_MAPPED "TRUE" !{Include zone 1} ++include ashinc:ashell.def ++include sbxinp.def ! definitions relating to sbxinp.sbx ++include sbxinp.map ! map of standard sbxinp.sbx params !{Definition zone} define BASE_CLICKCODE = 500 ! base exitcode define ROW_SPACING = 1500 ! spacing between rows (millirows) define LOCAL_DEF_TYPE$ = "||T" ! treat ENTER as TAB define FIELDNAME_MAX = 32 ! max size of a field name define FIELD_COUNT = 5 ! [generator] total # of fields !{Begin map zone} map1 field'params(FIELD_COUNT) ! array of field parameters map2 fp'fname$ ,s,FIELDNAME_MAX ! field name map2 fp'label$ ,s,32 ! label for field map2 fp'row ,i,2 ! field row map2 fp'col ,i,2 ! field column map2 fp'xmax ,i,2 ! max width (grid units) map2 fp'maxchars,i,2 ! max # chars map2 fp'xmin ,i,2 ! min # chars map2 fp'type$ ,s,20 ! additional field types map2 fp'setdef$ ,s,300 ! combo list, set matching, etc. map2 fp'clickcode,f,6 ! field exitcode (ID) map2 fp'tooltip$,S,100 ! field tooltip map2 fp'defpt ,i,2 ! def dec position or rows for multiline field map2 fp'maxpt ,i,2 ! max # digits to right of decimal map2 fp'parentid,i,2 ! parent id map1 globals ! misc variables used globally map2 infop ,b,2 ! infld/sbxinp opcode map2 fno ,i,4 ! field # map2 exitcode ,f,6 ! exitcode map2 cstatus ,f,6 ! status param map2 i ,i,2 ! misc for/next map2 mrc ,b,2 ! msgbox return code map1 eventwait map2 ev'ctlid ,i,2 ! control id map2 ev'parentid,i,2 ! parent id map1 dialog'params ! variables related to the dialog map2 dlg'id ,i,2 ! [generator] dialog control id map2 dlg'srow ,i,2,5000 ! [generator] map2 dlg'scol ,i,2,5 ! [generator] map2 dlg'erow ,i,2,15000 ! [generator] map2 dlg'ecol ,i,2,60 ! [generator] map2 dlg'title$ ,s,30,"Model Dialog 1" ! [generator] map2 dlg'width ,i,2 ! width of dialog map2 dlg'height ,i,2 ! height of dialog (millirows) map1 field'data ! variables holding field data contents map2 fld'name ,s,30 ! [generator] map2 fld'address ,s,30 ! [generator] map2 fld'city ,s,30 ! [generator] map2 fld'postalcode,s,10 ! [generator] map2 fld'phone ,s,10 ! [generator] !{End map zone} !{Begin Execution} ? tab(-1,0);"TEST1 - Simple test of SBXINP" call load'field'parameters() ! load design params into field'params() ! create a dialog (the old fashioned way) ... xcall AUI, AUI_CONTROL, CTLOP_ADD, dlg'id, "Model Dialog 1", MBST_ENABLE, & MBF_DIALOG+MBF_SYSMENU+MBF_ALTPOS, NUL_CMD$, NUL_FUNC$, cstatus, & dlg'srow, dlg'scol, dlg'erow, dlg'ecol, & NUL_FGC, NUL_BGC, NUL_FONTATTR, NUL_FONTSCALE, NUL_FONTFACE$, & NUL_TOOLTIP$, NUL_PARENTID, NUL_WINCLASS$, NUL_WINSTYLE, & NUL_WINSTYLEX dlg'height = dlg'erow - dlg'srow + 1000 dlg'width = dlg'ecol - dlg'scol + 1 ! draw a line across the bottom (note: don't start in column 1 or ! the row numbers (below) will clobber it) xcall AUI, AUI_CONTROL, CTLOP_ADD, NUL_CTLID, NUL_CTEXT$, MBST_ENABLE, & MBF_STATIC, NUL_CMD$, NUL_FUNC$, cstatus, & dlg'height-2000, 3, dlg'height-2000, dlg'width, & NUL_FGC, NUL_BGC, NUL_FONTATTR, NUL_FONTSCALE, NUL_FONTFACE$, & NUL_TOOLTIP$, dlg'id, "STATIC", SS_GRAYRECT+SS_SUNKEN, & NUL_WINSTYLEX ! create a pair of OK/CANCEL buttons (the old fashioned way) xcall AUI, AUI_CONTROL, CTLOP_ADD, NUL_CTLID, "OK", MBST_ENABLE, & MBF_BUTTON+MBF_KBD, "VK_XF2", NUL_FUNC$, cstatus, & dlg'height-1500, dlg'width-20, dlg'height-500, dlg'width-12, & NUL_FGC, NUL_BGC, NUL_FONTATTR, NUL_FONTSCALE, NUL_FONTFACE$, & NUL_TOOLTIP$, dlg'id, NUL_WINCLASS$, NUL_WINSTYLE, & NUL_WINSTYLEX xcall AUI, AUI_CONTROL, CTLOP_ADD, NUL_CTLID, "Cancel", MBST_ENABLE, & MBF_BUTTON+MBF_KBD, "VK_ESC", NUL_FUNC$, cstatus, & dlg'height-1500, dlg'width-10, dlg'height-500, dlg'width-2, & NUL_FGC, NUL_BGC, NUL_FONTATTR, NUL_FONTSCALE, NUL_FONTFACE$, & NUL_TOOLTIP$, dlg'id, NUL_WINCLASS$, NUL_WINSTYLE, & NUL_WINSTYLEX ! display row numbers down the side of the dialog, just for clarity for i = 1000 to dlg'height step 1000 tprint tab(i,1);str(i/1000); next i ! display col numbers across top of dialog, just for clarity i = 5 do while i < dlg'width tprint tab(1,i);str(i); i = i + 5 loop ! display the fields infop = SXI_DSP for fno = 1 TO FIELD_COUNT ! (following needs to be generated / modified based on screen def on fno call fld'name,fld'address,fld'city,fld'postalcode,fld'phone ! [generator] next fno infop = SXI_EDT ! from now on, it's edit mode ! this is the main event loop exitcode = 0 ! start at the first field ev'parentid = dlg'id ! in the dialog do Debug.print "$# $T Before Eventwait exitcode = "+exitcode+" ctlid = "+ev'ctlid xcall AUI, AUI_EVENTWAIT, ev'parentid, ev'ctlid, exitcode, & EVW_DESCEND+EVW_EXCDFOCUS+EVW_EXCDINOUT+EVW_INFLD & +EVW_HAREXIT+EVW_VAREXIT+EVW_CTLARROWS+EVW_CTLCLIPBD Debug.print "$# $T After Eventwait exitcode = "+exitcode+" ctlid = "+ev'ctlid call exitcode'handler Debug.print "$# $T Handler exitcode = "+exitcode loop until exitcode = 1 xcall MSGBOX,"Exit from event handler with exitcode = " + str(exitcode), & "Model 1 Debug",MBTN_OK,MBICON_ICON,MBMISC_TASKMODAL,i ! delete the dialog xcall AUI, AUI_CONTROL, CTLOP_DEL, dlg'id !{Exit Program} ? tab(23,1);"End Program" end !{Global subroutines} !------------------------------------------------------------------------------ !Exitcode Handler: ! This routine is responsible for taking in an exitcode value (returned ! from the last call to AUI_EVENTWAIT), and calling the appropriate field ! or other action. It returns the exitcode coming back from the lower ! level field handling routines. ! !Global Inputs: ! exitcode - exitcode from eventwait ! BASE_CLICKCODE - base of clickcode assignments (convenient for translating ! from exitcode to the corresponding field, although we could ! also determine the field by just scanning the field'params()) ! !Global Outputs: ! exitcode - exitcode from field handler ! !Notes: ! We can't make this a procedure unless we also make the field handlers ! into procedures (since a procedure can't call a global subroutine) !------------------------------------------------------------------------------ exitcode'handler: if exitcode = 1 return ! exit on ESC ! otherwise, get field # from exitcode so we can call the ! corresponding field handler fno = fn'fno'from'exitcode(exitcode,BASE_CLICKCODE) on fno call fld'name,fld'address,fld'city,fld'postalcode,fld'phone ![generator] returN !{Field Handlers} !------------------------------------------------------------------------------ !Field Handler Notes: each field has a separate routine (name matches field ! name) that is responsible for any preprocessing, calling SBXINP to display ! and/or edit the field, and any post-processing. ! !Global Inputs: ! infop - the sbxinp opcode ! fno - the field number (we could eliminate this because we could also ! locate the field number in array based on its name) ! fld'xxxx - the actual field contents variables ! !Outputs: ! flx'xxxx - updated field contents ! exitcode - exitcode returned from sbxinp. ! Note: to force the field to be re-edited, you can set ! exitcode = 0 !------------------------------------------------------------------------------ fld'name: ! example pre-process (plug in a default if blank) if (infop # 2 and fld'name = "") then fld'name = "Jacques Gauthé" endif call do'sbxinp(fno,infop,fld'name) return fld'address: call do'sbxinp(fno,infop,fld'address) ! example post process: (if null, skip to phone) if (infop # 2) then if (fld'address = "" and exitcode # 1) then exitcode = fn'exitcode'from'name("fld'phone") Debug.print "$# $T Sample field post-process: skip to field 'fld'phone' (exitcode="+exitcode+")" endif endif return fld'city: call do'sbxinp(fno,infop,fld'city) ! example post process: (if null & address not null, force re-entry) if (infop # 2) then if (fld'city = "" and fld'address # "" and exitcode # 1) then exitcode = 0 ! this forces re-entry of the same field xcall MSGBOX,"You must enter a city if address is not blank", & "Model 1 Sample Field Validation", MBTN_OK, MBICON_STOP, & MBMISC_TASKMODAL, mrc endif endif return fld'postalcode: call do'sbxinp(fno,infop,fld'postalcode) return fld'phone: call do'sbxinp(fno,infop,fld'phone) return !{Procedures} !--------------------------------------------------------------------- ! Procedure Name: load'field'parameters() ! Description: load in all of the field parameters !--------------------------------------------------------------------- !Parameters: ! none !Globals: ! field'params() - global field parameter array !Locals: ! !Error handling: ! No error trapping !Notes: ! For simplicity, we just load the field params here; ! (in a 'real' program, we would get them from some external source) ! Note that as a convenience, if row=0, we will auto-increment based on ! ROW_SPACING; but if col also zero, maintain row and auto-increment col ! based on label and field size. ! Also note: we can only call this routine once! !--------------------------------------------------------------------- Procedure load'field'parameters() ++pragma auto_extern map1 local'params map2 fno,i,2 map2 clickcode,i,2 DATA "fld'name","Name",2400,10,25,30,0,"`","","Name of person place or thing",-1,-1,0 DATA "fld'address","Address",0,10,25,30,0,"||I","","Address",-1,-1,0 DATA "fld'city","City",0,10,20,30,0,"||S",",San Diego,Cardiff by the Sea,La Jolla,Cardiff,,","Tooltip 1",-1,-1,0 ![101] DATA "fld'postalcode","Postal Code",0,0,8,10,0,"","","US zip or international postal code",-1,-1,0 DATA "fld'phone","Phone",0,10,14,10,0,"","","Phone #",-1,-1,0 ! load the field data, assigning field exitcodes as we go clickcode = BASE_CLICKCODE for fno = 1 to FIELD_COUNT read fp'fname$(fno),fp'label$(fno),fp'row(fno),fp'col(fno),fp'xmax(fno), & fp'maxchars(fno),fp'xmin(fno),fp'type$(fno),fp'setdef$(fno), & fp'tooltip$(fno),fp'defpt(fno),fp'maxpt(fno),fp'parentid(fno) ! add our own default types to those predefined in sbxinp fp'type$(fno) = fp'type$(fno) + LOCAL_DEF_TYPE$ ! handle auto-positioning logic if fno > 1 then if fp'col(fno) = 0 then fp'col(fno) = fp'col(fno-1) + fp'xmax(fno-1) + len(fp'label$(fno)) + 4 fp'row(fno) = fp'row(fno-1) endif IF fp'row(fno) = 0 then fp'row(fno) = fp'row(fno-1) + ROW_SPACING endif endif clickcode = clickcode + 1 fp'clickcode(fno) = clickcode ! assign exitcodes consecutively next fno End Procedure !--------------------------------------------------------------------- ! Procedure Name: do'sbxinp(fno,op,field$) ! Description: process a field display or edit operation !--------------------------------------------------------------------- !Parameters: ! fno [numeric, in] - index into global field'params() ! op [numeric, in] - opcode (1=edit, 2=display, 3=both, +20, +30) ! field$ [string, in/out] - field contents !Globals: ! field'params() - global field parameter array !Locals: ! sxi'params - standard set of global sbxinp.sbx params ! (use same map as caller uses!) !Error handling: ! No error trapping !Notes: ! The main value of this routine is to free up the individual field ! handlers from having to know anything about the structure of the field ! parameters. (This allows separation of the field's business logic ! and screen design parameters.) ! ! Currently this routine suffers from having to allow access to ! global variables in order to access the field parameter array. ! But eventually, the goal would be to move the field parameters ! external to the program (or perhaps private to a bsi). This would ! allow the field handlers to be completely independent of the screen ! design. (The screen design tool would generate the field parameters, ! and the field handlers would access them through this function. ! ! !--------------------------------------------------------------------- procedure do'sbxinp(fno as f,op as f,field$ as s32) ++include sbxinp.map ! local map of sxi'params ++pragma auto_extern map1 local'params map2 multiline,b,1,0 xgetarg 3,sxi'entry$ ! handle this manually due to ! possible large size (ignore field$) ! in the case of a multiline field, we'd better use the sxi'bigentry$ if (fp'defpt(fno) > 1) and (instr(1,fp'type$(fno),"|M") > 0) then xgetarg 3,sxi'bigentry$ multiline = 1 endif ! transfer the field param info from the global array to our local ! parameter set sxi'label$ = fp'label$(fno) sxi'row = fp'row(fno) sxi'col = fp'col(fno) sxi'xmax = fp'xmax(fno) sxi'type$ = fp'type$(fno) sxi'setdef$ = fp'setdef$(fno) sxi'maxchars = fp'maxchars(fno) sxi'clickcode = fp'clickcode(fno) sxi'tooltip$ = fp'tooltip$(fno) sxi'parentid = fp'parentid(fno) sxi'defpt = fp'defpt(fno) sxi'maxpt = fp'maxpt(fno) if multiline then xcall SBXINP, sxi'label$,infop,sxi'row,sxi'col,sxi'xmax, & sxi'bigentry$,sxi'type$,sxi'setdef$,sxi'maxchars,sxi'clickcode, & sxi'tooltip$,sxi'parentid,exitcode,sxi'defpt,sxi'timer,sxi'cmdflg, & sxi'maxpt,sxi'id,sxi'infclr,sxi'changed$ xputarg 3,sxi'bigentry$ ! return updated bigentry else xcall SBXINP, sxi'label$,infop,sxi'row,sxi'col,sxi'xmax, & sxi'entry$,sxi'type$,sxi'setdef$,sxi'maxchars,sxi'clickcode, & sxi'tooltip$,sxi'parentid,exitcode,sxi'defpt,sxi'timer,sxi'cmdflg, & sxi'maxpt,sxi'id,sxi'infclr,sxi'changed$ DEBUG.PRINT "$# $T do'sbxinp: label$ = ["+sxi'label$+"] infop=["+infop+"] exitcode=["+exitcode+"] clickcode=["+sxi'clickcode+"] " xputarg 3,sxi'entry$ ! return updated entry endif debug.print "SBXINP exitcode = "+exitcode End Procedure !------------------------------------------------------------------------- !{Functions} !------------------------------------------------------------------------- !Function: fn'fno'from'exitcode(exitcode,base'exitcode) !Parameters: ! exitcode [numeric, in] - incoming exitcode ! base'exitcode [numeric, in] - base offset of field click codes !Returns: ! fno !Globals: ! none !Module Variables: ! none !Locals: ! none !Error handling: ! note !Notes: ! currently does not guarantee that returned fno is in range, but ! assumption is that the exitcode handler will just not call a ! field handler if the fno is out of range !------------------------------------------------------------------------- Function fn'fno'from'exitcode(exitcode,base'exitcode) if abs(exitcode)>base'exitcode then fn'fno'from'exitcode = abs(exitcode)-base'exitcode else fn'fno'from'exitcode = 1 ! revert to field 1 if all else fails endif End Function !------------------------------------------------------------------------- !Function: fn'exitcode'from'name(fldname$) ! return the exitcode associated with the named field !Parameters: ! fldname$ [string, in] - incoming fieldname !Returns: ! exitcode (0 if not found) !Globals: ! field'params() !Module Variables: ! none !Locals: ! none !Error handling: ! note !Notes: ! currently does not guarantee that returned fno is in range, but ! assumption is that the exitcode handler will just not call a ! field handler if the fno is out of range !------------------------------------------------------------------------- strsiz FIELDNAME_MAX ! max size of a field name Function fn'exitcode'from'name(fldname$) ++pragma auto_extern ! needed to access fp'xxxx() field'param array map1 local'params map2 i,i,2 for i = 1 to FIELD_COUNT if (fldname$ = fp'fname$(i)) then fn'exitcode'from'name = -fp'clickcode(i) exit endif next i if (i > FIELD_COUNT) then trace.print "$# $T Internal Error: Unable to find field "+fldname$ endif End Function !------------------------------------------------------------------------- !{ErrorTrap} TRAP: END