home *** CD-ROM | disk | FTP | other *** search
/ The Developer Connection…ice Driver Kit for OS/2 3 / DEV3-D1.ISO / devtools / dataflex / picture.pkg < prev    next >
Encoding:
Text File  |  1993-05-19  |  13.0 KB  |  401 lines
  1. //
  2. // Picture.Pkg
  3. // February 7, 1992
  4. // Steven A. Lowe
  5. //
  6. //Package: Picture
  7. //
  8. //Content: This package defines a subclass of Entry_Form which allows the use of
  9. //  mask-string "pictures" to control data-entry on a character-by-character
  10. //  basis.  Included in the package are:
  11. //
  12. //  * Picture_Item - this command declares an ITEM of the form
  13. //                   to be a picture-controlled editing window.
  14. //                   All items on a Picture_Form MUST be declared
  15. //                   using the Picture_Item command (i.e. do
  16. //                   not use the ITEM command within a Picture_Form).
  17. //
  18. //  * Picture_Form - this class is a subclass of Entry_Form which provides
  19. //                   procedures and attributes necessary to support
  20. //                   mask-mediated data entry in its windows.
  21. //
  22.  
  23. #CHKSUB 1 1 // Verify the UI subsystem.
  24.  
  25. #REPLACE CONST_POS_NONE |CI-1
  26.  
  27. Use EntryFrm
  28.  
  29. //
  30. //initialize picture element array (string)
  31. //
  32. string Picture_Elements       //picture element array-string
  33. move "#$" to Picture_Elements //index 0, position 1 and index 1, position 2
  34.  
  35. //
  36. //Attribute: Picture_Actions
  37. //
  38. //Description: array of message numbers for picture-mask characters
  39. //
  40. //Representation: array of integers
  41. //
  42. object Picture_Actions is an ARRAY   //global picture action array
  43. end_object
  44.  
  45. //
  46. //Class: Picture_Form
  47. //
  48. //SuperClass: Entry_Form
  49. //
  50. //Description: This class provides properties and operations necessary to
  51. //  support mask-mediated data-entry
  52. //
  53. //Usage: 
  54. //
  55. class Picture_Form is a Entry_Form
  56.  
  57.   //
  58.   //Operation: FCT$
  59.   //
  60.   //Assumption(s): TERMCHAR contains the character code to check
  61.   //
  62.   //Goal(s): set TERMCHAR to 0 if its current value is non-alphanumeric
  63.   //
  64.   //Algorithm: if TERMCHAR < 32, TERMCHAR = 0
  65.   //
  66.   //Usage: used to validate "$" mask character
  67.   //
  68.   procedure Fct$
  69.     if TERMCHAR lt 32 move 0 to TERMCHAR  // < space not valid
  70.   end_procedure
  71.  
  72.   //
  73.   //Operation: FCT#
  74.   //
  75.   //Assumption(s): TERMCHAR contains the character code to check
  76.   //
  77.   //Goal(s): set TERMCHAR to 0 if its current value is non-numeric
  78.   //
  79.   //Algorithm: if TERMCHAR < 48 or TERMCHAR > 57, TERMCHAR = 0
  80.   //
  81.   //Usage: used to validate "#" mask character
  82.   //
  83.   procedure Fct#
  84.     if (TERMCHAR < 48 OR TERMCHAR > 57) move 0 to TERMCHAR
  85.   end_procedure
  86.  
  87.   //
  88.   //Operation: ADD_PICTURE
  89.   //
  90.   //Assumption(s): newCh is a one-character string, newFct is a message id
  91.   //
  92.   //Goal(s): add new mask character and associated function to mask set
  93.   //
  94.   //Algorithm: append newch to Picture_Elements, add newFct to
  95.   //             Picture_Actions array
  96.   //
  97.   //Usage: 
  98.   //
  99.   procedure Add_Picture string newCh integer newFct
  100.     left newCh to newCh 1
  101.     append Picture_Elements newCh
  102.     set array_value of Picture_Actions ;
  103.         item (item_count(Picture_Actions.obj)) to newFct
  104.   end_procedure
  105.  
  106.   //
  107.   //initialize picture action array
  108.   //
  109.   set array_value of Picture_Actions item 0 to MSG_Fct#  //# -> Fct#
  110.   set array_value of Picture_Actions item 1 to MSG_Fct$  //$ -> Fct$
  111.  
  112.   //
  113.   //Operation: CONSTRUCT_OBJECT
  114.   //
  115.   //Assumption(s): MyImg identifies an image
  116.   //
  117.   //Goal(s): define an instance containing an Item_Pictures array with
  118.   //  the integer properties Mask_Length, Last_Key, and Mask_Index, and the
  119.   //  string property Current_Mask.
  120.   //
  121.   //Algorithm: Augmented to define component Item_Pictures as array; also
  122.   //           defines Mask_Length, Current_Mask, Last_Key, and Mask_Index properties
  123.   //
  124.   //Usage: used internally
  125.   //
  126.   procedure CONSTRUCT_OBJECT integer myImg
  127.     Forward send construct_object myImg
  128.     object Item_Pictures is an ARRAY 
  129.     end_object     //array of picture-strings for items
  130.     //
  131.     //Attribute: Mask_Length
  132.     //
  133.     //Description: length of current mask string
  134.     //
  135.     //Representation: integer
  136.     //
  137.     Property integer Mask_Length PUBLIC 0  //length of current mask string
  138.     //
  139.     //Attribute: Current_Mask
  140.     //
  141.     //Description: current mask string
  142.     //
  143.     //Representation: string
  144.     //
  145.     Property string  Current_Mask    PUBLIC "" //current mask string
  146.     //
  147.     //Attribute: Last_Key
  148.     //
  149.     //Description: last key pressed during data-entry
  150.     //
  151.     //Representation: integer
  152.     //
  153.     Property integer Last_Key    PUBLIC 0  //last key pressed during data entry
  154.     //
  155.     //Attribute: Mask_Index
  156.     //
  157.     //Description: last mask offset of data-entry
  158.     //
  159.     //Representation: integer
  160.     //
  161.     Property integer Mask_Index  PUBLIC 0  //last mask offset of data entry
  162.  
  163.     Property integer Last_Const_Pos PUBLIC CONST_POS_NONE  // last position into which
  164.                                                            // a constant was placed
  165.     indicator Picture_Form.isautoclear
  166.     indicator Picture_Form.wascleared
  167.  
  168.     indicator Picture_Form.isonlyconst
  169.  
  170.   end_procedure
  171.  
  172.   //
  173.   //Operation: SET PICTURE_STRING
  174.   //
  175.   //Assumption(s): Item# is item index, InStr is valid picture mask string
  176.   //
  177.   //Goal(s): set element of Item_Pictures array corresponding to specified
  178.   //  item# to given mask (InStr) value
  179.   //
  180.   //Algorithm: sets array_value of Item_Pictures element Item# to InStr
  181.   //
  182.   //Usage: used by Picture_Item command
  183.   //
  184.   procedure Set Picture_String integer item# string inStr
  185.     local integer tot
  186.     get item_count of Picture_Form.Item_Pictures to tot
  187.     if item# gt tot begin // if you "skipped" some items, init them with ""
  188.         repeat
  189.           set array_value of Picture_Form.Item_Pictures item tot to ""
  190.           increment tot
  191.         until tot eq item#
  192.     end
  193.     set array_value of Picture_Form.Item_Pictures item item# to inStr
  194.   end_procedure
  195.  
  196.   //
  197.   //Operation: PICTURE_STRING
  198.   //
  199.   //Assumption(s): none
  200.   //
  201.   //Goal(s): return picture mask string for current item
  202.   //
  203.   //Algorithm: gets array value of Item_Pictures element equal to current item
  204.   //           and returns it
  205.   //
  206.   //Usage: 
  207.   //
  208.   function Picture_String RETURNS string
  209.     local integer item#
  210.     local string pStr
  211.     get current_item to item#
  212.     if item# ge (item_count(Picture_Form.Item_Pictures.obj)) ;
  213.       function_return "" // if there are non-picture-items at end, pretend
  214.                          // they are "".
  215.     get array_value of Picture_Form.Item_Pictures item item# to pStr
  216.     function_return pStr
  217.   end_function
  218.   
  219.   //
  220.   //Operation: ENTRY
  221.   //
  222.   //Assumption(s): none
  223.   //
  224.   //Goal(s): redefine the window editing routine to support mask-mediated
  225.   //  data-entry
  226.   //
  227.   //Algorithm: get picture mask string for current item
  228.   //           if string > "",
  229.   //             set Mask_Length to length of string
  230.   //             set Current_Mask to string
  231.   //             set Last_Key to 0
  232.   //             set Mask_Index to 0
  233.   //             set KBD_INPUT_MODE to False
  234.   //             forward get ENTRY
  235.   //             set KBD_INPUT_MODE to True
  236.   //           else forward get ENTRY
  237.   //           return TERMCHAR
  238.   //
  239.   //Usage: used internally
  240.   //
  241.   Function Entry returns integer
  242.     local integer msklen bits
  243.     local string mskstr
  244.     move (Picture_String(Current_Object)) to mskstr  //get current item's mask string
  245.     if mskstr gt "" begin
  246.       length mskstr to msklen                //get length of mask string
  247.       set Mask_Length to msklen               //init mask length
  248.       set Current_Mask to mskstr                  //set current maskstr
  249.       set Last_Key to 0                       //init Last_Key
  250.       set Mask_Index to 0                     //init Mask_Index
  251.  
  252.       get autoclear_state of current_object item CURRENT to bits
  253.       if bits begin
  254.         indicate Picture_Form.isautoclear TRUE
  255.         indicate Picture_Form.wascleared  FALSE
  256.         set autoclear_state of current_object item CURRENT to FALSE //turn off
  257.       end
  258.       else indicate Picture_Form.isautoclear FALSE
  259.  
  260.       indicate Picture_Form.isonlyconst TRUE
  261.  
  262.       set kbd_input_mode to false
  263.       Forward get Entry to fieldindex        //invoke ACCEPT
  264.       set kbd_input_mode to true
  265.     end
  266.     else Forward get Entry to fieldindex     //use default method
  267.  
  268.     [Picture_Form.isautoclear] set autoclear_state of current_object ;
  269.                                    item CURRENT to TRUE   //turn back on
  270.     function_return TERMCHAR
  271.   end_function
  272.  
  273.   //
  274.   //Operation: SUPPLY_KEY
  275.   //
  276.   //Assumption(s): ndx is current mask offset
  277.   //
  278.   //Goal(s): if mask element at current index (ndx) is a constant, return
  279.   //  it, else accept keypress and validate using mask-character function if
  280.   //  it is not an accelerator key, and return character code.  Otherwise, if
  281.   //  an accelerator key was pressed, return its code
  282.   //
  283.   //Algorithm: get current mask character and search for it in Picture_Elements
  284.   //           if not found, and the last entry index > current entry index,
  285.   //             set TERMCHAR to last key pressed, else set TERMCHAR to mask
  286.   //             character
  287.   //           else
  288.   //             get mask character validation function message id
  289.   //             repeat
  290.   //               wait for keypress
  291.   //               if keypress was not accelerator key, execute validation
  292.   //                 function
  293.   //             until keypress is valid of accelerator
  294.   //           set Last_Key to TERMCHAR
  295.   //           set Mask_Index to ndx
  296.   //           return TERMCHAR
  297.   //
  298.   //Usage: used internally
  299.   //
  300.   procedure supply_key integer ndx returns integer
  301.     local string dd PictStr PictCh
  302.     local integer ChPos MsgVector ConstPos
  303.  
  304.     move CONST_POS_NONE to ConstPos
  305.     if ndx ge (Mask_Length(current_object)) move KLEFTARROW to TERMCHAR // backup to last mask_char
  306.     else begin
  307.       get Current_Mask to PictStr
  308.       mid PictStr to pictCh 1 (ndx + 1)             //get picture element char
  309.       pos pictCh in Picture_Elements to ChPos        //find picture character
  310.       if ChPos lt 1 begin                            //constant character (not in pic elements)
  311.         get Mask_Index to MsgVector //get last entry position (Msg_Vector used as a temp var.)
  312.         if MsgVector gt ndx move (Last_Key(Current_Object)) to TERMCHAR  //return last key if left
  313.         else begin
  314.           get Last_Const_Pos to ChPos  // last constant position used
  315.           if ChPos eq ndx begin // last char of mask and window is a const
  316.             if [Picture_Form.isonlyconst] move 0 to TERMCHAR
  317.             else move KLEFTARROW to TERMCHAR // backup to non-constant
  318.           end
  319.           else begin
  320.             ascii PictCh to TERMCHAR                //not picture char - pass it
  321.             move ndx to ConstPos
  322.           end
  323.         end
  324.       end
  325.       else begin             //or accept keypress
  326.         indicate Picture_form.isonlyconst FALSE
  327.   
  328.         decrement chpos
  329.         get array_value of Picture_Actions item ChPos to MsgVector  //get msg#
  330.         repeat
  331.           set Kbd_Input_Mode to TRUE
  332.           inkey dd
  333.           set Kbd_Input_Mode to FALSE
  334.           if TERMCHAR lt 256 send MsgVector   //invoke PictElem procedure
  335.         until TERMCHAR gt 0                   //sets TERMCHAR > 0 if ok
  336.   
  337.         [Picture_Form.isautoclear NOT Picture_Form.wascleared] if TERMCHAR lt 256 begin
  338.           indicate Picture_Form.wascleared TRUE
  339.           if ndx gt 0 set value item current to (left(PictStr,ndx))
  340.           else set value item current to ""
  341.         end
  342.       end
  343.     end
  344.  
  345.     set Last_Key to TERMCHAR                 //save last keypress
  346.     set Mask_Index to ndx                    //save last index#
  347.     set Last_Const_pos to ConstPos           //save last constant position
  348.     procedure_return TERMCHAR
  349.   end_procedure
  350. end_class
  351.  
  352. //
  353. // support command
  354. //
  355.  
  356. // =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  357. //
  358. //   Command: PICTURE_ITEM <PictureString> <defaultValue> <Action>
  359. //
  360. //   Parameters:
  361. //      <PictureString> is the mask-string to be used to contol data-entry
  362. //                      for this window
  363. //      <defaultValue>  is the initial value of the window before editing
  364. //      <Action>        is the message to be executed after data-entry occurs
  365. //
  366. //   Description:
  367. //      PICTURE_ITEM declares an item on a Picture_Form and specifies its
  368. //      mask string.
  369. //
  370. // =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  371.  
  372. #COMMAND PICTURE_ITEM R 
  373.   #PUSH !u
  374.   #SET U$ (!Zg-1)
  375.   set Picture_String item |CI!u to !1
  376.   #POP U$
  377.   ON_ITEM !2 SEND !3
  378. #ENDCOMMAND
  379.  
  380. // =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  381. //
  382. //   Command: PICTURE_ENTRY_ITEM <PictureString>
  383. //                               <FieldName>|<Expr>|<Variable> <options>
  384. //
  385. //   Description:
  386. //      PICTURE_ENTRY_ITEM declares an entry_item on a Picture_Form and
  387. //      specifies its mask string.
  388. //
  389. // =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  390.  
  391. #COMMAND PICTURE_ENTRY_ITEM R R
  392.   ENTRY_ITEM !2 !3
  393.   #PUSH !u
  394.   #SET U$ (!Zg-1)
  395.   set Picture_String item |CI!u to !1
  396.   #POP U$
  397. #ENDCOMMAND
  398.  
  399.  
  400.  
  401.