// Use Array.nui // Item_Property command (No User Interface) //> pkgdoc.begin //> This package defines three commands ITEM_PROPERTY_LIST, ITEM_PROPERTY //> and END_ITEM_PROPERTY_LIST. They should be used like this: //> //> <code> //> object oTest is an Array //> item_property_list //> item_property string pItem_Label //> item_property integer pItem_Type //> item_property string pItem_Default //> end_item_property_list // IF IN CLASS REPEAT CLASS NAME HERE! //> end_object //> </code> //> //> You will now be able to write code like: //> //> <code> //> set pItem_Label item 2 to "Amazing" //> get pItem_Default item 0 to sVar //> </code> //> //> Note that you do not need to sub-class the array in order to do this. //> The ITEM_PROPERTY command structure simply defines a number of messages //> that lets you set the values of the array using your own names. //> //> In a normal array you may get the number of items by using the Item_Count //> function. Of course you may still do that, but you would more likely //> want to retrieve the number of 'rows' currently in the array. For this //> purpose the END_ITEM_PROPERTY_LIST command defines a function called //> Row_Count. //> //> In an empty array the Row_Count function returns 0 (surprise). Having //> set just one of the values of the 1'st row (row number 0) the Row_Count //> function will return 1. //> //> If you want to define item_properties as part of a class definition //> you should NOT define them inside procedure construct_object as you //> would with normal properties. Instead it looks like this: //> //> <code> //> class cTest is an Array //> item_property_list //> item_property string pItem_Label //> item_property integer pItem_Type //> item_property string pItem_Default //> end_item_property_list cTest // NOTE: Class name as parameter! //> end_class //> </code> //> pkgdoc.end use ui Enumeration_List // Symbols used internally by the item_property command define ITMP_INTEGER define ITMP_STRING define ITMP_REAL define ITMP_NUMBER define ITMP_DATE define ITMP_ARRAY End_Enumeration_List #COMMAND ITEM_PROPERTY_LIST . #PUSH !m // Used for signalling whether to create insert_row and swap_rows procedures #PUSH !p // #PUSH !g // Number of items per row (increments during define) #SET G$ 0 // #PUSH !i // Number of items per row (set at definition end) #PUSH !l // Used for pushing and pop'ing data types #PUSH !e // #PUSH !f // #SPUSH !$ // Property names #SET P$ !a // Copy current line number to P. Used for generating unique labels #ENDCOMMAND #COMMAND END_DEFINE_ARRAY_FIELDS$CREATE_SWAP_ROW #IF (!f<!g) // When this macro is called integers row1# and row2# are first items get value item liRow1 to lsString1 get value item liRow2 to lsString2 set value item liRow1 to lsString2 set value item liRow2 to lsString1 increment liRow1 increment liRow2 #SET F$ !F END_DEFINE_ARRAY_FIELDS$CREATE_SWAP_ROW #ENDIF #ENDCOMMAND #COMMAND END_DEFINE_ARRAY_FIELDS$CREATE_DELETE_ROWS #IF (!i<!g) #IF (IP$!p$!i=ITMP_ARRAY) get value item (liBase+!i) to lhObj if (lhObj<>0) begin send delete_data_recursive of lhObj send destroy of lhObj //showln "Eliminating: " lhObj end #ENDIF #SET I$ !I END_DEFINE_ARRAY_FIELDS$CREATE_DELETE_ROWS #ENDIF #ENDCOMMAND #COMMAND END_ITEM_PROPERTY_LIST_HELP #IF (!b & 2) // obj_flag == in_class? #IF !0 // Are there any parameters? #IFDEF U_!1 #ELSE #ERROR 666 Illegal class name in END_ITEM_PROPERTY_LIST command #ENDIF #ELSE #ERROR 666 Missing class name in END_ITEM_PROPERTY_LIST command #ENDIF #SET $$ !1 #ELSE #CHECK !1 . // If object: No parameters #ENDIF function row_count returns integer function_return (!g -1+item_count(self)/!g) end_function function items_per_row returns integer // Don't use this. Use column count instead function_return !g end_function function column_count returns integer function_return !g end_function procedure delete_row integer liRow integer liBase liItem move (liRow* !g) to liBase for liItem from 1 to !g send delete_item liBase loop end_procedure procedure delete_data_recursive integer liBase liRow liMax lhObj get row_count to liMax decrement liMax for liRow from 0 to liMax move (liRow* !g) to liBase #PUSH !i #SET I$ 0 END_DEFINE_ARRAY_FIELDS$CREATE_DELETE_ROWS #POP I$ loop send delete_data end_procedure #SET I$ !g // Copy number of items per row to I$ function item_property_type integer liColumn returns integer END_DEFINE_ARRAY_FIELDS$HELP2 end_function #SET G$ !i // Copy number of items per row to I$ #IF !m>0 procedure swap_rows integer liRow1 integer liRow2 string lsString1 lsString2 move (liRow1*!g) to liRow1 // Convert to first item in row move (liRow2*!g) to liRow2 // Convert to first item in row #SET F$ 0 END_DEFINE_ARRAY_FIELDS$CREATE_SWAP_ROW end_procedure procedure insert_row integer liRow integer liItem liMax get row_count to liMax decrement liMax for liItem from liRow to liMax send swap_rows (liMax+liRow-liItem) (liMax+liRow-liItem+1) loop for liItem from (liRow*!g) to (liRow+1*!g-1) // Reset the new row set value item liItem to "" loop end_procedure #ENDIF #SET I$ !g // Copy number of items per row to I$ END_DEFINE_ARRAY_FIELDS$HELP !1 #SPOP #POP F$ #POP E$ #POP L$ #POP I$ #POP G$ #POP P$ #POP M$ #ENDCOMMAND // END_ITEM_PROPERTY_LIST_HELP #COMMAND END_ITEM_PROPERTY_LIST #SET M$ 0 END_ITEM_PROPERTY_LIST_HELP !1 #ENDCOMMAND // END_ITEM_PROPERTY_LIST #COMMAND END_ITEM_PROPERTY_LIST_EXTENDED #SET M$ 1 // Signals the creation of insert_row and swap_rows procedures END_ITEM_PROPERTY_LIST_HELP !1 #ENDCOMMAND // END_ITEM_PROPERTY_LIST_EXTENDED #COMMAND ITEM_PROPERTY$HELP // Handle XML tags, subnodes, column headers asf. (cItemPropertyArray class required) #IF !0 // Are there any parameters? #IFSAME !1 XML_TAG send add_column_xml_tag !g !2 ITEM_PROPERTY$HELP !3 !4 !5 !6 !7 !8 !9 #ELSE #IFSAME !1 XML_SUBNODE_ARRAY send add_column_xml_subnode_array !g ITEM_PROPERTY$HELP !2 !3 !4 !5 !6 !7 !8 !9 #ELSE #IFSAME !1 COLUMN_HEADER send add_grid_header !g !2 ITEM_PROPERTY$HELP !3 !4 !5 !6 !7 !8 !9 #ELSE #IFSAME !1 COLUMN_DISPLAY send add_grid_display !g !2 ITEM_PROPERTY$HELP !3 !4 !5 !6 !7 !8 !9 #ELSE #IFSAME !1 COLUMN_LENGTH send add_grid_length !g !2 ITEM_PROPERTY$HELP !3 !4 !5 !6 !7 !8 !9 #ELSE #IFSAME !1 COLUMN_DECIMALS send add_grid_decimals !g !2 ITEM_PROPERTY$HELP !3 !4 !5 !6 !7 !8 !9 #ELSE #ERROR 666 Illegal argument in ITEM_PROPERTY command (!1) #ENDIF #ENDIF #ENDIF #ENDIF #ENDIF #ENDIF #ENDIF #ENDCOMMAND #COMMAND ITEM_PROPERTY R R . // Name, Type #SET $$ !2 #SPUSH !$ // Push property name #SET L$ -1 #IFSAME !1 INTEGER #SET L$ ITMP_INTEGER #ENDIF #IFSAME !1 STRING #SET L$ ITMP_STRING #ENDIF #IFSAME !1 NUMBER #SET L$ ITMP_NUMBER #ENDIF #IFSAME !1 DATE #SET L$ ITMP_DATE #ENDIF #IFSAME !1 REAL #SET L$ ITMP_REAL #ENDIF #IFSAME !1 ARRAY #SET L$ ITMP_ARRAY #ENDIF #IF (!l=-1) #ERROR 666 "Invalid data type in ITEM_PROPERTY command (!1)" #ENDIF #PUSH !l // Push data type #REPLACE IP$!p$!g !l ITEM_PROPERTY$HELP !3 !4 !5 !6 !7 !8 !9 #SET G$ !G // Increment number of items per row #ENDCOMMAND #COMMAND DEFINE_ITEM_PROPERTY$HELP // Name, Type, Items per row, OffSet, Class name #SET $$ !5 function !1 integer liRow returns !2 function_return (value(self,liRow*!3+!4)) end_function procedure set !1 integer liRow !2 lxValue set value item (liRow*!3+!4) to lxValue end_procedure #ENDCOMMAND #COMMAND END_DEFINE_ARRAY_FIELDS$HELP2 #IF !g #SET G$ (!g - 1) if liColumn eq !g function_return IP$!p$!g END_DEFINE_ARRAY_FIELDS$HELP2 #ENDIF #ENDCOMMAND #COMMAND END_DEFINE_ARRAY_FIELDS$HELP #IF !g #SPOP #POP L$ #SET G$ (!g - 1) #IF (!l = ITMP_INTEGER) DEFINE_ITEM_PROPERTY$HELP !$ INTEGER !i !g !1 #ENDIF #IF (!l = ITMP_STRING) DEFINE_ITEM_PROPERTY$HELP !$ STRING !i !g !1 #ENDIF #IF (!l = ITMP_REAL) DEFINE_ITEM_PROPERTY$HELP !$ REAL !i !g !1 #ENDIF #IF (!l = ITMP_NUMBER) DEFINE_ITEM_PROPERTY$HELP !$ NUMBER !i !g !1 #ENDIF #IF (!l = ITMP_DATE) DEFINE_ITEM_PROPERTY$HELP !$ DATE !i !g !1 #ENDIF #IF (!l = ITMP_ARRAY) DEFINE_ITEM_PROPERTY$HELP !$ INTEGER !i !g !1 #ENDIF END_DEFINE_ARRAY_FIELDS$HELP !1 #ENDIF #ENDCOMMAND #COMMAND ITEM_PROPERTY_REDIR R R "TO" R . procedure set !2 integer liRow !1 lxValue set !2 of !4 liRow to lxValue end_procedure function !2 integer liRow returns !1 function_return (!2(!4,liRow)) end_function #ENDCOMMAND procedure Clone_Array global integer lhSrc integer lhTarget integer liItem liMax move (item_count(lhSrc)) to liMax send delete_data to lhTarget for liItem from 0 to (liMax-1) set value of lhTarget item liItem to (value(lhSrc,liItem)) loop end_procedure //