Compiling Program: C:\projects\BRS\VDFQuery\AppSrc\dbquery.src Memory Available: 2147483647 1>// Compile this program to get stand alone query tool for Visual DataFlex 1> 1>Use APS // Auto Positioning and Sizing classes for VDF Including file: aps.pkg (C:\projects\BRS\VDFQuery\AppSrc\aps.pkg) 1>>>// ************************************************************************* 1>>>// Use APS.pkg // Auto Positioning and Sizing classes for VDF 1>>>// 1>>>// Version: 2.1+ 1>>>// by Sture Andersen 1>>>// 1>>>// NOTE! The classes defined in this file are ONLY concerned with sizing and 1>>>// locating objects. They do not change the navigational behavior of 1>>>// your objects or in any other way extend or limit the functionality 1>>>// compared to standard VDF classes. 1>>>// 1>>>// Once the objects have been created, sized and located APS makes 1>>>// no difference to the behavior to your objects. 1>>>// 1>>>// Support: Contact via DAW news groups preferred. 1>>>// 1>>>// E-mail: sture.aps@mail.tele.dk 1>>>// 1>>>// *********************************************************************** 1>>>// 1>>>// The following classes are defined in this package: 1>>>// 1>>>// 1>>>// Panel containers: aps.View aps.BasicPanel 1>>>// aps.dbView aps.TopMostModalPanel 1>>>// aps.ModalPanel aps.dbTopMostModalPanel 1>>>// aps.dbModalPanel aps.dbTabView 1>>>// 1>>>// Other containers: aps.Group aps.dbGroup 1>>>// aps.Container3D aps.dbContainer3D 1>>>// aps.TabDialog aps.dbTabDialog 1>>>// aps.TabPage aps.dbTabPage 1>>>// aps.RadioGroup aps.dbRadioGroup 1>>>// aps.RadioContainer //<-- NOTE: These do not have sizes 1>>>// aps.dbRadioContainer //<-- or locations. 1>>>// 1>>>// Controls: aps.Form aps.dbForm 1>>>// aps.ComboForm aps.dbComboForm 1>>>// aps.SpinForm aps.dbSpinForm 1>>>// aps.CheckBox aps.dbCheckBox 1>>>// aps.Edit aps.dbEdit 1>>>// aps.RichEdit aps.dbRichEdit 1>>>// aps.TextEdit aps.dbTextEdit 1>>>// aps.TextBox aps.Button 1>>>// aps.Radio aps.Multi_Button 1>>>// 1>>>// Grid controls: aps.List aps.dbList 1>>>// aps.Grid aps.dbGrid 1>>>// 1>>>// Exotics: aps.BitmapContainer aps.ToolButton 1>>>// aps.LineControl 1>>>// 1>>>// *********************************************************************** 1>>>// 1>>>// The following global alignment procedures are defined in this package: 1>>>// 1>>>// 1>>>// Align object 1 relative to object 2, by re-locating object 1: 1>>>// send APS_ALIGN_BY_MOVING obj1# obj2# align_mode# 1>>>// 1>>>// Align object 1 relative to object 2, by re-sizing object 1: 1>>>// send APS_ALIGN_BY_SIZING obj1# obj2# align_mode# 1>>>// 1>>>// Objects are sized to the bigger of the two: 1>>>// send APS_SIZE_IDENTICAL_MAX obj1# obj2# sizing_mode# 1>>>// 1>>>// Align an object (with ID ctrl#) inside its parent by re-locating it: 1>>>// send APS_ALIGN_INSIDE_CONTAINER_BY_MOVING ctrl# align_mode# 1>>>// 1>>>// Align an object (with ID ctrl#) inside its parent by re-sizing it: 1>>>// send APS_ALIGN_INSIDE_CONTAINER_BY_SIZING ctrl# align_mode# 1>>>// 1>>>// 1>>>// align_mode# : SL_ALIGN_LEFT SL_ALIGN_RIGHT SL_ALIGN_TOP 1>>>// SL_ALIGN_BOTTOM SL_ALIGN_CENTER SL_ALIGN_VCENTER 1>>>// 1>>>// sizing_mode# : SL_HORIZONTAL SL_VERTICAL 1>>>// 1>>>// 1>>>// 1>>>// *********************************************************************** 1>>> 1>>>Use DfAllent // Standard DAW everything Using pre-compiled package DFALLENT Including file: dfallent.pkd (C:\Programmer\Visual DataFlex 12.0\Pkg\dfallent.pkd) 34150>>>Use dfline // DAW 34150>>>Use Version.nui // Including file: version.nui (C:\projects\BRS\VDFQuery\AppSrc\version.nui) 34150>>>>>enumeration_list // _OS_ values 34150>>>>> define _OS_WIN_ 34150>>>>> define _OS_DOS_ 34150>>>>> define _OS_UNIX_ 34150>>>>>end_enumeration_list 34150>>>>> 34150>>>>>enumeration_list // _PRODUCT_ values 34150>>>>> define _DF_ 34150>>>>> define _VDF_ 34150>>>>> define _WEBAPP_ 34150>>>>>end_enumeration_list 34150>>>>> 34150>>>>>enumeration_list // _VERSION_ values 34150>>>>> define _20_ 34150>>>>> define _30_ 34150>>>>> define _31_ 34150>>>>> define _32_ 34150>>>>> define _4_ 34150>>>>> define _5_ 34150>>>>> define _6_ 34150>>>>> define _7_ 34150>>>>> define _8_ 34150>>>>> define _91_ 34150>>>>> define _10_ 34150>>>>> define _11_ 34150>>>>> define _12_ 34150>>>>>end_enumeration_list 34150>>>>> 34150>>>>> define _OS_ for _OS_WIN_ 34150>>>>> define _PRODUCT_ for _VDF_ // or WebApp server 34150>>>>> define _VERSION_ for _12_ // VDF12 34150>>>Use FieldInf // Global field info objects Including file: fieldinf.pkg (C:\projects\BRS\VDFQuery\AppSrc\fieldinf.pkg) 34150>>>>>//********************************************************************** 34150>>>>>// Use FieldInf // Global field info objects and abstract field types 34150>>>>>// 34150>>>>>// By Sture Andersen 34150>>>>>// 34150>>>>>// Create: Wed 28-01-1997 34150>>>>>// Update: Tue 11-02-1997 - Abstract field thing added 34150>>>>>// Thu 20-02-1997 - Register_abstract_field_label may now be 34150>>>>>// be used with only one argument (does nothing) 34150>>>>>// Thu 04-03-1997 - ascii_window and date_window are now defined 34150>>>>>// if not already (for use with CM) 34150>>>>>// Tue 22-04-1997 - File_Display_Name_Array added 34150>>>>>// Tue 29-04-1997 - Changed REGISTER_FIELD_LABEL command 34150>>>>>// Wed 04-02-1998 - Functions gl_generic_form_margin and 34150>>>>>// gl_generic_form_datatype added 34150>>>>>// Fri 29-01-1999 - DataDictionary_Class property moved to here 34150>>>>>// from dynamo.utl. 34150>>>>>// Wed 17-02-1999 - Class cVirtualFields added. 34150>>>>>// Mon 15-03-1999 - DataDictionary classes are now used when 34150>>>>>// determining field labels 34150>>>>>// Thu 03-07-2003 - Fixed error in procedure set pCurrentRecord 34150>>>>>// Tue 12-08-2003 - Added piDescriptionImage.i 34150>>>>>// Wed 14-09-2005 - Virtual fields now have a "call back" function 34150>>>>>// - Function FieldInf_Field_Length added. 34150>>>>>// Mon 20-03-2006 - Functions FieldInf_ValidationTableObject and 34150>>>>>// FieldInf_ValidationTableDecodeValue added. 34150>>>>>// 34150>>>>>// Purpose: To provide a global mechanism for registering field labels. 34150>>>>>// If used with APS, db-controls will automatically obtain their 34150>>>>>// labels from here, unless they are set manually or they are 34150>>>>>// specifically told not to. 34150>>>>>// 34150>>>>>// The package also let's you define abstract field types for 34150>>>>>// use with non-db controls or for overriding the definition of 34150>>>>>// DBMS fields. A classical example of the latter is that while 34150>>>>>// your data field is defined to have 4 decimal points you 34150>>>>>// really want the field to display with only 3. 34150>>>>>// 34150>>>>>// You set these global informations using the four commands 34150>>>>>// listed here: 34150>>>>>// 34150>>>>>// 1 REGISTER_FIELD_LABEL dffile.field ; 34150>>>>>// [ []] 34150>>>>>// 34150>>>>>// 2 REGISTER_ABSTRACT_FIELD_TYPE ; 34150>>>>>// 34150>>>>>// 34150>>>>>// 3 MODIFY_FIELD_TYPE dffile.field 34150>>>>>// 34150>>>>>// 4 REGISTER_FILE_ALIAS 34150>>>>>// 34150>>>>>// As you can see it is possible to register status help lines. 34150>>>>>// This was implemented since it felt to natural to do so. APS 34150>>>>>// will make use of such registrations only if used with the 34150>>>>>// aps.DataDictionary and only if status help has not been 34150>>>>>// registered the standard DD way. 34150>>>>>// 34150>>>>>// 34150>>>>>// Note: This package makes permanent use of compile-time variable J$. 34150>>>>>// If this is in conflict with your application source it is 34150>>>>>// easily changed since it is only referenced from within this 34150>>>>>// file. 34150>>>>>// 34150>>>>>//********************************************************************** 34150>>>>> 34150>>>>>Use ui 34150>>>>>Use Seq_Chnl // Defines global sequential device management operations (DAW) 34150>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes Including file: base.nui (C:\projects\BRS\VDFQuery\AppSrc\base.nui) 34150>>>>>>>// Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface) 34150>>>>>>> 34150>>>>>>>// This purpose of this package is to relieve me of having to remember which 34150>>>>>>>// package exactly holds a particular command or class. 34150>>>>>>> 34150>>>>>>> 34150>>>>>>> define BaseClass for Desktop 34150>>>>>>> 34150>>>>>>>Use Array.nui // Item_Property command Including file: array.nui (C:\projects\BRS\VDFQuery\AppSrc\array.nui) 34150>>>>>>>>>// Use Array.nui // Item_Property command (No User Interface) 34150>>>>>>>>> 34150>>>>>>>>>//> pkgdoc.begin 34150>>>>>>>>>//> This package defines three commands ITEM_PROPERTY_LIST, ITEM_PROPERTY 34150>>>>>>>>>//> and END_ITEM_PROPERTY_LIST. They should be used like this: 34150>>>>>>>>>//> 34150>>>>>>>>>//> 34150>>>>>>>>>//> object oTest is an Array 34150>>>>>>>>>//> item_property_list 34150>>>>>>>>>//> item_property string pItem_Label 34150>>>>>>>>>//> item_property integer pItem_Type 34150>>>>>>>>>//> item_property string pItem_Default 34150>>>>>>>>>//> end_item_property_list // IF IN CLASS REPEAT CLASS NAME HERE! 34150>>>>>>>>>//> end_object 34150>>>>>>>>>//> 34150>>>>>>>>>//> 34150>>>>>>>>>//> You will now be able to write code like: 34150>>>>>>>>>//> 34150>>>>>>>>>//> 34150>>>>>>>>>//> set pItem_Label item 2 to "Amazing" 34150>>>>>>>>>//> get pItem_Default item 0 to sVar 34150>>>>>>>>>//> 34150>>>>>>>>>//> 34150>>>>>>>>>//> Note that you do not need to sub-class the array in order to do this. 34150>>>>>>>>>//> The ITEM_PROPERTY command structure simply defines a number of messages 34150>>>>>>>>>//> that lets you set the values of the array using your own names. 34150>>>>>>>>>//> 34150>>>>>>>>>//> In a normal array you may get the number of items by using the Item_Count 34150>>>>>>>>>//> function. Of course you may still do that, but you would more likely 34150>>>>>>>>>//> want to retrieve the number of 'rows' currently in the array. For this 34150>>>>>>>>>//> purpose the END_ITEM_PROPERTY_LIST command defines a function called 34150>>>>>>>>>//> Row_Count. 34150>>>>>>>>>//> 34150>>>>>>>>>//> In an empty array the Row_Count function returns 0 (surprise). Having 34150>>>>>>>>>//> set just one of the values of the 1'st row (row number 0) the Row_Count 34150>>>>>>>>>//> function will return 1. 34150>>>>>>>>>//> 34150>>>>>>>>>//> If you want to define item_properties as part of a class definition 34150>>>>>>>>>//> you should NOT define them inside procedure construct_object as you 34150>>>>>>>>>//> would with normal properties. Instead it looks like this: 34150>>>>>>>>>//> 34150>>>>>>>>>//> 34150>>>>>>>>>//> class cTest is an Array 34150>>>>>>>>>//> item_property_list 34150>>>>>>>>>//> item_property string pItem_Label 34150>>>>>>>>>//> item_property integer pItem_Type 34150>>>>>>>>>//> item_property string pItem_Default 34150>>>>>>>>>//> end_item_property_list cTest // NOTE: Class name as parameter! 34150>>>>>>>>>//> end_class 34150>>>>>>>>>//> 34150>>>>>>>>>//> pkgdoc.end 34150>>>>>>>>> 34150>>>>>>>>>use ui 34150>>>>>>>>> 34150>>>>>>>>>Enumeration_List // Symbols used internally by the item_property command 34150>>>>>>>>> define ITMP_INTEGER 34150>>>>>>>>> define ITMP_STRING 34150>>>>>>>>> define ITMP_REAL 34150>>>>>>>>> define ITMP_NUMBER 34150>>>>>>>>> define ITMP_DATE 34150>>>>>>>>>End_Enumeration_List 34150>>>>>>>>> 34150>>>>>>>>> 34150>>>>>>>>> 34150>>>>>>>>> 34150>>>>>>>>> 34150>>>>>>>>> 34150>>>>>>>>> 34150>>>>>>>>> 34150>>>>>>>>> 34150>>>>>>>>> 34150>>>>>>>>> 34150>>>>>>>>> 34150>>>>>>>>> 34150>>>>>>>>>procedure Clone_Array global integer lhSrc integer lhTarget 34152>>>>>>>>> integer liItem liMax 34152>>>>>>>>> move (item_count(lhSrc)) to liMax 34153>>>>>>>>> send delete_data to lhTarget 34154>>>>>>>>> for liItem from 0 to (liMax-1) 34160>>>>>>>>>> 34160>>>>>>>>> set value of lhTarget item liItem to (value(lhSrc,liItem)) 34161>>>>>>>>> loop 34162>>>>>>>>>> 34162>>>>>>>>>end_procedure 34163>>>>>>>>> 34163>>>>>>>>>// 34163>>>>>>>Use Macros.utl // Various macros (FOR_EX...) Including file: macros.utl (C:\projects\BRS\VDFQuery\AppSrc\macros.utl) 34163>>>>>>>>>// Use Macros.utl // Various macros (FOR_EX...) 34163>>>>>>>>> 34163>>>>>>>>>// FOR_EX (extended FOR command) 34163>>>>>>>>>// ----------------------------- 34163>>>>>>>>>//> The FOR_EX command is exactly like the standard FOR command except 34163>>>>>>>>>//> that it will allow you to use keyword "DOWN_TO" instead of "TO" if 34163>>>>>>>>>//> you need to do a decremental loop. 34163>>>>>>>>> 34163>>>>>>>>> 34163>>>>>>>>>// DESKTOP_SECTION 34163>>>>>>>>>// --------------- 34163>>>>>>>>>//> The DESKTOP_SECTION/END_DESKTOP_SECTION commands will make a sequence of 34163>>>>>>>>>//> code compile (or rather instantiate) as if it was situated on the DESKTOP 34163>>>>>>>>>//> even when it isn't. DESKTOP_SECTION's may not be nested. 34163>>>>>>>>> 34163>>>>>>>>> 34163>>>>>>>>> 34163>>>>>>>Use Set.utl // cArray, cSet and cStack classes Including file: set.utl (C:\projects\BRS\VDFQuery\AppSrc\set.utl) 34163>>>>>>>>>// Use Set.utl // cArray, cSet and cStack classes 34163>>>>>>>>> 34163>>>>>>>>>use ui 34163>>>>>>>>> 34163>>>>>>>>>Use DestObj.pkg // DAW - Defines request_destroy_object Including file: destobj.pkg (C:\Programmer\Visual DataFlex 12.0\Pkg\destobj.pkg) 34163>>>>>>>>>>>Use VdfBase.pkg // this now lives here. (you don't need to ever use this). 34163>>>>>>>>> 34163>>>>>>>>>// The only difference between a cArray and an Array object is that 34163>>>>>>>>>// a cArray reacts with normal delegation to messages that it does 34163>>>>>>>>>// not understand. 34163>>>>>>>>> 34163>>>>>>>>>class cArray is an Array 34164>>>>>>>>> procedure construct_object integer liImg 34166>>>>>>>>> forward send construct_object liImg 34168>>>>>>>>> set delegation_mode to DELEGATE_TO_PARENT 34169>>>>>>>>> end_procedure 34170>>>>>>>>>end_class // cArray 34171>>>>>>>>> 34171>>>>>>>>>class cArray2d is a cArray 34172>>>>>>>>> function iObjectID.i integer liX returns integer 34174>>>>>>>>> integer lhObj 34174>>>>>>>>> get value item liX to lhObj 34175>>>>>>>>> ifnot lhObj begin 34177>>>>>>>>> object oArray2d is a cArray no_image 34179>>>>>>>>> move self to lhObj 34180>>>>>>>>> end_object 34181>>>>>>>>> set value item liX to lhObj 34182>>>>>>>>> end 34182>>>>>>>>>> 34182>>>>>>>>> function_return lhObj 34183>>>>>>>>> end_function 34184>>>>>>>>> procedure set Value.ii integer liX integer liY string lsValue 34186>>>>>>>>> integer lhObj 34186>>>>>>>>> get iObjectID.i liX to lhObj 34187>>>>>>>>> set value of lhObj item liY to lsValue 34188>>>>>>>>> end_procedure 34189>>>>>>>>> function Value.ii integer liX integer liY returns string 34191>>>>>>>>> integer lhObj 34191>>>>>>>>> get value item liX to lhObj 34192>>>>>>>>> if lhObj function_return (value(lhObj,liY)) 34195>>>>>>>>> function_return 0 34196>>>>>>>>> end_function 34197>>>>>>>>> procedure reset 34199>>>>>>>>> integer liItm liMax lhObj 34199>>>>>>>>> get item_count to liMax 34200>>>>>>>>> decrement liMax 34201>>>>>>>>> for liItm from 0 to liMax 34207>>>>>>>>>> 34207>>>>>>>>> get value item liItm to lhObj 34208>>>>>>>>> if lhObj send request_destroy_object to lhObj 34211>>>>>>>>> loop 34212>>>>>>>>>> 34212>>>>>>>>> send delete_data 34213>>>>>>>>> end_procedure 34214>>>>>>>>>end_class // cArray2d 34215>>>>>>>>> 34215>>>>>>>>>class cArray3d is a cArray2d 34216>>>>>>>>> function iObjectID.ii integer liX integer liY returns integer 34218>>>>>>>>> integer lhObj 34218>>>>>>>>> get Value.ii liX liY to lhObj 34219>>>>>>>>> ifnot lhObj begin 34221>>>>>>>>> object oArray3d is a cArray no_image 34223>>>>>>>>> move self to lhObj 34224>>>>>>>>> end_object 34225>>>>>>>>> set Value.ii liX liY to lhObj 34226>>>>>>>>> end 34226>>>>>>>>>> 34226>>>>>>>>> function_return lhObj 34227>>>>>>>>> end_function 34228>>>>>>>>> procedure set Value.iii integer liX integer liY integer liZ string lsValue 34230>>>>>>>>> integer lhObj 34230>>>>>>>>> get iObjectID.ii liX liY to lhObj 34231>>>>>>>>> set value of lhObj item liZ to lsValue 34232>>>>>>>>> end_procedure 34233>>>>>>>>> function Value.iii integer liX integer liY integer liZ returns string 34235>>>>>>>>> integer lhObj 34235>>>>>>>>> get value item liX to lhObj 34236>>>>>>>>> if lhObj begin 34238>>>>>>>>> get value of lhObj item liY to lhObj 34239>>>>>>>>> if lhObj function_return (value(lhObj,liZ)) 34242>>>>>>>>> end 34242>>>>>>>>>> 34242>>>>>>>>> function_return 0 34243>>>>>>>>> end_function 34244>>>>>>>>> procedure reset 34246>>>>>>>>> integer liXmax liYmax liX liY lhYobj lhZobj 34246>>>>>>>>> get item_count to liXmax 34247>>>>>>>>> decrement liXmax 34248>>>>>>>>> for liX from 0 to liXmax 34254>>>>>>>>>> 34254>>>>>>>>> get value item liX to lhYobj 34255>>>>>>>>> if lhYobj begin 34257>>>>>>>>> get item_count of lhYobj to liYmax 34258>>>>>>>>> decrement liYmax 34259>>>>>>>>> for liY from 0 to liYmax 34265>>>>>>>>>> 34265>>>>>>>>> get value of lhYobj item liY to lhZobj 34266>>>>>>>>> if lhZobj send request_destroy_object to lhZobj 34269>>>>>>>>> loop 34270>>>>>>>>>> 34270>>>>>>>>> end 34270>>>>>>>>>> 34270>>>>>>>>> loop 34271>>>>>>>>>> 34271>>>>>>>>> forward send reset 34273>>>>>>>>> end_procedure 34274>>>>>>>>>end_class // cArray3d 34275>>>>>>>>> 34275>>>>>>>>>class cArray2dFixedWidth is a cArray 34276>>>>>>>>> procedure construct_object integer liImg 34278>>>>>>>>> forward send construct_object liImg 34280>>>>>>>>> property integer private.piMaxColumn public 0 34281>>>>>>>>> end_procedure 34282>>>>>>>>> function piMaxColumn returns integer 34284>>>>>>>>> function_return (private.piMaxColumn(self)) 34285>>>>>>>>> end_function 34286>>>>>>>>> procedure set piMaxColumn integer liMax 34288>>>>>>>>> if (item_count(self)) error 666 "Can't set column index range while not empty" 34291>>>>>>>>> else set private.piMaxColumn to liMax 34293>>>>>>>>> end_procedure 34294>>>>>>>>> procedure set value.ii integer liRow integer liColumn string lsValue 34296>>>>>>>>> integer liItem liMaxColumn 34296>>>>>>>>> get private.piMaxColumn to liMaxColumn 34297>>>>>>>>> move (liRow*liMaxColumn+liColumn) to liItem 34298>>>>>>>>> if liColumn ge liMaxColumn error 666 "Column index is out of range" 34301>>>>>>>>> else set value item liItem to lsValue 34303>>>>>>>>> end_procedure 34304>>>>>>>>> function value.ii integer liRow integer liColumn returns string 34306>>>>>>>>> integer liItem liMaxColumn 34306>>>>>>>>> get private.piMaxColumn to liMaxColumn 34307>>>>>>>>> move (liRow*liMaxColumn+liColumn) to liItem 34308>>>>>>>>> if liColumn ge liMaxColumn error 666 "Column index is out of range" 34311>>>>>>>>> else function_return (value(self,liItem)) 34313>>>>>>>>> end_function 34314>>>>>>>>> function row_count returns integer 34316>>>>>>>>> integer liMaxColumn 34316>>>>>>>>> get private.piMaxColumn to liMaxColumn 34317>>>>>>>>> function_return (liMaxColumn-1+item_count(self)/liMaxColumn) 34318>>>>>>>>> end_function 34319>>>>>>>>> function column_count returns integer 34321>>>>>>>>> function_return (private.piMaxColumn(self)) 34322>>>>>>>>> end_function 34323>>>>>>>>> procedure reset 34325>>>>>>>>> send delete_data 34326>>>>>>>>> end_procedure 34327>>>>>>>>>end_class // cArray2dFixedWidth 34328>>>>>>>>> 34328>>>>>>>>>class cSet is an cArray 34329>>>>>>>>> function element_find string lsValue returns integer 34331>>>>>>>>> integer liMax liItm 34331>>>>>>>>> get item_count to liMax 34332>>>>>>>>> move 0 to liItm 34333>>>>>>>>> while liItm lt liMax 34337>>>>>>>>> if lsValue eq (value(self,liItm)) function_return liItm // Dirty exit 34340>>>>>>>>> increment liItm 34341>>>>>>>>> end 34342>>>>>>>>>> 34342>>>>>>>>> function_return -1 34343>>>>>>>>> end_function 34344>>>>>>>>> 34344>>>>>>>>> procedure element_add string lsValue 34346>>>>>>>>> if (element_find(self,lsValue)=-1) set value item (item_count(self)) to lsValue 34349>>>>>>>>> end_procedure 34350>>>>>>>>> 34350>>>>>>>>> procedure element_remove string lsValue 34352>>>>>>>>> integer liItm 34352>>>>>>>>> get element_find lsValue to liItm 34353>>>>>>>>> if liItm ge 0 send delete_item liItm 34356>>>>>>>>> end_procedure 34357>>>>>>>>> 34357>>>>>>>>> function iAddOrFind_Element string lsValue returns integer 34359>>>>>>>>> integer liRval 34359>>>>>>>>> get element_find lsValue to liRval 34360>>>>>>>>> if liRval eq -1 begin 34362>>>>>>>>> get item_count to liRval 34363>>>>>>>>> set value item liRval to lsValue 34364>>>>>>>>> end 34364>>>>>>>>>> 34364>>>>>>>>> function_return liRval 34365>>>>>>>>> end_function 34366>>>>>>>>> 34366>>>>>>>>>//// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- 34366>>>>>>>>>//// Original procedures (optimized) are mentioned for compatibility: 34366>>>>>>>>>// 34366>>>>>>>>>//function find_element string lsValue returns integer 34366>>>>>>>>>// integer liMax liItm 34366>>>>>>>>>// get item_count to liMax 34366>>>>>>>>>// move 0 to liItm 34366>>>>>>>>>// while liItm lt liMax 34366>>>>>>>>>// if lsValue eq (value(self,liItm)) function_return liItm // Dirty exit 34366>>>>>>>>>// increment liItm 34366>>>>>>>>>// end 34366>>>>>>>>>// function_return -1 34366>>>>>>>>>//end_function 34366>>>>>>>>>// 34366>>>>>>>>>//procedure Add_Element string lsValue returns integer 34366>>>>>>>>>// integer liRval 34366>>>>>>>>>// get find_element lsValue to liRval 34366>>>>>>>>>// if liRval lt 0 get item_count to liRval 34366>>>>>>>>>// set array_value item liRval to lsValue 34366>>>>>>>>>// procedure_return liRval 34366>>>>>>>>>//end_procedure 34366>>>>>>>>>// 34366>>>>>>>>>//procedure Remove_Element string lsValue 34366>>>>>>>>>// integer liItm 34366>>>>>>>>>// get Find_Element item lsValue to liItm 34366>>>>>>>>>// if liItm gt -1 send delete_item liItm 34366>>>>>>>>>//end_procedure 34366>>>>>>>>>//// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- 34366>>>>>>>>>end_class 34367>>>>>>>>> 34367>>>>>>>>>class cStack is an cArray 34368>>>>>>>>> function Stack_Empty returns integer 34370>>>>>>>>> function_return (item_count(self)=0) 34371>>>>>>>>> end_function 34372>>>>>>>>> // *** Integer interface ************************************** 34372>>>>>>>>> procedure Push.i integer liValue 34374>>>>>>>>> set value item (item_count(self)) to liValue 34375>>>>>>>>> end_procedure 34376>>>>>>>>> function iPop returns integer 34378>>>>>>>>> integer liRval liItm 34378>>>>>>>>> move (item_count(self)-1) to liItm 34379>>>>>>>>> get value item liItm to liRval 34380>>>>>>>>> send delete_item liItm 34381>>>>>>>>> function_return liRval 34382>>>>>>>>> end_function 34383>>>>>>>>> function iCopy returns integer 34385>>>>>>>>> function_return (value(self,item_count(self)-1)) 34386>>>>>>>>> end_function 34387>>>>>>>>> function bIsOnStack.i integer liValue returns integer 34389>>>>>>>>> integer liMax liItm 34389>>>>>>>>> get item_count to liMax 34390>>>>>>>>> decrement liMax 34391>>>>>>>>> for liItm from 0 to liMax 34397>>>>>>>>>> 34397>>>>>>>>> if (integer(value(self,liItm))=liValue) function_return 1 34400>>>>>>>>> loop 34401>>>>>>>>>> 34401>>>>>>>>> function_return 0 34402>>>>>>>>> end_function 34403>>>>>>>>> // *** String interface *************************************** 34403>>>>>>>>> procedure Push.s string lsValue 34405>>>>>>>>> set value item (item_count(self)) to lsValue 34406>>>>>>>>> end_procedure 34407>>>>>>>>> function sPop returns string 34409>>>>>>>>> integer liItm 34409>>>>>>>>> string lsRval 34409>>>>>>>>> move (item_count(self)-1) to liItm 34410>>>>>>>>> get value item liItm to lsRval 34411>>>>>>>>> send delete_item liItm 34412>>>>>>>>> function_return lsRval 34413>>>>>>>>> end_function 34414>>>>>>>>> function sCopy returns string 34416>>>>>>>>> function_return (value(self,item_count(self)-1)) 34417>>>>>>>>> end_function 34418>>>>>>>>> procedure Drop 34420>>>>>>>>> string lsGrb 34420>>>>>>>>> get sPop to lsGrb 34421>>>>>>>>> end_procedure 34422>>>>>>>>> function bIsOnStack.s string lsValue returns integer 34424>>>>>>>>> integer liMax liItm 34424>>>>>>>>> get item_count to liMax 34425>>>>>>>>> decrement liMax 34426>>>>>>>>> for liItm from 0 to liMax 34432>>>>>>>>>> 34432>>>>>>>>> if (value(self,liItm)=lsValue) function_return 1 34435>>>>>>>>> loop 34436>>>>>>>>>> 34436>>>>>>>>> function_return 0 34437>>>>>>>>> end_function 34438>>>>>>>>>end_class 34439>>>>>>> 34439>>>>>Use Strings.nui // String manipulation for VDF Including file: strings.nui (C:\projects\BRS\VDFQuery\AppSrc\strings.nui) 34439>>>>>>>// ********************************************************************** 34439>>>>>>>// Use Strings.nui // String manipulation for VDF (No User Interface) 34439>>>>>>>// 34439>>>>>>>// By Sture Andersen 34439>>>>>>>// 34439>>>>>>>// The file contains a number of global functions for manipulating 34439>>>>>>>// strings and converting numbers to strings. The package may be used 34439>>>>>>>// with DataFlex 3.2 and Visual DataFlex. This package is public domain. 34439>>>>>>>// 34439>>>>>>>// 34439>>>>>>>// Create: Fri 23-05-1997 - Merger of s_utl002, 006. 34439>>>>>>>// Update: Tue 25-08-1997 - Fixes by Magnus Bergh 34439>>>>>>>// Sun 14-12-1997 - Added the following functions: 34439>>>>>>>// ExtractWord ExtractInteger 34439>>>>>>>// HowManyWords HowManyIntegers 34439>>>>>>>// ExtractItemNeg IsIntegerPresent 34439>>>>>>>// Tue 31-03-1998 - Added the following functions: 34439>>>>>>>// Text_RemoveTrailingCr Text_CompressSubstCr 34439>>>>>>>// Text_RTrim Text_Format.sii 34439>>>>>>>// Text_Trim Text_FormattedLine.i 34439>>>>>>>// Text_Compress 34439>>>>>>>// Fri 06-11-1998 - Added function InsertThousandsSep 34439>>>>>>>// Sun 14-02-1999 - Added function Byte_ToHex 34439>>>>>>>// Wed 27-04-1999 - Added function CurrentDecimalSeparator 34439>>>>>>>// Mon 08-11-1999 - Added procedure Text_SetEditObjectValue and 34439>>>>>>>// function Text_EditObjectValue 34439>>>>>>>// Mon 22-11-1999 - Function Text_RemoveTrailingCr strengthened 34439>>>>>>>// Wed 01-12-1999 - Function StringFieldType added 34439>>>>>>>// Wed 12-01-2000 - Functions StringOemToAnsi and StringAnsiToOem 34439>>>>>>>// added when compiled using the Windows compiler 34439>>>>>>>// Wed 17-05-2000 - Function NumToStr fixed for use with VDF 6.0. 34439>>>>>>>// Mon 29-05-2000 - Attempt to fix function Text_EditObjectValue 34439>>>>>>>// Fri 21-07-2000 - InsertThousandsSep fixed for use with negative 34439>>>>>>>// numbers. 34439>>>>>>>// - Functions IntToStrRTS, NumToStrRTS and NumToStrTS 34439>>>>>>>// added. 34439>>>>>>>// Fri 25-08-2000 - Function NumToStrRzf added 34439>>>>>>>// Wed 28-02-2001 - Add function HexToByte, renamed existing function 34439>>>>>>>// Byte_ToHex to ByteToHex 34439>>>>>>>// Mon 19-03-2001 - Functions StringBeginsWith and StringEndsWith 34439>>>>>>>// added 34439>>>>>>>// Thu 19-07-2001 - StringIsInteger added 34439>>>>>>>// Sat 05-04-2002 - Global strings str.Chr10 and str.Chr1013 added. 34439>>>>>>>// Tue 04-06-2002 - Oem to ANSI and vice versa for DF3.2 UNIX/DOS/LINUX 34439>>>>>>>// Tue 09-09-2003 - Function StringFieldText added 34439>>>>>>>// Tue 18-01-2005 - Function String_NegateSortOrder added 34439>>>>>>>// Mon 14-03-2005 - Functions StringHead and StringTail added 34439>>>>>>>// Sun 12-11-2006 - Functions renamed: RightFromPos -> RightFromPos 34439>>>>>>>// ByteToHex -> ByteToHex 34439>>>>>>>// HexToByte -> HexToByte 34439>>>>>>>// StringToHex -> StringToHex 34439>>>>>>>// HexToString -> HexToString 34439>>>>>>>// WildCardMatch -> WildCardMatch 34439>>>>>>>// 34439>>>>>>>// 34439>>>>>>>// *********************************************************************** 34439>>>>>>> 34439>>>>>>>use ui 34439>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes 34439>>>>>>> 34439>>>>>>>// Returns the string of length len# inside which src# is right justified: 34439>>>>>>>Function RightShift global string src# integer len# returns string 34441>>>>>>> trim src# to src# 34442>>>>>>>> 34442>>>>>>> if (length(src#)) lt len# insert (left(pad("",len#),len#-length(src#))) in src# at 1 34446>>>>>>> function_return (left(src#,len#)) 34447>>>>>>>End_Function 34448>>>>>>> 34448>>>>>>>// Returns the string of length len# inside which src# is centered: 34448>>>>>>>Function CenterString global string src# integer len# returns string 34450>>>>>>> trim src# to src# 34451>>>>>>>> 34451>>>>>>> if (length(src#)) lt len# insert (left(pad("",len#),len#-length(src#)/2)) in src# at 1 34455>>>>>>> function_return (left(src#,len#)) 34456>>>>>>>End_Function 34457>>>>>>> 34457>>>>>>>// Returns all characters to the right of position pos# (including the character at 34457>>>>>>>// posistion pos#) 34457>>>>>>>Function RightFromPos global string str# integer pos# returns string 34459>>>>>>> function_return (right(str#,length(str#)-pos#+1)) 34460>>>>>>>End_Function 34461>>>>>>> 34461>>>>>>>// Number converting functions: 34461>>>>>>> 34461>>>>>>>integer NumToStringConversionMode# 34461>>>>>>> 34461>>>>>>>string str.Chr10 1 34461>>>>>>>string str.Chr13 1 34461>>>>>>>string str.Chr1013 2 34461>>>>>>>move (character(13)) to str.Chr13 34462>>>>>>>move (character(10)) to str.Chr10 34463>>>>>>>move (character(10)+character(13)) to str.Chr1013 34464>>>>>>> 34464>>>>>>>move NUMTOSTR_THOUSANDS_SEPARATOR_OFF to NumToStringConversionMode# 34465>>>>>>>procedure set pNumToStringConversionMode global integer value# 34467>>>>>>> move value# to NumToStringConversionMode# 34468>>>>>>>end_procedure 34469>>>>>>>function pNumToStringConversionMode global returns integer 34471>>>>>>> function_return NumToStringConversionMode# 34472>>>>>>>end_function 34473>>>>>>> 34473>>>>>>>function InsertThousandsSep global string str# returns string 34475>>>>>>> integer pos# tmp# neg# 34475>>>>>>> string sep# 34475>>>>>>> trim str# to str# 34476>>>>>>>> 34476>>>>>>> move (left(str#,1)="-") to neg# 34477>>>>>>> if neg# get StringRightBut str# 1 to str# 34480>>>>>>> get_attribute DF_DECIMAL_SEPARATOR to pos# 34483>>>>>>> character pos# to sep# 34484>>>>>>>> 34484>>>>>>> move (pos(sep#,str#)) to pos# 34485>>>>>>> ifnot pos# move (length(str#)+1) to pos# 34488>>>>>>> get_attribute DF_THOUSANDS_SEPARATOR to tmp# 34491>>>>>>> character tmp# to sep# 34492>>>>>>>> 34492>>>>>>> while pos# gt 4 34496>>>>>>> move (pos#-3) to pos# 34497>>>>>>> insert sep# in str# at pos# 34499>>>>>>> loop 34500>>>>>>>> 34500>>>>>>> if neg# move ("-"+str#) to str# 34503>>>>>>> function_return str# 34504>>>>>>>end_function 34505>>>>>>> 34505>>>>>>>// Calling the function below will convert the number stored in src# to a 34505>>>>>>>// string containing dcp# decimals rounding excess decimals. Parameter dcp# 34505>>>>>>>// may be negative. The expression (NumToStr(1789,-3)) will evaluate to "2000". 34505>>>>>>>// The functions in this package all respects the value of global attribute 34505>>>>>>>// DF_DECIMAL_SEPARATOR. 34505>>>>>>>Function NumToStr global number src# integer dcp# returns string 34507>>>>>>> integer pos# 34507>>>>>>> number correction# 34507>>>>>>> string rval# radix# 34507>>>>>>> if dcp# lt 0 function_return (NumToStr(src#*(10^dcp#),0)+left("00000000",-dcp#)) 34510>>>>>>> move (0.5/(10^dcp#)) to correction# 34511>>>>>>>// move (0.5/(10^dcp#)+src#) to src# // This does not always work with VDF 6.x!!! 34511>>>>>>> if src# ge 0 move (correction#+src#) to src# 34514>>>>>>> else move (src#-correction#) to src# 34516>>>>>>> get_attribute DF_DECIMAL_SEPARATOR to pos# // Overload 34519>>>>>>> character pos# to radix# // End overload 34520>>>>>>>> 34520>>>>>>> move src# to rval# 34521>>>>>>> ifnot (pos(radix#,rval#)) append rval# radix# 34524>>>>>>> append rval# "00000000" 34525>>>>>>> move (pos(radix#,rval#)) to pos# 34526>>>>>>> if dcp# eq 0 decrement pos# 34529>>>>>>> move (left(rval#,pos#+dcp#)) to rval# 34530>>>>>>> if NumToStringConversionMode# move (InsertThousandsSep(rval#)) to rval# 34533>>>>>>> function_return rval# 34534>>>>>>>End_Function 34535>>>>>>> 34535>>>>>>>// This function is the same as NumToStr except that you have to specify 34535>>>>>>>// the length of the target string (len#). The number will be right 34535>>>>>>>// justified accordingly. Post-fix `R' means right justify: 34535>>>>>>>Function NumToStrR global number src# integer dcp# integer len# returns string 34537>>>>>>> function_return (RightShift(NumToStr(src#,dcp#),len#)) 34538>>>>>>>End_Function 34539>>>>>>> 34539>>>>>>>// Function NumToStrTS is the same as NumToStr except that thousand 34539>>>>>>>// separators are inserted. (TS=Thousand Separator) 34539>>>>>>>Function NumToStrTS global number src# integer dcp# returns string 34541>>>>>>> integer Org# 34541>>>>>>> string rval# 34541>>>>>>> move NumToStringConversionMode# to org# 34542>>>>>>> move NUMTOSTR_THOUSANDS_SEPARATOR_ON to NumToStringConversionMode# 34543>>>>>>> move (NumToStr(src#,dcp#)) to rval# 34544>>>>>>> move org# to NumToStringConversionMode# 34545>>>>>>> function_return rval# 34546>>>>>>>End_Function 34547>>>>>>> 34547>>>>>>>Function IntToStrTS global number src# returns string 34549>>>>>>> function_return (NumToStrTS(src#,0)) 34550>>>>>>>End_Function 34551>>>>>>> 34551>>>>>>>Function NumToStrRTS global number src# integer dcp# integer len# returns string 34553>>>>>>> function_return (RightShift(NumToStrTS(src#,dcp#),len#)) 34554>>>>>>>End_Function 34555>>>>>>> 34555>>>>>>>// This function is the same as NumToStrR except that you do not specify 34555>>>>>>>// the number of decimals: 34555>>>>>>>Function IntToStrR global number src# integer len# returns string 34557>>>>>>> function_return (NumToStrR(src#,0,len#)) // Fixed, Magnus Bergh 34558>>>>>>>End_Function 34559>>>>>>> 34559>>>>>>>// Same as IntToStrR (TS=Thousand Separator) 34559>>>>>>>Function IntToStrRTS global number src# integer len# returns string 34561>>>>>>> function_return (NumToStrRTS(src#,0,len#)) 34562>>>>>>>End_Function 34563>>>>>>> 34563>>>>>>>// Is the same as IntToStrR, except that leading blanks are substituted 34563>>>>>>>// for leading zeros (zf=zero fill): 34563>>>>>>>Function IntToStrRzf global number src# integer len# returns string 34565>>>>>>> function_return (replaces(" ",NumToStrR(src#,0,len#),"0")) // Fixed, Magnus Bergh 34566>>>>>>>End_Function 34567>>>>>>> 34567>>>>>>>Function NumToStrRzf global number src# integer dcp# integer len# returns string 34569>>>>>>> function_return (replaces(" ",NumToStrR(src#,dcp#,len#),"0")) 34570>>>>>>>End_Function 34571>>>>>>> 34571>>>>>>>// Use this to obtain the number of the least significant "non zero 34571>>>>>>>// decimal in src#. 0.702 will return 3 while 100 will return -2: 34571>>>>>>>Function NumberOfDecs global number src# returns integer 34573>>>>>>> integer count# 34573>>>>>>> string tmp# radix# 34573>>>>>>> if src# eq 0 function_return 0 // Special case 34576>>>>>>> move src# to tmp# // This removes superflous decimals 34577>>>>>>> get_attribute DF_DECIMAL_SEPARATOR to count# // Overload 34580>>>>>>> character count# to radix# // End overload 34581>>>>>>>> 34581>>>>>>> if radix# in src# function_return (length(tmp#)-pos(radix#,tmp#)) 34584>>>>>>> move 0 to count# 34585>>>>>>> while (right(tmp#,1)="0") 34589>>>>>>> move (left(tmp#,length(tmp#)-1)) to tmp# 34590>>>>>>> decrement count# 34591>>>>>>> end 34592>>>>>>>> 34592>>>>>>> function_return count# 34593>>>>>>>End_Function 34594>>>>>>> 34594>>>>>>>Function CurrentDecimalSeparator global returns string 34596>>>>>>> integer rval# 34596>>>>>>> get_attribute DF_DECIMAL_SEPARATOR to rval# 34599>>>>>>> function_return (character(rval#)) 34600>>>>>>>End_Function 34601>>>>>>> 34601>>>>>>>Procedure Set CurrentDecimalSeparator global string value# 34603>>>>>>> set_attribute DF_DECIMAL_SEPARATOR to (ascii(value#)) 34606>>>>>>>End_Procedure 34607>>>>>>> 34607>>>>>>> 34607>>>>>>>// StripFromLastOccurance takes two strings (src# and val#) as 34607>>>>>>>// arguments. src# is scanned backwards for occurrances of substring 34607>>>>>>>// val#. If found, the function will return a string equal to src# 34607>>>>>>>// truncated at the first character of the right most occurance of substring 34607>>>>>>>// val#. 34607>>>>>>>// 34607>>>>>>>// StripFromLastOccurance("To be or not to be...","be") = "To be or not to " 34607>>>>>>>// StripFromLastOccurance("Mary had a little lamb","white") = "" 34607>>>>>>>// StripFromLastOccurance("Mary had a little lamb","") = "Mary had a little lamb" 34607>>>>>>>// 34607>>>>>>>Function StripFromLastOccurance global string src# string val# returns string 34609>>>>>>> integer len# search_len# 34609>>>>>>> string tmp# 34609>>>>>>> length val# to search_len# 34610>>>>>>>> 34610>>>>>>> if search_len# eq 0 function_return src# 34613>>>>>>> repeat 34613>>>>>>>> 34613>>>>>>> length src# to len# 34614>>>>>>>> 34614>>>>>>> if len# le search_len# function_return "" 34617>>>>>>> move (right(src#,search_len#)) to tmp# 34618>>>>>>> if tmp# eq val# function_return (left(src#,len#-search_len#)) 34621>>>>>>> move (left(src#,len#-1)) to src# 34622>>>>>>> loop 34623>>>>>>>> 34623>>>>>>>End_Function 34624>>>>>>> 34624>>>>>>>Function GetFromLastOccurance global string src# string val# returns string 34626>>>>>>> function_return (replace(StripFromLastOccurance(src#,val#),src#,"")) 34627>>>>>>>End_Function 34628>>>>>>> 34628>>>>>>>// (ExtractWord("item1 item2"," ",0)) = "" 34628>>>>>>>// (ExtractWord("item1 item2"," ",1)) = "item1" 34628>>>>>>>// (ExtractWord("item1 item2"," ",2)) = "item2" 34628>>>>>>>// (ExtractWord("item1 item2"," ",3)) = "" 34628>>>>>>>// (ExtractWord(" item1 item2 "," ",x)) = 34628>>>>>>>// (ExtractWord("item1 item2"," ",x)) 34628>>>>>>>// 34628>>>>>>> // source delimiters item number 34628>>>>>>>Function ExtractWord global string src# string dlm# integer itm# returns string 34630>>>>>>> integer count# pos# in_item# len# 34630>>>>>>> string rval# atom# 34630>>>>>>> move "" to rval# 34631>>>>>>> move 0 to count# 34632>>>>>>> move 0 to in_item# 34633>>>>>>> move (length(src#)) to len# 34634>>>>>>> for pos# from 1 to len# 34640>>>>>>>> 34640>>>>>>> mid src# to atom# 1 pos# 34643>>>>>>>> 34643>>>>>>> if in_item# begin 34645>>>>>>> if atom# in dlm# move 0 to in_item# 34648>>>>>>> else if count# eq itm# append rval# atom# 34652>>>>>>> end 34652>>>>>>>> 34652>>>>>>> else begin 34653>>>>>>> ifnot atom# in dlm# begin 34655>>>>>>> increment count# 34656>>>>>>> move 1 to in_item# 34657>>>>>>> if count# eq itm# move atom# to rval# 34660>>>>>>> end 34660>>>>>>>> 34660>>>>>>> end 34660>>>>>>>> 34660>>>>>>> loop 34661>>>>>>>> 34661>>>>>>> function_return rval# 34662>>>>>>>End_Function 34663>>>>>>> 34663>>>>>>>Function ExtractItem global string src# string dlm# integer itm# returns string 34665>>>>>>> Function_Return (ExtractWord(src#,dlm#,itm#)) 34666>>>>>>>End_Function 34667>>>>>>> // source delimiters 34667>>>>>>>Function HowManyWords global string src# string dlm# returns integer 34669>>>>>>> integer count# pos# in_item# len# 34669>>>>>>> string atom# 34669>>>>>>> move 0 to count# 34670>>>>>>> move 0 to in_item# 34671>>>>>>> move (length(src#)) to len# 34672>>>>>>> for pos# from 1 to len# 34678>>>>>>>> 34678>>>>>>> mid src# to atom# 1 pos# 34681>>>>>>>> 34681>>>>>>> if in_item# begin 34683>>>>>>> if atom# in dlm# move 0 to in_item# 34686>>>>>>> end 34686>>>>>>>> 34686>>>>>>> else begin 34687>>>>>>> ifnot atom# in dlm# begin 34689>>>>>>> increment count# 34690>>>>>>> move 1 to in_item# 34691>>>>>>> end 34691>>>>>>>> 34691>>>>>>> end 34691>>>>>>>> 34691>>>>>>> loop 34692>>>>>>>> 34692>>>>>>> function_return count# 34693>>>>>>>end_function 34694>>>>>>>Function HowManyItems global string src# string dlm# returns integer 34696>>>>>>> function_return (HowManyWords(src#,dlm#)) 34697>>>>>>>end_function 34698>>>>>>> 34698>>>>>>>Function ExtractWord2 global string src# string dlm# integer itm# returns string 34700>>>>>>> integer count# pos# len# 34700>>>>>>> string rval# char# 34700>>>>>>> move "" to rval# 34701>>>>>>> move 1 to count# 34702>>>>>>> move (length(src#)) to len# 34703>>>>>>> for pos# from 1 to len# 34709>>>>>>>> 34709>>>>>>> mid src# to char# 1 pos# 34712>>>>>>>> 34712>>>>>>> if char# in dlm# begin 34714>>>>>>> if itm# eq count# function_return rval# 34717>>>>>>> increment count# 34718>>>>>>> end 34718>>>>>>>> 34718>>>>>>> else if itm# eq count# move (rval#+char#) to rval# 34722>>>>>>> loop 34723>>>>>>>> 34723>>>>>>> function_return rval# 34724>>>>>>>End_Function 34725>>>>>>> // source delimiters 34725>>>>>>>Function HowManyWords2 global string src# string dlm# returns integer 34727>>>>>>> integer count# pos# len# 34727>>>>>>> string char# 34727>>>>>>> move 1 to count# 34728>>>>>>> move (length(src#)) to len# 34729>>>>>>> for pos# from 1 to len# 34735>>>>>>>> 34735>>>>>>> mid src# to char# 1 pos# 34738>>>>>>>> 34738>>>>>>> if char# in dlm# increment count# 34741>>>>>>> loop 34742>>>>>>>> 34742>>>>>>> function_return count# 34743>>>>>>>end_function 34744>>>>>>> // source legal char item number 34744>>>>>>>Function ExtractItemNeg global string src# string lch# integer itm# returns string 34746>>>>>>> integer count# pos# in_item# len# 34746>>>>>>> string rval# atom# 34746>>>>>>> move "" to rval# 34747>>>>>>> move 0 to count# 34748>>>>>>> move 0 to in_item# 34749>>>>>>> move (length(src#)) to len# 34750>>>>>>> for pos# from 1 to len# 34756>>>>>>>> 34756>>>>>>> mid src# to atom# 1 pos# 34759>>>>>>>> 34759>>>>>>> if in_item# begin 34761>>>>>>> ifnot atom# in lch# move 0 to in_item# 34764>>>>>>> else if count# eq itm# append rval# atom# 34768>>>>>>> end 34768>>>>>>>> 34768>>>>>>> else begin 34769>>>>>>> if atom# in lch# begin 34771>>>>>>> increment count# 34772>>>>>>> move 1 to in_item# 34773>>>>>>> if count# eq itm# move atom# to rval# 34776>>>>>>> end 34776>>>>>>>> 34776>>>>>>> end 34776>>>>>>>> 34776>>>>>>> loop 34777>>>>>>>> 34777>>>>>>> function_return rval# 34778>>>>>>>end_function 34779>>>>>>> 34779>>>>>>>// ExtractInteger("123 456 789",0) = 0 34779>>>>>>>// ExtractInteger("123 456 789",2) = 456 34779>>>>>>>// ExtractInteger("123 456 789",4) = 0 34779>>>>>>> 34779>>>>>>>function ExtractInteger global string str# integer itm# returns integer 34781>>>>>>> function_return (integer(ExtractItemNeg(str#,"0123456789",itm#))) 34782>>>>>>>end_function 34783>>>>>>> 34783>>>>>>>function HowManyIntegers global string str# returns integer 34785>>>>>>> integer rval# pos# len# in_int# 34785>>>>>>> move 0 to in_int# //in integer? 34786>>>>>>> move 0 to rval# 34787>>>>>>> move (length(str#)) to len# 34788>>>>>>> for pos# from 1 to len# 34794>>>>>>>> 34794>>>>>>> if (mid(str#,1,pos#)) in "0123456789" begin 34796>>>>>>> ifnot in_int# begin 34798>>>>>>> increment rval# 34799>>>>>>> move 1 to in_int# 34800>>>>>>> end 34800>>>>>>>> 34800>>>>>>> end 34800>>>>>>>> 34800>>>>>>> else if in_int# move 0 to in_int# 34804>>>>>>> loop 34805>>>>>>>> 34805>>>>>>> function_return rval# 34806>>>>>>>end_function 34807>>>>>>> 34807>>>>>>>function IsIntegerPresent global string str# integer int# returns integer 34809>>>>>>> integer max# itm# 34809>>>>>>> if str# eq "" function_return 0 34812>>>>>>> move (HowManyIntegers(str#)) to max# 34813>>>>>>> for itm# from 1 to max# 34819>>>>>>>> 34819>>>>>>> if (ExtractInteger(str#,itm#)=int#) function_return 1 34822>>>>>>> loop 34823>>>>>>>> 34823>>>>>>> function_return 0 34824>>>>>>>end_function 34825>>>>>>> 34825>>>>>>>function AddIntegerToString global string str# integer int# returns string 34827>>>>>>> function_return (trim(str#+" "+string(int#))) 34828>>>>>>>end_function 34829>>>>>>> 34829>>>>>>>// This function is used to compose a new string from an existing string. This 34829>>>>>>>// is similar to the way Windows 95 generates 8.3 file names. 34829>>>>>>> 34829>>>>>>>// For example: StringIncrementId("STURE",8) = "STURE ~1" 34829>>>>>>>// StringIncrementId("STURE ~1",8) = "STURE ~2" 34829>>>>>>>// StringIncrementId("STURE ~2",8) = "STURE ~3" 34829>>>>>>>// etc... 34829>>>>>>>function StringIncrementId global string id# integer len# returns string 34831>>>>>>> string char# 34831>>>>>>> if (mid(id#,1,len#-1)) eq "~" begin 34833>>>>>>> move (mid(id#,1,len#)) to char# 34834>>>>>>> if (ascii(char#)) lt 93 function_return (overstrike(character(ascii(char#)+1),id#,len#)) 34837>>>>>>> else function_return "" 34839>>>>>>> end 34839>>>>>>>> 34839>>>>>>> function_return (overstrike("~1",id#,len#-1)) 34840>>>>>>>end_function 34841>>>>>>> 34841>>>>>>>function StringUppercaseFirstLetters global string str# returns string 34843>>>>>>> integer len# pos# in_word# 34843>>>>>>> string rval# char# 34843>>>>>>> move (lowercase(str#)) to str# 34844>>>>>>> move (length(str#)) to len# 34845>>>>>>> move 0 to in_word# 34846>>>>>>> for pos# from 1 to len# 34852>>>>>>>> 34852>>>>>>> move (mid(str#,1,pos#)) to char# 34853>>>>>>> if char# eq "" move 0 to in_word# 34856>>>>>>> else begin 34857>>>>>>> ifnot in_word# begin 34859>>>>>>> uppercase char# to char# 34860>>>>>>>> 34860>>>>>>> move 1 to in_word# 34861>>>>>>> end 34861>>>>>>>> 34861>>>>>>> end 34861>>>>>>>> 34861>>>>>>> move (rval#+char#) to rval# 34862>>>>>>> loop 34863>>>>>>>> 34863>>>>>>> function_return rval# 34864>>>>>>>end_function 34865>>>>>>> 34865>>>>>>>function StringLeftBut global string str# integer but# returns string 34867>>>>>>> function_return (left(str#,length(str#)-but# max 0)) 34868>>>>>>>end_function 34869>>>>>>> 34869>>>>>>>function StringRightBut global string str# integer but# returns string 34871>>>>>>> function_return (right(str#,length(str#)-but# max 0)) 34872>>>>>>>end_function 34873>>>>>>> 34873>>>>>>>//> This function returns 1 if lsString is an integer and 2 if it 34873>>>>>>>//> is a number (the function does not currently handle thousand seps) 34873>>>>>>>function StringIsNumber global string lsString integer liDecSep returns integer 34875>>>>>>> integer liLen liPos liDecSepFound liRval 34875>>>>>>> string lsChar 34875>>>>>>> move 1 to liRval 34876>>>>>>> move 0 to liDecSepFound 34877>>>>>>> move (trim(lsString)) to lsString 34878>>>>>>> if (left(lsString,1)="-") move (replace("-",lsString,"")) to lsString 34881>>>>>>> move (length(lsString)) to liLen 34882>>>>>>> for liPos from 1 to liLen 34888>>>>>>>> 34888>>>>>>> move (mid(lsString,1,liPos)) to lsChar 34889>>>>>>> if (ascii(lsChar)) eq liDecSep begin 34891>>>>>>> if liDecSepFound function_return 0 34894>>>>>>> move 1 to liDecSepFound 34895>>>>>>> end 34895>>>>>>>> 34895>>>>>>> else ifnot ("0123456789" contains lsChar) function_return 0 34899>>>>>>> loop 34900>>>>>>>> 34900>>>>>>> function_return liRval 34901>>>>>>>end_function 34902>>>>>>>function StringIsInteger global string lsString returns integer 34904>>>>>>> integer liPos liLen 34904>>>>>>> move (trim(lsString)) to lsString 34905>>>>>>> if (left(lsString,1)="-") move (replace("-",lsString,"")) to lsString 34908>>>>>>> move (length(lsString)) to liLen 34909>>>>>>> for liPos from 1 to liLen 34915>>>>>>>> 34915>>>>>>> ifnot (pos(mid(lsString,1,liPos),"0123456789")) function_return DFFALSE 34918>>>>>>> loop 34919>>>>>>>> 34919>>>>>>> function_return DFTRUE 34920>>>>>>>end_function 34921>>>>>>> 34921>>>>>>>function StringFieldType global integer liType returns string 34923>>>>>>> if liType eq DF_ASCII function_return "ASCII" 34926>>>>>>> if liType eq DF_BCD function_return "Number" 34929>>>>>>> if liType eq DF_DATE function_return "Date" 34932>>>>>>> if liType eq DF_OVERLAP function_return "Overlap" 34935>>>>>>> if liType eq DF_TEXT function_return "Text" 34938>>>>>>> if liType eq DF_BINARY function_return "Binary" 34941>>>>>>> function_return "Un-defined" 34942>>>>>>>end_function 34943>>>>>>> 34943>>>>>>>function StringFieldLenText global integer liType integer liLen integer liDec returns string 34945>>>>>>> if liType eq DF_BCD function_return (NumToStr(liLen+(liDec/10.0),1)) 34948>>>>>>> else function_return (string(liLen)) 34950>>>>>>>end_function 34951>>>>>>>function StringFieldText global integer liType integer liLen integer liDec returns string 34953>>>>>>> string lsRval 34953>>>>>>> move "# (#)" to lsRval 34954>>>>>>> replace "#" in lsRval with (StringFieldType(liType)) 34956>>>>>>> replace "#" in lsRval with (StringFieldLenText(liType,liLen,liDec)) 34958>>>>>>> function_return lsRval 34959>>>>>>>end_function 34960>>>>>>> 34960>>>>>>> 34960>>>>>>>function StringConsistsOf global string src# string tpl# returns integer 34962>>>>>>> integer count# len# 34962>>>>>>> trim src# to src# 34963>>>>>>>> 34963>>>>>>> move (length(src#)) to len# 34964>>>>>>> for count# from 1 to len# 34970>>>>>>>> 34970>>>>>>> ifnot (mid(src#,1,count#)) in tpl# function_return 0 34973>>>>>>> loop 34974>>>>>>>> 34974>>>>>>> function_return 1 34975>>>>>>>end_function 34976>>>>>>> 34976>>>>>>>function StringBeginsWith global string lsHostString string lsLeadInCharacters returns integer 34978>>>>>>> function_return (left(lsHostString,length(lsLeadInCharacters))=lsLeadInCharacters) 34979>>>>>>>end_function 34980>>>>>>> 34980>>>>>>>function StringEndsWith global string lsHostString string lsTrailingCharacters returns integer 34982>>>>>>> function_return (right(lsHostString,length(lsTrailingCharacters))=lsTrailingCharacters) 34983>>>>>>>end_function 34984>>>>>>> 34984>>>>>>>function StringReverse global string lsValue returns string 34986>>>>>>> integer liLen liPos 34986>>>>>>> string lsRval lsChar 34986>>>>>>> move "" to lsRval 34987>>>>>>> move (length(lsValue)) to liLen 34988>>>>>>> for_ex liPos from liLen down_to 1 34995>>>>>>> move (lsRval+mid(lsValue,1,liPos)) to lsRval 34996>>>>>>> loop 34997>>>>>>>> 34997>>>>>>> function_return lsRval 34998>>>>>>>end_function 34999>>>>>>> 34999>>>>>>>function StringHead global string lsValue string lsDlm returns string 35001>>>>>>> integer liLen liPos 35001>>>>>>> move (length(lsValue)) to liLen 35002>>>>>>> for liPos from 1 to liLen 35008>>>>>>>> 35008>>>>>>> if (lsDlm contains mid(lsValue,1,liPos)) function_return (left(lsValue,liPos-1)) 35011>>>>>>> loop 35012>>>>>>>> 35012>>>>>>> function_return lsValue 35013>>>>>>>end_function 35014>>>>>>> 35014>>>>>>>function StringTail global string lsValue string lsDlm returns string 35016>>>>>>> integer liLen liPos 35016>>>>>>> move (length(lsValue)) to liLen 35017>>>>>>> for liPos from 1 to liLen 35023>>>>>>>> 35023>>>>>>> if (lsDlm contains mid(lsValue,1,liPos)) function_return (right(lsValue,liLen-liPos)) 35026>>>>>>> loop 35027>>>>>>>> 35027>>>>>>> function_return "" 35028>>>>>>>end_function 35029>>>>>>> 35029>>>>>>>// If function ConvertChar is not already defined we define it here: 35029>>>>>>> use WinBase Including file: Winbase.pkg (C:\Programmer\Visual DataFlex 12.0\Pkg\Winbase.pkg) 35029>>>>>>>>>Use VDfBase.pkg 35029>>>>>>>>> 35029>>>>>>>>> 35029>>>>>>>>>//************************************************************************* 35029>>>>>>>>>//* 35029>>>>>>>>>//* Copyright (c) 1997 Data Access Corporation, Miami Florida, 35029>>>>>>>>>//* All rights reserved. 35029>>>>>>>>>//* DataFlex is a registered trademark of Data Access Corporation. 35029>>>>>>>>>//* 35029>>>>>>>>>//************************************************************************* 35029>>>>>>>>>//* 35029>>>>>>>>>//* Module Name: 35029>>>>>>>>>//* WINDOWS.PKG 35029>>>>>>>>>//* 35029>>>>>>>>>//* Creator: 35029>>>>>>>>>//* DataFlex 4.0 Development Team 35029>>>>>>>>>//* 01/01/1997 35029>>>>>>>>>//* 35029>>>>>>>>>//* Purpose: 35029>>>>>>>>>//* DataFlex 4.0 Windows classes and constants 35029>>>>>>>>>//* 35029>>>>>>>>>//* 07/23/96 JJT - New Class names 35029>>>>>>>>>//************************************************************************* 35029>>>>>>>>> 35029>>>>>>>>>//use ui 35029>>>>>>>>> 35029>>>>>>>>>//// This replacement creates an alternate symbol for Current_Object as used 35029>>>>>>>>>//// in message addressing. Future revisions of VDF will use SELF as the 35029>>>>>>>>>//// preferred addressing reference. 35029>>>>>>>>>//// 35029>>>>>>>>>//#replace SELF CURRENT_OBJECT 35029>>>>>>>>> 35029>>>>>>>>>//// this allows meta system to know about the runtime classes. 35029>>>>>>>>> 35029>>>>>>>>>//Use BaseData_Set.pkg // defines RT baseData_set 35029>>>>>>>>> 35029>>>>>>>>>//// define class used throughout system for mixins 35029>>>>>>>>>//Class Mixin Is A cObject 35029>>>>>>>>>//End_Class 35029>>>>>>>>> 35029>>>>>>>>>//Use ErrorNum.inc // allows all packages to use symbolic names for errors. 35029>>>>>>>>>//use registry.pkg // (obsolete) this just has defintiions of registry commands and constants 35029>>>>>>>>>//use dll.pkg // support for Dll stuff 35029>>>>>>>>>//use InetTransfer.pkg // add defintions for Internet transfer classes 35029>>>>>>>>> 35029>>>>>>>>>////* Justification modes */ 35029>>>>>>>>> 35029>>>>>>>>>//#REPLACE JMODE_LEFT |CI0 35029>>>>>>>>>//#REPLACE JMODE_CENTER |CI1 35029>>>>>>>>>//#REPLACE JMODE_RIGHT |CI2 35029>>>>>>>>>//#REPLACE JMODE_TOP |CI4 35029>>>>>>>>>//#REPLACE JMODE_BOTTOM |CI8 35029>>>>>>>>>//#REPLACE JMODE_VCENTER |CI512 //12 35029>>>>>>>>>//#REPLACE JMODE_WRAP |CI16 35029>>>>>>>>> 35029>>>>>>>>>//// New Justification modes - undocumented vertical-center by MS 35029>>>>>>>>>////#REPLACE jmCenter $0001 35029>>>>>>>>>////#REPLACE jmVCenter $1000 35029>>>>>>>>>////#REPLACE jmAllCenter $1001 35029>>>>>>>>> 35029>>>>>>>>>////* Form Justificationmodes */ 35029>>>>>>>>>//#REPLACE FORM_DISPLAYLEFT |CI0 35029>>>>>>>>>//#REPLACE FORM_DISPLAYCENTER |CI$0001 35029>>>>>>>>>//#REPLACE FORM_DISPLAYRIGHT |CI$0002 35029>>>>>>>>>//#REPLACE FORM_EDITLEFT |CI$0000 35029>>>>>>>>>//#REPLACE FORM_EDITRIGHT |CI$0800 35029>>>>>>>>> 35029>>>>>>>>>////* Button Aspects */ 35029>>>>>>>>>//#REPLACE BASPECT_NONE |CI0 35029>>>>>>>>>//#REPLACE BASPECT_PUSHBUTTON |CI1 35029>>>>>>>>>//#REPLACE BASPECT_CHECKBOX |CI2 35029>>>>>>>>>//#REPLACE BASPECT_RADIO |CI3 35029>>>>>>>>>//#REPLACE BASPECT_TRISTATE |CI4 35029>>>>>>>>>//#REPLACE BASPECT_PULLDOWN |CI5 35029>>>>>>>>>//#REPLACE BASPECT_COMBOBUTTON |CI6 35029>>>>>>>>>//#REPLACE BASPECT_FORM |CI7 35029>>>>>>>>>//#REPLACE BASPECT_COMBOFORM |CI8 35029>>>>>>>>>//#REPLACE BASPECT_ACTIONBAR |CI9 35029>>>>>>>>> 35029>>>>>>>>> 35029>>>>>>>>>//#REPLACE BASPECT_MULTI |CI128 35029>>>>>>>>>//#REPLACE BASPECT_PUSHBUTTONLIST |CI129 35029>>>>>>>>>//#REPLACE BASPECT_CHECKLIST |CI130 35029>>>>>>>>>//#REPLACE BASPECT_RADIOLIST |CI131 35029>>>>>>>>>//#REPLACE BASPECT_TRISTATELIST |CI132 35029>>>>>>>>> 35029>>>>>>>>>//// Map modes 35029>>>>>>>>>//#REPLACE MAP_DEVICE |CI0 35029>>>>>>>>>//#REPLACE MAP_CHARACTER |CI1 35029>>>>>>>>>//#REPLACE MAP_DIALOG |CI2 35029>>>>>>>>>//#REPLACE MAP_RATIO |CI3 35029>>>>>>>>> 35029>>>>>>>>>////* Borders */ 35029>>>>>>>>>//#REPLACE BORDER_NONE |CI0 35029>>>>>>>>>//#REPLACE BORDER_NORMAL |CI1 35029>>>>>>>>>//#REPLACE BORDER_DIALOG |CI2 35029>>>>>>>>>//#REPLACE BORDER_THICK |CI3 35029>>>>>>>>>//#REPLACE BORDER_CLIENTEDGE |CI4 35029>>>>>>>>>//#REPLACE BORDER_WINDOWEDGE |CI5 35029>>>>>>>>>//#REPLACE BORDER_STATICEDGE |CI6 35029>>>>>>>>> 35029>>>>>>>>>////* View Modes */ 35029>>>>>>>>>//#REPLACE VIEWMODE_NORMAL |CI0 35029>>>>>>>>>//#REPLACE VIEWMODE_ICONIZE |CI1 35029>>>>>>>>>//#REPLACE VIEWMODE_ZOOM |CI2 35029>>>>>>>>> 35029>>>>>>>>>//// Data Types 35029>>>>>>>>>//#REPLACE DATE_WINDOW |CI128 35029>>>>>>>>>//#REPLACE ASCII_WINDOW |CI255 35029>>>>>>>>> 35029>>>>>>>>>//// Make Proportional constants 35029>>>>>>>>> 35029>>>>>>>>>//#REPLACE MP_SIZE |CI0 // the window was resized 35029>>>>>>>>>//#REPLACE MP_ACTIONBAR |CI1 // an action bar was added or deleted 35029>>>>>>>>>//#REPLACE MP_BORDER |CI2 // the border style was changed 35029>>>>>>>>>//#REPLACE MP_CAPTION |CI3 // the caption_bar was added or deleted 35029>>>>>>>>>//#REPLACE MP_MAPMODE |CI4 // switched to map_ratio 35029>>>>>>>>>//#REPLACE MP_MAPRATIOS |CI5 // program changed ratios with message 35029>>>>>>>>> 35029>>>>>>>>>//// ImageList constants 35029>>>>>>>>>//#REPLACE ILC_MASK |CI$0001 35029>>>>>>>>>//#REPLACE ILC_COLOR |CI$0000 35029>>>>>>>>>//#REPLACE ILC_COLORDDB |CI$00FE 35029>>>>>>>>>//#REPLACE ILC_COLOR4 |CI$0004 35029>>>>>>>>>//#REPLACE ILC_COLOR8 |CI$0008 35029>>>>>>>>>//#REPLACE ILC_COLOR16 |CI$0010 35029>>>>>>>>>//#REPLACE ILC_COLOR24 |CI$0018 35029>>>>>>>>>//#REPLACE ILC_COLOR32 |CI$0020 35029>>>>>>>>>//#REPLACE ILC_PALETTE |CI$0800 35029>>>>>>>>> 35029>>>>>>>>>//// Buttonbar constants 35029>>>>>>>>>//// Button Styles 35029>>>>>>>>>//#REPLACE TBSTYLE_BUTTON 0 35029>>>>>>>>>//#REPLACE TBSTYLE_SEP 1 35029>>>>>>>>>//#REPLACE TBSTYLE_CHECK 2 35029>>>>>>>>>//#REPLACE TBSTYLE_GROUP 4 35029>>>>>>>>>//#REPLACE TBSTYLE_CHECKGROUP (TBSTYLE_GROUP IOR TBSTYLE_CHECK) 35029>>>>>>>>> 35029>>>>>>>>>//#REPLACE IDB_STANDARD 1 35029>>>>>>>>>//#REPLACE IDB_VIEW 2 35029>>>>>>>>>//#REPLACE IDB_SMALL 0 35029>>>>>>>>>//#REPLACE IDB_LARGE 4 35029>>>>>>>>> 35029>>>>>>>>>//// icon indexes for standard bitmaps 35029>>>>>>>>>//#REPLACE ICO_STD_CUT 0 35029>>>>>>>>>//#REPLACE ICO_STD_COPY 1 35029>>>>>>>>>//#REPLACE ICO_STD_PASTE 2 35029>>>>>>>>>//#REPLACE ICO_STD_UNDO 3 35029>>>>>>>>>//#REPLACE ICO_STD_REDOW 4 35029>>>>>>>>>//#REPLACE ICO_STD_DELETE 5 35029>>>>>>>>>//#REPLACE ICO_STD_FILENEW 6 35029>>>>>>>>>//#REPLACE ICO_STD_FILEOPEN 7 35029>>>>>>>>>//#REPLACE ICO_STD_FILESAVE 8 35029>>>>>>>>>//#REPLACE ICO_STD_PRINTPRE 9 35029>>>>>>>>>//#REPLACE ICO_STD_PROPERTIES 10 35029>>>>>>>>>//#REPLACE ICO_STD_HELP 11 35029>>>>>>>>>//#REPLACE ICO_STD_FIND 12 35029>>>>>>>>>//#REPLACE ICO_STD_REPLACE 13 35029>>>>>>>>>//#REPLACE ICO_STD_PRINT 14 35029>>>>>>>>> 35029>>>>>>>>>//// icon indexes for standard view bitmaps 35029>>>>>>>>>//#REPLACE ICO_VIEW 15 35029>>>>>>>>>//#REPLACE ICO_VIEW_LARGEICONS (ICO_VIEW + 0) 35029>>>>>>>>>//#REPLACE ICO_VIEW_SMALLICONS (ICO_VIEW + 1) 35029>>>>>>>>>//#REPLACE ICO_VIEW_LIST (ICO_VIEW + 2) 35029>>>>>>>>>//#REPLACE ICO_VIEW_DETAILS (ICO_VIEW + 3) 35029>>>>>>>>>//#REPLACE ICO_VIEW_SORTNAME (ICO_VIEW + 4) 35029>>>>>>>>>//#REPLACE ICO_VIEW_SORTSIZE (ICO_VIEW + 5) 35029>>>>>>>>>//#REPLACE ICO_VIEW_SORTDATE (ICO_VIEW + 6) 35029>>>>>>>>>//#REPLACE ICO_VIEW_SORTTYPE (ICO_VIEW + 7) 35029>>>>>>>>>//#REPLACE ICO_VIEW_PARENTFOLDER (ICO_VIEW + 8) 35029>>>>>>>>>//#REPLACE ICO_VIEW_NETCONNECT (ICO_VIEW + 9) 35029>>>>>>>>>//#REPLACE ICO_VIEW_NETDISCONNECT (ICO_VIEW + 10) 35029>>>>>>>>>//#REPLACE ICO_VIEW_NEWFOLDER (ICO_VIEW + 11) 35029>>>>>>>>> 35029>>>>>>>>>//#REPLACE ICO_USER (ICO_VIEW_NEWFOLDER+1) 35029>>>>>>>>> 35029>>>>>>>>>//// MAPI constants 35029>>>>>>>>>//#REPLACE MAPI_ORIG 0 // Recipient is message originator 35029>>>>>>>>>//#REPLACE MAPI_TO 1 // Recipient is a primary recipient 35029>>>>>>>>>//#REPLACE MAPI_CC 2 // Recipient is a copy recipient 35029>>>>>>>>>//#REPLACE MAPI_BCC 3 // Recipient is blind copy recipient 35029>>>>>>>>> 35029>>>>>>>>>//#replace MAPI_DIALOG |CI$00000008 35029>>>>>>>>> 35029>>>>>>>>>//#replace MAPI_LOGON_UI |CI$00000001 35029>>>>>>>>>//#replace MAPI_PASSWORD_UI |CI$00020000 35029>>>>>>>>>//#replace MAPI_NEW_SESSION |CI$00000002 35029>>>>>>>>>//#replace MAPI_FORCE_DOWNLOAD |CI$00001000 35029>>>>>>>>>//#replace MAPI_ALLOW_OTHERS |CI$00000008 35029>>>>>>>>>//#replace MAPI_EXPLICIT_PROFILE |CI$00000010 35029>>>>>>>>>//#replace MAPI_EXTENDED |CI$00000020 35029>>>>>>>>>//#replace MAPI_USE_DEFAULT |CI$00000040 35029>>>>>>>>> 35029>>>>>>>>>//#replace MAPI_SIMPLE_DEFAULT (MAPI_LOGON_UI + MAPI_FORCE_DOWNLOAD + MAPI_ALLOW_OTHERS) 35029>>>>>>>>>//#replace MAPI_SIMPLE_EXPLICIT (MAPI_NEW_SESSION + MAPI_FORCE_DOWNLOAD + MAPI_EXPLICIT_PROFILE) 35029>>>>>>>>> 35029>>>>>>>>>//// MAPIFindNext() flags. 35029>>>>>>>>>//#replace MAPI_UNREAD_ONLY (|CI$00000020) 35029>>>>>>>>>//#replace MAPI_GUARANTEE_FIFO |CI$00000100 35029>>>>>>>>>//#replace MAPI_LONG_MSGID |CI$00004000 35029>>>>>>>>> 35029>>>>>>>>>//// MAPIReadMail() flags. 35029>>>>>>>>>//#replace MAPI_PEEK |CI$00000080 35029>>>>>>>>>//#replace MAPI_SUPPRESS_ATTACH |CI$00000800 35029>>>>>>>>>//#replace MAPI_BODY_AS_FILE |CI$00000200 35029>>>>>>>>> 35029>>>>>>>>>//#replace MAPI_ENVELOPE_ONLY |CI$00000040 35029>>>>>>>>> 35029>>>>>>>>>//// Masked Edit control constants 35029>>>>>>>>>//#REPLACE MASK_BOOLEAN_WINDOW 512 35029>>>>>>>>>//#REPLACE MASK_CLOCK_WINDOW 1024 35029>>>>>>>>>//#REPLACE MASK_CURRENCY_WINDOW 2048 35029>>>>>>>>>//#REPLACE MASK_DATE_WINDOW 4096 35029>>>>>>>>>//#REPLACE MASK_DATETIME_WINDOW 8192 35029>>>>>>>>>//#REPLACE MASK_WINDOW 16384 35029>>>>>>>>>//#REPLACE MASK_NUMERIC_WINDOW 32768 35029>>>>>>>>>//#REPLACE MASK_TIME 65536 35029>>>>>>>>> 35029>>>>>>>>>//// Form Button constants 35029>>>>>>>>>//#REPLACE FORM_BUTTON_NONE 0 35029>>>>>>>>>//#REPLACE FORM_BUTTON_PROMPT 1 35029>>>>>>>>>//#REPLACE FORM_BUTTON_SPIN 2 35029>>>>>>>>>//#REPLACE FORM_BUTTON_SPIN_WRAP 3 35029>>>>>>>>> 35029>>>>>>>>>//// Grid Modes 35029>>>>>>>>>//#REPLACE GRID_VISIBLE_NONE 0 35029>>>>>>>>>//#REPLACE GRID_VISIBLE_HORZ 1 35029>>>>>>>>>//#REPLACE GRID_VISIBLE_VERT 2 35029>>>>>>>>>//#REPLACE GRID_VISIBLE_BOTH (GRID_VISIBLE_HORZ+GRID_VISIBLE_VERT) 35029>>>>>>>>> 35029>>>>>>>>>//// Bitmap Styles 35029>>>>>>>>>//#REPLACE BITMAP_ACTUAL 0 // actual size 35029>>>>>>>>>//#REPLACE BITMAP_STRETCH 1 // stretch to client size 35029>>>>>>>>>//#REPLACE BITMAP_CENTER 2 // center in client 35029>>>>>>>>>//#REPLACE BITMAP_TILE 3 // tile inside client 35029>>>>>>>>> 35029>>>>>>>>> 35029>>>>>>>>>//Enum_List 35029>>>>>>>>>// Define anNone for 0 35029>>>>>>>>>// Define anTop for 1 35029>>>>>>>>>// Define anBottom for 2 35029>>>>>>>>>// Define anTopBottom for 3 35029>>>>>>>>>// Define anLeft for 4 35029>>>>>>>>>// Define anTopLeft for 5 35029>>>>>>>>>// Define anBottomLeft for 6 35029>>>>>>>>>// Define anTopBottomLeft for 7 35029>>>>>>>>>// Define anRight for 8 35029>>>>>>>>>// Define anTopRight for 9 35029>>>>>>>>>// Define anBottomRight for 10 35029>>>>>>>>>// Define anTopBottomRight for 11 35029>>>>>>>>>// Define anLeftRight for 12 35029>>>>>>>>>// Define anTopLeftRight for 13 35029>>>>>>>>>// Define anBottomLeftRight for 14 35029>>>>>>>>>// Define anAll for 15 35029>>>>>>>>>//End_Enum_List 35029>>>>>>>>> 35029>>>>>>>>>//// This symbol can be used to detect if an object is in its preconstruction 35029>>>>>>>>>//// phase - before Contruct_Object is called. If BuildingObjectID is GT 0, the 35029>>>>>>>>>//// object is being initialized. The value contained in BuildingObjectID is actually 35029>>>>>>>>>//// the ID of the object currently being initialized. 35029>>>>>>>>>//// 35029>>>>>>>>> 35029>>>>>>>>>//#REPLACE BuildingObjectID |VI105 35029>>>>>>>>> 35029>>>>>>>>>//// flags can be added together. 35029>>>>>>>>> 35029>>>>>>>>>//#replace SHIFT_KEY_DOWN 1 35029>>>>>>>>>//#replace CTRL_KEY_DOWN 2 35029>>>>>>>>>//#replace ALT_KEY_DOWN 4 35029>>>>>>>>> 35029>>>>>>>>> 35029>>>>>>>>> 35029>>>>>>>>>//#REPLACE DRIVE_NOT_AVAILABLE 0 35029>>>>>>>>>//#REPLACE DRIVE_ROOT_NOT_EXIST 1 35029>>>>>>>>>//#REPLACE DRIVE_REMOVABLE 2 35029>>>>>>>>>//#REPLACE DRIVE_FIXED 3 35029>>>>>>>>>//#REPLACE DRIVE_REMOTE 4 35029>>>>>>>>>//#REPLACE DRIVE_CDROM 5 35029>>>>>>>>>//#REPLACE DRIVE_RAMDISK 6 35029>>>>>>>>> 35029>>>>>>>>>//#COMMAND GETDSKINFO RS#DG RC#DG . 35029>>>>>>>>>// !A [] $541 !1 !2 35029>>>>>>>>>//#ENDCOMMAND 35029>>>>>>>>> 35029>>>>>>>>>//// This command is the same as GET_CURRENT_DIRECTORY except that a 35029>>>>>>>>>//// new parameter has been provided to get the directory of any drive. 35029>>>>>>>>>//// if specified drive is 0, the current drive is used. Drive A is 1. 35029>>>>>>>>>//// Usage: Get_Drive_Directory DriveNum to DirString 35029>>>>>>>>> 35029>>>>>>>>>//#COMMAND GET_DRIVE_DIRECTORY _RUND "TO" _RUNRIDCE . 35029>>>>>>>>>// !A [] $54F !3 !1 35029>>>>>>>>>//#ENDCOMMAND 35029>>>>>>>>> 35029>>>>>>>>>//#COMMAND GET_WINDOWS_DIRECTORY "TO" _RUDINEC 35029>>>>>>>>>// !A [] $548 !2 35029>>>>>>>>>//#ENDCOMMAND 35029>>>>>>>>> 35029>>>>>>>>>//#COMMAND GET_PRINTER_SETUP _RUND "TEMP""PERM" "TO" _RUND 35029>>>>>>>>>// #IFSAME !2 PERM 35029>>>>>>>>>// MOVE 1 TO STRMARK 35029>>>>>>>>>// #ELSE 35029>>>>>>>>>// MOVE 0 TO STRMARK 35029>>>>>>>>>// #ENDIF 35029>>>>>>>>>// !A [] $549 !1 !4 35029>>>>>>>>>//#ENDCOMMAND 35029>>>>>>>>> 35029>>>>>>>>>//#COMMAND GET_ICON_COUNT _R "TO" _R 35029>>>>>>>>>// !A [] $54A !1 !3 35029>>>>>>>>>//#ENDCOMMAND 35029>>>>>>>>> 35029>>>>>>>>>//#COMMAND DESTROY_CLASS _RUND . 35029>>>>>>>>>// !A [] $466 !1 35029>>>>>>>>>//#ENDCOMMAND 35029>>>>>>>>> 35029>>>>>>>>>//#COMMAND GRAPHICS_ADJUST_COORDS _R _R . 35029>>>>>>>>>// !A [] $3A9 !1 !2 35029>>>>>>>>>//#ENDCOMMAND 35029>>>>>>>>> 35029>>>>>>>>>//#COMMAND SET_DEFAULT_MAP_MODE "TO" _RDU . 35029>>>>>>>>>// !A [] $54E !2 35029>>>>>>>>>//#ENDCOMMAND 35029>>>>>>>>> 35029>>>>>>>>>//#COMMAND GET_DEFAULT_MAP_MODE "TO" _RDU . 35029>>>>>>>>>// !A [] $550 !2 35029>>>>>>>>>//#ENDCOMMAND 35029>>>>>>>>> 35029>>>>>>>>> 35029>>>>>>>>>//// The GetAddress Command returns the memory address of a DF string 35029>>>>>>>>>//// variable. The command is necessary where external function require 35029>>>>>>>>>//// The address of a string to be passed. 35029>>>>>>>>> 35029>>>>>>>>>Use windows.pkg // this now lives here. (you don't need to ever use this). 35029>>>>>>> Function ConvertChar Global integer bToAnsi String sString Returns String 35031>>>>>>> pointer psString 35031>>>>>>> integer iVoid bIsCString 35031>>>>>>> Move (ascii(Right(sString,1))=0) to bIsCString 35032>>>>>>> If Not bISCString Append sString (character(0)) 35035>>>>>>> GetAddress Of sString To psString 35036>>>>>>> if bToAnsi Move (OEMToANSI(psString,psString)) To iVoid 35039>>>>>>> else Move (ANSItoOEM(psString,psString)) To iVoid 35041>>>>>>> Function_Return (if(bIsCString, sString, cstring(sString))) 35042>>>>>>> End_Function 35043>>>>>>> 35043>>>>>>>function StringAnsiToOem global string str# returns string 35045>>>>>>> function_return (ConvertChar(0,str#)) 35046>>>>>>>end_function 35047>>>>>>> 35047>>>>>>>function StringOemToAnsi global string str# returns string 35049>>>>>>> function_return (ConvertChar(1,str#)) 35050>>>>>>>end_function 35051>>>>>>> 35051>>>>>>>function RemoveDblBlanks global string lsValue returns string 35053>>>>>>> integer fin# 35053>>>>>>> move 0 to fin# 35054>>>>>>> repeat 35054>>>>>>>> 35054>>>>>>> move (replaces(" ",lsValue," ")) to lsValue 35055>>>>>>> ifnot " " in lsValue move 1 to fin# 35058>>>>>>> until fin# 35060>>>>>>> function_return lsValue 35061>>>>>>>end_function 35062>>>>>>> 35062>>>>>>>function ByteToHex global integer byte# returns string 35064>>>>>>> function_return (mid("0123456789ABCDEF",1,byte#/16+1)+mid("0123456789ABCDEF",1,(byte# iand 15)+1)) 35065>>>>>>>end_function 35066>>>>>>> 35066>>>>>>>function HexToByte global string lsHex returns integer 35068>>>>>>> function_return (pos(left(lsHex,1),"0123456789ABCDEF")-1*16+pos(right(lsHex,1),"0123456789ABCDEF")-1) 35069>>>>>>>end_function 35070>>>>>>> 35070>>>>>>>function StringToHex global string lsValue returns string 35072>>>>>>> integer liLen liPos 35072>>>>>>> string lsRval 35072>>>>>>> move (length(lsValue)) to liLen 35073>>>>>>> move "" to lsRval 35074>>>>>>> for liPos from 1 to liLen 35080>>>>>>>> 35080>>>>>>> move (string(lsRval)+string(ByteToHex(ascii(mid(lsValue,1,liPos))))) to lsRval 35081>>>>>>> loop 35082>>>>>>>> 35082>>>>>>> function_return lsRval 35083>>>>>>>end_function 35084>>>>>>> 35084>>>>>>>function HexToString global string lsValue returns string 35086>>>>>>> integer liLen liPos 35086>>>>>>> string lsRval 35086>>>>>>> move (length(lsValue)/2) to liLen 35087>>>>>>> move "" to lsRval 35088>>>>>>> for liPos from 1 to liLen 35094>>>>>>>> 35094>>>>>>> move (string(lsRval)+string(HexToByte(ascii(mid(lsValue,2,liPos*2-1))))) to lsRval 35095>>>>>>> loop 35096>>>>>>>> 35096>>>>>>> function_return lsRval 35097>>>>>>>end_function 35098>>>>>>> 35098>>>>>>>function Text_RemoveTrailingCr global string lsValue returns string 35100>>>>>>> integer fin# 35100>>>>>>> string char# char10# char255# char13# 35100>>>>>>> move 0 to fin# 35101>>>>>>> move (character(10)) to char10# 35102>>>>>>> move (character(13)) to char13# 35103>>>>>>> move (character(255)) to char255# 35104>>>>>>> repeat 35104>>>>>>>> 35104>>>>>>> ifnot (length(lsValue)) function_return "" 35107>>>>>>> move (right(lsValue,1)) to char# 35108>>>>>>> if (char#=char10# or char#=" " or char#=char13# or char#=char255#) move (left(lsValue,(length(lsValue)-1))) to lsValue 35111>>>>>>> else move 1 to fin# 35113>>>>>>> until fin# 35115>>>>>>> function_return lsValue 35116>>>>>>>end_function 35117>>>>>>> 35117>>>>>>>function Text_RTrim global string lsValue returns string 35119>>>>>>> move (rtrim(replaces(character(255),lsValue," "))) to lsValue 35120>>>>>>> function_return (Text_RemoveTrailingCr(lsValue)) 35121>>>>>>>end_function 35122>>>>>>> 35122>>>>>>>function Text_Trim global string lsValue returns string 35124>>>>>>> move (trim(replaces(character(255),lsValue," "))) to lsValue 35125>>>>>>> function_return (Text_RemoveTrailingCr(lsValue)) 35126>>>>>>>end_function 35127>>>>>>> 35127>>>>>>>function Text_Compress global string lsValue returns string 35129>>>>>>> move (replaces(character(10),lsValue," ")) to lsValue 35130>>>>>>> trim lsValue to lsValue 35131>>>>>>>> 35131>>>>>>> move (RemoveDblBlanks(lsValue)) to lsValue 35132>>>>>>> function_return lsValue 35133>>>>>>>end_function 35134>>>>>>> 35134>>>>>>>function Text_CompressSubstCr global string lsValue string new_line# returns string 35136>>>>>>> move (replaces(character(13),lsValue,"")) to lsValue 35137>>>>>>> function_return (RemoveDblBlanks(trim(replaces(character(10),Text_RemoveTrailingCr(lsValue),new_line#)))) 35138>>>>>>>end_function 35139>>>>>>> 35139>>>>>>>class cText_Formatter is an array 35140>>>>>>> procedure construct_object integer img# 35142>>>>>>> forward send construct_object img# 35144>>>>>>> property integer pRmargin public 40 35145>>>>>>> property integer pCompress_state public 0 35146>>>>>>> property integer pTrim_state public 1 // 0=no trim, 1=trim, 2=rtrim 35147>>>>>>> property integer pSubst_below_32_state public 0 35148>>>>>>> end_procedure 35149>>>>>>> 35149>>>>>>> procedure add_item.s string lsValue 35151>>>>>>> integer char# 35151>>>>>>> if (pSubst_below_32_state(self)) begin 35153>>>>>>> for char# from 0 to 31 35159>>>>>>>> 35159>>>>>>> move (replaces(character(char#),lsValue," ")) to lsValue 35160>>>>>>> loop 35161>>>>>>>> 35161>>>>>>> end 35161>>>>>>>> 35161>>>>>>> set array_value item (item_count(self)) to lsValue 35162>>>>>>> end_procedure 35163>>>>>>> 35163>>>>>>> function split_word string lsValue integer len# returns string 35165>>>>>>> integer pos# 35165>>>>>>> string rval# 35165>>>>>>> move (pos("-",lsValue)) to pos# 35166>>>>>>> if (pos# and pos#<=len#) move (replace("-",lsValue," ")) to rval# 35169>>>>>>> else begin 35170>>>>>>> move (left(lsValue,len#)) to rval# 35171>>>>>>> move (rval#+" "+replace(rval#,lsValue,"")) to rval# 35172>>>>>>> end 35172>>>>>>>> 35172>>>>>>> function_return rval# // The space in the return value indicates 35173>>>>>>> end_function // where to split the word 35174>>>>>>> 35174>>>>>>> procedure format.s string lsValue 35176>>>>>>> integer Trim_state# done# pRmargin# word_done# pos# max# len# 35176>>>>>>> string word# line# lf# left# char# 35176>>>>>>> 35176>>>>>>> //pre-format: 35176>>>>>>> get pTrim_state to Trim_state# 35177>>>>>>> if Trim_state# eq 1 move (Text_Trim(lsValue)) to lsValue 35180>>>>>>> else if Trim_state# eq 2 move (Text_RTrim(lsValue)) to lsValue 35184>>>>>>> if (pCompress_state(self)) move (Text_Compress(lsValue)) to lsValue 35187>>>>>>> 35187>>>>>>> move (character(10)) to lf# 35188>>>>>>> get pRmargin to pRmargin# 35189>>>>>>> if pRmargin# gt 1 begin // Otherwise nothing makes sense! 35191>>>>>>> move 0 to done# 35192>>>>>>> move "" to line# 35193>>>>>>> move 1 to pos# 35194>>>>>>> move (length(lsValue)) to max# 35195>>>>>>> repeat 35195>>>>>>>> 35195>>>>>>> 35195>>>>>>> move "" to word# 35196>>>>>>> move 0 to word_done# 35197>>>>>>> repeat 35197>>>>>>>> 35197>>>>>>> if pos# gt max# move 1 to word_done# 35200>>>>>>> else begin 35201>>>>>>> mid lsValue to char# 1 pos# 35204>>>>>>>> 35204>>>>>>> if char# eq lf# begin // Line feed 35206>>>>>>> if word# eq "" begin 35208>>>>>>> move lf# to word# 35209>>>>>>> increment pos# 35210>>>>>>> end 35210>>>>>>>> 35210>>>>>>> move 1 to word_done# 35211>>>>>>> end 35211>>>>>>>> 35211>>>>>>> else begin 35212>>>>>>> if char# eq "" begin 35214>>>>>>> if word# eq "" increment pos# 35217>>>>>>> else move 1 to word_done# 35219>>>>>>> end 35219>>>>>>>> 35219>>>>>>> else begin 35220>>>>>>> move (word#+char#) to word# 35221>>>>>>> increment pos# 35222>>>>>>> end 35222>>>>>>>> 35222>>>>>>> end 35222>>>>>>>> 35222>>>>>>> end 35222>>>>>>>> 35222>>>>>>> until word_done# 35224>>>>>>> 35224>>>>>>> if word# eq "" move 1 to done# // We're done! 35227>>>>>>> else begin 35228>>>>>>> if word# eq lf# begin // If hard return: 35230>>>>>>> send add_item.s line# 35231>>>>>>> move "" to line# 35232>>>>>>> end 35232>>>>>>>> 35232>>>>>>> else begin // 35233>>>>>>> if (length(line#)+length(word#)+1) gt pRmargin# begin // Soft new line 35235>>>>>>> if line# ne "" begin 35237>>>>>>> send add_item.s line# // Could be that word is longer that pRmargin 35238>>>>>>> move "" to line# 35239>>>>>>> end 35239>>>>>>>> 35239>>>>>>> if (length(word#)) gt pRmargin# begin // Word IS longer that line! 35241>>>>>>> repeat 35241>>>>>>>> 35241>>>>>>> if line# eq "" move (pRmargin#-1) to len# 35244>>>>>>> else move (pRmargin#-length(line#)-2) to len# 35246>>>>>>> move (split_word(self,word#,len#)) to word# 35247>>>>>>> move (ExtractItem(word#," ",1)) to left# 35248>>>>>>> move (ExtractItem(word#," ",2)) to word# 35249>>>>>>> if word# eq "" move left# to line# 35252>>>>>>> else send add_item.s (left#+"-") 35254>>>>>>> until word# eq "" 35256>>>>>>> end 35256>>>>>>>> 35256>>>>>>> else move word# to line# 35258>>>>>>> end 35258>>>>>>>> 35258>>>>>>> else begin 35259>>>>>>> if line# ne "" move (line#+" "+word#) to line# // add word to line 35262>>>>>>> else move word# to line# 35264>>>>>>> end 35264>>>>>>>> 35264>>>>>>> end 35264>>>>>>>> 35264>>>>>>> end 35264>>>>>>>> 35264>>>>>>> until done# 35266>>>>>>> if line# ne "" send add_item.s line# 35269>>>>>>> end 35269>>>>>>>> 35269>>>>>>> end_procedure 35270>>>>>>>end_class // cText_Formatter 35271>>>>>>> 35271>>>>>>>desktop_section 35277>>>>>>> object oText_Formatter is a cText_Formatter no_image 35279>>>>>>> set pSubst_below_32_state to DFTRUE 35280>>>>>>> end_object 35281>>>>>>>end_desktop_section 35286>>>>>>> 35286>>>>>>>procedure Text_Format_Reset global 35288>>>>>>> send delete_data to (oText_Formatter(self)) 35289>>>>>>>end_procedure 35290>>>>>>> 35290>>>>>>>function Text_Format_LineCount global returns integer 35292>>>>>>> function_return (item_count(oText_Formatter(self))) 35293>>>>>>>end_function 35294>>>>>>> 35294>>>>>>>function Text_Format.sii global string lsValue integer liWidth integer lbReset returns integer 35296>>>>>>> integer lhObj 35296>>>>>>> if lbReset send Text_Format_Reset 35299>>>>>>> move (oText_Formatter(self)) to lhObj 35300>>>>>>> set pRmargin of lhObj to liWidth 35301>>>>>>> send format.s to lhObj lsValue 35302>>>>>>> function_return (item_count(lhObj)) 35303>>>>>>>end_function 35304>>>>>>> 35304>>>>>>>function Text_FormattedLine.i global integer liLine returns string 35306>>>>>>> function_return (string_value(oText_Formatter(self),liLine)) 35307>>>>>>>end_function 35308>>>>>>> 35308>>>>>>>function Text_FormattedText global returns string 35310>>>>>>> integer liItem liMax liObj 35310>>>>>>> string lsRval 35310>>>>>>> move "" to lsRval 35311>>>>>>> move (oText_Formatter(self)) to liObj 35312>>>>>>> get item_count of liObj to liMax 35313>>>>>>> get Text_Format_LineCount to liMax 35314>>>>>>> decrement liMax 35315>>>>>>> for liItem from 0 to liMax 35321>>>>>>>> 35321>>>>>>> move (lsRval+value(liObj,liItem)) to lsRval 35322>>>>>>> if liItem ne liMax move (lsRval+character(10)) to lsRval 35325>>>>>>> loop 35326>>>>>>>> 35326>>>>>>> function_return lsRval 35327>>>>>>>end_function 35328>>>>>>> 35328>>>>>>>string gs$CollateString 255 // Here's the string 35328>>>>>>> 35328>>>>>>>object oCollateStringBuilder is an Array 35330>>>>>>> procedure MakeCollateString 35333>>>>>>> integer liCharacter liMax liItem 35333>>>>>>> string lsRval 35333>>>>>>> for liCharacter from 32 to 255 35339>>>>>>>> 35339>>>>>>> set value item (liCharacter-32) to (character(liCharacter)) 35340>>>>>>> loop 35341>>>>>>>> 35341>>>>>>> send sort_items DESCENDING // We need them backwards 35342>>>>>>> get item_count to liMax 35343>>>>>>> decrement liMax 35344>>>>>>> move "" to lsRval 35345>>>>>>> for liItem from 0 to liMax 35351>>>>>>>> 35351>>>>>>> move (lsRval+value(self,liItem)) to lsRval 35352>>>>>>> loop 35353>>>>>>>> 35353>>>>>>> move (repeat(" ",31)+lsRval) to gs$CollateString 35354>>>>>>> send delete_data 35355>>>>>>> end_procedure 35356>>>>>>> send MakeCollateString 35357>>>>>>>end_object 35358>>>>>>> 35358>>>>>>>function String_NegateSortOrder global string lsValue returns string 35360>>>>>>> integer liPos liLen 35360>>>>>>> string lsRval lsChar 35360>>>>>>> move (length(lsValue)) to liLen 35361>>>>>>> move "" to lsRval 35362>>>>>>> for liPos from 1 to liLen 35368>>>>>>>> 35368>>>>>>> move (mid(lsValue,1,liPos)) to lsChar 35369>>>>>>> move (lsRval+mid(gs$CollateString,1,ascii(lsChar))) to lsRval 35370>>>>>>> loop 35371>>>>>>>> 35371>>>>>>> function_return lsRval 35372>>>>>>>end_function 35373>>>>>>> 35373>>>>>>>// The same function (StringEncrypt) is used to encrypt and decrypt a string: 35373>>>>>>>// 35373>>>>>>>// Ŀ 35373>>>>>>>// 35373>>>>>>>// StringEncrypt(string,code) 35373>>>>>>>// stringEncrypt(encrypted_string,code) 35373>>>>>>>// 35373>>>>>>>//   35373>>>>>>>// -- -- 35373>>>>>>>// 35373>>>>>>>// 35373>>>>>>>// 35373>>>>>>>// The code used to encrypt a string may be any integer value and must 35373>>>>>>>// be the same when decrypting 35373>>>>>>>// 35373>>>>>>> 35373>>>>>>> function iEncryptXor.iii global integer liX integer liY integer liBitCount returns integer 35375>>>>>>> integer liRval liBit liXbit liYbit liBitExp 35375>>>>>>> move 0 to liRval 35376>>>>>>> for liBit from 0 to (liBitCount-1) 35382>>>>>>>> 35382>>>>>>> move (2^liBit) to liBitExp 35383>>>>>>> move ((liX/liBitExp)-(((liX/liBitExp)/2)*2)) to liXbit 35384>>>>>>> move ((liY/liBitExp)-(((liY/liBitExp)/2)*2)) to liYbit 35385>>>>>>> if liXbit ne liYbit move (liRval+liBitExp) to liRval 35388>>>>>>> loop 35389>>>>>>>> 35389>>>>>>> function_return liRval 35390>>>>>>> end_function 35391>>>>>>> 35391>>>>>>>function StringEncrypt global string lsInput integer liCode integer liLen returns string 35393>>>>>>> integer liPos 35393>>>>>>> string lsRval 35393>>>>>>> move "" to lsRval 35394>>>>>>> for liPos from 1 to liLen 35400>>>>>>>> 35400>>>>>>> move (lsRval+character(iEncryptXor.iii(ascii(mid(pad(lsInput,liLen),1,liPos)),((liCode+(liPos*7)) iand 31),8))) to lsRval 35401>>>>>>> loop 35402>>>>>>>> 35402>>>>>>> function_return lsRval 35403>>>>>>>end_function 35404>>>>>>> 35404>>>>>>>// The function returns the number of items that the value was split into. Negative if parsing error 35404>>>>>>>// 35404>>>>>>>// lsValue is the string to split 35404>>>>>>>// lsSeparatorChar is the separating character 35404>>>>>>>// lbDiscardDblSeps determines whether succeeding separating characters are to be considered as one 35404>>>>>>>// lbProtectQuotes determines if items in quotes should be 35404>>>>>>>function StringSplitToArrayObj global string lsValue string lsSeparatorChar integer lbDiscardDblSeps integer lbProtectQuotes integer lhTargetArray returns integer 35406>>>>>>> integer liLen // Length of the string we are parsing 35406>>>>>>> integer liItem // Pointer to the next available index in the target array (lhTargetArray) 35406>>>>>>> integer liStartItem // Number of items originally in the target array 35406>>>>>>> integer liPos // The current position in the string (lsValue) we are parsing 35406>>>>>>> 35406>>>>>>> string lsChar // The character currently being examined by the loop 35406>>>>>>> string lsItem // The value of the next item as it is being built 35406>>>>>>> string lsQuoteChar // If " or ', we are currently in a quoted section of the string 35406>>>>>>> string lsQuotes // Quotation characters: "' 35406>>>>>>> 35406>>>>>>> move "" to lsQuoteChar 35407>>>>>>> get item_count of lhTargetArray to liStartItem // If the array is not empty, we just add to its current content. 35408>>>>>>> move liStartItem to liItem 35409>>>>>>> move (length(lsValue)) to liLen 35410>>>>>>> move "" to lsItem 35411>>>>>>> move ("'"+'"') to lsQuotes 35412>>>>>>> 35412>>>>>>> move 1 to liPos 35413>>>>>>> while (liPos<=liLen) 35417>>>>>>> move (mid(lsValue,1,liPos)) to lsChar 35418>>>>>>> increment liPos 35419>>>>>>> 35419>>>>>>> if (lsQuoteChar<>"") begin 35421>>>>>>> if (lsChar=lsQuoteChar) begin 35423>>>>>>> move "" to lsQuoteChar 35424>>>>>>> if (liPos<=liLen) begin // Next item MUST be a separating character or end of string 35426>>>>>>> move (mid(lsValue,1,liPos)) to lsChar 35427>>>>>>> if (lsChar<>lsSeparatorChar) function_return (0-liPos) // Error: Illegal character after quoted string 35430>>>>>>> end 35430>>>>>>>> 35430>>>>>>> // else it's the end of the string and we're therefore OK 35430>>>>>>> end 35430>>>>>>>> 35430>>>>>>> else begin 35431>>>>>>> move (lsItem+lsChar) to lsItem 35432>>>>>>> end 35432>>>>>>>> 35432>>>>>>> end 35432>>>>>>>> 35432>>>>>>> else begin // We're not in a quote 35433>>>>>>> if (lsChar=lsSeparatorChar) begin 35435>>>>>>> set value of lhTargetArray item liItem to lsItem 35436>>>>>>> increment liItem 35437>>>>>>> move "" to lsItem 35438>>>>>>> 35438>>>>>>> if lbDiscardDblSeps begin // succeeding separating characters are to be considered as one, we advance the position accordingly 35440>>>>>>> while (liPos>>>>>> increment liPos 35445>>>>>>> end 35446>>>>>>>> 35446>>>>>>> end 35446>>>>>>>> 35446>>>>>>> end 35446>>>>>>>> 35446>>>>>>> else if (lbProtectQuotes<>0 and lsQuotes contains lsChar) begin 35449>>>>>>> if (lsItem="") begin 35451>>>>>>> move lsChar to lsQuoteChar 35452>>>>>>> end 35452>>>>>>>> 35452>>>>>>> else function_return (0-liPos+1) // Error: Illegal position of quotation character 35454>>>>>>> end 35454>>>>>>>> 35454>>>>>>> else move (lsItem+lsChar) to lsItem 35456>>>>>>> end 35456>>>>>>>> 35456>>>>>>> end 35457>>>>>>>> 35457>>>>>>> 35457>>>>>>> if (lsItem<>"") begin 35459>>>>>>> set value of lhTargetArray item liItem to lsItem 35460>>>>>>> increment liItem 35461>>>>>>> end 35461>>>>>>>> 35461>>>>>>> 35461>>>>>>> if (lsQuoteChar<>"") function_return (0-liPos) // Error: Quoted string not terminated 35464>>>>>>> function_return (liItem-liStartItem) // Return number of items added to the target array 35465>>>>>>>end_function // StringSplitToArrayObj 35466>>>>>>> 35466>>>>> 35466>>>>>class cFieldInfoStuff is a cArray 35467>>>>> function array_id.i integer file# returns integer 35469>>>>> integer rval# 35469>>>>> get value item file# to rval# 35470>>>>> ifnot rval# begin 35472>>>>> object fldinf.array is an array 35474>>>>> move self to rval# 35475>>>>> end_object 35476>>>>> set value item file# to rval# 35477>>>>> end 35477>>>>>> 35477>>>>> function_return rval# 35478>>>>> end_function 35479>>>>> procedure set string_value.ii integer file# integer field# string str# 35481>>>>> set value of (array_id.i(self,file#)) item field# to str# 35482>>>>> end_procedure 35483>>>>> function string_value.ii integer file# integer field# returns string 35485>>>>> integer arr# 35485>>>>> get value item file# to arr# 35486>>>>> if arr# function_return (value(arr#,field#)) 35489>>>>> function_return "" 35490>>>>> end_function 35491>>>>> procedure set integer_value.ii integer file# integer field# integer int# 35493>>>>> set value of (array_id.i(self,file#)) item field# to int# 35494>>>>> end_procedure 35495>>>>> function integer_value.ii integer file# integer field# returns integer 35497>>>>> integer arr# 35497>>>>> get value item file# to arr# 35498>>>>> if arr# function_return (value(arr#,field#)) 35501>>>>> function_return 0 35502>>>>> end_function 35503>>>>> 35503>>>>> // The purpose of the make_alias procedure is to redirect references 35503>>>>> // to file number refer to file number instead. 35503>>>>> procedure make_alias integer master# integer alias# 35505>>>>> integer master_arr# 35505>>>>> get array_id.i master# to master_arr# 35506>>>>> set value item alias# to master_arr# 35507>>>>> end_procedure 35508>>>>> 35508>>>>> procedure delete_fieldinfo_data 35510>>>>> integer lhObj liMax liItm 35510>>>>> get item_count to liMax 35511>>>>> decrement liMax 35512>>>>> for liItm from 1 to liMax // Leave the abstract definitions 35518>>>>>> 35518>>>>> get value item liItm to lhObj 35519>>>>> if lhObj begin 35521>>>>> send request_destroy_object to lhObj 35522>>>>> set value item liItm to 0 35523>>>>> end 35523>>>>>> 35523>>>>> loop 35524>>>>>> 35524>>>>> end_procedure 35525>>>>>end_class 35526>>>>> 35526>>>>>integer field_labels_array# grid_labels_array# status_help_array# 35526>>>>>integer form_datatype_array# form_margin_array# abstract_array# 35526>>>>> 35526>>>>>object field_labels_array is a cFieldInfoStuff 35528>>>>> move self to field_labels_array# 35529>>>>>end_object 35530>>>>>object grid_labels_array is a cFieldInfoStuff 35532>>>>> move self to grid_labels_array# 35533>>>>>end_object 35534>>>>>object status_help_array is a cFieldInfoStuff 35536>>>>> move self to status_help_array# 35537>>>>>end_object 35538>>>>>object form_datatype_array is a cFieldInfoStuff 35540>>>>> move self to form_datatype_array# 35541>>>>>end_object 35542>>>>>object form_margin_array is a cFieldInfoStuff 35544>>>>> move self to form_margin_array# 35545>>>>>end_object 35546>>>>>object abtract_array is a cFieldInfoStuff 35548>>>>> // If a DBMS field (file,field) has an entry in this array it means 35548>>>>> // that its corresponding form_datatype and form_margin should be 35548>>>>> // looked up in the other arrays rather than using its original values. 35548>>>>> move self to abstract_array# 35549>>>>>end_object 35550>>>>>object capslocked_array is a cFieldInfoStuff 35552>>>>>// move self to abstract_array# 35552>>>>>end_object 35553>>>>> 35553>>>>>// Prefix "gl_" means "global" 35553>>>>>function gl_field_label for desktop integer file# integer field# returns string 35555>>>>> string rval# 35555>>>>> move (string_value.ii(field_labels_array#,file#,field#)) to rval# 35556>>>>> if rval# eq "" begin 35558>>>>> get_attribute df_field_name of file# field# to rval# 35561>>>>> move (replaces("_",rval#," ")) to rval# 35562>>>>> move (lowercase(rval#)) to rval# 35563>>>>> move (overstrike(uppercase(left(rval#,1)),rval#,1)) to rval# 35564>>>>> set string_value.ii of field_labels_array# file# field# to rval# 35565>>>>> end 35565>>>>>> 35565>>>>> function_return rval# 35566>>>>>end_function 35567>>>>>function gl_grid_label for desktop integer file# integer field# returns string 35569>>>>> string rval# 35569>>>>> move (string_value.ii(grid_labels_array#,file#,field#)) to rval# 35570>>>>> if rval# eq "" begin 35572>>>>> get_attribute df_field_name of file# field# to rval# 35575>>>>> move (replaces("_",rval#," ")) to rval# 35576>>>>> move (lowercase(rval#)) to rval# 35577>>>>> move (overstrike(uppercase(left(rval#,1)),rval#,1)) to rval# 35578>>>>> set string_value.ii of grid_labels_array# file# field# to rval# 35579>>>>> end 35579>>>>>> 35579>>>>> function_return rval# 35580>>>>>end_function 35581>>>>>function gl_status_help for desktop integer file# integer field# returns string 35583>>>>> function_return (string_value.ii(status_help_array#,file#,field#)) 35584>>>>>end_function 35585>>>>>function gl_datatype for desktop integer file# integer field# returns integer 35587>>>>> function_return (integer_value.ii(form_datatype_array#,file#,field#)) 35588>>>>>end_function 35589>>>>>function gl_margin for desktop integer file# integer field# returns integer 35591>>>>> function_return (integer_value.ii(form_margin_array#,file#,field#)) 35592>>>>>end_function 35593>>>>>function gl_abstract for desktop integer file# integer field# returns integer 35595>>>>> function_return (integer_value.ii(abstract_array#,file#,field#)) 35596>>>>>end_function 35597>>>>> 35597>>>>> 35597>>>>>// REGISTER_FIELD_LABEL dffile.field ; 35597>>>>>// [ []] 35597>>>>> 35597>>>>> 35597>>>>> 35597>>>>>// REGISTER_ABSTRACT_FIELD_TYPE ; 35597>>>>>// 35597>>>>> 35597>>>>> 35597>>>>> 35597>>>>>// REGISTER_ABSTRACT_FIELD_LABEL ; 35597>>>>>// [ []] 35597>>>>>// 35597>>>>>// Registrations done with the REGISTER_ABSTRACT_FIELD_LABEL are not 35597>>>>>// currently used by APS 35597>>>>> 35597>>>>> 35597>>>>> 35597>>>>>// MODIFY_FIELD_TYPE dffile.field 35597>>>>> 35597>>>>> 35597>>>>>// REGISTER_FILE_ALIAS 35597>>>>> 35597>>>>> 35597>>>>> 35597>>>>> function gl_generic_form_datatype global integer file# integer field# returns integer 35599>>>>> integer type# rval# 35599>>>>> get_attribute DF_FIELD_TYPE of file# field# to type# 35602>>>>> if type# eq DF_ASCII function_return ascii_window 35605>>>>> if type# eq DF_DATE function_return date_window 35608>>>>> if type# eq DF_BCD begin 35610>>>>> get_attribute DF_FIELD_PRECISION of file# field# to rval# 35613>>>>> function_return rval# 35614>>>>> end 35614>>>>>> 35614>>>>> function_return ascii_window // DF_OVERLAP DF_TEXT DF_BINARY 35615>>>>> end_function 35616>>>>> 35616>>>>> function gl_generic_form_margin global integer file# integer field# returns integer 35618>>>>> integer datatype# len# 35618>>>>> move (gl_generic_form_datatype(file#,field#)) to datatype# 35619>>>>> if datatype# eq date_window function_return 10 35622>>>>> get_attribute DF_FIELD_LENGTH of file# field# to len# 35625>>>>> if datatype# eq ascii_window function_return len# 35628>>>>> function_return (len#+1) // Room for comma 35629>>>>> end_function 35630>>>>> 35630>>>>> function gl_effective_form_datatype global integer file# integer field# returns integer 35632>>>>> integer abstract# 35632>>>>> get gl_abstract file# field# to abstract# 35633>>>>> if abstract# function_return (gl_datatype(self,0,abstract#)) 35636>>>>> function_return (gl_generic_form_datatype(file#,field#)) 35637>>>>> end_function 35638>>>>> function gl_effective_form_margin global integer file# integer field# returns integer 35640>>>>> integer rval# 35640>>>>> get gl_margin file# field# to rval# 35641>>>>> if rval# function_return rval# 35644>>>>> function_return (gl_generic_form_margin(file#,field#)) 35645>>>>> end_function 35646>>>>> 35646>>>>>register_abstract_field_type AFT_ASCII1 1 ascii_window 35648>>>>>register_abstract_field_type AFT_ASCII2 2 ascii_window 35650>>>>>register_abstract_field_type AFT_ASCII3 3 ascii_window 35652>>>>>register_abstract_field_type AFT_ASCII4 4 ascii_window 35654>>>>>register_abstract_field_type AFT_ASCII5 5 ascii_window 35656>>>>>register_abstract_field_type AFT_ASCII6 6 ascii_window 35658>>>>>register_abstract_field_type AFT_ASCII7 7 ascii_window 35660>>>>>register_abstract_field_type AFT_ASCII8 8 ascii_window 35662>>>>>register_abstract_field_type AFT_ASCII10 10 ascii_window 35664>>>>>register_abstract_field_type AFT_ASCII12 12 ascii_window 35666>>>>>register_abstract_field_type AFT_ASCII14 14 ascii_window 35668>>>>>register_abstract_field_type AFT_ASCII15 15 ascii_window 35670>>>>>register_abstract_field_type AFT_ASCII20 20 ascii_window 35672>>>>>register_abstract_field_type AFT_ASCII25 25 ascii_window 35674>>>>>register_abstract_field_type AFT_ASCII30 30 ascii_window 35676>>>>>register_abstract_field_type AFT_ASCII32 32 ascii_window 35678>>>>>register_abstract_field_type AFT_ASCII35 35 ascii_window 35680>>>>>register_abstract_field_type AFT_ASCII40 40 ascii_window 35682>>>>>register_abstract_field_type AFT_ASCII45 45 ascii_window 35684>>>>>register_abstract_field_type AFT_ASCII50 50 ascii_window 35686>>>>>register_abstract_field_type AFT_ASCII60 60 ascii_window 35688>>>>>register_abstract_field_type AFT_ASCII70 70 ascii_window 35690>>>>>register_abstract_field_type AFT_ASCII80 80 ascii_window 35692>>>>>register_abstract_field_type AFT_ASCII100 100 ascii_window 35694>>>>>register_abstract_field_type AFT_ASCII255 255 ascii_window 35696>>>>>register_abstract_field_type AFT_NUMERIC1.0 1 0 // Length 4, 2 decimal points 35698>>>>>register_abstract_field_type AFT_NUMERIC1.2 4 2 // Length 4, 2 decimal points 35700>>>>>register_abstract_field_type AFT_NUMERIC2.0 2 0 // Length 2, 0 decimal points 35702>>>>>register_abstract_field_type AFT_NUMERIC2.1 4 1 // Length 4, 1 decimal points 35704>>>>>register_abstract_field_type AFT_NUMERIC2.2 5 2 // Length 5, 2 decimal points 35706>>>>>register_abstract_field_type AFT_NUMERIC3.0 3 0 // Length 3, 0 decimal points 35708>>>>>register_abstract_field_type AFT_NUMERIC3.3 7 3 // Length 7, 3 decimal points 35710>>>>>register_abstract_field_type AFT_NUMERIC4.0 4 0 // Length 4, 0 decimal points 35712>>>>>register_abstract_field_type AFT_NUMERIC4.2 7 2 // Length 7, 2 decimal points 35714>>>>>register_abstract_field_type AFT_NUMERIC5.1 8 1 // Length 7, 2 decimal points 35716>>>>>register_abstract_field_type AFT_NUMERIC6.0 6 0 // Length 6, 0 decimal points 35718>>>>>register_abstract_field_type AFT_NUMERIC8.0 8 0 // Length 8, 0 decimal points 35720>>>>>register_abstract_field_type AFT_NUMERIC10.0 10 0 // Length 10, 0 decimal points 35722>>>>>register_abstract_field_type AFT_NUMERIC14.0 14 0 // Length 14, 0 decimal points 35724>>>>>register_abstract_field_type AFT_DATE 10 date_window 35726>>>>>register_abstract_field_type AFT_BOOLEAN 1 0 35728>>>>> 35728>>>>> 35728>>>>>// An extra feature allows specifying a replacement to the user display name 35728>>>>>// of files (df_File_Display_Name). APS makes no use of such registrations. 35728>>>>>// 35728>>>>>// REGISTER_FILE_DISPLAY_NAME dffile 35728>>>>> 35728>>>>>desktop_section 35733>>>>> object File_Display_Name_Array is a cArray 35735>>>>> end_object 35736>>>>>end_desktop_section 35741>>>>>procedure set File_Display_Name global integer file# string name# 35743>>>>> set value of (File_Display_Name_Array(self)) item file# to name# 35744>>>>>end_procedure 35745>>>>>function File_Display_Name global integer file# returns string 35747>>>>> string rval# 35747>>>>> move (value(File_Display_Name_Array(self),file#)) to rval# 35748>>>>> if rval# eq "" begin 35750>>>>> get_attribute DF_FILE_DISPLAY_NAME of file# to rval# 35753>>>>> move (rtrim(rval#)) to rval# 35754>>>>> set File_Display_Name file# to rval# 35755>>>>> end 35755>>>>>> 35755>>>>> function_return rval# 35756>>>>>end_function 35757>>>>> 35757>>>>> 35757>>>>>// In order for the aps_ObjectDynamo class to be able to use the 35757>>>>>// generic DD-classes a few lines is needed that will allow us to 35757>>>>>// register which classes to use when creating DDO's for the various 35757>>>>>// data files. 35757>>>>>// 35757>>>>>// Use like this: 35757>>>>>// 35757>>>>>// set DataDictionary_Class OrderHdr.file_number to U_OrderHdr_DD 35757>>>>>// 35757>>>>> 35757>>>>>desktop_section 35762>>>>> object oDataDictionary_Class_Array is a cArray 35764>>>>> end_object 35765>>>>>end_desktop_section 35770>>>>>function DataDictionary_Class global integer file# returns integer 35772>>>>> function_return (value(oDataDictionary_Class_Array(self),file#)) 35773>>>>>end_function 35774>>>>>procedure set DataDictionary_Class global integer file# integer class# 35776>>>>> set value of (oDataDictionary_Class_Array(self)) item file# to class# 35777>>>>>end_procedure 35778>>>>> 35778>>>>>desktop_section 35783>>>>> object oDataDictionary_Object_Array is a cArray 35785>>>>> end_object 35786>>>>>end_desktop_section 35791>>>>>function DataDictionary_Object global integer file# returns integer 35793>>>>> function_return (value(oDataDictionary_Object_Array(self),file#)) 35794>>>>>end_function 35795>>>>>procedure set DataDictionary_Object global integer file# integer obj# 35797>>>>> set value of (oDataDictionary_Object_Array(self)) item file# to obj# 35798>>>>>end_procedure 35799>>>>>procedure DataDictionary_Objects_Destroy global 35801>>>>> integer lhObj liItm liMax lhDD 35801>>>>> move (oDataDictionary_Object_Array(self)) to lhObj 35802>>>>> get item_count of lhObj to liMax 35803>>>>> for liItm from 0 to liMax 35809>>>>>> 35809>>>>> get value of lhObj item liItm to lhDD 35810>>>>> if lhDD send request_destroy_object to lhDD 35813>>>>> loop 35814>>>>>> 35814>>>>> send delete_data to lhObj 35815>>>>>end_procedure 35816>>>>> 35816>>>>>function iDD_Object global integer file# returns integer 35818>>>>> integer rval# class# self# 35818>>>>> get DataDictionary_Object file# to rval# 35819>>>>> ifnot rval# begin 35821>>>>> get DataDictionary_Class file# to class# 35822>>>>> if class# begin 35824>>>>> name class# U_fieldinf_class // Ŀ 35824>>>>> move self to self# // Push self 35825>>>>> move desktop to self // Create at desktop 35826>>>>> object dynamo_object is a fieldinf_class // Create an object of class 35828>>>>> move self to rval# // Get the object ID to rval# 35829>>>>> end_object // 35830>>>>> move self# to self // Pop self 35831>>>>> set DataDictionary_Object file# to rval# // Register the new object 35832>>>>> end 35832>>>>>> 35832>>>>> end 35832>>>>>> 35832>>>>> function_return rval# 35833>>>>>end_function 35834>>>>> 35834>>>>>class cVirtualFields is a cArray 35835>>>>> procedure construct_object integer img# 35837>>>>> forward send construct_object img# 35839>>>>> property integer pMainFile public 0 35840>>>>> property integer private.pCurrentRecord public -1 35841>>>>> property string pUserName public "Un-named" 35842>>>>> end_procedure 35843>>>>> item_property_list 35843>>>>> // VDFQuery only considers active fields 35843>>>>> item_property integer piFieldActive.i 35843>>>>> item_property string psFieldLabel.i 35843>>>>> item_property string psFieldLabel_Short.i 35843>>>>> item_property integer piFieldType.i 35843>>>>> item_property integer piFieldLength.i 35843>>>>> item_property integer piFieldDecPoint.i 35843>>>>> item_property integer piFieldCapslock.i 35843>>>>> item_property integer piFieldLoadMessage.i // Function to call in order to get the function value 35843>>>>> item_property integer piFieldLoadObject.i // Optional object in which to call the load-message 35843>>>>> item_property integer pbFieldLoadParamSpecified.i // Indicates whether piFieldLoadParam.i has been specified 35843>>>>> item_property integer piFieldLoadParam.i // If specified, is sent to the function 35843>>>>> item_property string psFieldValue.i 35843>>>>> item_property integer piFieldDirty.i 35843>>>>> item_property integer piDescriptionImage.i 35843>>>>> end_item_property_list cVirtualFields // When in class, class neame must be repeated here #REM 35911 DEFINE FUNCTION PIDESCRIPTIONIMAGE.I INTEGER LIROW RETURNS INTEGER #REM 35915 DEFINE PROCEDURE SET PIDESCRIPTIONIMAGE.I INTEGER LIROW INTEGER VALUE #REM 35919 DEFINE FUNCTION PIFIELDDIRTY.I INTEGER LIROW RETURNS INTEGER #REM 35923 DEFINE PROCEDURE SET PIFIELDDIRTY.I INTEGER LIROW INTEGER VALUE #REM 35927 DEFINE FUNCTION PSFIELDVALUE.I INTEGER LIROW RETURNS STRING #REM 35931 DEFINE PROCEDURE SET PSFIELDVALUE.I INTEGER LIROW STRING VALUE #REM 35935 DEFINE FUNCTION PIFIELDLOADPARAM.I INTEGER LIROW RETURNS INTEGER #REM 35939 DEFINE PROCEDURE SET PIFIELDLOADPARAM.I INTEGER LIROW INTEGER VALUE #REM 35943 DEFINE FUNCTION PBFIELDLOADPARAMSPECIFIED.I INTEGER LIROW RETURNS INTEGER #REM 35947 DEFINE PROCEDURE SET PBFIELDLOADPARAMSPECIFIED.I INTEGER LIROW INTEGER VALUE #REM 35951 DEFINE FUNCTION PIFIELDLOADOBJECT.I INTEGER LIROW RETURNS INTEGER #REM 35955 DEFINE PROCEDURE SET PIFIELDLOADOBJECT.I INTEGER LIROW INTEGER VALUE #REM 35959 DEFINE FUNCTION PIFIELDLOADMESSAGE.I INTEGER LIROW RETURNS INTEGER #REM 35963 DEFINE PROCEDURE SET PIFIELDLOADMESSAGE.I INTEGER LIROW INTEGER VALUE #REM 35967 DEFINE FUNCTION PIFIELDCAPSLOCK.I INTEGER LIROW RETURNS INTEGER #REM 35971 DEFINE PROCEDURE SET PIFIELDCAPSLOCK.I INTEGER LIROW INTEGER VALUE #REM 35975 DEFINE FUNCTION PIFIELDDECPOINT.I INTEGER LIROW RETURNS INTEGER #REM 35979 DEFINE PROCEDURE SET PIFIELDDECPOINT.I INTEGER LIROW INTEGER VALUE #REM 35983 DEFINE FUNCTION PIFIELDLENGTH.I INTEGER LIROW RETURNS INTEGER #REM 35987 DEFINE PROCEDURE SET PIFIELDLENGTH.I INTEGER LIROW INTEGER VALUE #REM 35991 DEFINE FUNCTION PIFIELDTYPE.I INTEGER LIROW RETURNS INTEGER #REM 35995 DEFINE PROCEDURE SET PIFIELDTYPE.I INTEGER LIROW INTEGER VALUE #REM 35999 DEFINE FUNCTION PSFIELDLABEL_SHORT.I INTEGER LIROW RETURNS STRING #REM 36003 DEFINE PROCEDURE SET PSFIELDLABEL_SHORT.I INTEGER LIROW STRING VALUE #REM 36007 DEFINE FUNCTION PSFIELDLABEL.I INTEGER LIROW RETURNS STRING #REM 36011 DEFINE PROCEDURE SET PSFIELDLABEL.I INTEGER LIROW STRING VALUE #REM 36015 DEFINE FUNCTION PIFIELDACTIVE.I INTEGER LIROW RETURNS INTEGER #REM 36019 DEFINE PROCEDURE SET PIFIELDACTIVE.I INTEGER LIROW INTEGER VALUE 36024>>>>> procedure FieldsCallBack integer lhMsg integer lhObj 36026>>>>> integer liRow liMax liFile 36026>>>>> get pMainFile to liFile 36027>>>>> get row_count to liMax 36028>>>>> decrement liMax 36029>>>>> for liRow from 0 to liMax 36035>>>>>> 36035>>>>> if (piFieldActive.i(self,liRow)) begin 36037>>>>> // procedure HandleField integer liFile integer liField string lsLabel integer liType integer liLenth integer liPrecision integer lhVF 36037>>>>> send lhMsg to lhObj liFile liRow (psFieldLabel.i(self,liRow)) (piFieldType.i(self,liRow)) (piFieldLength.i(self,liRow)) (piFieldDecPoint.i(self,liRow)) self 36038>>>>> end 36038>>>>>> 36038>>>>> loop 36039>>>>>> 36039>>>>> end_procedure 36040>>>>> procedure SetAllFieldsDirty integer lbState 36042>>>>> integer liMax liField 36042>>>>> get row_count to liMax 36043>>>>> for liField from 0 to (liMax-1) 36049>>>>>> 36049>>>>> set piFieldDirty.i liField to lbState 36050>>>>> loop 36051>>>>>> 36051>>>>> end_procedure 36052>>>>> procedure OnNewRecord 36054>>>>> end_procedure 36055>>>>> procedure set pCurrentRecord integer liRecnum 36057>>>>> integer liField liPreviousRecnum 36057>>>>> get private.pCurrentRecord to liPreviousRecnum 36058>>>>> if liRecnum ne liPreviousRecnum begin 36060>>>>> send SetAllFieldsDirty DFTRUE 36061>>>>> send OnNewRecord 36062>>>>> end 36062>>>>>> 36062>>>>> set private.pCurrentRecord to liRecnum 36063>>>>> end_procedure 36064>>>>> function pCurrentRecord returns integer 36066>>>>> function_return (private.pCurrentRecord(self)) 36067>>>>> end_function 36068>>>>> procedure LoadFieldValue integer liField 36070>>>>> integer lhGet lhObj 36070>>>>> string lsValue 36070>>>>> get piFieldLoadMessage.i liField to lhGet 36071>>>>> get piFieldLoadObject.i liField to lhObj 36072>>>>> 36072>>>>> if (pbFieldLoadParamSpecified.i(self,liField)) begin 36074>>>>> if lhObj get lhGet of lhObj (piFieldLoadParam.i(self,liField)) to lsValue 36077>>>>> else get lhGet (piFieldLoadParam.i(self,liField)) to lsValue 36079>>>>> end 36079>>>>>> 36079>>>>> else begin 36080>>>>> if lhObj get lhGet of lhObj to lsValue 36083>>>>> else get lhGet to lsValue 36085>>>>> end 36085>>>>>> 36085>>>>> 36085>>>>> set psFieldValue.i liField to lsValue 36086>>>>> set piFieldDirty.i liField to DFFALSE 36087>>>>> end_procedure 36088>>>>> procedure CheckCurrentRecord 36090>>>>> integer liFile liRecnum 36090>>>>> get pMainFile to liFile 36091>>>>> if liFile begin 36093>>>>> get_field_value liFile 0 to liRecnum 36096>>>>> if liRecnum ne (private.pCurrentRecord(self)) set pCurrentRecord to liRecnum 36099>>>>> end 36099>>>>>> 36099>>>>> end_procedure 36100>>>>> function sFieldValue.i integer liField returns string 36102>>>>> send CheckCurrentRecord 36103>>>>> if (piFieldDirty.i(self,liField)) send LoadFieldValue liField 36106>>>>> function_return (psFieldValue.i(self,liField)) 36107>>>>> end_function 36108>>>>> procedure define_field integer field# string Label# string Label_Short# integer Type# integer Length# integer DecPoint# integer LoadMessage# integer LoadObjectTmp# 36110>>>>> integer LoadObject# 36110>>>>> if num_arguments gt 7 move LoadObjectTmp# to LoadObject# 36113>>>>> else move 0 to LoadObject# 36115>>>>> set psFieldLabel.i field# to Label# 36116>>>>> 36116>>>>> if Label_Short# ne "" ; set psFieldLabel_Short.i field# to Label_Short# 36119>>>>> else set psFieldLabel_Short.i field# to Label# 36121>>>>> 36121>>>>> set piFieldType.i field# to Type# 36122>>>>> set piFieldLength.i field# to Length# 36123>>>>> set piFieldDecPoint.i field# to DecPoint# 36124>>>>> set piFieldLoadMessage.i field# to LoadMessage# 36125>>>>> set piFieldLoadObject.i field# to LoadObject# 36126>>>>> set piFieldDirty.i field# to DFTRUE 36127>>>>> set piFieldActive.i field# to DFTRUE 36128>>>>> set piFieldCapslock.i field# to DFFALSE 36129>>>>> end_procedure 36130>>>>> procedure set LoadParameter integer liField integer liAuxValue 36132>>>>> set pbFieldLoadParamSpecified.i liField to 1 36133>>>>> set piFieldLoadParam.i liField to liAuxValue 36134>>>>> end_procedure 36135>>>>>end_class // cVirtualFields 36136>>>>> 36136>>>>>integer oFieldInf_VitualFields# 36136>>>>>object oFieldInf_VitualFields is a cArray 36138>>>>> move self to oFieldInf_VitualFields# 36139>>>>>end_object 36140>>>>> 36140>>>>>function FieldInf_VirtualFields_Object global integer file# returns integer 36142>>>>> function_return (value(oFieldInf_VitualFields#,file#)) 36143>>>>>end_function 36144>>>>>procedure set FieldInf_VirtualFields_Object global integer file# integer value# 36146>>>>> set value of (oFieldInf_VitualFields#) item file# to value# 36147>>>>>end_procedure 36148>>>>>procedure FieldInf_VirtualFieldsCallBack global integer liFile integer lhMsg integer lhObj 36150>>>>> integer lhVF 36150>>>>> get FieldInf_VirtualFields_Object liFile to lhVF 36151>>>>> if lhVF send FieldsCallBack to lhVF lhMsg lhObj 36154>>>>>end_procedure 36155>>>>> 36155>>>>>function FieldInf_FieldType global integer liFile integer liField returns integer 36157>>>>> integer liFieldType 36157>>>>> if liField lt 256 get_attribute DF_FIELD_TYPE of liFile liField to liFieldType 36162>>>>> else move (piFieldType.i(FieldInf_VirtualFields_Object(liFile),liField-256)) to liFieldType 36164>>>>> function_return liFieldType 36165>>>>>end_function 36166>>>>>function FieldInf_FieldValue global integer liFile integer liField returns string 36168>>>>> integer liPushFieldindex liPushFieldnumber 36168>>>>> string lsValue 36168>>>>> move fieldindex to liPushFieldindex 36169>>>>> move fieldnumber to liPushFieldnumber 36170>>>>> if liField lt 256 get_field_value liFile liField to lsValue 36175>>>>> else move (sFieldValue.i(FieldInf_VirtualFields_Object(liFile),liField-256)) to lsValue 36177>>>>> move liPushFieldindex to fieldindex 36178>>>>> move liPushFieldnumber to fieldnumber 36179>>>>> function_return lsValue 36180>>>>>end_function 36181>>>>>function FieldInf_DecPoints global integer file# integer field# returns integer 36183>>>>> integer rval# 36183>>>>>// if field# lt 256 get_attribute DF_FIELD_PRECISION of file# field# to rval# 36183>>>>> if field# lt 256 get gl_effective_form_datatype file# field# to rval# 36186>>>>> else move (piFieldDecPoint.i(FieldInf_VirtualFields_Object(file#),field#-256)) to rval# 36188>>>>> function_return rval# 36189>>>>>end_function 36190>>>>>function FieldInf_FieldLabel_Long global integer file# integer field# returns string 36192>>>>> integer dd# 36192>>>>> string rval# 36192>>>>> move (string_value.ii(field_labels_array#,file#,field#)) to rval# 36193>>>>> if field# lt 256 begin 36195>>>>> if rval# eq "" begin // No global label was assigned 36197>>>>> get gl_field_label file# field# to rval# 36198>>>>> end 36198>>>>>> 36198>>>>> end 36198>>>>>> 36198>>>>> else move (psFieldLabel.i(FieldInf_VirtualFields_Object(file#),field#-256)) to rval# 36200>>>>> function_return rval# 36201>>>>>end_function 36202>>>>>function FieldInf_FieldLabel_Short global integer file# integer field# returns string 36204>>>>> integer dd# 36204>>>>> string rval# 36204>>>>> if field# lt 256 begin 36206>>>>> move (string_value.ii(grid_labels_array#,file#,field#)) to rval# 36207>>>>> if rval# eq "" begin // No global label was assigned 36209>>>>> get gl_field_label file# field# to rval# 36210>>>>> end 36210>>>>>> 36210>>>>> end 36210>>>>>> 36210>>>>> else move (psFieldLabel_Short.i(FieldInf_VirtualFields_Object(file#),field#-256)) to rval# 36212>>>>> function_return rval# 36213>>>>>end_function 36214>>>>> 36214>>>>>function FieldInf_Field_Length global integer liFile integer liField returns integer 36216>>>>> integer liLen lhVF 36216>>>>> move -1 to liLen 36217>>>>> if (liField<256) get_attribute DF_FIELD_LENGTH of liFile liField to liLen 36222>>>>> else begin 36223>>>>> move (liField-256) to liField 36224>>>>> get FieldInf_VirtualFields_Object liFile to lhVF 36225>>>>> if lhVF get piFieldLength.i of lhVF liField to liLen 36228>>>>> end 36228>>>>>> 36228>>>>> function_return liLen 36229>>>>>end_function 36230>>>>> 36230>>>>>function FieldInf_Field_Length_String global integer file# integer field# returns string 36232>>>>> integer fieldtype# len# dec# obj# 36232>>>>> string rval# 36232>>>>> if field# lt 256 begin 36234>>>>> get_attribute DF_FIELD_TYPE of file# field# to fieldtype# 36237>>>>> get_attribute DF_FIELD_LENGTH of file# field# to len# 36240>>>>> if fieldtype# eq DF_DATE move 10 to len# 36243>>>>> move len# to rval# 36244>>>>> if fieldtype# eq DF_BCD begin 36246>>>>> get gl_effective_form_datatype file# field# to dec# 36247>>>>> move "#.#" to rval# 36248>>>>> //if dec# decrement len# 36248>>>>> replace "#" in rval# with (string(len#-dec#)) 36250>>>>> replace "#" in rval# with (string(dec#)) 36252>>>>> end 36252>>>>>> 36252>>>>> end 36252>>>>>> 36252>>>>> else begin 36253>>>>> get FieldInf_VirtualFields_Object file# to obj# 36254>>>>> move (field#-256) to field# 36255>>>>> get piFieldType.i of obj# field# to fieldtype# 36256>>>>> get piFieldLength.i of obj# field# to len# 36257>>>>> if fieldtype# eq DF_DATE move 10 to len# 36260>>>>> move len# to rval# 36261>>>>> if fieldtype# eq DF_BCD begin 36263>>>>> get piFieldDecPoint.i of obj# field# to dec# 36264>>>>> move "#.#" to rval# 36265>>>>> replace "#" in rval# with (string(len#-dec#)) 36267>>>>> replace "#" in rval# with (string(dec#)) 36269>>>>> end 36269>>>>>> 36269>>>>> end 36269>>>>>> 36269>>>>> function_return rval# 36270>>>>>end_function 36271>>>>> 36271>>>>>function FieldInf_Field_Width global integer file# integer field# returns integer 36273>>>>> integer liDecs lbComma 36273>>>>> string lsLength 36273>>>>> get FieldInf_Field_Length_String file# field# to lsLength 36274>>>>> move (ExtractInteger(lsLength,2)) to liDecs 36275>>>>> move (liDecs<>0) to lbComma 36276>>>>> function_return (ExtractInteger(lsLength,1)+ExtractInteger(lsLength,2)+lbComma) 36277>>>>>end_function 36278>>>>> 36278>>>>>class cVirtualIndex is a cArray 36279>>>>> item_property_list 36279>>>>> item_property integer piFile.i 36279>>>>> item_property integer piField.i 36279>>>>> item_property string psValue.i 36279>>>>> end_item_property_list cVirtualIndex #REM 36314 DEFINE FUNCTION PSVALUE.I INTEGER LIROW RETURNS STRING #REM 36318 DEFINE PROCEDURE SET PSVALUE.I INTEGER LIROW STRING VALUE #REM 36322 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER #REM 36326 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE #REM 36330 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER #REM 36334 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE 36339>>>>> procedure ReadValues 36341>>>>> integer row# max# file# field# type# dec# 36341>>>>> string rval# value# 36341>>>>> move "" to rval# 36342>>>>> get row_count to max# 36343>>>>> for row# from 0 to (max#-1) 36349>>>>>> 36349>>>>> get piFile.i row# to file# 36350>>>>> get piField.i row# to field# 36351>>>>> get FieldInf_FieldValue file# field# to value# 36352>>>>> get FieldInf_FieldType file# field# to type# 36353>>>>> if type# eq DF_DATE begin 36355>>>>> move (integer(date(value#))) to value# 36356>>>>> move (NumToStrR(value#,0,6)) to value# 36357>>>>> end 36357>>>>>> 36357>>>>> if type# eq DF_BCD begin 36359>>>>> get FieldInf_DecPoints file# field# to dec# 36360>>>>> move (NumToStrR(value#,dec#,14)) to value# 36361>>>>> end 36361>>>>>> 36361>>>>> set psValue.i row# to value# 36362>>>>> loop 36363>>>>>> 36363>>>>> end_procedure 36364>>>>> function sIndexValue returns string 36366>>>>> integer row# max# 36366>>>>> string rval# 36366>>>>> move "" to rval# 36367>>>>> get row_count to max# 36368>>>>> decrement max# 36369>>>>> for row# from 0 to max# 36375>>>>>> 36375>>>>> move (rval#+psValue.i(self,row#)) to rval# 36376>>>>> if row# ne max# move (rval#+" ") to rval# 36379>>>>> loop 36380>>>>>> 36380>>>>> function_return rval# 36381>>>>> end_function 36382>>>>> function sSegmentName integer seg# returns string 36384>>>>> function_return (FieldInf_FieldLabel_Long(piFile.i(self,seg#),piField.i(self,seg#))) 36385>>>>> end_function 36386>>>>> function sIndexNames returns string // FieldInf_FieldLabel_Long 36388>>>>> integer row# max# 36388>>>>> string rval# 36388>>>>> move "" to rval# 36389>>>>> get row_count to max# 36390>>>>> decrement max# 36391>>>>> for row# from 0 to max# 36397>>>>>> 36397>>>>> move (rval#*FieldInf_FieldLabel_Long(piFile.i(self,row#),piField.i(self,row#))) to rval# 36398>>>>> if row# ne max# move (rval#+",") to rval# 36401>>>>> loop 36402>>>>>> 36402>>>>> function_return rval# 36403>>>>> end_function 36404>>>>> procedure reset 36406>>>>> send delete_data 36407>>>>> end_procedure 36408>>>>> procedure add_segment integer file# integer field# 36410>>>>> integer row# 36410>>>>> get row_count to row# 36411>>>>> set piFile.i row# to file# 36412>>>>> set piField.i row# to field# 36413>>>>> end_procedure 36414>>>>>end_class // cVirtualIndex 36415>>>>> 36415>>>>>class cVirtualIndices is a cArray 36416>>>>> procedure construct_object integer img# 36418>>>>> forward send construct_object img# 36420>>>>> property integer piCurrentIdx public 0 36421>>>>> end_procedure 36422>>>>> item_property_list 36422>>>>> item_property string psIndexName.i 36422>>>>> item_property integer piObj.i 36422>>>>> end_item_property_list cVirtualIndices #REM 36454 DEFINE FUNCTION PIOBJ.I INTEGER LIROW RETURNS INTEGER #REM 36458 DEFINE PROCEDURE SET PIOBJ.I INTEGER LIROW INTEGER VALUE #REM 36462 DEFINE FUNCTION PSINDEXNAME.I INTEGER LIROW RETURNS STRING #REM 36466 DEFINE PROCEDURE SET PSINDEXNAME.I INTEGER LIROW STRING VALUE 36471>>>>> function iObject.i integer index# returns integer 36473>>>>> integer rval# 36473>>>>> get piObj.i index# to rval# 36474>>>>> ifnot rval# begin 36476>>>>> object oVirtualIndex is a cVirtualIndex no_image 36478>>>>> move self to rval# 36479>>>>> end_object 36480>>>>> set piObj.i index# to rval# 36481>>>>> end 36481>>>>>> 36481>>>>> function_return rval# 36482>>>>> end_function 36483>>>>> procedure define_index integer index# string name# 36485>>>>> set psIndexName.i index# to name# 36486>>>>> set piObj.i index# to (iObject.i(self,index#)) 36487>>>>> set piCurrentIdx to index# 36488>>>>> end_procedure 36489>>>>> procedure add_segment integer file# integer field# 36491>>>>> integer idx# obj# 36491>>>>> get piCurrentIdx to idx# 36492>>>>> get piObj.i idx# to obj# 36493>>>>> send add_segment to obj# file# field# 36494>>>>> end_procedure 36495>>>>> procedure reset 36497>>>>> integer row# max# obj# 36497>>>>> get row_count to max# 36498>>>>> for row# from 0 to (max#-1) 36504>>>>>> 36504>>>>> get piObj.i row# to obj# 36505>>>>> if obj# send request_destroy_object to obj# 36508>>>>> loop 36509>>>>>> 36509>>>>> send delete_data 36510>>>>> end_procedure 36511>>>>>end_class // cVirtualIndices 36512>>>>> 36512>>>>>integer oFieldInf_VitualIndices# 36512>>>>>object oFieldInf_VitualIndices is a cArray 36514>>>>> move self to oFieldInf_VitualIndices# 36515>>>>>end_object 36516>>>>> 36516>>>>>function FieldInf_VirtualIndices_Object global integer file# returns integer 36518>>>>> function_return (value(oFieldInf_VitualIndices#,file#)) 36519>>>>>end_function 36520>>>>>procedure set FieldInf_VirtualIndices_Object global integer file# integer value# 36522>>>>> set value of oFieldInf_VitualIndices# item file# to value# 36523>>>>>end_procedure 36524>>>>>function FieldInf_VirtualIndex_Object global integer file# integer idx# returns integer 36526>>>>> integer obj# 36526>>>>> get FieldInf_VirtualIndices_Object file# to obj# 36527>>>>> if obj# get piObj.i of obj# idx# to obj# 36530>>>>> function_return obj# 36531>>>>>end_function 36532>>>>> 36532>>>>>function FieldInf_ValidationTableObject global integer liFile integer liField returns integer 36534>>>>> integer lhDD lhValTbl 36534>>>>> get iDD_Object liFile to lhDD 36535>>>>> if lhDD get Field_Table_Object of lhDD liField to lhValTbl 36538>>>>> else move 0 to lhValTbl 36540>>>>> function_return lhValTbl 36541>>>>>end_function 36542>>>>>function FieldInf_ValidationTableDecodeValue global integer liFile integer liField string lsValue returns string 36544>>>>> integer lhValTbl liMax liRow 36544>>>>> string lsData lsDescr 36544>>>>> get FieldInf_ValidationTableObject liFile liField to lhValTbl 36545>>>>> if lhValTbl begin 36547>>>>> send fill_list of lhValTbl 36548>>>>> get Data_Item_Count of lhValTbl to liMax 36549>>>>> decrement liMax 36550>>>>> for liRow from 0 to liMax 36556>>>>>> 36556>>>>> get Data_Value of lhValTbl liRow to lsData 36557>>>>> get Data_Description of lhValTbl liRow to lsDescr 36558>>>>> if (lsDescr="") move lsData to lsDescr 36561>>>>> if (lsValue=lsData) function_return lsDescr 36564>>>>> loop 36565>>>>>> 36565>>>>> 36565>>>>> end 36565>>>>>> 36565>>>>> function_return "N/A" 36566>>>>>end_function 36567>>>Use Macros.utl // Various macros (DESKTOP_SECTION command) 36567>>> 36567>>>Use cDbRichEdit.pkg // RTF classes Including file: cDbRichEdit.pkg (C:\Programmer\Visual DataFlex 12.0\Pkg\cDbRichEdit.pkg) 36567>>>>>Use cRichEdit.pkg Including file: cRichEdit.pkg (C:\Programmer\Visual DataFlex 12.0\Pkg\cRichEdit.pkg) 36567>>>>>>>use Windows.pkg 36567>>>>>>>Use cEdit_Mixin.pkg 36567>>>>>>> 36567>>>>>>>// DFO: cRichEdit.Dfo 36567>>>>>>>// DFC: cRichEdit.Dfc 36567>>>>>>> 36567>>>>>>>// constants used for RichEdit Properties 36567>>>>>>>// peAlignment 36567>>>>>>>Enum_List 36567>>>>>>> Define alLeft for 1 36567>>>>>>> Define alRight for 2 36567>>>>>>> Define alCenter for 3 36567>>>>>>>End_Enum_List 36567>>>>>>> 36567>>>>>>>// peBullets 36567>>>>>>>Enum_List 36567>>>>>>> Define buNone 36567>>>>>>> Define buBullets 36567>>>>>>> Define buArabicNumbers 36567>>>>>>> Define buLowerLetters 36567>>>>>>> Define buUpperLetters 36567>>>>>>> Define buLowerRomans 36567>>>>>>> Define buUpperRomans 36567>>>>>>>End_Enum_List 36567>>>>>>> 36567>>>>>>>// peBulletStyle 36567>>>>>>>Enum_List 36567>>>>>>> Define busRightParen for 0 36567>>>>>>> Define busEncloseParen for 256 36567>>>>>>> Define busPeriod for 512 36567>>>>>>> Define busNumberOnly for 768 36567>>>>>>> Define busNoDisplay for 1024 36567>>>>>>>End_Enum_List 36567>>>>>>> 36567>>>>>>>// peLineSpacingType 36567>>>>>>>Enum_List 36567>>>>>>> Define lstSingle 36567>>>>>>> Define lstSingleAndOneHalf 36567>>>>>>> Define lstDouble 36567>>>>>>>End_Enum_List 36567>>>>>>> 36567>>>>>>>Class cRichEdit Is A DFBaseRichEdit 36568>>>>>>> 36568>>>>>>> Procedure Construct_Object 36570>>>>>>> Forward Send Construct_Object 36572>>>>>>> Send Define_cEdit_Mixin 36573>>>>>>> 36573>>>>>>> On_key Key_Ctrl+Key_B send ToggleBold 36574>>>>>>> On_key Key_Ctrl+Key_I send ToggleItalics 36575>>>>>>> On_key Key_Ctrl+Key_U send ToggleUnderline 36576>>>>>>> 36576>>>>>>> End_Procedure // Construct_Object 36577>>>>>>> 36577>>>>>>> Import_Class_Protocol cEdit_Mixin 36578>>>>>>> 36578>>>>>>> Procedure ToggleBold 36580>>>>>>> Set pbBold to (not(pbBold(self))) 36581>>>>>>> end_procedure 36582>>>>>>> 36582>>>>>>> Procedure ToggleItalics 36584>>>>>>> Set pbItalics to (not(pbItalics(self))) 36585>>>>>>> end_procedure 36586>>>>>>> 36586>>>>>>> Procedure ToggleUnderline 36588>>>>>>> Set pbUnderLine to (not(pbUnderLine(self))) 36589>>>>>>> end_procedure 36590>>>>>>> 36590>>>>>>>End_Class 36591>>>>>>> 36591>>>>>Use Text_Win.pkg 36591>>>>>Use DFNav_mx.pkg // Navigation changes for DF DEOs 36591>>>>>Use DFCdDeo.pkg // DEO Code message support 36591>>>>>Use DD_Deomx.pkg // mixin support for dd classes 36591>>>>> 36591>>>>>// DFO: cDbRichEdit.Dfo 36591>>>>>// DFC: cDbRichEdit.Dfc 36591>>>>> 36591>>>>>Class cDbRichEdit_ is a cRichEdit 36592>>>>> 36592>>>>> Import_Class_Protocol Text_Window_mixin 36593>>>>> 36593>>>>> // 36593>>>>> // created for EntItem simulation and Server support: 36593>>>>> // if file# = 0, display only if Data_File is in Done-array 36593>>>>> // else display only if file# = Data_File 36593>>>>> // 36593>>>>> procedure Entry_Display integer iFile integer iFlag 36595>>>>> Boolean bUpdate bOld 36595>>>>> Integer iDataFile 36595>>>>> get data_file to iDataFile 36596>>>>> if (iDataFile) begin // if not data file, we have nothing to update 36598>>>>> if (iFile=0) begin 36600>>>>> is_file_included iDataFile 1 36601>>>>> Move (found) to bUpdate 36602>>>>> end 36602>>>>>> 36602>>>>> else begin 36603>>>>> Move (iFile=iDataFile or iFlag) to bUpdate 36604>>>>> end 36604>>>>>> 36604>>>>> 36604>>>>> If bUpdate begin 36606>>>>> get dynamic_update_state to bOld 36607>>>>> set dynamic_update_state to false 36608>>>>> send Delete_Data // init buffer 36609>>>>> send DisplayData // read buffer from file 36610>>>>> send beginning_of_data 36611>>>>> set dynamic_update_state to bOld 36612>>>>> end 36612>>>>>> 36612>>>>> end 36612>>>>>> 36612>>>>> end_procedure 36613>>>>> 36613>>>>> Procedure DisplayData 36615>>>>> integer iFile iField iFldLen 36615>>>>> Address pField 36615>>>>> Boolean bOk bOld 36615>>>>> Get Data_File to iFile 36616>>>>> Get Data_Field to iField 36617>>>>> If (iFile>0 and iField>0) begin 36619>>>>> Get Change_Disabled_State to bOld 36620>>>>> Set Change_Disabled_State to True 36621>>>>> Get_Attribute DF_FIELD_LENGTH of iFile iField to iFldLen 36624>>>>> Move (Alloc(iFldLen)) to pField 36625>>>>> Get_Field_value iFile iField to pField 36628>>>>> Set paValue to pField 36629>>>>> Move (Free(pField)) to bOk 36630>>>>> Set Change_Disabled_State to bOld 36631>>>>> end 36631>>>>>> 36631>>>>> End_procedure 36632>>>>> 36632>>>>> // 36632>>>>> // This is designed onlt to work with DDs. With DDs, this is called under 36632>>>>> // two conditons. 36632>>>>> // 1. Update for find (passes iFile and Flag=1). We never want to update for finds. Text is not indexed 36632>>>>> // 2. Update for save (passes iFile=0 and Flag=3). 36632>>>>> // Thus we update if a ddo save (iFlag=3) the field is changed, and the file is in done array 36632>>>>> // 36632>>>>> procedure Entry_Update integer iFile integer iFlag 36634>>>>> Integer iDataFile 36634>>>>> Boolean bUpdate 36634>>>>> If (iFlag=3 and changed_State(Self)) begin 36636>>>>> get Data_File to iDataFile 36637>>>>> If (iDataFile) begin 36639>>>>> is_file_included iDataFile 1 // is file in done array (will it get saved)? 36640>>>>> Move (found) to bUpdate 36641>>>>> end 36641>>>>>> 36641>>>>> If bUpdate begin 36643>>>>> send UpdateData 36644>>>>> end 36644>>>>>> 36644>>>>> end 36644>>>>>> 36644>>>>> end_procedure 36645>>>>> 36645>>>>> // Move data from Text Control to the File/field buffer 36645>>>>> Procedure UpdateData 36647>>>>> integer iFile iField iFldLen 36647>>>>> Address pField 36647>>>>> Boolean bOk 36647>>>>> Get Data_File to iFile 36648>>>>> Get Data_Field to iField 36649>>>>> If (iFile>0 and iField>0) begin 36651>>>>> Get paValue to pField 36652>>>>> //Move (Length(pField)) to iFldLen 36652>>>>> Move (CStringLength(pField)) to iFldLen 36653>>>>> Set_Field_Value iFile iField to pField LENGTH iFldLen 36656>>>>> Move (Free(pField)) to bOk 36657>>>>> end 36657>>>>>> 36657>>>>> End_procedure 36658>>>>> 36658>>>>>End_Class 36659>>>>> 36659>>>>>Class cDbRichEditDS_ is a cDbRichEdit_ 36660>>>>> 36660>>>>> Procedure Construct_Object 36662>>>>> Forward Send Construct_Object 36664>>>>> Send Define_DFNavigation // GUI navigate changes 36665>>>>> // restore standard begin/end of text window behavior (which 36665>>>>> // is altered by CM packages 36665>>>>> On_key kBegin_of_data send default_key 36666>>>>> On_key kEnd_of_data send default_key 36667>>>>> End_Procedure // Construct_Object 36668>>>>> 36668>>>>> Import_Class_Protocol DFNavigate_Mixin 36669>>>>> Import_Class_Protocol DFCode_DEO_Mixin 36670>>>>> Import_Class_Protocol DataFile_Help_Mixin 36671>>>>> 36671>>>>> // these should be in text_win.pkg All DEOs shoudld understand this 36671>>>>> // message. Needed for smart pulldown shadowing of these items 36671>>>>> // 36671>>>>> Function Prompt_Object integer item# returns integer 36673>>>>> End_Function 36674>>>>> 36674>>>>> Function Zoom_Object integer item# returns integer 36676>>>>> End_Function 36677>>>>> 36677>>>>> Procedure Bind_Data integer File# Integer Field# 36679>>>>> Set Data_File to File# 36680>>>>> Set Data_Field to Field# 36681>>>>> End_Procedure // Bind_Data 36682>>>>> 36682>>>>> // augment to raise an error if the field length is too long. With Rich edit we only know this when we try 36682>>>>> // to update the buffer 36682>>>>> function Validate_Items integer flag returns integer 36684>>>>> integer iFile iField iFldLen iEditLen 36684>>>>> Address pField 36684>>>>> Boolean bOk 36684>>>>> Get Data_File to iFile 36685>>>>> Get Data_Field to iField 36686>>>>> If (iFile>0 and iField>0) begin 36688>>>>> Get_Attribute DF_FIELD_LENGTH of iFile iField to iFldLen 36691>>>>> Get CharCount to iEditLen 36692>>>>> If (iEditLen>iFldLen) begin 36694>>>>> Send Activate_Area True 36695>>>>> Error DFERR_TEXT_TOO_LARGE_FOR_FIELD (sFormat(C_$MaxLenAndCurrentLen,iFldLen,iEditLen)) 36696>>>>>> 36696>>>>> Function_return 1 36697>>>>> end 36697>>>>>> 36697>>>>> end 36697>>>>>> 36697>>>>> end_function 36698>>>>> 36698>>>>> 36698>>>>>End_Class 36699>>>>> 36699>>>>> 36699>>>>> 36699>>>>>Class cDbRichEdit is a cDbRichEditDS_ 36700>>>>> Import_Class_Protocol Extended_DEO_Status_Help_Mixin 36701>>>>> 36701>>>>> Procedure Construct_Object 36703>>>>> Forward Send Construct_Object 36705>>>>> Property Integer Auto_Label_State False 36706>>>>> End_Procedure // Construct_Object 36707>>>>> 36707>>>>> //************************************************************************// 36707>>>>> // Copy_Item_Options // 36707>>>>> // Currently there is nothing to do except optionally support an auto- // 36707>>>>> // label. We maintain this format to keep in similar to the other DEOs // 36707>>>>> //************************************************************************// 36707>>>>> // 36707>>>>> Procedure Copy_Item_Options Integer iDSO Integer iFile Integer iField ; Integer iDEO Integer iItem 36709>>>>> If not (Extended_DSO_State(iDSO)) ; Procedure_Return 36712>>>>> If (Auto_Label_State(self)) ; Send Assign_DD_Label iDSO iFile iField iDEO iItem 36715>>>>> End_Procedure 36716>>>>> 36716>>>>> //************************************************************************// 36716>>>>> // Assign_DD_Label // 36716>>>>> // This assigns the DEO's from the DD. This uses long labels and // 36716>>>>> // and sets the label property // 36716>>>>> //************************************************************************// 36716>>>>> // 36716>>>>> Procedure Assign_DD_Label Integer iDSO Integer iFile Integer iField ; Integer iDEO Integer iItem 36718>>>>> string sName 36718>>>>> Get File_Field_Label of iDSO iFile iField DD_LABEL_LONG to sName 36719>>>>> Set Label to sName 36720>>>>> End_Procedure 36721>>>>> 36721>>>>>End_Class 36722>>>>> 36722>>>>> 36722>>>>> 36722>>> 36722>>> // location of objects runtime. 36722>>> 36722>>> // between tab pages using ctrl+PgUp/PgDn. 36722>>> // This is in sync. with standard MS beha. 36722>>> 36722>>> 36722>>>// Relative location of objects: 36722>>>define SL_DOWN for -1 36722>>>define SL_LEFT for -2 36722>>>define SL_LOWER_RIGHT_CORNER_EXTEND_ROW for -3 36722>>>define SL_CURRENT_POS_NO_LABEL_ADJUST for -4 36722>>>define SL_RIGHT for -5 36722>>>define SL_UP for -6 36722>>>define SL_LOWER_RIGHT_CORNER for -7 36722>>>define SL_XRIGHT for -8 36722>>>define SL_UPPER_RIGHT_CORNER_EXTEND_COLUMN for -9 36722>>>define SL_RIGHT_SPACE for -10 36722>>>define SL_CURRENT_POS for -11 36722>>> 36722>>>define SL_ALIGN_LEFT for 1 36722>>>define SL_ALIGN_RIGHT for 2 36722>>>define SL_ALIGN_TOP for 4 36722>>>define SL_ALIGN_BOTTOM for 8 36722>>>define SL_ALIGN_CENTER for 16 36722>>>define SL_ALIGN_VCENTER for 32 36722>>> 36722>>>define SL_HORIZONTAL for 1 36722>>>define SL_VERTICAL for 2 36722>>> 36722>>>define APS.ITEM_OPTION_CAPSLOCK for 19 36722>>> 36722>>>//> This function translates form_margin to form_width (or column_width). It 36722>>>//> does so taking into account the data type and whether or not the field 36722>>>//> is capslocked. 36722>>>function aps.form_width.iii for BaseClass integer typ# integer mrg# integer caps# returns integer 36724>>> integer rval# 36724>>> if typ# eq ASCII_WINDOW begin // Ascii: 36726>>> if caps# move (mrg#*8+5 max 20) to rval# // If capsl: 8 units per character. 36729>>> else move (mrg#*5+5 max 20) to rval# // Otherwise 5. At least 20. 36731>>> end 36731>>>> 36731>>> else begin 36732>>> if typ# eq DATE_WINDOW move 47 to rval# // Dates are 47, period! 36735>>> else begin 36736>>> move (mrg#*4+7) to rval# // Digits are easy. They always have the same width. 36737>>> if (mrg#=2) move (rval#+9) to rval# // Spooky correction! 36740>>> if (mrg#=4) move (rval#+9) to rval# // Spooky correction! 36743>>> if (mrg#=6) move (rval#+9) to rval# // Spooky correction! 36746>>> if (mrg#=8) move (rval#+9) to rval# // Spooky correction! 36749>>> end 36749>>>> 36749>>> end 36749>>>> 36749>>> function_return rval# 36750>>>end_function 36751>>> 36751>>>function FieldWidthMDU global integer liFile integer liField returns integer 36753>>> integer lhDD liType lbCaps liLen 36753>>> 36753>>> move FALSE to lbCaps 36754>>> if (liField<255) begin 36756>>> get DataDictionary_Object liFile to lhDD 36757>>> if lhDD get Field_Option of lhDD liField DD_CAPSLOCK to lbCaps 36760>>> end 36760>>>> 36760>>> 36760>>> get FieldInf_FieldType liFile liField to liType 36761>>> get FieldInf_Field_Length liFile liField to liLen 36762>>> 36762>>> if (liType=DF_DATE) function_return 47 36765>>> if (liType=DF_ASCII) begin 36767>>> if lbCaps function_return (liLen*8+5 max 20) // If capsl: 8 units per character. 36770>>> else function_return (liLen*5+5 max 20) // Otherwise 5. At least 20. 36772>>> end 36772>>>> 36772>>> if (liType=DF_BCD) begin 36774>>> function_return (liLen*4+7) // Digits are easy. They always have the same width. 36775>>> end 36775>>>> 36775>>> function_return 0 36776>>>end_function 36777>>> 36777>>>External_Function32 ApsOemToCharA "OemToCharA" User32.DLL Pointer hpszOem Pointer hpszWindow Returns Integer 36778>>>Function APS_OemToChar Global String OemStr Returns String 36780>>> String CharStr 36780>>> Integer OemAdress CharAdress grb# 36780>>> Append OemStr (Character(0)) 36781>>> Move (Repeat(Character(0), (Length(OemStr)))) To CharStr 36782>>> GetAddress Of OemStr To OemAdress 36783>>> GetAddress Of CharStr To CharAdress 36784>>> Move (ApsOemToCharA(OemAdress, CharAdress)) To grb# 36785>>> Function_Return (CString(CharStr)) 36786>>>End_Function 36787>>> 36787>>>// Insert: 36787>>>// I'm sure this can be done more gracefully. Still... 36787>>>number aps.gui2mdu_width# aps.gui2mdu_height# 36787>>> 36787>>>desktop_section 36792>>> object ApsTestGuiConv is a dfcontainer 36794>>> procedure damit 36797>>> integer low_h# low_w# 36797>>> integer hi_h# hi_w# 36797>>> set guisize to 20 20 36798>>> send adjust_logicals 36799>>> get size to low_w# 36800>>> move (hi(low_w#)) to low_h# 36801>>> move (low(low_w#)) to low_w# 36802>>> set guisize to 420 420 36803>>> send adjust_logicals 36804>>> get size to hi_w# 36805>>> move (hi(hi_w#)) to hi_h# 36806>>> move (low(hi_w#)) to hi_w# 36807>>> move (hi_h#-low_h#/400.0) to aps.gui2mdu_height# 36808>>> move (hi_w#-low_w#/400.0) to aps.gui2mdu_width# 36809>>> end_procedure 36810>>> send damit 36811>>> end_object 36812>>>end_desktop_section 36817>>> 36817>>>class aps.tabulator_array is an array 36818>>> procedure tab_column_define integer tab# integer val# integer label_width# integer label_just# 36820>>> integer base# 36820>>> move (tab#*3) to base# 36821>>> set value item base# to val# 36822>>> set value item (base#+1) to label_width# 36823>>> set value item (base#+2) to label_just# 36824>>> end_procedure 36825>>> procedure tab_label_column_goto integer tab# 36827>>> delegate set p_cur_column to (integer(value(self,tab#*3))-integer(value(self,tab#*3+1))) 36829>>> end_procedure 36830>>> procedure tab_column_goto integer tab# 36832>>> delegate set p_cur_column to (value(self,tab#*3)) 36834>>> end_procedure 36835>>> function ilabel_width.i integer tab# returns integer 36837>>> function_return (value(self,tab#*3+1)) 36838>>> end_function 36839>>> function ilabel_just.i integer tab# returns integer 36841>>> function_return (value(self,tab#*3+2)) 36842>>> end_function 36843>>>end_class 36844>>> 36844>>>//> Class aps_panel_mx is mixed into aps.(db)ModalPanel and aps.(db)View. All 36844>>>//> other APS objects must be nested inside one of these. 36844>>>class aps_panel_mx is a mixin 36845>>> procedure define_aps_panel_mx 36847>>> property integer p_resize_in_progress private DFTRUE 36848>>> property integer pMinimumSize private 0 36849>>> set p_auto_column to false 36850>>> end_procedure 36851>>> 36851>>> procedure set pMinimumSize integer x# integer y# 36853>>> set aps_panel_mx.pMinimumSize to (x#*65536+y#) 36854>>> end_procedure 36855>>> 36855>>> function pMinimumSize returns integer 36857>>> function_return (aps_panel_mx.pMinimumSize(self)) 36858>>> end_function 36859>>> 36859>>> procedure aps_MakeMinimumSize 36861>>> integer size# 36861>>> get size to size# 36862>>> set pMinimumSize to (hi(size#)) (low(size#)) 36863>>> end_procedure 36864>>> 36864>>> procedure end_define_aps_panel_mx 36866>>> send aps_beautify 36867>>> set aps_panel_mx.p_resize_in_progress to false 36868>>> end_procedure 36869>>> 36869>>> function aps_PanelID returns integer 36871>>> function_return self 36872>>> end_function 36873>>> 36873>>> procedure aps_beautify 36875>>> end_procedure 36876>>> 36876>>> procedure aps_onResize integer delta_rw# integer delta_cl# 36878>>> // SAMPLE09.SRC shows how to use this in a simple panel 36878>>> end_procedure 36879>>> 36879>>> procedure onResize // Event sent when panel is displayed or resized 36881>>> integer old_rw# old_cl# new_rw# new_cl# 36881>>> ifnot (aps_panel_mx.p_resize_in_progress(self)) begin 36883>>> set aps_panel_mx.p_resize_in_progress to true 36884>>> get size to old_cl# 36885>>> move (hi(old_cl#)) to old_rw# 36886>>> move (low(old_cl#)) to old_cl# 36887>>> send adjust_logicals 36888>>> get size to new_cl# 36889>>> move (hi(new_cl#)) to new_rw# 36890>>> move (low(new_cl#)) to new_cl# 36891>>> send aps_init 36892>>> if new_rw# lt (hi(aps_panel_mx.pMinimumSize(self))) move (hi(aps_panel_mx.pMinimumSize(self))) to new_rw# 36895>>> if new_cl# lt (low(aps_panel_mx.pMinimumSize(self))) move (low(aps_panel_mx.pMinimumSize(self))) to new_cl# 36898>>> send aps_onResize (new_rw#-old_rw#) (new_cl#-old_cl#) 36899>>> set aps_panel_mx.p_resize_in_progress to false 36900>>> end 36900>>>> 36900>>> end_procedure 36901>>>end_class 36902>>> 36902>>>desktop_section 36907>>> object oAPS_Stack is an array 36909>>> procedure Push.i integer value# 36912>>> set value item (item_count(self)) to value# 36913>>> end_procedure 36914>>> function iPop returns integer 36917>>> integer rval# itm# 36917>>> move (item_count(self)-1) to itm# 36918>>> get value item itm# to rval# 36919>>> send delete_item itm# 36920>>> function_return rval# 36921>>> end_function 36922>>> end_object 36923>>> object oAPS_PresetColumnWidths is a array 36925>>> end_object 36926>>>end_desktop_section 36931>>> 36931>>>//> Class aps_container_mx is mixed into all visual container classes. That 36931>>>//> means that all APS container classes have the properties and the methods 36931>>>//> defined by this class: 36931>>>class aps_container_mx is a mixin 36932>>> procedure define_aps_container_mx 36934>>> property integer p_left_margin public 5 //These are all 36935>>> property integer p_right_margin public 5 // measured in 36936>>> property integer p_top_margin public 5 // map_dialog- 36937>>> property integer p_bottom_margin public 5 // units 36938>>> property integer p_form_height public 13 // 36939>>> property integer p_cur_row public 5 // 36940>>> property integer p_cur_column public 5 // 36941>>> property integer p_max_row public 0 // 36942>>> property integer p_max_column public 0 // 36943>>> property integer p_row_space public 2 // 36944>>> property integer p_column_space public 2 // 36945>>> property integer p_last_object public 0 // Last object positioned 36946>>> // by container. 36946>>> //> p_lrcer_offset is used to determine the amount of extra row space 36946>>> //> inserted when snapping to SL_LOWER_RIGHT_CORNER_EXTEND_ROW (lrcer) 36946>>> property integer p_lrcer_offset public 3 36947>>> //> p_urcec_offset is used to determine the amount of extra column space 36947>>> //> inserted when snapping to SL_UPPER_RIGHT_CORNER_EXTEND_COLUMN (urcec) 36947>>> property integer p_urcec_offset public 3 36948>>> 36948>>> property integer p_auto_column private 1 36949>>> property integer p_auto_column_just_set private 1 36950>>> 36950>>> //> Should the container auto size?: 36950>>> property integer p_auto_size_container_state public true 36951>>> 36951>>> object column_array is an aps.tabulator_array 36953>>> send tab_column_define 1 60 55 JMODE_LEFT // Default column setting 36954>>> end_object 36955>>> end_procedure 36956>>> 36956>>> function aps_parent returns integer 36958>>> function_return self 36959>>> end_function 36960>>> 36960>>> procedure set p_auto_column integer col# 36962>>> set aps_container_mx.p_auto_column to col# 36963>>> set aps_container_mx.p_auto_column_just_set to true // No automatic lf! 36964>>> end_procedure 36965>>> function p_auto_column returns integer 36967>>> function_return (aps_container_mx.p_auto_column(self)) 36968>>> end_function 36969>>> 36969>>> procedure end_define_aps_container_mx 36971>>> if (p_auto_size_container_state(self)) send aps_auto_size_container 36974>>> end_procedure 36975>>> 36975>>> procedure tab_column_define integer tab# integer val# integer label_width# integer label_just# 36977>>> send tab_column_define to (column_array(self)) tab# val# label_width# label_just# 36978>>> end_procedure 36979>>> 36979>>> procedure tab_column_define_adhoc integer tab# 36981>>> integer lhObj loc# 36981>>> get p_last_object to lhObj 36982>>> get location of lhObj to loc# 36983>>> move (low(loc#)) to loc# 36984>>> send tab_column_define tab# loc# 100 jmode_right 36985>>> end_procedure 36986>>> 36986>>> procedure aps_push_current_position 36988>>> integer lhObj 36988>>> move (oAPS_Stack(self)) to lhObj 36989>>> send push.i to lhObj (p_cur_row(self)) 36990>>> send push.i to lhObj (p_cur_column(self)) 36991>>> send push.i to lhObj (p_last_object(self)) 36992>>> end_procedure 36993>>> 36993>>> procedure aps_pop_current_position 36995>>> integer lhObj 36995>>> move (oAPS_Stack(self)) to lhObj 36996>>> set p_last_object to (iPop(lhObj)) 36997>>> set p_cur_column to (iPop(lhObj)) 36998>>> set p_cur_row to (iPop(lhObj)) 36999>>> end_procedure 37000>>> 37000>>> procedure aps_push_max_positions 37002>>> integer lhObj 37002>>> move (oAPS_Stack(self)) to lhObj 37003>>> send push.i to lhObj (p_max_row(self)) 37004>>> send push.i to lhObj (p_max_column(self)) 37005>>> end_procedure 37006>>> 37006>>> procedure aps_pop_max_positions 37008>>> integer lhObj p_max_row# p_max_column# 37008>>> move (oAPS_Stack(self)) to lhObj 37009>>> move (iPop(lhObj)) to p_max_column# 37010>>> move (iPop(lhObj)) to p_max_row# 37011>>> if p_max_column# gt (p_max_column(self)) set p_max_column to p_max_column# 37014>>> if p_max_row# gt (p_max_row(self)) set p_max_row to p_max_row# 37017>>> end_procedure 37018>>> 37018>>> procedure tab_column_goto integer tab# 37020>>> send tab_column_goto to (column_array(self)) tab# 37021>>> end_procedure 37022>>> procedure tab_label_column_goto integer tab# 37024>>> send tab_label_column_goto to (column_array(self)) tab# 37025>>> end_procedure 37026>>> 37026>>> procedure make_row_space integer amount# // Move the cursor down 37028>>> integer tmp# 37028>>> ifnot num_arguments move (p_row_space(self)) to tmp# 37031>>> else move amount# to tmp# 37033>>> set p_cur_row to (tmp#+p_cur_row(self)) 37034>>> end_procedure 37035>>> 37035>>> procedure make_column_space integer amount# // Advance cursor to the left 37037>>> integer tmp# 37037>>> ifnot num_arguments move (p_column_space(self)) to tmp# 37040>>> else move amount# to tmp# 37042>>> set p_cur_column to (tmp#+p_cur_column(self)) 37043>>> end_procedure 37044>>> 37044>>> //> Because combo forms are the only objects (until now) that 37044>>> //> does not have a visual size corresponding to their size-setting, 37044>>> //> we have to treat combo's much differently. Therefore this 37044>>> //> function is provided to help determine whether we are dealing 37044>>> //> with a combo form or not. 37044>>> function is_comboform integer lhObj returns integer 37046>>> integer dm# rval# 37046>>> get delegation_mode of lhObj to dm# 37047>>> set delegation_mode of lhObj to NO_DELEGATE_OR_ERROR 37048>>> get p_is_comboform of lhObj to rval# 37049>>> set delegation_mode of lhObj to dm# 37050>>> function_return rval# 37051>>> end_function 37052>>> 37052>>> //> The idea of this function is to retrieve value of property 37052>>> //> p_extra_external_width. But since we are not sure that 37052>>> //> is one of ours (meaning and APS object), we retrieve it this way: 37052>>> function extra_external_width integer lhObj returns integer 37054>>> integer dm# rval# 37054>>> get delegation_mode of lhObj to dm# 37055>>> set delegation_mode of lhObj to NO_DELEGATE_OR_ERROR 37056>>> get p_extra_external_width of lhObj to rval# 37057>>> set delegation_mode of lhObj to dm# 37058>>> function_return rval# 37059>>> end_function 37060>>> 37060>>> //> The idea of this function is to retrieve value of property 37060>>> //> p_extra_internal_width. But since we are not sure that 37060>>> //> is one of ours (APS), we retrieve it this way. 37060>>> function extra_internal_width integer lhObj returns integer 37062>>> integer dm# rval# 37062>>> get delegation_mode of lhObj to dm# 37063>>> set delegation_mode of lhObj to NO_DELEGATE_OR_ERROR 37064>>> get p_extra_internal_width of lhObj to rval# 37065>>> set delegation_mode of lhObj to dm# 37066>>> function_return rval# 37067>>> end_function 37068>>> 37068>>> //> This one is used internally by the mixin classes to update properties 37068>>> //> p_max_row and p_max_column with respect to a (control) object. It 37068>>> //> may be used externally to make the container aware of an object that 37068>>> //> has been sized and located manually. 37068>>> procedure aps_register_max_rc integer lhObj 37070>>> integer row# col# size# loc# 37070>>> get size of lhObj to size# 37071>>> 37071>>> // The next line fools APS into thinking that the control is only 37071>>> // 13 units high if it is a combo form. 37071>>> if (is_comboform(self,lhObj)) move (13*65536+low(size#)) to size# 37074>>> move (size#+extra_external_width(self,lhObj)) to size# 37075>>> 37075>>> get location of lhObj to loc# 37076>>> move (hi(size#)+hi(loc#)) to row# 37077>>> move (low(size#)+low(loc#)) to col# 37078>>> if (row#>p_max_row(self)) set p_max_row to row# 37081>>> if (col#>p_max_column(self)) set p_max_column to col# 37084>>> end_procedure 37085>>> 37085>>> procedure new_field_row 37087>>> // Carriage return 37087>>> set p_cur_row to (p_cur_row(self)+p_form_height(self)+p_row_space(self)) 37088>>> set p_cur_column to (p_left_margin(self)) 37089>>> end_procedure 37090>>> 37090>>> procedure increment_max_row integer val# 37092>>> integer incr# 37092>>> if num_arguments move val# to incr# 37095>>> else get p_row_space to incr# 37097>>> set p_max_row to (p_max_row(self)+incr#) 37098>>> end_procedure 37099>>> 37099>>> procedure increment_max_column integer val# 37101>>> integer incr# 37101>>> if num_arguments move val# to incr# 37104>>> else get p_column_space to incr# 37106>>> set p_max_column to (p_max_column(self)+incr#) 37107>>> end_procedure 37108>>> 37108>>> procedure aps_init 37110>>> set p_cur_row to (p_top_margin(self)) 37111>>> set p_cur_column to (p_left_margin(self)) 37112>>> set p_max_row to 0 37113>>> set p_max_column to 0 37114>>> // To let each tab-page start a new, we must set p_auto_column_just_set: 37114>>> set aps_container_mx.p_auto_column_just_set to true 37115>>> set p_last_object to 0 37116>>> end_procedure 37117>>> 37117>>> procedure aps_auto_size_container 37119>>> integer cap_height# lhObj 37119>>> move 0 to cap_height# 37120>>> move self to lhObj 37121>>> if (caption_bar(lhObj)) move (GetSystemMetrics (SM_CYSMCAPTION)) to cap_height# // 15 37124>>> set size to (p_max_row(lhObj)+p_bottom_margin(lhObj)+cap_height#) (p_max_column(lhObj)+p_right_margin(lhObj)) 37125>>> end_procedure 37126>>> 37126>>> function p_snap_location returns integer 37128>>> // Default value for controls without property p_snap_location (non aps.-objects) 37128>>> end_function 37129>>> 37129>>> register_function p_extra_external_width returns integer 37129>>> procedure aps_adjust_to_snap_location integer lhObj integer dictate_snap# 37131>>> integer snap_location# label_size# label_offset# column_array# label_just# last_object# 37131>>> integer vertical_offset# dm# label_obj# jmode_top_vert_offset# 37131>>> 37131>>> get delegation_mode of lhObj to dm# 37132>>> set delegation_mode of lhObj to NO_DELEGATE_OR_ERROR 37133>>> 37133>>> get p_snap_location of lhObj to snap_location# 37134>>> if num_arguments gt 1 move dictate_snap# to snap_location# 37137>>> ifnot snap_location# begin 37139>>> // If no snap_location has been defined we try to obtain one 37139>>> // from our container. If we still have no snap_location 37139>>> // we default to SL_RIGHT. 37139>>> get p_auto_column to snap_location# 37140>>> if snap_location# begin 37142>>> ifnot (aps_container_mx.p_auto_column_just_set(self)) send new_field_row 37145>>> else set aps_container_mx.p_auto_column_just_set to false 37147>>> end 37147>>>> 37147>>> else move SL_RIGHT to snap_location# 37149>>> end 37149>>>> 37149>>> 37149>>> get label_object of lhObj to label_obj# 37150>>> move (if(label_obj#,low(size(label_obj#)),0)) to label_size# 37151>>> 37151>>> // Make sure to make a vertical adjustment if a label is present 37151>>> // and it is positioned above the control: 37151>>> if (label_size# and label_justification_mode(lhObj)=jmode_top) begin 37153>>> get p_jmode_top_vert_offset of lhObj to jmode_top_vert_offset# 37154>>> move (hi(label_offset(lhObj))+jmode_top_vert_offset#) to vertical_offset# 37155>>> end 37155>>>> 37155>>> else move 0 to vertical_offset# 37157>>> 37157>>> if snap_location# gt 0 begin // Means that we should locate relative to tabulator 37159>>> move (column_array(self)) to column_array# 37160>>> send tab_column_goto to column_array# snap_location# 37161>>> if label_size# begin 37163>>> move (ilabel_just.i(column_array#,snap_location#)) to label_just# 37164>>> set label_justification_mode of lhObj to label_just# 37165>>> if label_just# eq jmode_left set label_offset of lhObj to 0 (ilabel_width.i(column_array#,snap_location#)) 37168>>> else set label_offset of lhObj to 0 0 37170>>> end 37170>>>> 37170>>> // If snap_column and no label, we just go there (and we already have). 37170>>> end 37170>>>> 37170>>> else begin 37171>>> get p_last_object to last_object# 37172>>> if (snap_location#=SL_RIGHT or snap_location#=SL_RIGHT_SPACE or snap_location#=SL_CURRENT_POS) begin 37174>>> //if last_object# begin // ???? 37174>>> // set p_cur_column to (low(location(last_object#))+low(size(last_object#))+extra_external_width(self,last_object#)+p_column_space(self)) 37174>>> // set p_cur_row to (hi(location(last_object#))) 37174>>> //end // ???? 37174>>> if label_size# begin 37176>>> if (label_justification_mode(lhObj)=JMODE_TOP) begin 37178>>> set p_cur_row to (p_cur_row(self)+vertical_offset#) 37179>>> set label_offset of lhObj to 0 0 37180>>> end 37180>>>> 37180>>> else begin 37181>>> // Advance p_cur_column: 37181>>> set p_cur_column to (p_cur_column(self)+label_size#) 37182>>> set label_justification_mode of lhObj to jmode_right 37183>>> set label_offset of lhObj to 0 0 37184>>> end 37184>>>> 37184>>> end 37184>>>> 37184>>> if snap_location# eq SL_RIGHT_SPACE set p_cur_column to (p_cur_column(self)+10) 37187>>> // If no label and no tab column, we don't do a thing! 37187>>> end 37187>>>> 37187>>> else begin 37188>>> if (snap_location#=SL_XRIGHT and last_object#) begin 37190>>> set p_cur_column to (low(location(last_object#))+low(size(last_object#))+extra_external_width(self,last_object#)+p_column_space(self)) 37191>>> set p_cur_row to (hi(location(last_object#))+vertical_offset#) 37192>>> end 37192>>>> 37192>>> if snap_location# eq SL_DOWN begin 37194>>> set p_cur_column to (low(location(last_object#))) 37195>>> ifnot (is_comboform(self,last_object#)) ; set p_cur_row to (hi(location(last_object#))+hi(size(last_object#))+p_row_space(self)+vertical_offset#) 37198>>> else ; set p_cur_row to (hi(location(last_object#))+13+p_row_space(self)+vertical_offset#) 37200>>> end 37200>>>> 37200>>> if snap_location# eq SL_UP begin 37202>>> set p_cur_column to (low(location(last_object#))) 37203>>> set p_cur_row to (hi(location(last_object#))-p_row_space(self)-hi(size(lhObj))-vertical_offset#) 37204>>> end 37204>>>> 37204>>> if snap_location# eq SL_LEFT begin 37206>>> set p_cur_column to (low(location(last_object#))-p_column_space(self)-low(size(lhObj))-p_extra_external_width(lhObj)) 37207>>> set p_cur_row to (hi(location(last_object#))+vertical_offset#) 37208>>> end 37208>>>> 37208>>> if snap_location# eq SL_LOWER_RIGHT_CORNER_EXTEND_ROW begin 37210>>> set p_cur_column to (p_max_column(self)-low(size(lhObj))) 37211>>> set p_cur_row to (p_max_row(self)+p_row_space(self)+vertical_offset#+p_lrcer_offset(self)) 37212>>> end 37212>>>> 37212>>> if snap_location# eq SL_LOWER_RIGHT_CORNER begin 37214>>> set p_cur_column to (p_max_column(self)-low(size(lhObj))) 37215>>> set p_cur_row to (p_max_row(self)-hi(size(lhObj))-vertical_offset#) 37216>>> end 37216>>>> 37216>>> if snap_location# eq SL_UPPER_RIGHT_CORNER_EXTEND_COLUMN begin 37218>>> set p_cur_column to (p_max_column(self)+p_column_space(self)+p_urcec_offset(self)) 37219>>> set p_cur_row to (p_top_margin(self)+vertical_offset#) 37220>>> end 37220>>>> 37220>>> if snap_location# eq SL_CURRENT_POS begin 37222>>> //set p_cur_column to (p_max_column(self)) 37222>>> //set p_cur_row to (p_top_margin(self)+vertical_offset#) 37222>>> end 37222>>>> 37222>>> end 37222>>>> 37222>>> end 37222>>>> 37222>>> set delegation_mode of lhObj to dm# 37223>>> end_procedure 37224>>> 37224>>> procedure aps_auto_locate_control integer lhObj integer dictate_snap# integer dictate_last_object# 37226>>> integer extra_external_width# dm# 37226>>> get delegation_mode of lhObj to dm# 37227>>> set delegation_mode of lhObj to NO_DELEGATE_OR_ERROR 37228>>> if num_arguments gt 1 begin 37230>>> if num_arguments gt 2 set p_last_object to dictate_last_object# 37233>>> send aps_adjust_to_snap_location lhObj dictate_snap# 37234>>> end 37234>>>> 37234>>> else send aps_adjust_to_snap_location lhObj 37236>>> get p_extra_external_width of lhObj to extra_external_width# 37237>>> set location of lhObj to (p_cur_row(self)) (p_cur_column(self)) 37238>>> set p_cur_column to (p_cur_column(self)+low(size(lhObj))+p_column_space(self)+extra_external_width#) 37239>>> set p_last_object to lhObj 37240>>> send aps_register_max_rc lhObj 37241>>> set delegation_mode of lhObj to dm# 37242>>> end_procedure 37243>>> 37243>>> procedure aps_goto_max_row integer row_space# 37245>>> // Position the cursor on a new line below the 37245>>> set p_cur_row to (p_max_row(self)+p_row_space(self)) 37246>>> set p_cur_column to (p_left_margin(self)) 37247>>> set aps_container_mx.p_auto_column_just_set to true // No automatic lf! 37248>>> if num_arguments send make_row_space row_space# 37251>>> end_procedure 37252>>> 37252>>> function aps_grid_column_start integer lhObj integer col# returns integer 37254>>> integer itm# column# 37254>>> move (low(location(lhObj))) to column# // Left edge of grid 37255>>> for itm# from 0 to (col#-1) 37261>>>> 37261>>> move (column#+form_width(lhObj,itm#)) to column# 37262>>> loop 37263>>>> 37263>>> function_return column# 37264>>> end_function 37265>>> 37265>>> procedure aps_goto_grid_column integer lhObj integer col# 37267>>> // Position the object cursor by the left edge of column 37267>>> // (0-base) in grid . 37267>>> set p_cur_column to (aps_grid_column_start(self,lhObj,col#)) 37268>>> end_procedure 37269>>> 37269>>> procedure aps_resize integer lhObj integer delta_rw# integer delta_cl# integer tmp# 37271>>> integer old_rw# old_cl# register# 37271>>> if num_arguments gt 3 move tmp# to register# 37274>>> else move 1 to register# 37276>>> get size of lhObj to old_cl# 37277>>> move (hi(old_cl#)) to old_rw# 37278>>> move (low(old_cl#)) to old_cl# 37279>>> set size of lhObj to ((old_rw#+delta_rw#) max 0) ((old_cl#+delta_cl#) max 0) 37280>>> if register# send aps_register_max_rc lhObj 37283>>> set p_last_object to lhObj 37284>>> end_procedure 37285>>> 37285>>> procedure aps_relocate integer lhObj integer delta_rw# integer delta_cl# integer lbRegister 37287>>> integer old_rw# old_cl# register# 37287>>> if num_arguments gt 3 move lbRegister to register# 37290>>> else move 1 to register# 37292>>> get location of lhObj to old_cl# 37293>>> move (hi(old_cl#)) to old_rw# 37294>>> move (low(old_cl#)) to old_cl# 37295>>> set location of lhObj to ((old_rw#+delta_rw#) max 0) ((old_cl#+delta_cl#) max 0) 37296>>> if register# send aps_register_max_rc lhObj 37299>>> set p_last_object to lhObj 37300>>> end_procedure 37301>>>end_class // aps_container_mx 37302>>> 37302>>>//> Class aps_control_mx is mixed into all control classes and all 37302>>>//> containers that are not panel containers. That means that all the 37302>>>//> classes mentioned have the properties and the methods defined by 37302>>>//> this mix-in class: 37302>>>class aps_control_mx is a mixin 37303>>> procedure define_aps_control_mx 37305>>> //> Should the control attempt to auto size?: 37305>>> property integer p_auto_size_control_state public true 37306>>> //> Should the control attempt to locate itself 37306>>> //> within the container? 37306>>> property integer p_auto_locate_control_state public true 37307>>> //> Objects of class dbForm may or may not have 37307>>> //> prompt buttons attached. When they do, this 37307>>> //> button is created outside the form, and so 37307>>> //> APS must reserve extra space. This is the purpose 37307>>> //> of property p_extra_external_width. 37307>>> property integer p_extra_external_width public 0 37308>>> property integer p_extra_internal_width public 0 37309>>> //> p_snap_location: 0 means current position 37309>>> //> >0 means adjust to column 37309>>> //> <0 means special adjustments 37309>>> property integer p_snap_location public 0 37310>>> //> In the context of APS you can never trust the size of 37310>>> //> a comboform. Therefore this property is provided to 37310>>> //> let APS know when to handle a control as a comboform. 37310>>> property integer p_is_comboform public 0 // You ain't no friend of mine! 37311>>> //> Should the object try to obtain a label from the global 37311>>> //> label mechanism? 37311>>> property integer p_auto_label_state public true 37312>>> property integer p_auto_label_add_colon_state public true 37313>>> //> Should the object conform to an abstract field type? 37313>>> property integer p_auto_abstract_state public 1 37314>>> //> If yes, which? 37314>>> property integer p_abstract public 0 37315>>> //> APS needs to know the ID of the server of each control. 37315>>> //> Unfortunatly it is not possible to use the server function 37315>>> //> to get that at the time of creation. Therefore this property 37315>>> //> is used to store the server once manually found. 37315>>> property integer p_server private -1 // -1=not checked, 0=not found, >0=svr# 37316>>> // 37316>>> property integer p_jmode_top_vert_offset public 10 37317>>> 37317>>> 37317>>> property integer p_dbControl public 0 // 37318>>> 37318>>> end_procedure 37319>>> 37319>>> 37319>>> // ******************************************************************* 37319>>> procedure aps_auto_label 37321>>> integer file# field# dm# 37321>>> string label# 37321>>> get delegation_mode to dm# 37322>>> set delegation_mode to NO_DELEGATE_OR_ERROR 37323>>> get label to label# 37324>>> if label# eq "" begin 37326>>> get data_file item 0 to file# 37327>>> get data_field item 0 to field# 37328>>> if (file# and field#) begin 37330>>> // If p_auto_label_state lt 0 we obtain the short version of the label 37330>>> if (p_auto_label_state(self)) ge 0 get FieldInf_FieldLabel_Long file# field# to label# 37333>>> else get FieldInf_FieldLabel_Short file# field# to label# 37335>>> if label# ne "" set label to (label#+if(p_auto_label_add_colon_state(self),":","")) 37338>>> end 37338>>>> 37338>>> end 37338>>>> 37338>>> set delegation_mode to dm# 37339>>> end_procedure 37340>>> 37340>>> //> This function manually retrieves the server of a control. This is 37340>>> //> necessary because the DSO structure is not connected at the time 37340>>> //> of object creation. 37340>>> function aps_server returns integer 37342>>> integer PanelID# rval# lhObj dm# 37342>>> get aps_control_mx.p_server to rval# 37343>>> if rval# eq -1 begin // If we have not looked for it yet 37345>>> move self to lhObj 37346>>> get server of lhObj to rval# 37347>>> ifnot rval# begin 37349>>> get aps_PanelID to PanelID# 37350>>> repeat // This loop does a manual delegation 37350>>>> 37350>>> get parent of lhObj to lhObj 37351>>> // If db-controls are nested inside non db-panels errors will occur 37351>>> // from asking what the server is. Thus we set delegation_mode while 37351>>> // asking: 37351>>> get delegation_mode of lhObj to dm# 37352>>> set delegation_mode of lhObj to NO_DELEGATE_OR_ERROR 37353>>> get server of lhObj to rval# 37354>>> set delegation_mode of lhObj to dm# 37355>>> until (lhObj=PanelID# or rval#) // Delegation stops when we hit the panel 37357>>> end 37357>>>> 37357>>> set aps_control_mx.p_server to rval# 37358>>> end 37358>>>> 37358>>> function_return rval# 37359>>> end_function 37360>>> 37360>>> // Wow! Try to hand-trace this function down, and you will see what kind of 37360>>> // load it is to _really_ figure out if a field is capslock'ed or not: 37360>>> function is_capslocked integer itm# returns integer 37362>>> integer caps# svr# file# field# lhObj 37362>>> if (p_dbControl(self)) begin 37364>>> get prototype_object to lhObj // ???Why no invalid message from this??? 37365>>> ifnot lhObj move self to lhObj 37368>>> 37368>>> get item_option of lhObj item itm# APS.ITEM_OPTION_CAPSLOCK to caps# 37369>>> // extended_deo_state is not set yet! 37369>>> ifnot caps# begin 37371>>> get aps_server to svr# 37372>>> if svr# begin 37374>>> get data_file of lhObj item itm# to file# 37375>>> get data_field of lhObj item itm# to field# 37376>>> if (file# and field#) begin 37378>>> get which_data_set of svr# file# to svr# 37379>>> if (svr# and file# eq main_file(svr#) and Extended_DSO_State(svr#)) ; get Field_Option of svr# field# dd_capslock to caps# 37382>>> end 37382>>>> 37382>>> end 37382>>>> 37382>>> end 37382>>>> 37382>>> end 37382>>>> 37382>>> function_return caps# 37383>>> end_function 37384>>> 37384>>> procedure aps_auto_size_control 37386>>> integer type# marg# caps# lhObj 37386>>> move self to lhObj 37387>>> 37387>>> get form_datatype item 0 to type# 37388>>> get form_margin item 0 to marg# 37389>>> 37389>>> if type# eq ASCII_WINDOW get is_capslocked 0 to caps# 37392>>> else move 0 to caps# // If not ascii_window it can't be capslocked! 37394>>> 37394>>> ifnot (is_comboform(lhObj,lhObj)) ; set size to (p_form_height(lhObj)) (aps.form_width.iii(lhObj,type#,marg#,caps#)+extra_internal_width(lhObj,lhObj)) 37397>>> else ; // button width  set size to (hi(size(lhObj))) (aps.form_width.iii(lhObj,type#,marg#,caps#)+10+extra_internal_width(lhObj,lhObj)) 37399>>> end_procedure 37400>>> 37400>>> procedure aps_copy_abstract integer abstract# 37402>>> integer file# field# dm# type# marg# 37402>>> ifnot abstract# begin 37404>>> if (p_auto_abstract_state(self)) begin 37406>>> // If an explicit abstract is not specified, we try to obtain one 37406>>> // from the "global field info"-arrangement: 37406>>> get delegation_mode to dm# 37407>>> set delegation_mode to NO_DELEGATE_OR_ERROR 37408>>> get data_file item 0 to file# 37409>>> get data_field item 0 to field# 37410>>> set delegation_mode to dm# 37411>>> if (file# and field#) get gl_abstract file# field# to abstract# 37414>>> end 37414>>>> 37414>>> end 37414>>>> 37414>>> if abstract# begin 37416>>> if abstract# gt 0 begin 37418>>> get gl_datatype 0 abstract# to type# 37419>>> get gl_margin 0 abstract# to marg# 37420>>> set form_datatype item 0 to type# 37421>>> set form_margin item 0 to marg# 37422>>> end 37422>>>> 37422>>> else begin // Copy abstract from file.field 37423>>> move ((0-abstract#)/4096) to file# 37424>>> move (0-abstract#-(file#*4096)) to field# 37425>>> move 0 to abstract# 37426>>> if (file# and field#) begin 37428>>> get gl_abstract file# field# to abstract# 37429>>> if abstract# begin // if MODIFY_FIELD_TYPE has been applied 37431>>> get gl_datatype 0 abstract# to type# 37432>>> get gl_margin 0 abstract# to marg# 37433>>> set form_datatype item 0 to type# 37434>>> set form_margin item 0 to marg# 37435>>> end 37435>>>> 37435>>> else begin // We have to ask the DBMS 37436>>> get gl_generic_form_datatype file# field# to type# 37437>>> get gl_generic_form_margin file# field# to marg# 37438>>> set form_datatype item 0 to type# 37439>>> set form_margin item 0 to marg# 37440>>> end 37440>>>> 37440>>> end 37440>>>> 37440>>> end 37440>>>> 37440>>> end 37440>>>> 37440>>> end_procedure 37441>>> 37441>>> procedure end_define_aps_control_mx 37443>>> integer lhObj 37443>>> move self to lhObj 37444>>> if (p_auto_label_state(self)) send aps_auto_label 37447>>> send aps_copy_abstract (p_abstract(self)) 37448>>> if (p_auto_size_control_state(self)) send aps_auto_size_control 37451>>> if (p_auto_locate_control_state(self)) delegate send aps_auto_locate_control lhObj 37455>>> end_procedure 37456>>> 37456>>> function caption_bar returns integer // Controls do not have captions 37458>>> end_function 37459>>>end_class 37460>>> 37460>>>// Class aps_grid_mx is mixed into the APS grid classes: 37460>>>class aps_grid_mx is a mixin 37461>>> procedure define_aps_grid_mx 37463>>> property integer p_auto_size_columns_state public true 37464>>> property integer p_max_column_width public 999 37465>>> set size to 100 0 // Default height 37466>>> end_procedure 37467>>> procedure aps_auto_grid_labels 37469>>> integer file# field# itm# max# p_obj# 37469>>> string label# 37469>>> move (low(matrix_size(self))-1) to max# // Get number of columns 37470>>> get prototype_object to p_obj# // Get object id of prototype 37471>>> for itm# from 0 to max# 37477>>>> 37477>>> get header_label item itm# to label# 37478>>> if label# eq "" begin 37480>>> get data_file of p_obj# item itm# to file# 37481>>> get data_field of p_obj# item itm# to field# 37482>>> if (file# and field#) begin 37484>>> get FieldInf_FieldLabel_Short file# field# to label# 37485>>> if label# ne "" set header_label item itm# to label# 37488>>> end 37488>>>> 37488>>> end 37488>>>> 37488>>> loop 37489>>>> 37489>>> if (p_extra_internal_width(self)) eq 0 ; if max# eq 0 set p_extra_internal_width to 5 37494>>> set p_auto_label_state to false // Disable standard auto_label 37495>>> end_procedure 37496>>> 37496>>> procedure aps_auto_grid_abstracts 37498>>> integer file# field# itm# max# p_obj# abstract# type# marg# 37498>>> move (low(matrix_size(self))-1) to max# // Get number of columns 37499>>> get prototype_object to p_obj# // Get object id of prototype 37500>>> for itm# from 0 to max# 37506>>>> 37506>>> get data_file of p_obj# item itm# to file# 37507>>> get data_field of p_obj# item itm# to field# 37508>>> if (file# and field#) begin 37510>>> get gl_abstract file# field# to abstract# 37511>>> if abstract# begin 37513>>> get gl_datatype 0 abstract# to type# 37514>>> get gl_margin 0 abstract# to marg# 37515>>> set form_datatype item itm# to type# 37516>>> set form_margin item itm# to marg# 37517>>> end 37517>>>> 37517>>> end 37517>>>> 37517>>> loop 37518>>>> 37518>>> set p_auto_abstract_state to false // Disable standard auto_label 37519>>> end_procedure 37520>>> 37520>>> procedure set aps_fixed_column_width integer column# integer value# 37522>>> set value of (oAPS_PresetColumnWidths(self)) item column# to value# 37523>>> end_procedure 37524>>> 37524>>> procedure set aps_column_abstract integer column# integer file# integer field# 37526>>> set form_margin item column# to (gl_margin(self,file#,field#)) 37527>>> set form_datatype item column# to (gl_datatype(self,file#,field#)) 37528>>> end_procedure 37529>>> 37529>>> function aps_ColumnCorrection integer liColumn returns integer 37531>>> end_function 37532>>> 37532>>> procedure aps_auto_size_columns 37534>>> // This will not size perfectly, but pretty close! 37534>>> integer itm# max# tbl_sz# tbl_width# fld# lhObj 37534>>> integer column_width# type# marg# caps# label_size# field_width# label_width# 37534>>> integer max_column_width# auto_create_prompt_button# 37534>>> integer svr# dd# file# field# p_obj# len# add_it# dm# 37534>>> integer oFixedWidths# liColumnCorrection 37534>>> string label_value# pbv# // pbv# is prompt_button_value 37534>>> 37534>>> move (oAPS_PresetColumnWidths(self)) to oFixedWidths# 37535>>> 37535>>> if (p_dbControl(self)) begin 37537>>> get aps_server to svr# 37538>>> get prototype_object to p_obj# // Get object id of prototype 37539>>> get delegation_mode to dm# // dbList's do not understand what we about to do: 37540>>> set delegation_mode to NO_DELEGATE_OR_ERROR 37541>>> get prompt_button_value to pbv# 37542>>> get auto_create_prompt_button to auto_create_prompt_button# 37543>>> if (auto_create_prompt_button#<>0 and pbv#<>'') length pbv# to len# 37546>>> set delegation_mode to dm# 37547>>> end 37547>>>> 37547>>> 37547>>> move self to lhObj 37548>>> move (hi(size(lhObj))) to tbl_sz# // Get height of grid 37549>>> move (low(matrix_size(lhObj))-1) to max# // Get number of columns 37550>>> move (extra_internal_width(lhObj,lhObj)) to tbl_width# // Initialize total width 37551>>> get p_max_column_width to max_column_width# 37552>>> for itm# from 0 to max# 37558>>>> 37558>>> get header_label item itm# to label_value# 37559>>> // We have to try to figure out if we need to append ">>" to the label 37559>>> if (svr# and len# and right(label_value#,len#)<>pbv#) begin // If dbControl: 37561>>> get data_file of lhObj item itm# to file# 37562>>> get data_field of lhObj item itm# to field# 37563>>> if (file# and field#) begin 37565>>> if (Prompt_Object(p_obj#,itm#) and not(Shadow_State(p_obj#,itm#))) ; move 1 to add_it# 37568>>> else begin 37569>>> get which_data_set of svr# file# to dd# 37570>>> if (dd# and file# eq main_file(dd#) and Extended_DSO_State(dd#)) ; get field_prompt_object of dd# field# dd_capslock to add_it# 37573>>> end 37573>>>> 37573>>> if add_it# move (label_value#*pbv#) to label_value# 37576>>> end 37576>>>> 37576>>> end 37576>>>> 37576>>> 37576>>> move (value(oFixedWidths#,itm#)) to column_width# 37577>>> 37577>>> ifnot column_width# begin 37579>>> get form_datatype item itm# to type# 37580>>> get form_margin item itm# to marg# 37581>>> 37581>>> if type# eq ascii_window get is_capslocked itm# to caps# 37584>>> else move 0 to caps# // If not ascii_window it can't be capslocked! 37586>>> 37586>>> get aps.form_width.iii type# marg# caps# to field_width# 37587>>> if label_value# ne "" get text_extent label_value# to label_size# 37590>>> else move 0 to label_size# 37592>>> move (low(label_size#)*aps.gui2mdu_width#+12.5) to label_width# 37593>>> if itm# eq 0 move (label_width#+2) to label_width# 37596>>> 37596>>> move ((field_width# max label_width#) min max_column_width#) to column_width# 37597>>> end 37597>>>> 37597>>> get aps_ColumnCorrection itm# to liColumnCorrection 37598>>> move (column_width#+liColumnCorrection) to column_width# 37599>>> if column_width# lt 0 move 0 to column_width# 37602>>> move (tbl_width#+column_width#) to tbl_width# 37603>>> set size to tbl_sz# (tbl_width#+5) 37604>>> set form_width item itm# to column_width# 37605>>> loop 37606>>>> 37606>>> send delete_data to oFixedWidths# 37607>>> end_procedure 37608>>>end_class 37609>>> 37609>>>// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- 37609>>>// Global procedures for manipulating size and location 37609>>>// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- 37609>>> 37609>>>procedure aps_align_objects$help for BaseClass integer obj1# integer obj2# integer alignment_mode# integer move# 37611>>> // This procedure should not be called directly from your component code. 37611>>> // It is used by the aps_align_by_moving and aps_align_by_sizing procedures 37611>>> // that are defined just below it. 37611>>> // 37611>>> // We assume that they have a common visible container. 37611>>> // (What this procedure really needed to do is to find a common ancestor 37611>>> // for obj1# and obj2# and then go through all of it to really figure 37611>>> // location offsets out.) 37611>>> integer sz_rw2# sz_cl2# sz_rw1# sz_cl1# 37611>>> integer lc_rw2# lc_cl2# lc_rw1# lc_cl1# eew# 37611>>> get size of obj2# to sz_rw2# 37612>>> get size of obj1# to sz_rw1# 37613>>> move (low(sz_rw2#)) to sz_cl2# 37614>>> move (hi(sz_rw2#)) to sz_rw2# 37615>>> move (low(sz_rw1#)) to sz_cl1# 37616>>> move (hi(sz_rw1#)) to sz_rw1# 37617>>> 37617>>> move (extra_external_width(obj1#,obj1#)) to eew# 37618>>> move (sz_cl1#+eew#) to sz_cl1# 37619>>> move (sz_cl2#+extra_external_width(obj2#,obj2#)) to sz_cl2# 37620>>> 37620>>> get location of obj2# to lc_rw2# 37621>>> get location of obj1# to lc_rw1# 37622>>> move (low(lc_rw2#)) to lc_cl2# 37623>>> move (hi(lc_rw2#)) to lc_rw2# 37624>>> move (low(lc_rw1#)) to lc_cl1# 37625>>> move (hi(lc_rw1#)) to lc_rw1# 37626>>> if move# begin 37628>>> if (alignment_mode# iand SL_ALIGN_LEFT ) move lc_cl2# to lc_cl1# 37631>>> if (alignment_mode# iand SL_ALIGN_TOP ) move lc_rw2# to lc_rw1# 37634>>> if (alignment_mode# iand SL_ALIGN_RIGHT ) move (lc_cl2#+sz_cl2#-sz_cl1#) to lc_cl1# 37637>>> if (alignment_mode# iand SL_ALIGN_BOTTOM ) move (lc_rw2#+sz_rw2#-sz_rw1#) to lc_rw1# 37640>>> if (alignment_mode# iand SL_ALIGN_CENTER ) move (sz_cl2#-sz_cl1#/2+lc_cl2#) to lc_cl1# 37643>>> if (alignment_mode# iand SL_ALIGN_VCENTER) move (sz_rw2#-sz_rw1#/2+lc_rw2#) to lc_rw1# 37646>>> end 37646>>>> 37646>>> else begin 37647>>> if (alignment_mode# iand SL_ALIGN_LEFT ) move lc_cl2# to lc_cl1# 37650>>> if (alignment_mode# iand SL_ALIGN_TOP ) move lc_rw2# to lc_rw1# 37653>>> if (alignment_mode# iand SL_ALIGN_RIGHT ) move (lc_cl2#+sz_cl2#-lc_cl1#) to sz_cl1# 37656>>> if (alignment_mode# iand SL_ALIGN_BOTTOM) move (lc_rw2#+sz_rw2#-lc_rw1#) to sz_rw1# 37659>>> end 37659>>>> 37659>>> set size of obj1# to sz_rw1# (sz_cl1#-eew#) 37660>>> set location of obj1# to lc_rw1# lc_cl1# 37661>>>end_procedure 37662>>> 37662>>>procedure aps_align_by_moving for BaseClass integer obj1# integer obj2# integer alignment_mode# 37664>>> // Align object 1 relative to object 2, by re-locating object 1 37664>>> send aps_align_objects$help obj1# obj2# alignment_mode# 1 37665>>>end_procedure 37666>>> 37666>>>procedure aps_align_by_sizing for BaseClass integer obj1# integer obj2# integer alignment_mode# 37668>>> // Align object 1 relative to object 2, by re-sizing object 1 37668>>> send aps_align_objects$help obj1# obj2# alignment_mode# 0 37669>>>end_procedure 37670>>> 37670>>>procedure aps_size_identical_max for BaseClass integer obj1# integer obj2# integer sizing_mode# 37672>>> // Objects are sized to the bigger of the two. 37672>>> integer sz_rw1# sz_cl1# sz_rw2# sz_cl2# 37672>>> get size of obj1# to sz_rw1# 37673>>> get size of obj2# to sz_rw2# 37674>>> move (low(sz_rw1#)) to sz_cl1# 37675>>> move (hi(sz_rw1#)) to sz_rw1# 37676>>> move (low(sz_rw2#)) to sz_cl2# 37677>>> move (hi(sz_rw2#)) to sz_rw2# 37678>>> if (sizing_mode# iand SL_HORIZONTAL) begin 37680>>> move (sz_cl1# max sz_cl2#) to sz_cl1# 37681>>> move sz_cl1# to sz_cl2# 37682>>> end 37682>>>> 37682>>> if (sizing_mode# iand SL_VERTICAL) begin 37684>>> move (sz_rw1# max sz_rw2#) to sz_rw1# 37685>>> move sz_rw1# to sz_rw2# 37686>>> end 37686>>>> 37686>>> set size of obj1# to sz_rw1# sz_cl1# 37687>>> set size of obj2# to sz_rw2# sz_cl2# 37688>>>end_procedure 37689>>> 37689>>>procedure aps_align_inside_container$help for BaseClass integer ctrl# integer jmode# integer move# 37691>>> // This procedure should not be called directly from your component 37691>>> // code. It is used by the aps_align_inside_container_by_moving and 37691>>> // the aps_align_inside_container_by_sizing procedures that are defined, 37691>>> // just below it. 37691>>> integer ctrl_sz_rw# ctrl_sz_cl# cont_sz_rw# cont_sz_cl# cap_height# 37691>>> integer ctrl_lc_rw# ctrl_lc_cl# cont# dm# eew# 37691>>> get delegation_mode of ctrl# to dm# 37692>>> set delegation_mode of ctrl# to NO_DELEGATE_OR_ERROR 37693>>> get p_extra_external_width of ctrl# to eew# 37694>>> set delegation_mode of ctrl# to dm# 37695>>> // There has to be an APS-container out there! This way we go through 37695>>> // non visible containers and TabPages: 37695>>> get aps_parent of (parent(ctrl#)) to cont# 37696>>> get size of ctrl# to ctrl_sz_rw# 37697>>> move (low(ctrl_sz_rw#)+eew#) to ctrl_sz_cl# 37698>>> move (hi(ctrl_sz_rw#)) to ctrl_sz_rw# 37699>>> 37699>>> get size of cont# to cont_sz_rw# 37700>>> move (low(cont_sz_rw#)) to cont_sz_cl# 37701>>> move (hi(cont_sz_rw#)) to cont_sz_rw# 37702>>> 37702>>> get location of ctrl# to ctrl_lc_rw# 37703>>> move (low(ctrl_lc_rw#)) to ctrl_lc_cl# 37704>>> move (hi(ctrl_lc_rw#)) to ctrl_lc_rw# 37705>>> 37705>>> if (caption_bar(cont#)) move (GetSystemMetrics(SM_CYSMCAPTION)) to cap_height# // 15 37708>>> else move 0 to cap_height# 37710>>> 37710>>> if move# begin 37712>>> if (jmode# iand SL_ALIGN_LEFT ) move (p_left_margin(cont#)) to ctrl_lc_cl# 37715>>> if (jmode# iand SL_ALIGN_RIGHT ) move (cont_sz_cl#-ctrl_sz_cl#-p_right_margin(cont#)) to ctrl_lc_cl# 37718>>> if (jmode# iand SL_ALIGN_CENTER ) move (cont_sz_cl#-ctrl_sz_cl#-p_left_margin(cont#)-p_right_margin(cont#)/2+p_left_margin(cont#)) to ctrl_lc_cl# 37721>>> if (jmode# iand SL_ALIGN_TOP ) move (p_top_margin(cont#)) to ctrl_lc_rw# 37724>>> if (jmode# iand SL_ALIGN_BOTTOM ) move (cont_sz_rw#-ctrl_sz_rw#-p_bottom_margin(cont#)-cap_height#) to ctrl_lc_rw# 37727>>> if (jmode# iand SL_ALIGN_VCENTER) move (cont_sz_rw#-ctrl_sz_rw#-p_top_margin(cont#)-p_bottom_margin(cont#)/2+p_top_margin(cont#)) to ctrl_lc_rw# 37730>>> end 37730>>>> 37730>>> else begin // sizing (and moving) 37731>>> if (jmode# iand SL_ALIGN_LEFT) begin 37733>>> move (ctrl_sz_cl#+ctrl_lc_cl#-p_left_margin(cont#)) to ctrl_sz_cl# 37734>>> move (p_left_margin(cont#)) to ctrl_lc_cl# 37735>>> end 37735>>>> 37735>>> if (jmode# iand SL_ALIGN_RIGHT) move (cont_sz_cl#-ctrl_lc_cl#-p_right_margin(cont#)) to ctrl_sz_cl# 37738>>> 37738>>> if (jmode# iand SL_ALIGN_TOP) begin 37740>>> move (ctrl_sz_rw#+ctrl_lc_rw#-p_top_margin(cont#)) to ctrl_sz_rw# 37741>>> move (p_top_margin(cont#)) to ctrl_lc_rw# 37742>>> end 37742>>>> 37742>>> if (jmode# iand SL_ALIGN_BOTTOM) move (cont_sz_rw#-ctrl_lc_rw#-p_bottom_margin(cont#)) to ctrl_sz_rw# 37745>>> 37745>>> if (jmode# iand SL_ALIGN_TOP or jmode# iand SL_ALIGN_BOTTOM or jmode# iand SL_ALIGN_VCENTER) ; set size of ctrl# to (ctrl_sz_rw#-cap_height#) (ctrl_sz_cl#-eew#) 37748>>> else ; set size of ctrl# to ctrl_sz_rw# (ctrl_sz_cl#-eew#) 37750>>> end 37750>>>> 37750>>> set location of ctrl# to ctrl_lc_rw# ctrl_lc_cl# 37751>>>end_procedure 37752>>> 37752>>>procedure aps_align_inside_container_by_moving for BaseClass integer ctrl# integer jmode# 37754>>> // Align an object (with ID ctrl#) inside its parent by re-locating it. 37754>>> send aps_align_inside_container$help ctrl# jmode# 1 37755>>>end_procedure 37756>>>procedure aps_align_inside_container_by_sizing for BaseClass integer ctrl# integer jmode# 37758>>> // Align an object (with ID ctrl#) inside its parent by re-sizing it. 37758>>> send aps_align_inside_container$help ctrl# jmode# 0 37759>>>end_procedure 37760>>> 37760>>>// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- 37760>>>// This section defines a number of macros that are used for binding 37760>>>// object command line parameters. These are: 37760>>>// 37760>>>// Keywords covered: 37760>>>// 37760>>>// SNAP ; This will make the object locate itself 37760>>>// [RELATIVE_TO obj] relative to a previous objects within the 37760>>>// current container. Valid 's are: 37760>>>// 37760>>>// SL_DOWN 37760>>>// SL_LEFT 37760>>>// SL_LOWER_RIGHT_CORNER_EXTEND_ROW 37760>>>// SL_CURRENT_POS_NO_LABEL_ADJUST 37760>>>// SL_RIGHT 37760>>>// SL_RIGHT_SPACE 37760>>>// SL_UP 37760>>>// SL_LOWER_RIGHT_CORNER 37760>>>// SL_UPPER_RIGHT_CORNER_EXTEND_COLUMN 37760>>>// 37760>>>// Default action is to locate the object 37760>>>// relative to the previous (APS) object in 37760>>>// the current container. It is possible to 37760>>>// change that by adding key word RELATIVE_TO 37760>>>// to the object command line: 37760>>>// 37760>>>// ...snap SL_DOWN relative_to (xx(self)) 37760>>>// 37760>>>// NEXT_ROW Is the equivalent of: "send new_field_row" 37760>>>// before the object declaration. 37760>>>// 37760>>>// NEW_COLUMN Seldom used. Will make the object cursor 37760>>>// go back to the top of the container. 37760>>>// 37760>>>// MAX_ROW Is the equivalent of: send aps_goto_max_row 37760>>>// before the object declaration. 37760>>>// 37760>>>// (1) LABEL "label" Will make the object use label as its label. 37760>>>// Same as: set label to "label" 37760>>>// 37760>>>// (2) LABEL NONE Will disable automatic label assignment. Is the 37760>>>// equivalent of setting p_auto_label_state to 37760>>>// false. 37760>>>// 37760>>>// (3) LABEL SHORT Will make the control use the short (grid-) 37760>>>// version of its standard label. Is the 37760>>>// equivalent of setting p_auto_label_state to -1. 37760>>>// 37760>>>// (4) LABEL COPY ; Will make the control use the standard label 37760>>>// dffile.field of another DBMS field. This is the equivalent 37760>>>// of setting label to: 37760>>>// 37760>>>// (FieldInf_FieldLabel_Long(file#,field#)) 37760>>>// 37760>>>// for the dffile.field desired. 37760>>>// 37760>>>// ABSTRACT (Re-)defines the form_margin and form_type for 37760>>>// that (db)Form to be equal to those defined 37760>>>// for abstract field type . 37760>>>// 37760>>>// Also works with (db)SpinForms and (db)Comboform. 37760>>>// 37760>>> 37760>>> 37760>>> 37760>>> 37760>>> 37760>>> 37760>>> 37760>>> 37760>>> 37760>>> 37760>>> 37760>>>// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 37760>>>// Panel containers 37760>>>// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 37760>>> 37760>>>class aps.View is a View startmac APS.STARTMAC_LABEL 37761>>> procedure construct_object 37763>>> forward send construct_object 37765>>> send define_aps_container_mx 37766>>> send define_aps_panel_mx 37767>>> set p_right_margin to 8 37768>>> send aps_init 37769>>> end_procedure 37770>>> import_class_protocol aps_container_mx 37771>>> import_class_protocol aps_panel_mx 37772>>> procedure end_construct_object 37774>>> forward send end_construct_object 37776>>> send end_define_aps_container_mx 37777>>> send end_define_aps_panel_mx 37778>>> end_procedure 37779>>>end_class 37780>>> 37780>>>class aps.dbView is a dbView startmac APS.STARTMAC_LABEL 37781>>> procedure construct_object 37783>>> forward send construct_object 37785>>> send define_aps_container_mx 37786>>> send define_aps_panel_mx 37787>>> property integer p_auto_label_state public true 37788>>> set p_right_margin to 8 37789>>> send aps_init 37790>>> end_procedure 37791>>> import_class_protocol aps_container_mx 37792>>> import_class_protocol aps_panel_mx 37793>>> procedure end_construct_object 37795>>> forward send end_construct_object 37797>>> send end_define_aps_container_mx 37798>>> send end_define_aps_panel_mx 37799>>> if (p_auto_label_state(self) and label(self)="" and main_dd(self)) ; set label to (File_Display_Name(main_file(main_dd(self)))) 37802>>> end_procedure 37803>>>end_class 37804>>> 37804>>>class aps.ModalPanel is a ModalPanel startmac APS.STARTMAC_LABEL 37805>>> procedure construct_object 37807>>> forward send construct_object 37809>>> send define_aps_container_mx 37810>>> send define_aps_panel_mx 37811>>> set p_right_margin to 8 37812>>> send aps_init 37813>>> end_procedure 37814>>> import_class_protocol aps_container_mx 37815>>> import_class_protocol aps_panel_mx 37816>>> procedure end_construct_object 37818>>> forward send end_construct_object 37820>>> send end_define_aps_container_mx 37821>>> send end_define_aps_panel_mx 37822>>> end_procedure 37823>>>end_class 37824>>> 37824>>>//> Unlike ModalPanel's, dbModalPanel's have a mechanism for adding buttons 37824>>>//> to the panel. This means that the APS augmentation needs an extra 37824>>>//> procedure for positioning the buttons that are added this way. The 37824>>>//> procedure is a re-write of the position_child_objects method in the 37824>>>//> super class. 37824>>>class aps.dbModalPanel is a dbModalPanel startmac APS.STARTMAC_LABEL 37825>>> procedure construct_object 37827>>> forward send construct_object 37829>>> send define_aps_container_mx 37830>>> send define_aps_panel_mx 37831>>> set p_right_margin to 8 37832>>> end_procedure 37833>>> import_class_protocol aps_container_mx 37834>>> import_class_protocol aps_panel_mx 37835>>> procedure position_child_objects // Position add_button-buttons: 37837>>> integer button_count# btn_obj# lhObj itm# max# 37837>>> move (button_ids(self)) to lhObj 37838>>> get item_count of lhObj to max# 37839>>> if max# begin 37841>>> for itm# from 0 to (max#-1) 37847>>>> 37847>>> move (value(lhObj,max#-1-itm#)) to btn_obj# 37848>>> if itm# send aps_auto_locate_control btn_obj# SL_LEFT 37851>>> else send aps_auto_locate_control btn_obj# SL_LOWER_RIGHT_CORNER_EXTEND_ROW 37853>>> loop 37854>>>> 37854>>> end 37854>>>> 37854>>> end_procedure 37855>>> procedure end_construct_object 37857>>> forward send end_construct_object 37859>>> send end_define_aps_container_mx 37860>>> send end_define_aps_panel_mx 37861>>> end_procedure 37862>>>end_class 37863>>> 37863>>> 37863>>>// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 37863>>>// Other containers 37863>>>// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 37863>>> 37863>>>class aps.Group is a Group startmac APS.STARTMAC_LABEL_SNAP 37864>>> procedure construct_object 37866>>> forward send construct_object 37868>>> send define_aps_container_mx 37869>>> send define_aps_control_mx 37870>>> set p_auto_size_control_state to false // Do not autosize as control 37871>>> set p_top_margin to 10 // Set non-default top margin 37872>>> send aps_init // Reflect this in object cursor position 37873>>> end_procedure 37874>>> import_class_protocol aps_container_mx 37875>>> import_class_protocol aps_control_mx 37876>>> procedure end_construct_object 37878>>> forward send end_construct_object 37880>>> send end_define_aps_container_mx // Size the object 37881>>> send end_define_aps_control_mx // Locate the object 37882>>> end_procedure 37883>>>end_class 37884>>> 37884>>>class aps.dbGroup is a dbGroup startmac APS.STARTMAC_LABEL_SNAP 37885>>> procedure construct_object 37887>>> forward send construct_object 37889>>> send define_aps_container_mx 37890>>> send define_aps_control_mx 37891>>> set p_auto_size_control_state to false // Do not autosize as control 37892>>> set p_top_margin to 10 // Set non-default top margin 37893>>> send aps_init // Reflect this in object cursor position 37894>>> end_procedure 37895>>> import_class_protocol aps_container_mx 37896>>> import_class_protocol aps_control_mx 37897>>> procedure end_construct_object 37899>>> forward send end_construct_object 37901>>> send end_define_aps_container_mx // Size the object 37902>>> send end_define_aps_control_mx // Locate the object 37903>>> end_procedure 37904>>>end_class 37905>>> 37905>>>class aps.Container3D is a Container3D startmac APS.STARTMAC_SNAP 37906>>> procedure construct_object 37908>>> forward send construct_object 37910>>> send define_aps_container_mx 37911>>> send define_aps_control_mx 37912>>> set p_auto_size_control_state to false // Do not autosize as control 37913>>> set p_bottom_margin to 7 // Set non-default margins 37914>>> set p_right_margin to 8 37915>>> send aps_init // Reflect this in object cursor position 37916>>> end_procedure 37917>>> import_class_protocol aps_container_mx 37918>>> import_class_protocol aps_control_mx 37919>>> procedure end_construct_object 37921>>> forward send end_construct_object 37923>>> send end_define_aps_container_mx // Size the object 37924>>> send end_define_aps_control_mx // Locate the object 37925>>> end_procedure 37926>>>end_class 37927>>> 37927>>>class aps.dbContainer3D is a dbContainer3D startmac APS.STARTMAC_SNAP 37928>>> procedure construct_object 37930>>> forward send construct_object 37932>>> send define_aps_container_mx 37933>>> send define_aps_control_mx 37934>>> set p_auto_size_control_state to false // Do not autosize as control 37935>>> set p_bottom_margin to 7 // Set non-default margins 37936>>> set p_right_margin to 8 37937>>> send aps_init // Reflect this in object cursor position 37938>>> end_procedure 37939>>> import_class_protocol aps_container_mx 37940>>> import_class_protocol aps_control_mx 37941>>> procedure end_construct_object 37943>>> forward send end_construct_object 37945>>> send end_define_aps_container_mx // Size the object 37946>>> send end_define_aps_control_mx // Locate the object 37947>>> end_procedure 37948>>>end_class 37949>>> 37949>>>class aps.TabDialog is a TabDialog startmac APS.STARTMAC_LABEL_SNAP 37950>>> procedure construct_object 37952>>> forward send construct_object 37954>>> send define_aps_container_mx 37955>>> send define_aps_control_mx 37956>>> set p_auto_size_control_state to false 37957>>> set p_right_margin to 8 37958>>> set p_bottom_margin to 20 37959>>> property integer p_max_row_on_tabdialog public 0 37960>>> property integer p_max_column_on_tabdialog public 0 37961>>> on_key KEY_CTRL+KEY_PGUP send request_previous_tab 37962>>> on_key KEY_CTRL+KEY_PGDN send request_next_tab 37963>>> end_procedure 37964>>> import_class_protocol aps_container_mx 37965>>> import_class_protocol aps_control_mx 37966>>> procedure end_construct_object 37968>>> set p_max_row to (p_max_row_on_tabdialog(self)) 37969>>> set p_max_column to (p_max_column_on_tabdialog(self)) 37970>>> forward send end_construct_object 37972>>> send end_define_aps_container_mx // Size the object 37973>>> send end_define_aps_control_mx // Locate the object 37974>>> end_procedure 37975>>>end_class 37976>>> 37976>>>class aps.dbTabDialog is a dbTabDialog startmac APS.STARTMAC_LABEL_SNAP 37977>>> procedure construct_object 37979>>> forward send construct_object 37981>>> send define_aps_container_mx 37982>>> send define_aps_control_mx 37983>>> set p_auto_size_control_state to false 37984>>> set p_right_margin to 8 37985>>> set p_bottom_margin to 20 37986>>> property integer p_max_row_on_tabdialog public 0 37987>>> property integer p_max_column_on_tabdialog public 0 37988>>> on_key KEY_CTRL+KEY_PGUP send request_previous_tab 37989>>> on_key KEY_CTRL+KEY_PGDN send request_next_tab 37990>>> end_procedure 37991>>> import_class_protocol aps_container_mx 37992>>> import_class_protocol aps_control_mx 37993>>> procedure end_construct_object 37995>>> set p_max_row to (p_max_row_on_tabdialog(self)) 37996>>> set p_max_column to (p_max_column_on_tabdialog(self)) 37997>>> forward send end_construct_object 37999>>> send end_define_aps_container_mx // Size the object 38000>>> send end_define_aps_control_mx // Locate the object 38001>>> end_procedure 38002>>>end_class 38003>>> 38003>>>class aps.TabPage is a TabPage startmac APS.STARTMAC_LABEL 38004>>> procedure construct_object 38006>>> forward send construct_object 38008>>> send aps_init 38009>>> end_procedure 38010>>> procedure end_construct_object 38012>>> integer max_row# max_column# 38012>>> get p_max_row to max_row# 38013>>> get p_max_column to max_column# 38014>>> if max_row# gt (p_max_row_on_tabdialog(self)) ; set p_max_row_on_tabdialog to max_row# 38017>>> if max_column# gt (p_max_column_on_tabdialog(self)) ; set p_max_column_on_tabdialog to max_column# 38020>>> forward send end_construct_object 38022>>> end_procedure 38023>>>end_class 38024>>> 38024>>>class aps.dbTabPage is a dbTabPage startmac APS.STARTMAC_LABEL 38025>>> procedure construct_object 38027>>> forward send construct_object 38029>>> send aps_init 38030>>> end_procedure 38031>>> procedure end_construct_object 38033>>> integer max_row# max_column# 38033>>> get p_max_row to max_row# 38034>>> get p_max_column to max_column# 38035>>> if max_row# gt (p_max_row_on_tabdialog(self)) ; set p_max_row_on_tabdialog to max_row# 38038>>> if max_column# gt (p_max_column_on_tabdialog(self)) ; set p_max_column_on_tabdialog to max_column# 38041>>> forward send end_construct_object 38043>>> end_procedure 38044>>>end_class 38045>>> 38045>>>class aps.RadioGroup is a RadioGroup startmac APS.STARTMAC_LABEL_SNAP 38046>>> procedure construct_object 38048>>> forward send construct_object 38050>>> send define_aps_container_mx 38051>>> send define_aps_control_mx 38052>>> property integer p_radio_minimum_label_width public 0 38053>>> set p_auto_size_control_state to false // Do not autosize as control 38054>>> set p_top_margin to 10 // Set non-default top margin 38055>>> send aps_init // Reflect this in object cursor position 38056>>> send tab_column_define 1 5 0 jmode_left 38057>>> end_procedure 38058>>> import_class_protocol aps_container_mx 38059>>> import_class_protocol aps_control_mx 38060>>> procedure end_construct_object 38062>>> forward send end_construct_object 38064>>> send end_define_aps_container_mx // Size the object 38065>>> send end_define_aps_control_mx // Locate the object 38066>>> end_procedure 38067>>>end_class 38068>>> 38068>>>//> Child objects to this class (aps.radio's) will have their 38068>>>//> label set from either DD settings or from values set in 38068>>>//> the Fill_list procedure. 38068>>>//> The label value will then not have been set on object 38068>>>//> creation time, and this class (the container) will not be 38068>>>//> able to size correct. To prevent the container object to 38068>>>//> be sized too narrow the property p_radio_minimum_label_width 38068>>>//> can be used to set a minimum width for the radio's label. 38068>>>class aps.dbRadioGroup is a dbRadioGroup startmac APS.STARTMAC_LABEL_SNAP 38069>>> procedure construct_object 38071>>> forward send construct_object 38073>>> send define_aps_container_mx 38074>>> send define_aps_control_mx 38075>>> property integer p_radio_minimum_label_width public 0 38076>>> set p_auto_size_control_state to false // Do not autosize as control 38077>>> set p_top_margin to 10 // Set non-default top margin 38078>>> send aps_init // Reflect this in object cursor position 38079>>> send tab_column_define 1 5 0 jmode_left 38080>>> end_procedure 38081>>> import_class_protocol aps_container_mx 38082>>> import_class_protocol aps_control_mx 38083>>> procedure end_construct_object 38085>>> forward send end_construct_object 38087>>> send end_define_aps_container_mx // Size the object 38088>>> send end_define_aps_control_mx // Locate the object 38089>>> end_procedure 38090>>>end_class 38091>>> 38091>>>class aps.RadioContainer is a RadioContainer 38092>>> function p_radio_minimum_label_width returns integer 38094>>> end_function 38095>>>end_class 38096>>> 38096>>>class aps.dbRadioContainer is a dbRadioContainer 38097>>> function p_radio_minimum_label_width returns integer 38099>>> end_function 38100>>>end_class 38101>>> 38101>>> 38101>>>// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 38101>>>// Controls 38101>>>// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 38101>>> 38101>>>class aps.Form is a form startmac APS.STARTMAC_LABEL_SNAP 38102>>> procedure construct_object 38104>>> forward send construct_object 38106>>> send define_aps_control_mx 38107>>> end_procedure 38108>>> procedure set form_button integer itm# integer val# 38110>>> forward set form_button item itm# to val# 38112>>> // val#= 0: Create if needed, and expand size 38112>>> // val#= 1: Create prompt button, period! Do not expand size. 38112>>> // val#= 2: Remove prompt button (Don't use this) 38112>>> if (val#=1 and not(p_extra_internal_width(self))) ; set p_extra_internal_width to 10 38115>>> end_procedure 38116>>> import_class_protocol aps_control_mx 38117>>> procedure end_construct_object 38119>>> forward send end_construct_object 38121>>> send end_define_aps_control_mx 38122>>> end_procedure 38123>>>end_class 38124>>> 38124>>>class aps.dbForm is a dbForm startmac APS.STARTMAC_LABEL_SNAP 38125>>> procedure construct_object 38127>>> forward send construct_object 38129>>> send define_aps_control_mx 38130>>> set p_dbControl to true 38131>>> end_procedure 38132>>> 38132>>> procedure auto_extra_external_width 38134>>> integer svr# prompt_object# file# field# 38134>>> if (not(p_extra_external_width(self)) and auto_create_prompt_button(self)) begin 38136>>> get aps_server to svr# 38137>>> if svr# begin 38139>>> get data_file item 0 to file# 38140>>> get data_field item 0 to field# 38141>>> if (file# and field#) begin 38143>>> get which_data_set of svr# file# to svr# 38144>>> if (svr# and file# eq main_file(svr#) and Extended_DSO_State(svr#)) begin 38146>>> get Field_Prompt_Object of svr# field# to prompt_object# 38147>>> if prompt_object# set p_extra_internal_width to (p_extra_internal_width(self)+13) // Makes APS resize the object 38150>>> end 38150>>>> 38150>>> end 38150>>>> 38150>>> end 38150>>>> 38150>>> end 38150>>>> 38150>>> end_procedure 38151>>> 38151>>> procedure set form_button integer itm# integer val# 38153>>> forward set form_button item itm# to val# 38155>>> if (val#=1 and not(p_extra_internal_width(self))) ; set p_extra_internal_width to 13 38158>>> end_procedure 38159>>> import_class_protocol aps_control_mx 38160>>> procedure end_construct_object 38162>>> forward send end_construct_object 38164>>> send auto_extra_external_width 38165>>> send end_define_aps_control_mx 38166>>> end_procedure 38167>>>end_class 38168>>> 38168>>>class aps.ComboForm is a ComboForm startmac APS.STARTMAC_LABEL_SNAP 38169>>> procedure construct_object 38171>>> forward send construct_object 38173>>> send define_aps_control_mx 38174>>> set p_is_comboform to true 38175>>> end_procedure 38176>>> import_class_protocol aps_control_mx 38177>>> procedure end_construct_object 38179>>> forward send end_construct_object 38181>>> send end_define_aps_control_mx 38182>>> end_procedure 38183>>>end_class 38184>>> 38184>>>class aps.dbComboForm is a dbComboForm startmac APS.STARTMAC_LABEL_SNAP 38185>>> procedure construct_object 38187>>> forward send construct_object 38189>>> send define_aps_control_mx 38190>>> set p_dbControl to true 38191>>> set p_is_comboform to true 38192>>> end_procedure 38193>>> procedure set form_button integer itm# integer val# 38195>>> forward set form_button item itm# to val# 38197>>> ifnot (p_extra_external_width(self)) ; set p_extra_external_width to 10 // It always has a button 38200>>> end_procedure 38201>>> import_class_protocol aps_control_mx 38202>>> procedure end_construct_object 38204>>> forward send end_construct_object 38206>>> send end_define_aps_control_mx 38207>>> end_procedure 38208>>>end_class 38209>>> 38209>>>class aps.SpinForm is a dbSpinForm startmac APS.STARTMAC_LABEL_SNAP 38210>>> procedure construct_object 38212>>> forward send construct_object 38214>>> send define_aps_control_mx 38215>>> set p_dbControl to true 38216>>> set p_extra_internal_width to 10 // It always has a button 38217>>> end_procedure 38218>>> import_class_protocol aps_control_mx 38219>>> procedure end_construct_object 38221>>> forward send end_construct_object 38223>>> send end_define_aps_control_mx 38224>>> end_procedure 38225>>>end_class 38226>>> 38226>>>class aps.dbSpinForm is a dbSpinForm startmac APS.STARTMAC_LABEL_SNAP 38227>>> procedure construct_object 38229>>> forward send construct_object 38231>>> send define_aps_control_mx 38232>>> set p_dbControl to true 38233>>> set p_extra_internal_width to 10 // It always has a button 38234>>> end_procedure 38235>>> import_class_protocol aps_control_mx 38236>>> procedure end_construct_object 38238>>> forward send end_construct_object 38240>>> send end_define_aps_control_mx 38241>>> end_procedure 38242>>>end_class 38243>>> 38243>>>class aps.CheckBox is a CheckBox startmac APS.STARTMAC_LABEL_SNAP 38244>>> procedure construct_object 38246>>> forward send construct_object 38248>>> send define_aps_control_mx 38249>>> set p_auto_label_add_colon_state to false 38250>>> end_procedure 38251>>> import_class_protocol aps_control_mx 38252>>> procedure aps_auto_size_control 38254>>> integer sz# 38254>>> get size to sz# 38255>>> set size to (p_form_height(self)) (low(sz#) max 9) 38256>>> end_procedure 38257>>> procedure end_construct_object 38259>>> forward send end_construct_object 38261>>> send end_define_aps_control_mx 38262>>> end_procedure 38263>>>end_class 38264>>> 38264>>>class aps.dbCheckBox is a dbCheckBox startmac APS.STARTMAC_LABEL_SNAP 38265>>> procedure construct_object 38267>>> forward send construct_object 38269>>> send define_aps_control_mx 38270>>> set p_dbControl to true 38271>>> set p_auto_label_add_colon_state to false 38272>>> end_procedure 38273>>> import_class_protocol aps_control_mx 38274>>> procedure aps_auto_size_control 38276>>> integer sz# 38276>>> get size to sz# 38277>>> set auto_size_state to false 38278>>> set size to (p_form_height(self)) (low(sz#) max 9) 38279>>> end_procedure 38280>>> procedure end_construct_object 38282>>> forward send end_construct_object 38284>>> send end_define_aps_control_mx 38285>>> end_procedure 38286>>>end_class 38287>>> 38287>>>class aps.Edit is an Edit startmac APS.STARTMAC_LABEL_SNAP 38288>>> procedure construct_object 38290>>> forward send construct_object 38292>>> send define_aps_control_mx 38293>>> set p_auto_size_control_state to false 38294>>> set label_justification_mode to default_label_jmode // Default is jmode_top 38295>>> end_procedure 38296>>> import_class_protocol aps_control_mx 38297>>> procedure end_construct_object 38299>>> forward send end_construct_object 38301>>> send end_define_aps_control_mx 38302>>> end_procedure 38303>>>end_class 38304>>> 38304>>>class aps.dbEdit is a dbEdit startmac APS.STARTMAC_LABEL_SNAP 38305>>> procedure construct_object 38307>>> forward send construct_object 38309>>> send define_aps_control_mx 38310>>> set p_dbControl to true 38311>>> set p_auto_size_control_state to false 38312>>> set label_justification_mode to default_label_jmode // (dflblmx.pkg) 38313>>> end_procedure 38314>>> import_class_protocol aps_control_mx 38315>>> procedure end_construct_object 38317>>> forward send end_construct_object 38319>>> send end_define_aps_control_mx 38320>>> end_procedure 38321>>>end_class 38322>>> 38322>>>class aps.RichEdit is an cRichEdit startmac APS.STARTMAC_LABEL_SNAP 38323>>> procedure construct_object 38325>>> forward send construct_object 38327>>> send define_aps_control_mx 38328>>> set p_auto_size_control_state to false 38329>>> set label_justification_mode to default_label_jmode // Default is jmode_top 38330>>> end_procedure 38331>>> import_class_protocol aps_control_mx 38332>>> procedure end_construct_object 38334>>> forward send end_construct_object 38336>>> send end_define_aps_control_mx 38337>>> end_procedure 38338>>>end_class 38339>>> 38339>>>class aps.dbRichEdit is a cdbRichEdit startmac APS.STARTMAC_LABEL_SNAP 38340>>> procedure construct_object 38342>>> forward send construct_object 38344>>> send define_aps_control_mx 38345>>> set p_dbControl to true 38346>>> set p_auto_size_control_state to false 38347>>> set label_justification_mode to default_label_jmode // (dflblmx.pkg) 38348>>> end_procedure 38349>>> import_class_protocol aps_control_mx 38350>>> procedure end_construct_object 38352>>> forward send end_construct_object 38354>>> send end_define_aps_control_mx 38355>>> end_procedure 38356>>>end_class 38357>>> 38357>>>class aps.TextEdit is an cTextEdit startmac APS.STARTMAC_LABEL_SNAP 38358>>> procedure construct_object 38360>>> forward send construct_object 38362>>> send define_aps_control_mx 38363>>> set p_auto_size_control_state to false 38364>>> set label_justification_mode to default_label_jmode // Default is jmode_top 38365>>> end_procedure 38366>>> import_class_protocol aps_control_mx 38367>>> procedure end_construct_object 38369>>> forward send end_construct_object 38371>>> send end_define_aps_control_mx 38372>>> end_procedure 38373>>>end_class 38374>>> 38374>>>class aps.dbTextEdit is a cdbTextEdit startmac APS.STARTMAC_LABEL_SNAP 38375>>> procedure construct_object 38377>>> forward send construct_object 38379>>> send define_aps_control_mx 38380>>> set p_dbControl to true 38381>>> set p_auto_size_control_state to false 38382>>> set label_justification_mode to default_label_jmode // (dflblmx.pkg) 38383>>> end_procedure 38384>>> import_class_protocol aps_control_mx 38385>>> procedure end_construct_object 38387>>> forward send end_construct_object 38389>>> send end_define_aps_control_mx 38390>>> end_procedure 38391>>>end_class 38392>>> 38392>>>class aps.TextBox is a TextBox startmac APS.STARTMAC_LABEL_SNAP 38393>>> procedure construct_object 38395>>> forward send construct_object 38397>>> send define_aps_control_mx 38398>>> // set justification_mode to (JMODE_CENTER+JMODE_VCENTER) 38398>>> set p_auto_size_control_state to false 38399>>> property integer p_fixed_width public 0 38400>>> property integer p_fixed_height public 0 38401>>> end_procedure 38402>>> procedure set fixed_size integer h# integer w# 38404>>> set p_fixed_height to h# 38405>>> set p_fixed_width to w# 38406>>> end_procedure 38407>>> import_class_protocol aps_control_mx 38408>>> procedure end_construct_object 38410>>> integer fixed_width# fixed_height# 38410>>> forward send end_construct_object 38412>>> set auto_size_state to false 38413>>> get p_fixed_width to fixed_width# 38414>>> get p_fixed_height to fixed_height# 38415>>> set size to (if(fixed_height#,fixed_height#,p_form_height(self))) (if(fixed_width#,fixed_width#,low(size(self)))) 38416>>> send end_define_aps_control_mx 38417>>> end_procedure 38418>>>end_class 38419>>> 38419>>>// This is a stupid class that will probably go away! 38419>>>class aps.TextBoxEx is an aps.Edit startmac APS.STARTMAC_LABEL_SNAP 38420>>> procedure construct_object 38422>>> forward send construct_object 38424>>> set object_shadow_state to true 38425>>> set border_style to BORDER_NONE 38426>>> set scroll_bar_visible_state to false 38427>>> end_procedure 38428>>>end_class 38429>>> 38429>>>class aps.Button is a Button startmac APS.STARTMAC_LABEL_SNAP 38430>>> procedure construct_object 38432>>> forward send construct_object 38434>>> set size to 14 60 38435>>> send define_aps_control_mx 38436>>> set p_auto_size_control_state to false 38437>>> end_procedure 38438>>> import_class_protocol aps_control_mx 38439>>> procedure end_construct_object 38441>>> forward send end_construct_object 38443>>> send end_define_aps_control_mx 38444>>> end_procedure 38445>>>end_class 38446>>> 38446>>>//> When objects of this class are used within a aps.dbRadioGroup 38446>>>//> the label value will be set from either DD settings or from 38446>>>//> values set in the Fill_list procedure in the group 38446>>>//> The label value will then not have been set on object 38446>>>//> creation time, and this class will not be able to size correct. 38446>>>//> To prevent this the container object has a property called 38446>>>//> p_radio_minimum_label_width that will be used to set a minimum 38446>>>//> width for the radio objects label. 38446>>>//> OBS! If you want to place aps.Radio objects within an object 38446>>>//> of the RadioContainer or the dbRadioContainer class you must 38446>>>//> manually place a function in the container object to return 38446>>>//> the value of p_radio_minimum_label_width. 38446>>>class aps.Radio is a Radio startmac APS.STARTMAC_LABEL_SNAP 38447>>> procedure construct_object 38449>>> forward send construct_object 38451>>> send define_aps_control_mx 38452>>> set p_auto_label_add_colon_state to false 38453>>> end_procedure 38454>>> import_class_protocol aps_control_mx 38455>>> procedure aps_auto_size_control 38457>>> integer sz# 38457>>> get size to sz# 38458>>> set auto_size_state to false 38459>>> set size to (p_form_height(self)) (low(sz#) MAX p_radio_minimum_label_width(self)) 38460>>> end_procedure 38461>>> procedure end_construct_object 38463>>> forward send end_construct_object 38465>>> send end_define_aps_control_mx 38466>>> end_procedure 38467>>>end_class 38468>>> 38468>>> 38468>>>// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 38468>>>// Grid controls 38468>>>// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 38468>>> 38468>>>class aps.List is a List startmac APS.STARTMAC_LABEL_SNAP 38469>>> procedure construct_object 38471>>> forward send construct_object 38473>>> send define_aps_control_mx 38474>>> set p_auto_size_control_state to false 38475>>> end_procedure 38476>>> import_class_protocol aps_control_mx 38477>>> procedure end_construct_object 38479>>> forward send end_construct_object 38481>>> send end_define_aps_control_mx 38482>>> end_procedure 38483>>>end_class 38484>>> 38484>>>class aps.dbList is a dbList startmac APS.STARTMAC_SNAP 38485>>> procedure construct_object 38487>>> forward send construct_object 38489>>> send define_aps_control_mx 38490>>> set p_dbControl to true 38491>>> send define_aps_grid_mx 38492>>> set p_auto_size_control_state to false 38493>>> end_procedure 38494>>> import_class_protocol aps_control_mx 38495>>> import_class_protocol aps_grid_mx 38496>>> procedure end_construct_object 38498>>> forward send end_construct_object 38500>>> if (p_auto_label_state(self)) send aps_auto_grid_labels 38503>>> if (p_auto_abstract_state(self)) send aps_auto_grid_abstracts 38506>>> if (p_auto_size_columns_state(self)) send aps_auto_size_columns 38509>>> send end_define_aps_control_mx 38510>>> end_procedure 38511>>>end_class 38512>>> 38512>>>class aps.Grid is a Grid startmac APS.STARTMAC_SNAP 38513>>> procedure construct_object 38515>>> forward send construct_object 38517>>> send define_aps_control_mx 38518>>> send define_aps_grid_mx 38519>>> set p_auto_label_state to false 38520>>> set p_auto_size_control_state to false 38521>>> end_procedure 38522>>> import_class_protocol aps_control_mx 38523>>> import_class_protocol aps_grid_mx 38524>>> procedure end_construct_object 38526>>> forward send end_construct_object 38528>>>// if (p_auto_abstract_state(self)) send aps_auto_grid_abstracts 38528>>> if (p_auto_size_columns_state(self)) send aps_auto_size_columns // Defined in define_aps_grid_mx 38531>>> send end_define_aps_control_mx 38532>>> end_procedure 38533>>>end_class 38534>>> 38534>>>class aps.dbGrid is a dbGrid startmac APS.STARTMAC_SNAP 38535>>> procedure construct_object 38537>>> forward send construct_object 38539>>> send define_aps_control_mx 38540>>> set p_dbControl to true 38541>>> send define_aps_grid_mx 38542>>> set p_auto_size_control_state to false 38543>>> end_procedure 38544>>> import_class_protocol aps_control_mx 38545>>> import_class_protocol aps_grid_mx 38546>>> procedure entry_display integer iFile integer iType 38548>>> forward send entry_display iFile iType 38550>>> end_procedure 38551>>> procedure end_construct_object 38553>>> forward send end_construct_object 38555>>> if (p_auto_label_state(self)) send aps_auto_grid_labels 38558>>> if (p_auto_abstract_state(self)) send aps_auto_grid_abstracts 38561>>> if (p_auto_size_columns_state(self)) send aps_auto_size_columns // Defined in define_aps_grid_mx 38564>>> send end_define_aps_control_mx 38565>>> end_procedure 38566>>>end_class 38567>>> 38567>>> 38567>>>// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 38567>>>// Freaks 38567>>>// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 38567>>> 38567>>>class aps.dbTabView is a dbTabView startmac APS.STARTMAC_LABEL 38568>>> procedure construct_object 38570>>> forward send construct_object 38572>>> send aps_init 38573>>> end_procedure 38574>>> procedure end_construct_object 38576>>> integer max_row# max_column# 38576>>> get p_max_row to max_row# 38577>>> get p_max_column to max_column# 38578>>> if max_row# gt (p_max_row_on_tabdialog(self)) set p_max_row_on_tabdialog to max_row# 38581>>> if max_column# gt (p_max_column_on_tabdialog(self)) set p_max_column_on_tabdialog to max_column# 38584>>> forward send end_construct_object 38586>>> end_procedure 38587>>>end_class 38588>>> 38588>>>//> The aps.DataDictionary class only differs from the standard VDF class 38588>>>//> in that when queried about field specific status help, it will first 38588>>>//> check its internal array (this is standard class behavior). If that 38588>>>//> does not return a value the global status_help array (defined in 38588>>>//> fieldinf.pkg) will be checked. Don't use it. 38588>>> 38588>>>class aps.DataDictionary is a DataDictionary 38589>>> function status_help integer fld# returns string 38591>>> string rval# 38591>>> forward get status_help fld# to rval# 38593>>> if rval# eq "" get gl_status_help (main_file(self)) fld# to rval# 38596>>> function_return rval# 38597>>> end_function 38598>>>end_class 38599>>> 38599>>> 38599>>>// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 38599>>>// Multi Buttons 38599>>>// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 38599>>>// 38599>>>// aps.Multi_Button 38599>>>// 38599>>>//> An aps.Multi_Button does not have a name equivalent in the standard VDF 38599>>>//> class hierarchy. It is a normal button and it is only "multi" in that 38599>>>//> you often declare a number of them in a row. What makes it special is 38599>>>//> that APS is capable of locating them more easily than normal aps.Buttons. 38599>>>//> 38599>>>//> aps.Multi_Buttons are not "snapped" anywhere. They are all located at 38599>>>//> the same time, when sending the aps_locate_multi_buttons message. 38599>>>//> 38599>>>//> One word of WARNING: If more aps.Multi_Button's are defined than 38599>>>//> will fit in the container (horizontally) the container will collapse 38599>>>//> (negative size). No check is built into APS for this condition. It's one 38599>>>//> of those oddities you'll have to know about. 38599>>> 38599>>>desktop_section 38604>>> object aps.multi_button_array is an array 38606>>> // Upon declaration of a multi_button its object ID is registered in this 38606>>> // global array. This way all multi_buttons are collected and when 38606>>> // sending the message aps_locate_multi_buttons all multi_buttons are 38606>>> // located, and the array is reset. 38606>>> set delegation_mode to delegate_to_parent 38607>>> property integer p_aps_container public 0 38609>>> property integer p_mb_height public 0 38611>>> property integer p_mb_width public 0 38613>>> property integer p_mb_space public -1 38615>>> procedure register_button.i integer lhObj 38618>>> integer item_count# 38618>>> get item_count to item_count# 38619>>> set value item item_count# to lhObj 38620>>> // If first object, we retrieve the obj_id of the container in which 38620>>> // the buttons are located: 38620>>> ifnot item_count# set p_aps_container to (aps_parent(lhObj)) 38623>>> end_procedure 38624>>> procedure arrange_objects.iii integer snap_tmp# integer orientation_tmp# integer relative_to_tmp# 38627>>> integer relative_to# aps_cont# max# orientation# itm# lhObj dm# spc# org_spc# 38627>>> integer backwards# trailing_snap# snap# 38627>>> integer restore_spc# 38627>>> get item_count to max# 38628>>> if max# begin // If there is any objects registered at all? 38630>>> get p_aps_container to aps_cont# 38631>>> 38631>>> if num_arguments gt 0 move snap_tmp# to snap# 38634>>> else move SL_LOWER_RIGHT_CORNER_EXTEND_ROW to snap# 38636>>> if num_arguments gt 1 move orientation_tmp# to orientation# 38639>>> else move SL_HORIZONTAL to orientation# 38641>>> if num_arguments gt 2 move relative_to_tmp# to relative_to# 38644>>> else get p_last_object of aps_cont# to relative_to# 38646>>> 38646>>> move 0 to restore_spc# 38647>>> if snap# eq SL_VERTICAL begin 38649>>> move SL_UPPER_RIGHT_CORNER_EXTEND_COLUMN to snap# 38650>>> move SL_VERTICAL to orientation# 38651>>> get p_mb_space to spc# 38652>>> if spc# ne -1 begin 38654>>> get p_row_space of aps_cont# to org_spc# 38655>>> set p_row_space of aps_cont# to spc# 38656>>> move 1 to restore_spc# 38657>>> end 38657>>>> 38657>>> end 38657>>>> 38657>>> if snap# eq SL_HORIZONTAL begin 38659>>> move SL_LOWER_RIGHT_CORNER_EXTEND_ROW to snap# 38660>>> move SL_HORIZONTAL to orientation# 38661>>> get p_mb_space to spc# 38662>>> if spc# ne -1 begin 38664>>> get p_column_space of aps_cont# to org_spc# 38665>>> set p_column_space of aps_cont# to spc# 38666>>> move 2 to restore_spc# 38667>>> end 38667>>>> 38667>>> end 38667>>>> 38667>>> 38667>>> // Now we have to figure out in which order to locate the 38667>>> // objects (forwards or backwards). 38667>>> 38667>>> if orientation# eq SL_HORIZONTAL begin 38669>>> if (snap#=SL_LEFT or snap#=SL_LOWER_RIGHT_CORNER_EXTEND_ROW or snap#=SL_LOWER_RIGHT_CORNER) begin 38671>>> move 1 to backwards# 38672>>> move SL_LEFT to trailing_snap# 38673>>> end 38673>>>> 38673>>> else begin // Forward horizontal 38674>>> move 0 to backwards# 38675>>> move SL_RIGHT to trailing_snap# 38676>>> end 38676>>>> 38676>>> end 38676>>>> 38676>>> else begin // vertical 38677>>> if (snap#=SL_LOWER_RIGHT_CORNER_EXTEND_ROW or snap#=SL_UP) begin 38679>>> move 1 to backwards# 38680>>> move SL_UP to trailing_snap# 38681>>> end 38681>>>> 38681>>> else begin // Forward vertical 38682>>> move 0 to backwards# 38683>>> move SL_DOWN to trailing_snap# 38684>>> end 38684>>>> 38684>>> end 38684>>>> 38684>>> 38684>>> set p_last_object of aps_cont# to relative_to# 38685>>> if backwards# get value item (max#-1) to lhObj 38688>>> else get value item 0 to lhObj 38690>>> send aps_auto_locate_control to aps_cont# lhObj snap# 38691>>> send aps_push_current_position to aps_cont# 38692>>> if lhObj begin 38694>>> get delegation_mode of lhObj to dm# 38695>>> set delegation_mode of lhObj to NO_DELEGATE_OR_ERROR 38696>>> send Locate_Extra_Label to lhObj 38697>>> set delegation_mode of lhObj to dm# 38698>>> end 38698>>>> 38698>>> send aps_pop_current_position to aps_cont# 38699>>> 38699>>> for itm# from 1 to (max#-1) 38705>>>> 38705>>> if backwards# get value item (max#-1-itm#) to lhObj 38708>>> else get value item itm# to lhObj 38710>>> send aps_auto_locate_control to aps_cont# lhObj trailing_snap# 38711>>> send aps_push_current_position to aps_cont# 38712>>> get delegation_mode of lhObj to dm# 38713>>> set delegation_mode of lhObj to NO_DELEGATE_OR_ERROR 38714>>> send Locate_Extra_Label to lhObj 38715>>> set delegation_mode of lhObj to dm# 38716>>> send aps_pop_current_position to aps_cont# 38717>>> loop 38718>>>> 38718>>> send delete_data 38719>>> end 38719>>>> 38719>>> set p_mb_height to 0 // Reset temporary Multi_Button size 38720>>> set p_mb_width to 0 38721>>> set p_mb_space to -1 38722>>> if restore_spc# eq 1 set p_row_space of aps_cont# to org_spc# 38725>>> if restore_spc# eq 2 set p_column_space of aps_cont# to org_spc# 38728>>> end_procedure 38729>>> end_object 38730>>>end_desktop_section 38735>>> 38735>>>procedure aps_locate_multi_buttons global integer snap_tmp# integer orientation_tmp# integer relative_to_tmp# 38737>>> if num_arguments gt 2 send arrange_objects.iii to (aps.multi_button_array(self)) snap_tmp# orientation_tmp# relative_to_tmp# 38740>>> else begin 38741>>> if num_arguments gt 1 send arrange_objects.iii to (aps.multi_button_array(self)) snap_tmp# orientation_tmp# 38744>>> else begin 38745>>> if num_arguments gt 0 send arrange_objects.iii to (aps.multi_button_array(self)) snap_tmp# 38748>>> else send arrange_objects.iii to (aps.multi_button_array(self)) 38750>>> end 38750>>>> 38750>>> end 38750>>>> 38750>>>end_procedure 38751>>> 38751>>>procedure aps_register_multi_button global integer lhObj 38753>>> send register_button.i to (aps.multi_button_array(self)) lhObj 38754>>>end_procedure 38755>>> 38755>>>procedure set multi_button_size global integer x# integer y# 38757>>> set p_mb_height of (aps.multi_button_array(self)) to x# 38758>>> set p_mb_width of (aps.multi_button_array(self)) to y# 38759>>>end_procedure 38760>>> 38760>>>procedure set multi_button_spacing global integer x# 38762>>> set p_mb_space of (aps.multi_button_array(self)) to x# 38763>>>end_procedure 38764>>> 38764>>>class aps.Multi_Button is a aps.Button 38765>>> procedure construct_object 38767>>> forward send construct_object 38769>>> set p_auto_locate_control_state to false 38770>>> on_key kleftarrow send previous // Since buttons of this class are 38771>>> on_key krightarrow send next // arranged in a row (horizontally or 38772>>> on_key kuparrow send previous // vertically), we make them respond 38773>>> on_key kdownarrow send next // to the arrow keys. 38774>>> property string psExtraLabel public "" 38775>>> property integer piExtraLabelID public 0 38776>>> end_procedure 38777>>> procedure Locate_Extra_Label 38779>>> string str# 38779>>> integer lhObj parent# self# liAnchorValue 38779>>> set delegation_mode to DELEGATE_TO_PARENT 38780>>> get psExtraLabel to str# 38781>>> if str# ne "" begin 38783>>> get piExtraLabelID to lhObj 38784>>> move self to self# 38785>>> get peAnchors to liAnchorValue 38786>>> ifnot lhObj begin 38788>>> get parent to parent# 38789>>> move parent# to self 38790>>> object oExtraLabel is a aps.TextBox label str# snap SL_DOWN relative_to self# 38799>>> set auto_size_state to false 38800>>> set fixed_size to 8 0 38801>>> move self to lhObj 38802>>> set peAnchors to liAnchorValue 38803>>> end_object 38804>>> set piExtraLabelID of self# to lhObj 38805>>> move self# to self 38806>>> end 38806>>>> 38806>>> send aps_auto_locate_control lhObj SL_DOWN self# 38807>>> send aps_align_by_moving lhObj self# SL_ALIGN_CENTER 38808>>> end 38808>>>> 38808>>> end_procedure 38809>>> procedure end_construct_object 38811>>> integer self# 38811>>> forward send end_construct_object 38813>>> move self to self# 38814>>> send aps_register_multi_button self# 38815>>> if (p_mb_height(aps.multi_button_array(self))) set size to (p_mb_height(aps.multi_button_array(self))) (p_mb_width(aps.multi_button_array(self))) 38818>>> end_procedure 38819>>>end_class 38820>>> 38820>>>// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 38820>>>// Exotics 38820>>>// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 38820>>> 38820>>>function aps_read_bitmap_guisize global string bitmap# integer ch# returns integer 38822>>> integer guisize# 38822>>> string str# // The method used for reading the size 38822>>> direct_input channel ch# bitmap# // of a bitmap has been stolen from 38824>>> [~seqeof] begin // splash.pkg by Andrew S. Kaplan 38826>>>> 38826>>> set_channel_position ch# to 18 38827>>>> 38827>>> read_block channel ch# str# 6 38829>>> move ( ascii(mid(str#,1,6))) to guisize# 38830>>> move (guisize#*256+ascii(mid(str#,1,5))) to guisize# 38831>>> move (guisize#*256+ascii(mid(str#,1,2))) to guisize# 38832>>> move (guisize#*256+ascii(mid(str#,1,1))) to guisize# 38833>>> end 38833>>>> 38833>>> close_input channel ch# 38835>>> function_return guisize# 38836>>>end_function 38837>>> 38837>>>class aps.BitmapContainer is a BitmapContainer startmac APS.STARTMAC_SNAP 38838>>> procedure construct_object 38840>>> forward send construct_object 38842>>> send define_aps_container_mx 38843>>> send define_aps_control_mx 38844>>> set p_auto_size_control_state to false // Do not autosize as control 38845>>> set p_bottom_margin to 7 // Set non-default bottom margin 38846>>> set p_right_margin to 8 38847>>> send aps_init // Reflect this in object cursor position 38848>>> end_procedure 38849>>> import_class_protocol aps_container_mx 38850>>> import_class_protocol aps_control_mx 38851>>> 38851>>> function read_channel returns integer // Objects of this class needs to read 38853>>> function_return 5 // from a file via a channel. These 38854>>> end_function // hooks are provided for augmentation 38855>>> procedure release_channel integer ch# // purposes, if you do not want to use 38857>>> end_procedure // channel 5. 38858>>> 38858>>> procedure end_construct_object 38860>>> integer size_h# size_w# bitmap_h# bitmap_w# ch# 38860>>> forward send end_construct_object 38862>>> get read_channel to ch# 38863>>> get aps_read_bitmap_guisize (bitmap(self)) ch# to bitmap_h# 38864>>> send release_channel ch# 38865>>> move (low(bitmap_h#)) to bitmap_w# 38866>>> move (hi(bitmap_h#)) to bitmap_h# 38867>>> set guisize to bitmap_h# bitmap_w# 38868>>> send adjust_logicals 38869>>> get size to bitmap_h# 38870>>> move (low(bitmap_h#)) to bitmap_w# 38871>>> move (hi(bitmap_h#)) to bitmap_h# // Now we have the bitmap size 38872>>> 38872>>> send end_define_aps_container_mx // Size the object 38873>>> send end_define_aps_control_mx // Locate the object 38874>>> 38874>>> get size to size_h# 38875>>> move (low(size_h#)) to size_w# 38876>>> move (hi(size_h#)) to size_h# 38877>>> 38877>>> set size to (size_h# max bitmap_h#) (size_w# max bitmap_w#) 38878>>> delegate send aps_register_max_rc self 38880>>> end_procedure 38881>>>end_class 38882>>> 38882>>>define APS.TBSTYLE_WRAPABLE for |CI$200 // Mystery! Got it from Sam Cannone 38882>>> 38882>>>//> aps.ToolButton is not an authorized class. I invented it for use within 38882>>>//> Views and ModalPanels. Its purpose is that of a normal button, but 38882>>>//> instead of a text it should display bitmaps (like toolbar's). What 38882>>>//> further differentiates it from a normal button is its ability to 38882>>>//> display tool-tips and status help. It will not take focus! 38882>>>//> 38882>>>//> Its interface is that of a BasicToolbar except that only the following 38882>>>//> messages are implemented: 38882>>>//> 38882>>>//> imagelist_add, add_button, add_tooltip and set status_help 38882>>>//> 38882>>>//> If you add more than one button they will appear next to each other 38882>>>//> horizontally. However, you may set property p_horizontal_button_count to 38882>>>//> x to make it wrap after x buttons. (Set it to 1 to make the buttons 38882>>>//> appear vertically). 38882>>>//> 38882>>>//> It will probably only work with small bitmaps. SAMPLE06.SRC displays 38882>>>//> an example. 38882>>>// 38882>>> 38882>>>class aps.ToolButton is a Container3D startmac APS.STARTMAC_SNAP 38883>>> procedure construct_object 38885>>> forward send construct_object 38887>>> send define_aps_container_mx 38888>>> send define_aps_control_mx 38889>>> set p_auto_size_control_state to false // Do not autosize as control 38890>>> set border_style to border_none // No visible border 38891>>> object oToolBar is a basictoolbar 38893>>> set window_style to APS.TBSTYLE_WRAPABLE true // Wrap if necessary 38894>>> set focus_mode to pointer_only // Do not take focus 38895>>> set window_style to CCS_NODIVIDER true // Do not display line above buttons 38896>>> end_object 38897>>> property integer p_horizontal_button_count public 999 38898>>> end_procedure 38899>>> import_class_protocol aps_container_mx 38900>>> import_class_protocol aps_control_mx 38901>>> 38901>>> procedure aps_auto_size_container // Augmented to calculate size from 38903>>> // number of buttons in the object 38903>>> integer tb# count# sz# buttons_w# buttons_h# 38903>>> move (oToolBar(self)) to tb# 38904>>> get p_horizontal_button_count to buttons_w# 38905>>> get item_count of tb# to count# 38906>>> if buttons_w# gt count# begin 38908>>> move count# to buttons_w# 38909>>> move 1 to buttons_h# 38910>>> end 38910>>>> 38910>>> else move (count#-1/buttons_w#+1) to buttons_h# 38912>>> get guisize of tb# to sz# 38913>>> set guisize to (hi(sz#)-5*buttons_h#+1) (low(sz#)-5*buttons_w#) 38914>>> send adjust_logicals 38915>>> end_procedure 38916>>> 38916>>> procedure end_construct_object 38918>>> forward send end_construct_object 38920>>> send end_define_aps_container_mx // Size the object 38921>>> send end_define_aps_control_mx // Locate the object 38922>>> end_procedure 38923>>> 38923>>> // Redirect the following messages to embedded toolbar object: 38923>>> procedure set status_help string itm# string str# 38925>>> if num_arguments gt 1 set status_help of (oToolBar(self)) item itm# to str# 38928>>> else set status_help of (oToolBar(self)) to itm# 38930>>> end_procedure 38931>>> procedure add_button integer bmp# integer msg# integer lhObj 38933>>> if num_arguments gt 2 send add_button to (oToolBar(self)) bmp# msg# lhObj 38936>>> else send add_button to (oToolBar(self)) bmp# msg# 38938>>> end_procedure 38939>>> procedure add_tooltip string tip# 38941>>> send add_tooltip to (oToolBar(self)) tip# 38942>>> end_procedure 38943>>> procedure imagelist_add string bmp# 38945>>> send imagelist_add to (oToolBar(self)) bmp# 38946>>> end_procedure 38947>>>end_class 38948>>> 38948>>>class aps.ComboFormAux is a aps.ComboForm 38949>>> procedure construct_object 38951>>> forward send construct_object 38953>>> object oAux_Values is an array 38955>>> end_object 38956>>> set combo_sort_state to false 38957>>> end_procedure 38958>>> // Private message: 38958>>> procedure set aux_value integer liItm integer liValue 38960>>> set value of (oAux_Values(self)) item liItm to liValue 38961>>> end_procedure 38962>>> // Private message: 38962>>> function aux_value integer liItm returns integer 38964>>> function_return (value(oAux_Values(self),liItm)) 38965>>> end_function 38966>>> // Augmented Combo_Add_Item: 38966>>> Procedure Combo_Add_Item string lsValue integer liAuxValue 38968>>> integer liAux liItm 38968>>> forward send Combo_Add_Item lsValue 38970>>> if num_arguments gt 1 move liAuxValue to liAux 38973>>> get Combo_Item_Count to liItm 38974>>> set aux_value item (liItm-1) to liAux 38975>>> End_Procedure 38976>>> // Returns the aux value of the currently selected value: 38976>>> Function Combo_Current_Aux_Value returns integer 38978>>> integer liItm 38978>>> get Combo_Item_Matching (value(self,0)) to liItm 38979>>> function_return (aux_value(self,liItm)) 38980>>> End_Function 38981>>> // Set the value corresponding to aux value passed in liAuxValue 38981>>> Procedure set Combo_Current_Aux_Value integer liAuxValue 38983>>> integer liItm liMax lhObj 38983>>> move (oAux_Values(self)) to lhObj 38984>>> get item_count of lhObj to liMax 38985>>> for liItm from 0 to (liMax-1) 38991>>>> 38991>>> if (value(lhObj,liItm)=liAuxValue) Set Value item 0 to (Combo_Value(self,liItm)) 38994>>> loop 38995>>>> 38995>>> End_Procedure 38996>>> 38996>>> function iFindAuxValue integer liAuxValue returns integer 38998>>> integer liItem liMax lhObj 38998>>> move (oAux_Values(self)) to lhObj 38999>>> get item_count of lhObj to liMax 39000>>> decrement liMax 39001>>> for liItem from 0 to liMax 39007>>>> 39007>>> if (value(lhObj,liItem)=liAuxValue) function_return liItem 39010>>> loop 39011>>>> 39011>>> function_return -1 39012>>> end_function 39013>>> 39013>>> 39013>>> 39013>>> // Augmented Combo_Delete_Data 39013>>> Procedure Combo_Delete_Data 39015>>> forward send Combo_Delete_Data 39017>>> send delete_data to (oAux_Values(self)) 39018>>> End_Procedure 39019>>>end_class // aps.ComboFormAux 39020>>> 39020>>>// The SetWindowPos external function and the constants below it are as 39020>>>// defined in the WinUser.pkg DAC package. 39020>>>External_Function ApsSetWindowPos "SetWindowPos" User32.dll Handle hWnd# Handle hWndAfter# Integer x# Integer y# Integer cx# Integer cy# Integer uFlags# Returns Integer 39021>>> 39021>>>class aps.TopMostModalPanel is a aps.ModalPanel 39022>>> Procedure Popup_Group 39024>>> Integer swp# 39024>>> Forward Send Popup_Group 39026>>> Move (ApsSetWindowPos(Window_Handle(self), APS.HWND_TOPMOST, 0, 0, 0, 0, APS.SWP_NOMOVE ior APS.SWP_NOSIZE)) to swp# 39027>>> End_Procedure 39028>>>End_Class 39029>>> 39029>>>class aps.dbTopMostModalPanel is a aps.dbModalPanel 39030>>> //procedure popup 39030>>> // Set Extended_Window_Style to WS_EX_TOOLWINDOW False 39030>>> // forward send popup 39030>>> //end_procedure 39030>>> Procedure Popup_Group 39032>>> Integer swp# 39032>>> Forward Send Popup_Group 39034>>> Move (ApsSetWindowPos(Window_Handle(self), APS.HWND_TOPMOST, 0, 0, 0, 0, APS.SWP_NOMOVE ior APS.SWP_NOSIZE)) to swp# 39035>>> End_Procedure 39036>>>End_Class 39037>>> 39037>>>class aps.BasicPanel is a BasicPanel startmac APS.STARTMAC_LABEL 39038>>> procedure construct_object 39040>>> forward send construct_object 39042>>> send define_aps_container_mx 39043>>> send define_aps_panel_mx 39044>>> set p_right_margin to 8 39045>>> send aps_init // Reflect this in object cursor position 39046>>> end_procedure 39047>>> import_class_protocol aps_container_mx 39048>>> import_class_protocol aps_panel_mx 39049>>> procedure end_construct_object 39051>>> forward send end_construct_object 39053>>> send end_define_aps_container_mx 39054>>> send end_define_aps_panel_mx 39055>>> end_procedure 39056>>>end_class 39057>>> 39057>>>class aps.LineControl is a LineControl 39058>>> procedure construct_object 39060>>> forward send construct_object 39062>>> set location to (p_cur_row(self)) (p_cur_column(self)) 39063>>> set guisize to 2 25 39064>>> send adjust_logicals 39065>>> end_procedure 39066>>> procedure set size integer height# integer width# 39068>>> integer gui# 39068>>> forward set size to height# width# 39070>>> get guisize to gui# 39071>>> set guisize to 2 (low(gui#)) 39072>>> send adjust_logicals 39073>>> end_procedure 39074>>> procedure end_construct_object 39076>>> forward send end_construct_object 39078>>> send aps_register_max_rc self 39079>>> end_procedure 39080>>>end_class 39081>>> 39081>>>procedure aps_SetMinimumDialogSize global integer lhPanel 39083>>> set piMinSize of lhPanel to (hi(size(lhPanel))) (low(size(lhPanel))) 39084>>>end_procedure 39085>>> 39085>>>// class aps.ReportView is a ReportView startmac APS.STARTMAC_LABEL 39085>>>// procedure construct_object 39085>>>// forward send construct_object 39085>>>// send define_aps_container_mx 39085>>>// send define_aps_panel_mx 39085>>>// set p_right_margin to 8 39085>>>// send aps_init 39085>>>// end_procedure 39085>>>// import_class_protocol aps_container_mx 39085>>>// import_class_protocol aps_panel_mx 39085>>>// procedure end_construct_object 39085>>>// forward send end_construct_object 39085>>>// send end_define_aps_container_mx 39085>>>// send end_define_aps_panel_mx 39085>>>// end_procedure 39085>>>// end_class 39085>>> 39085>>> 39085>>>// Subclass all APS classes 39085>>>// 39085>>>// You are encouraged to sub-class the APS classes since these only 39085>>>// addresses APS-issues. You probably want to add further customization. 39085>>>// 39085>>>// class my.View is a aps.View 39085>>>// end_class 39085>>>// class my.dbView is a aps.dbView 39085>>>// end_class 39085>>>// class my.ModalPanel is a aps.ModalPanel 39085>>>// end_class 39085>>>// class my.dbModalPanel is a aps.dbModalPanel 39085>>>// end_class 39085>>>// class my.Group is a aps.Group 39085>>>// end_class 39085>>>// class my.dbGroup is a aps.dbGroup 39085>>>// end_class 39085>>>// class my.Container3D is a aps.Container3D 39085>>>// end_class 39085>>>// class my.dbContainer3D is a aps.dbContainer3D 39085>>>// end_class 39085>>>// class my.TabDialog is a aps.TabDialog 39085>>>// end_class 39085>>>// class my.dbTabDialog is a aps.dbTabDialog 39085>>>// end_class 39085>>>// class my.TabPage is a aps.TabPage 39085>>>// end_class 39085>>>// class my.dbTabPage is a aps.dbTabPage 39085>>>// end_class 39085>>>// class my.RadioGroup is a aps.RadioGroup 39085>>>// end_class 39085>>>// class my.dbRadioGroup is a aps.dbRadioGroup 39085>>>// end_class 39085>>>// class my.RadioContainer is a aps.RadioContainer 39085>>>// end_class 39085>>>// class my.dbRadioContainer is a aps.dbRadioContainer 39085>>>// end_class 39085>>>// class my.Form is a aps.Form 39085>>>// end_class 39085>>>// class my.dbForm is a aps.dbForm 39085>>>// end_class 39085>>>// class my.ComboForm is a aps.ComboForm 39085>>>// end_class 39085>>>// class my.dbComboForm is a aps.dbComboForm 39085>>>// end_class 39085>>>// class my.SpinForm is a aps.SpinForm 39085>>>// end_class 39085>>>// class my.dbSpinForm is a aps.dbSpinForm 39085>>>// end_class 39085>>>// class my.CheckBox is a aps.CheckBox 39085>>>// end_class 39085>>>// class my.dbCheckBox is a aps.dbCheckBox 39085>>>// end_class 39085>>>// class my.Edit is a aps.Edit 39085>>>// end_class 39085>>>// class my.dbEdit is a aps.dbEdit 39085>>>// end_class 39085>>>// class my.TextBox is a aps.TextBox 39085>>>// end_class 39085>>>// class my.Button is a aps.Button 39085>>>// end_class 39085>>>// class my.Radio is a aps.Radio 39085>>>// end_class 39085>>>// class my.List is a aps.List 39085>>>// end_class 39085>>>// class my.dbList is a aps.dbList 39085>>>// end_class 39085>>>// class my.Grid is a aps.Grid 39085>>>// end_class 39085>>>// class my.dbGrid is a aps.dbGrid 39085>>>// end_class 39085>>>// class my.Multi_Button is a aps.Multi_Button 39085>>>// end_class 39085>>>// class my.BitmapContainer is a aps.BitmapContainer 39085>>>// end_class 39085>>>// class my.ToolButton is a aps.ToolButton 39085>>>// end_class 39085> 39085>Use LangSymb.pkg // Language symbols Including file: langsymb.pkg (C:\projects\BRS\VDFQuery\AppSrc\langsymb.pkg) 39085>>>// Use LangSymb.pkg // Language symbols 39085>>>// 39085>>>// This package file is part of VDFQuery. 39085>>> 39085>>>define LNG_DUTCH for 0 // 131 39085>>>define LNG_FRENCH for 1 // 133 39085>>>define LNG_SPANISH for 2 // 134 39085>>>define LNG_ITALIAN for 3 // 139 // NOT TRANSLATED. DO NOT SELECT! 39085>>>define LNG_ENGLISH for 4 // 144 39085>>>define LNG_DANISH for 5 // 145 39085>>>define LNG_SWEDISH for 6 // 146 39085>>>define LNG_NORWEGIAN for 7 // 147 39085>>>define LNG_GERMAN for 8 // 149 39085>>>define LNG_PORTUGUESE for 9 // 155 39085>>>define LNG_PAPIAMENTU for 10 // 199 // NOT TRANSLATED. DO NOT SELECT! 39085>>>define LNG_MAX for 11 // Points one higher than the highest language 39085>//define lng_default for lng_portuguese // <-- Change default language here 39085>//define lng_default for lng_french // <-- Change default language here 39085>define lng_default for lng_english // <-- Change default language here 39085>//define lng_default for lng_dutch // <-- Change default language here 39085> 39085>Use Splash.utl // Graphic splish-splash Including file: splash.utl (C:\projects\BRS\VDFQuery\AppSrc\splash.utl) 39085>>>// Use Splash.utl // 39085>>> 39085>>>Use VdfGraph.utl // Graphics for Visual DataFlex Including file: vdfgraph.utl (C:\projects\BRS\VDFQuery\AppSrc\vdfgraph.utl) 39085>>>>>// ********************************************************************** 39085>>>>>// Use VdfGraph.utl // Graphics for Visual DataFlex 39085>>>>>// 39085>>>>>// by Sture Andersen and friends 39085>>>>>// Version: 1.4 39085>>>>>// 39085>>>>>// The basic mechanism of this package is derived from standard DAC package 39085>>>>>// dfshape.pkg by Stuart Booth. Some of the comments in here stems from that. 39085>>>>>// 39085>>>>>// 39085>>>>>// Create: Tue 27-05-1997 - 39085>>>>>// Update: Tue 10-06-1997 - cAutoScaler class added 39085>>>>>// Fri 13-06-1997 - cCoordinateSystem class added 39085>>>>>// Wed 25-06-1997 - Fixed various errors in coordinate 39085>>>>>// transformation functions 39085>>>>>// Sun 21-09-1997 - Leak identified and fixed 39085>>>>>// Wed 15-10-1997 - Bar chart added 39085>>>>>// Sat 06-12-1997 - External paint mode added 39085>>>>>// Wed 18-02-1998 - APS taken out (class now in apsgraph.pkg). 39085>>>>>// Sat 28-03-1998 - Polylines and polygons added (Geoff Furlong 39085>>>>>// of MSG Systems implemented the methods needed) 39085>>>>>// Fri 16-10-1998 - Added True Type font ability 39085>>>>>// Mon 19-10-1998 - Re-worked mthd_TextOut to be able to vertically 39085>>>>>// center a text (using DrawText instead of TextOut) 39085>>>>>// Wed 21-10-1998 - Properties that specified number of steps are 39085>>>>>// now of type integer 39085>>>>>// - Better control of axis texts 39085>>>>>// - Eliminated lack of precision when printing 39085>>>>>// to VPE (rectangles) 39085>>>>>// - Character conversion error fixed 39085>>>>>// --- Ver 1.1 --- 39085>>>>>// Fri 06-11-1998 - Fixed a leak in TT fonts. 39085>>>>>// - Procedure WMSG_GrphPaint source of pen and 39085>>>>>// brush leak. Procedure fixed. 39085>>>>>// - Procedure Add4Angle added 39085>>>>>// --- Ver 1.2 --- 39085>>>>>// Mon 30-11-1998 - Polylines may now consist of more than 32 39085>>>>>// points (thanks to Ben Weijers). 39085>>>>>// Mon 21-12-1998 - Dots implemented 39085>>>>>// Wed 23-12-1998 - Procedures DrawAxisTextX and DrawAxisTextY of 39085>>>>>// the cCoordinateSystem class have been changed 39085>>>>>// (now works in parent coordinates). 39085>>>>>// - Properties pxTextOffset and pyTextOffset have 39085>>>>>// been added to the cCoordinateSystem. 39085>>>>>// - Properties pViewPortX and pViewPortY added. 39085>>>>>// - Global functions RGB_Darken, RGB_Brighten, 39085>>>>>// RGB_Blend and RGB_Negate added. 39085>>>>>// Sat 02-01-1999 - Procedures Write_To_File and Read_From_File 39085>>>>>// added. 39085>>>>>// Wed 06-01-1999 - Events onMouseDown, onMouseDrag, onMouseMove 39085>>>>>// and onMouseUp are now captured. 39085>>>>>// Wed 13-01-1999 - Procedure AddDot added to cCoordinateSystem class. 39085>>>>>// Thu 05-10-2000 - Mouse trackable objects implemented (grtest25.pkg) 39085>>>>>// --- Ver 1.3 --- 39085>>>>>// Wed 19-09-2001 - Now updates global variable gr$TrackArray correctly 39085>>>>>// Tue 02-10-2001 - Fixed incorrect mouse tracking on resize event. This 39085>>>>>// caused the "Number too large to convert to integer" 39085>>>>>// error seen when re-zising long enough. 39085>>>>>// - Added double click event (Doesn't work) 39085>>>>>// - Four new properties on GraphArea: 39085>>>>>// piX_Offset, piY_Offset (Pixel offset) 39085>>>>>// piX_Range, piY_Range (Default for both is 10000) 39085>>>>>// Don't use these!! 39085>>>>>// --- Ver 1.4 --- 39085>>>>>// Wed 09-02-2005 - Release_All_Content procedure added 39085>>>>>// Clears all added objects. (Note: You have to repaint 39085>>>>>// manually after cleaning up). May be handy for some reason. 39085>>>>>// (Chris Stammen) 39085>>>>>// Tue 15-02-2005 - Offscreen image processing added (no more flickering) 39085>>>>>// Eraseback doesnt erase anymore. 39085>>>>>// Some GDI functions added for doing the job. 39085>>>>>// SRCCOPY defined for bitblitting the screen. 39085>>>>>// See GrphPaint procedure for changes (Chris Stammen) 39085>>>>>// 39085>>>>>// Tue 15-02-2005 - Added new mechanism for setting background color (and 39085>>>>>// making sure it is ignored when printed via VPE). 39085>>>>>// - Updated grdemo.src a bit. 39085>>>>>// 39085>>>>>// Tue 15-03-2005 - Changed procedure draw_background (Chris Stammen) 39085>>>>>// 39085>>>>>// Mon 28-11-2005 - Added property pbPixelScale that will change the 39085>>>>>// coordinate system of a GraphicArea object from 39085>>>>>// 10000x10000 no matter its visible size to the actual 39085>>>>>// number of pixels. 39085>>>>>// 39085>>>>>// 39085>>>>>// Jakob Kruse has been a great help on GDI issues. 39085>>>>>// Chris Stammen added some very clever code to get rid of screen flicker 39085>>>>>// when resizing and dragging. 39085>>>>>// 39085>>>>>// Drawing is what we do when we specify what is going to be inside 39085>>>>>// the area. Painting is what the object does to present our drawing 39085>>>>>// on the screen. 39085>>>>>// 39085>>>>>// By reasonable convention the origin of a graphic area is in the upper 39085>>>>>// left corner with the cursor moving down for increasing values of X and 39085>>>>>// moving right with increasing values of Y. 39085>>>>>// 39085>>>>>// *********************************************************************** 39085>>>>> 39085>>>>>use dfallent // I cannot figure out which packages to use so we use 'em all 39085>>>>>use font_dlg // Standard DAC package. Contains useful constant declarations. 39085>>>>>use Strings.nui // String manipulation for VDF 39085>>>>>Use RGB.utl // Some color functions Including file: rgb.utl (C:\projects\BRS\VDFQuery\AppSrc\rgb.utl) 39085>>>>>>>// This package is obsolete. Use rgb.nui instead 39085>>>>>>>Use RGB.nui // Some color functions Including file: rgb.nui (C:\projects\BRS\VDFQuery\AppSrc\rgb.nui) 39085>>>>>>>>>// Use RGB.nui // Some basic RGB color functions 39085>>>>>>>>>// Part of VDFQuery by Sture ApS 39085>>>>>>>>> 39085>>>>>>>>>//> pkgdoc.begin 39085>>>>>>>>>//> This package contains some global functions to manipulate RGB colors. 39085>>>>>>>>>//> The RGB color model is an additive color model in which red, green, and blue light are combined in various ways 39085>>>>>>>>>//> to create other colors. The very idea for the model itself and the abbreviation "RGB" come from the three primary 39085>>>>>>>>>//> colors in additive light models (check: http://www.wordiq.com/definition/RGB). 39085>>>>>>>>>//> pkgdoc.end 39085>>>>>>>>> 39085>>>>>>>>>Use Strings.nui // String manipulation for VDF 39085>>>>>>>>> 39085>>>>>>>>>//> Return a RGB color composed from red, green and blue components (each of a value between 0 and 255) 39085>>>>>>>>>function RGB_Compose global integer liRed integer liGreen integer liBlue returns integer 39087>>>>>>>>> function_return (liBlue*256+liGreen*256+liRed) 39088>>>>>>>>>end_function 39089>>>>>>>>> 39089>>>>>>>>>//> Brighten a RGB color by a percentage. 39089>>>>>>>>>function RGB_Brighten global integer liColor integer liPercent returns integer 39091>>>>>>>>> integer liRed liGreen liBlue 39091>>>>>>>>> move (liColor IAND $0000FF) to liRed 39092>>>>>>>>> move (liColor IAND $00FF00/256) to liGreen 39093>>>>>>>>> move (liColor IAND $FF0000/65536) to liBlue 39094>>>>>>>>> move (255-liRed*liPercent/100+liRed) to liRed 39095>>>>>>>>> move (255-liGreen*liPercent/100+liGreen) to liGreen 39096>>>>>>>>> move (255-liBlue*liPercent/100+liBlue) to liBlue 39097>>>>>>>>> function_return (liBlue*256+liGreen*256+liRed) 39098>>>>>>>>>end_function 39099>>>>>>>>> 39099>>>>>>>>>//> Darken a RGB color by a percentage. 39099>>>>>>>>>function RGB_Darken global integer liColor integer liPercent returns integer 39101>>>>>>>>> integer liRed liGreen liBlue 39101>>>>>>>>> move (liColor IAND $0000FF) to liRed 39102>>>>>>>>> move (liColor IAND $00FF00/256) to liGreen 39103>>>>>>>>> move (liColor IAND $FF0000/65536) to liBlue 39104>>>>>>>>> move (-liRed*liPercent/100+liRed) to liRed 39105>>>>>>>>> move (-liGreen*liPercent/100+liGreen) to liGreen 39106>>>>>>>>> move (-liBlue*liPercent/100+liBlue) to liBlue 39107>>>>>>>>> function_return (liBlue*256+liGreen*256+liRed) 39108>>>>>>>>>end_function 39109>>>>>>>>> 39109>>>>>>>>>//> Blend two RGB colors weighing color1 by a percentage. 39109>>>>>>>>>function RGB_Blend global integer liColor1 integer liColor2 integer liPercent1 returns integer 39111>>>>>>>>> integer liRed1 liGreen1 liBlue1 39111>>>>>>>>> integer liRed2 liGreen2 liBlue2 39111>>>>>>>>> move (liColor1 IAND $0000FF) to liRed1 39112>>>>>>>>> move (liColor1 IAND $00FF00/256) to liGreen1 39113>>>>>>>>> move (liColor1 IAND $FF0000/65536) to liBlue1 39114>>>>>>>>> move (liColor2 IAND $0000FF) to liRed2 39115>>>>>>>>> move (liColor2 IAND $00FF00/256) to liGreen2 39116>>>>>>>>> move (liColor2 IAND $FF0000/65536) to liBlue2 39117>>>>>>>>> move (liRed1*liPercent1+(100-liPercent1*liRed2)/100) to liRed1 39118>>>>>>>>> move (liGreen1*liPercent1+(100-liPercent1*liGreen2)/100) to liGreen1 39119>>>>>>>>> move (liBlue1*liPercent1+(100-liPercent1*liBlue2)/100) to liBlue1 39120>>>>>>>>> function_return (liBlue1*256+liGreen1*256+liRed1) 39121>>>>>>>>>end_function 39122>>>>>>>>> 39122>>>>>>>>>//> Negate a RGB color 39122>>>>>>>>>function RGB_Negate global integer liColor returns integer 39124>>>>>>>>> integer liRed liGreen liBlue 39124>>>>>>>>> move (liColor IAND $0000FF) to liRed 39125>>>>>>>>> move (liColor IAND $00FF00/256) to liGreen 39126>>>>>>>>> move (liColor IAND $FF0000/65536) to liBlue 39127>>>>>>>>> move (255-liRed) to liRed 39128>>>>>>>>> move (255-liGreen) to liGreen 39129>>>>>>>>> move (255-liBlue) to liBlue 39130>>>>>>>>> function_return (liBlue*256+liGreen*256+liRed) 39131>>>>>>>>>end_function 39132>>>>>>>>> 39132>>>>>>>>>//> Translate a RGB color to HTML syntax. 39132>>>>>>>>>function RGB_ToHTML global integer liColor returns string 39134>>>>>>>>> integer liRed liGreen liBlue 39134>>>>>>>>> move (liColor IAND $0000FF) to liRed 39135>>>>>>>>> move (liColor IAND $00FF00/256) to liGreen 39136>>>>>>>>> move (liColor IAND $FF0000/65536) to liBlue 39137>>>>>>>>> function_return ("#"+ByteToHex(liRed)+ByteToHex(liGreen)+ByteToHex(liBlue)) 39138>>>>>>>>>end_function 39139>>>>>>>>> 39139>>>>>>>>>function RGB_HTMLToRgb global string lsColor returns integer 39141>>>>>>>>> integer liRed liGreen liBlue 39141>>>>>>>>> move (uppercase(replace("#",lsColor,""))) to lsColor 39142>>>>>>>>> get HexToByte (mid(lsColor,2,1)) to liRed 39143>>>>>>>>> get HexToByte (mid(lsColor,2,3)) to liGreen 39144>>>>>>>>> get HexToByte (mid(lsColor,2,5)) to liBlue 39145>>>>>>>>> function_return (RGB_Compose(liRed,liGreen,liBlue)) 39146>>>>>>>>>end_function 39147>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes 39147>>>>> 39147>>>>>Define SRCCOPY For |CI$00CC0020 //* dest = source */ 39147>>>>> 39147>>>>>External_Function32 GrphDeleteDC "DeleteDC" GDI32.DLL Handle hDC Returns Integer 39148>>>>>External_Function32 GrphBitBlt "BitBlt" GDI32.DLL Handle hDC_Dest dWord D_x dWord D_y dWord width dWord height Handle hDC_Source dWord S_x dWord S_y dWord dwType returns Integer 39149>>>>>External_Function32 GrphCreateCompatibleBitmap "CreateCompatibleBitmap" GDI32.DLL Handle hDC dWord dwWidth dWord dwHeight returns dWord 39150>>>>>External_Function32 GrphCreateCompatibleDC "CreateCompatibleDC" GDI32.DLL Handle hDC returns Integer 39151>>>>> 39151>>>>>External_Function32 GrphOemToCharA "OemToCharA" USER32.DLL Pointer hpszOem Pointer hpszWindow Returns Integer 39152>>>>>External_Function32 GrphSetTextAlign "SetTextAlign" GDI32.DLL Handle hDC dWord TextAlign RETURNS integer 39153>>>>>External_Function32 GrphCreateHatchBrush "CreateHatchBrush" GDI32.DLL dWord nHatchStyle dWord crColor Returns Integer 39154>>>>>External_Function32 GrphPolygon "Polygon" GDI32.DLL Handle hDC Pointer lpPolyRect dWord dwPoints Returns Integer 39155>>>>>External_Function32 GrphPolyLine "Polyline" GDI32.DLL Handle hDC Pointer lpPolyRect dWord dwPoints Returns Integer 39156>>>>>External_Function32 GrphSetPolyFillMode "SetPolyFillMode" GDI32.DLL Handle hDC Integer iFillMode Returns Integer 39157>>>>>// This version became too much (long) for the compiler: 39157>>>>>//External_Function32 GrphCreateFontA "CreateFontA" GDI32.DLL dWord nHt# dWord nWd# dWord nEsc# dWord nOri# dWord fnW# dWord Ita# dWord Und# dWord Strike# dWord CharSet# dWord OutPrec# dWord ClpPrec# dWord Qual# dWord Pitch# Pointer font# 39157>>>>>// This version is OK (just): 39157>>>>>External_Function32 GrphCFA "CreateFontA" GDI32.DLL dWord v1# dWord v2# dWord v3# dWord v4# dWord v5# dWord v6# dWord v7# dWord v8# dWord v9# dWord va# dWord vb# dWord vc# dWord vd# Pointer ve# returns dWord 39158>>>>>External_Function32 GrphSetViewportOrgEx "SetViewportOrgEx" GDI32.DLL Handle hDC dWord x# dWord y# pointer lpRect returns integer 39159>>>>> 39159>>>>>TYPE tPOINTS3 39159>>>>> Field tPOINTS3.x1 as DWORD 39159>>>>> Field tPOINTS3.y1 as DWORD 39159>>>>> Field tPOINTS3.x2 as DWORD 39159>>>>> Field tPOINTS3.y2 as DWORD 39159>>>>> Field tPOINTS3.x3 as DWORD 39159>>>>> Field tPOINTS3.y3 as DWORD 39159>>>>>END_TYPE 39159>>>>>TYPE tPOINTS4 39159>>>>> Field tPOINTS4.x1 as DWORD 39159>>>>> Field tPOINTS4.y1 as DWORD 39159>>>>> Field tPOINTS4.x2 as DWORD 39159>>>>> Field tPOINTS4.y2 as DWORD 39159>>>>> Field tPOINTS4.x3 as DWORD 39159>>>>> Field tPOINTS4.y3 as DWORD 39159>>>>> Field tPOINTS4.x4 as DWORD 39159>>>>> Field tPOINTS4.y4 as DWORD 39159>>>>>END_TYPE 39159>>>>> 39159>>>>>Function Grph_OemToChar Global String OemStr Returns String 39161>>>>> string CharStr 39161>>>>> integer OemAdress CharAdress Grb# 39161>>>>> Append OemStr (Character(0)) 39162>>>>> Move (Repeat(Character(0), (Length(OemStr)))) To CharStr 39163>>>>> GetAddress Of OemStr To OemAdress 39164>>>>> GetAddress Of CharStr To CharAdress 39165>>>>> Move (GrphOemToCharA(OemAdress, CharAdress)) To grb# 39166>>>>> Function_Return (CString(CharStr)) 39167>>>>>End_Function 39168>>>>> 39168>>>>>Use version.nui 39168>>>>> 39168>>>>> 39168>>>>> 39168>>>>>// Text Alignments 39168>>>>>DEFINE TA_LEFT FOR 0 //|CI$0000 39168>>>>>DEFINE TA_RIGHT FOR 2 //|CI$0002 39168>>>>>DEFINE TA_CENTER FOR 6 //|CI$0006 39168>>>>>DEFINE TA_TOP FOR 0 //|CI$0000 39168>>>>>DEFINE TA_BOTTOM FOR 8 //|CI$0008 39168>>>>>DEFINE TA_NOUPDATECP FOR 0 //|CI$0000 39168>>>>>DEFINE TA_UPDATECP FOR 1 //|CI$0001 39168>>>>>DEFINE TA_BASELINE FOR 24 //|CI$0024 39168>>>>> 39168>>>>> 39168>>>>> 39168>>>>>// Hatch Styles: 39168>>>>>DEFINE HS_NONE FOR -1 //* */ 39168>>>>>DEFINE HS_HORIZONTAL FOR 0 //* ----- */ 39168>>>>>DEFINE HS_VERTICAL FOR 1 //* ||||| */ 39168>>>>>DEFINE HS_FDIAGONAL FOR 2 //* \\\\\ */ 39168>>>>>DEFINE HS_BDIAGONAL FOR 3 //* ///// */ 39168>>>>>DEFINE HS_CROSS FOR 4 //* +++++ */ 39168>>>>>DEFINE HS_DIAGCROSS FOR 5 //* xxxxx */ 39168>>>>> 39168>>>>>// Axis text states: 39168>>>>>DEFINE AT_NONE FOR 0 39168>>>>>DEFINE AT_AUTO FOR 1 39168>>>>>DEFINE AT_TEXT FOR 2 39168>>>>> 39168>>>>>// Polygon fill modes: 39168>>>>>DEFINE FM_WINDING FOR 0 39168>>>>>DEFINE FM_ALTERNATE FOR 1 39168>>>>> 39168>>>>>// DrawText Format Flags 39168>>>>>DEFINE XDT_TOP FOR 0 // 0x00000000 39168>>>>>DEFINE XDT_LEFT FOR 0 // 0x00000000 39168>>>>>DEFINE XDT_CENTER FOR 1 // 0x00000001 39168>>>>>DEFINE XDT_RIGHT FOR 2 // 0x00000002 39168>>>>>DEFINE XDT_VCENTER FOR 4 // 0x00000004 39168>>>>>DEFINE XDT_BOTTOM FOR 8 // 0x00000008 39168>>>>>DEFINE XDT_WORDBREAK FOR 16 // 0x00000010 39168>>>>>DEFINE XDT_SINGLELINE FOR 32 // 0x00000020 39168>>>>>DEFINE XDT_EXPANDTABS FOR 64 // 0x00000040 39168>>>>>DEFINE XDT_TABSTOP FOR 128 // 0x00000080 39168>>>>>DEFINE XDT_NOCLIP FOR 256 // 0x00000100 39168>>>>>DEFINE XDT_EXTERNALLEADING FOR 512 // 0x00000200 39168>>>>>DEFINE XDT_CALCRECT FOR 1024 // 0x00000400 39168>>>>>DEFINE XDT_NOPREFIX FOR 2048 // 0x00000800 39168>>>>>DEFINE XDT_INTERNAL FOR 4096 // 0x00001000 39168>>>>> 39168>>>>>enumeration_list // Dot types 39168>>>>> define DT_PIXEL // 39168>>>>> define DT_CROSS // x 39168>>>>> define DT_PLUS // + 39168>>>>> define DT_HORIZONTAL // - 39168>>>>> define DT_VERTICAL // | 39168>>>>> define DT_CIRCLE // o 39168>>>>> define DT_TRIANGLE_UP //  39168>>>>> define DT_TRIANGLE_DOWN //  39168>>>>> define DT_TRIANGLE_RIGHT //  39168>>>>> define DT_TRIANGLE_LEFT //  39168>>>>> define DT_SQUARE // 39168>>>>> define DT_DIAMOND //  39168>>>>>end_enumeration_list 39168>>>>> 39168>>>>>// Graphic Operations 39168>>>>>enumeration_list 39168>>>>> define GO_SetPenColor 39168>>>>> define GO_SetPenWidth 39168>>>>> define GO_SetPenStyle 39168>>>>> define GO_SetFillColor 39168>>>>> define GO_SetHatchStyle 39168>>>>> define GO_SetBackColor 39168>>>>> define GO_SetRoundRectFactor 39168>>>>> define GO_SetPolyGonFillMode 39168>>>>> define GO_SetTextAlign 39168>>>>> define GO_SetTextColor 39168>>>>> define GO_SetStockFont 39168>>>>> define GO_SetTTFont 39168>>>>> define GO_AddDot 39168>>>>> define GO_SetDotStyle 39168>>>>> define GO_SetDotSize 39168>>>>> define GO_SetDotAlign 39168>>>>> define GO_Rectangle 39168>>>>> define GO_Ellipse 39168>>>>> define GO_RoundRect 39168>>>>> define GO_LineTo 39168>>>>> define GO_MoveTo 39168>>>>> define GO_TextOut 39168>>>>> define GO_Polygon 39168>>>>> define GO_PolyLine 39168>>>>>end_enumeration_list 39168>>>>> 39168>>>>>integer gr$PenColor // Global variables used for speed 39168>>>>>integer gr$PenWidth 39168>>>>>integer gr$PenStyle 39168>>>>>integer gr$HatchStyle 39168>>>>>integer gr$FillColor 39168>>>>>integer gr$RoundRectFactor 39168>>>>>integer gr$PolyGonFillMode 39168>>>>>integer gr$BackColor 39168>>>>>integer gr$DotSize 39168>>>>>integer gr$DotType 39168>>>>>integer gr$DotAlign 39168>>>>>integer gr$CPU$RAM 39168>>>>>integer gr$CPU$PC 39168>>>>>handle gr$hCurrentDC 39168>>>>>handle gr$hCurrentPen 39168>>>>>handle gr$hCurrentBrush 39168>>>>>handle gr$hCurrentTemp 39168>>>>>handle gr$hCurrentTTFont gr$PreviousFont 39168>>>>>integer gr$vCenterActive 39168>>>>>integer gr$PenDirty 39168>>>>>integer gr$BrushDirty 39168>>>>>integer gr$Void 39168>>>>>integer gr$CoordXY1# 39168>>>>>integer gr$CoordXY2# 39168>>>>>integer gr$Tmp# 39168>>>>>integer gr$GuiSizeX# 39168>>>>>integer gr$GuiSizeY# 39168>>>>>integer gr$TrackArray 39168>>>>>string gr$Point 32 39168>>>>> 39168>>>>>number gr$X_Range 39168>>>>>number gr$Y_Range 39168>>>>>move 20000.0 to gr$X_Range 39169>>>>>move 20000.0 to gr$Y_Range 39170>>>>>integer gr$GuiOffsetX# 39170>>>>>integer gr$GuiOffsetY# 39170>>>>>move 0 to gr$GuiOffsetX# 39171>>>>>move 0 to gr$GuiOffsetY# 39172>>>>> 39172>>>>>if DFFALSE begin // Do not execution this on program start up. 39174>>>>> // Good old fashioned subroutines also used for speed. 39174>>>>> vdfgraph$Update_GDI_Objects: 39174>>>>> if gr$PenDirty begin 39176>>>>> move gr$hCurrentPen to gr$hCurrentTemp 39177>>>>> move (CreatePen(gr$PenStyle,gr$PenWidth,gr$PenColor)) to gr$hCurrentPen 39178>>>>> move (SelectObject(gr$hCurrentDC,gr$hCurrentPen)) to gr$Void 39179>>>>> move 0 to gr$PenDirty 39180>>>>> move (DeleteObject(gr$hCurrentTemp)) to gr$Void 39181>>>>> graph_res$showln ("DeleteObject 1 "+string(gr$Void)) 39181>>>>> end 39181>>>>>> 39181>>>>> if gr$BrushDirty begin 39183>>>>> move gr$hCurrentBrush to gr$hCurrentTemp 39184>>>>> if gr$HatchStyle ne HS_NONE ; move (GrphCreateHatchBrush(gr$HatchStyle,gr$FillColor)) to gr$hCurrentBrush 39187>>>>> else ; move (CreateSolidBrush(gr$FillColor)) to gr$hCurrentBrush 39189>>>>> move (SelectObject(gr$hCurrentDC,gr$hCurrentBrush)) to gr$Void 39190>>>>> move 0 to gr$BrushDirty 39191>>>>> move (DeleteObject(gr$hCurrentTemp)) to gr$Void 39192>>>>> graph_res$showln ("DeleteObject 2 "+string(gr$Void)) 39192>>>>> end 39192>>>>>> 39192>>>>> return 39193>>>>> vdfgraph$DeletePreviousTTFont: 39193>>>>> if gr$hCurrentTTFont ne 0 begin 39195>>>>> move (SelectObject(gr$hCurrentDC,gr$PreviousFont)) to gr$Void 39196>>>>> move (DeleteObject(gr$hCurrentTTFont)) to gr$Void 39197>>>>> graph_res$showln ("DeleteObject 6 "+string(gr$Void)) 39197>>>>> end 39197>>>>>> 39197>>>>> return 39198>>>>> vdfgraph$PreparePoint: 39198>>>>> gosub vdfgraph$Update_GDI_Objects 39199>>>>>> 39199>>>>> get value of gr$CPU$RAM item gr$CPU$PC to gr$CoordXY1# 39200>>>>> gosub vdfgraph$ConvertToGUI1 39201>>>>>> 39201>>>>> increment gr$CPU$PC 39202>>>>> return 39203>>>>> vdfgraph$Prepare2Points: 39203>>>>> gosub vdfgraph$Update_GDI_Objects 39204>>>>>> 39204>>>>> get value of gr$CPU$RAM item gr$CPU$PC to gr$CoordXY1# 39205>>>>> gosub vdfgraph$ConvertToGUI1 39206>>>>>> 39206>>>>> increment gr$CPU$PC 39207>>>>> get value of gr$CPU$RAM item gr$CPU$PC to gr$CoordXY2# 39208>>>>> increment gr$CPU$PC 39209>>>>> gosub vdfgraph$ConvertToGUI2 39210>>>>>> 39210>>>>> return 39211>>>>> vdfgraph$ConvertToGui1: 39211>>>>> move (integer(hi(gr$CoordXY1#)*gr$GuiSizeX#/gr$X_Range)+gr$GuiOffsetX#*65536+(low(gr$CoordXY1#)*gr$GuiSizeY#/gr$Y_Range)+gr$GuiOffsetY#) to gr$CoordXY1# 39212>>>>> return 39213>>>>> vdfgraph$ConvertToGui2: 39213>>>>> move (integer(hi(gr$CoordXY2#)*gr$GuiSizeX#/gr$X_Range)+gr$GuiOffsetX#*65536+(low(gr$CoordXY2#)*gr$GuiSizeY#/gr$Y_Range)+gr$GuiOffsetY#) to gr$CoordXY2# 39214>>>>> return 39215>>>>> vdfgraph$ConvertToVirtual: 39215>>>>> if gr$CoordXY1# lt 0 move 0 to gr$CoordXY1# 39218>>>>> move (integer(hi(gr$CoordXY1#)-gr$GuiOffsetX#*gr$X_Range/gr$GuiSizeX#)*65536+(low(gr$CoordXY1#)-gr$GuiOffsetY#*gr$Y_Range/gr$GuiSizeY#)) to gr$CoordXY1# 39219>>>>> return 39220>>>>>end 39220>>>>>> 39220>>>>> 39220>>>>> 39220>>>>> 39220>>>>>Register_Procedure WMSG_GrphPaint dWord wParam dWord lParam 39220>>>>>Register_Procedure WMSG_GrphEraseBkGnd dWord wParam dWord lParam 39220>>>>>Register_Procedure WMSG_OnMouseDown 39220>>>>>Register_Procedure WMSG_OnMouseUp 39220>>>>>Register_Procedure WMSG_OnMouse2Down 39220>>>>>Register_Procedure WMSG_OnMouse2Up 39220>>>>>Register_Procedure WMSG_OnMouseMove 39220>>>>>Register_Procedure WMSG_OnMouseDblClick 39220>>>>>Register_Object oGraphOperationMsgTabel 39220>>>>> 39220>>>>>enumeration_list 39220>>>>> define GR_TRACK_RECTANGLE 39220>>>>> define GR_TRACK_LINE 39220>>>>> define GR_TRACK_ELLIPSE 39220>>>>>end_enumeration_list 39220>>>>> 39220>>>>>class cTrackableObjects is a cArray 39221>>>>> item_property_list 39221>>>>> item_property integer piType.i // RECTANGLE_CHECK LINE_CHECK ELLIPSE_CHECK 39221>>>>> item_property integer piX1.i 39221>>>>> item_property integer piY1.i 39221>>>>> item_property integer piX2.i 39221>>>>> item_property integer piY2.i 39221>>>>> item_property integer piCB_Value.i // Callback value (when clicked) 39221>>>>> end_item_property_list cTrackableObjects #REM 39265 DEFINE FUNCTION PICB_VALUE.I INTEGER LIROW RETURNS INTEGER #REM 39269 DEFINE PROCEDURE SET PICB_VALUE.I INTEGER LIROW INTEGER VALUE #REM 39273 DEFINE FUNCTION PIY2.I INTEGER LIROW RETURNS INTEGER #REM 39277 DEFINE PROCEDURE SET PIY2.I INTEGER LIROW INTEGER VALUE #REM 39281 DEFINE FUNCTION PIX2.I INTEGER LIROW RETURNS INTEGER #REM 39285 DEFINE PROCEDURE SET PIX2.I INTEGER LIROW INTEGER VALUE #REM 39289 DEFINE FUNCTION PIY1.I INTEGER LIROW RETURNS INTEGER #REM 39293 DEFINE PROCEDURE SET PIY1.I INTEGER LIROW INTEGER VALUE #REM 39297 DEFINE FUNCTION PIX1.I INTEGER LIROW RETURNS INTEGER #REM 39301 DEFINE PROCEDURE SET PIX1.I INTEGER LIROW INTEGER VALUE #REM 39305 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER #REM 39309 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE 39314>>>>> procedure add_track integer type# integer x1# integer y1# integer x2# integer y2# integer cb_val# 39316>>>>> integer row# 39316>>>>> get row_count to row# 39317>>>>> set piType.i row# to type# 39318>>>>> set piX1.i row# to x1# 39319>>>>> set piY1.i row# to y1# 39320>>>>> set piX2.i row# to x2# 39321>>>>> set piY2.i row# to y2# 39322>>>>> set piCB_Value.i row# to cb_val# 39323>>>>> end_procedure 39324>>>>> procedure delete_data 39326>>>>> forward send delete_data 39328>>>>> end_procedure 39329>>>>> procedure TestTrackHit integer track_msg# 39331>>>>> integer row# max# x# y# level# 39331>>>>> get row_count to max# 39332>>>>> move (low(gr$CoordXY1#)) to x# 39333>>>>> move (hi(gr$CoordXY1#)) to y# 39334>>>>> decrement max# 39335>>>>> move 0 to level# 39336>>>>> // GRAPH$SHOWLN 39336>>>>> for_ex row# from max# down_to 0 39343>>>>> GRAPH$SHOWLN "Test: " x# "," y# " against: " (piX1.i(self,row#)) "," (piX2.i(self,row#)) " " (piY1.i(self,row#)) "," (piY2.i(self,row#)) 39343>>>>> if (piType.i(self,row#)) eq GR_TRACK_RECTANGLE if ((x#>=piX1.i(self,row#)) and (x#<=piX2.i(self,row#)) and (y#>=piY1.i(self,row#)) and (y#<=piY2.i(self,row#))) begin 39347>>>>> send track_msg# (piCB_Value.i(self,row#)) level# 39348>>>>> increment level# 39349>>>>> end 39349>>>>>> 39349>>>>> loop 39350>>>>>> 39350>>>>> end_procedure 39351>>>>>end_class // cTrackableObjects 39352>>>>> 39352>>>>>use cWinControl.pkg 39352>>>>> 39352>>>>> 39352>>>>>class GraphicArea is a cWinControl //dfControl 39353>>>>> Procedure Construct_Object 39355>>>>> Set External_Class_Name "GraphicArea" to "static" 39356>>>>> Forward Send Construct_Object 39358>>>>> 39358>>>>> set window_style to SS_NOTIFY DFTRUE 39359>>>>> 39359>>>>> set border_style to BORDER_STATICEDGE 39360>>>>>// set border_style to BORDER_NONE 39360>>>>> set delegation_mode to DELEGATE_TO_PARENT 39361>>>>> 39361>>>>> property integer pPenColor public clBlack 39362>>>>> property integer pPenWidth public 1 39363>>>>> property integer pFillColor public clRed 39364>>>>> property integer pPenStyle public PS_SOLID 39365>>>>> property integer pBackColor public (GetSysColor(COLOR_BTNFACE)) 39366>>>>> property integer pRoundRectFactor public (25*65536+25) 39367>>>>> property integer pHatchStyle public HS_NONE 39368>>>>> property integer pPolyPointsOffS public 0 39369>>>>> 39369>>>>> property integer pOemToAnsi_State public DFTRUE 39370>>>>> 39370>>>>> property string pTitle public "" 39371>>>>> property string pHeaderLeft public "" 39372>>>>> property string pHeaderMid public "" 39373>>>>> property string pHeaderRight public "" 39374>>>>> property string pFooterLeft public "" 39375>>>>> property string pFooterMid public "" 39376>>>>> property string pFooterRight public "" 39377>>>>> property integer pHeaderHeight public 1000 39378>>>>> property integer pFooterHeight public 1000 39379>>>>> property integer pHeaderBackColor public 0 39380>>>>> property integer pFooterBackColor public 0 39381>>>>> 39381>>>>> property integer piX_Offset public 0 39382>>>>> property integer piY_Offset public 0 39383>>>>> property integer piX_Range public 10000 39384>>>>> property integer piY_Range public 10000 39385>>>>> 39385>>>>> property integer pbPixelScale public FALSE 39386>>>>> 39386>>>>> Set Focus_Mode To NONFOCUSABLE 39387>>>>> 39387>>>>> object Program_RAM is an array 39389>>>>> end_object 39390>>>>> property integer piProgram_RAM 39391>>>>> set piProgram_RAM to (Program_RAM(self)) 39392>>>>> 39392>>>>> object oColors is an array 39394>>>>> set value item 0 to (rgb(255, 0, 0)) // Red Normal 39395>>>>> set value item 1 to (rgb( 0, 0,255)) // Blue 39396>>>>> set value item 2 to (rgb( 0,255, 0)) // Green 39397>>>>> set value item 3 to (rgb(255,255, 0)) // Yellow 39398>>>>> set value item 4 to (rgb( 0,255,255)) // Turkis 39399>>>>> set value item 5 to (rgb(255, 0,255)) // Purple 39400>>>>> set value item 6 to (rgb(128,128,128)) // Grey 39401>>>>> set value item 7 to (rgb(255,128, 0)) // Orange 39402>>>>> 39402>>>>> set value item 8 to (rgb(255,128,128)) // Red Bright 39403>>>>> set value item 9 to (rgb(128,128,255)) // Blue 39404>>>>> set value item 10 to (rgb(128,255,128)) // Green 39405>>>>> set value item 11 to (rgb(255,255,128)) // Yellow 39406>>>>> set value item 12 to (rgb(128,255,255)) // Turkis 39407>>>>> set value item 13 to (rgb(255,128,255)) // Purple 39408>>>>> set value item 14 to (rgb(192,192,192)) // Grey 39409>>>>> set value item 15 to (rgb(255,192,128)) // Orange 39410>>>>> 39410>>>>> set value item 16 to (rgb(128, 0, 0)) // Red Dark 39411>>>>> set value item 17 to (rgb( 0, 0,128)) // Blue 39412>>>>> set value item 18 to (rgb( 0,128, 0)) // Green 39413>>>>> set value item 19 to (rgb(128,128, 0)) // Yellow 39414>>>>> set value item 20 to (rgb( 0,128,128)) // Turkis 39415>>>>> set value item 21 to (rgb(128, 0,128)) // Purple 39416>>>>> set value item 22 to (rgb( 64, 64, 64)) // Grey 39417>>>>> set value item 23 to (rgb(128, 64, 0)) // Orange 39418>>>>> 39418>>>>> set value item 24 to (rgb( 64, 0, 0)) // Red Very dark 39419>>>>> set value item 25 to (rgb( 0, 0, 64)) // Blue 39420>>>>> set value item 26 to (rgb( 0, 64, 0)) // Green 39421>>>>> set value item 27 to (rgb( 64, 64, 0)) // Yellow 39422>>>>> set value item 28 to (rgb( 0, 64, 64)) // Turkis 39423>>>>> set value item 29 to (rgb( 64, 0, 64)) // Purple 39424>>>>> set value item 30 to (rgb( 32, 32, 32)) // Grey 39425>>>>> set value item 31 to (rgb( 64, 32, 0)) // Orange 39426>>>>> end_object 39427>>>>> 39427>>>>> object oHatches is an array 39429>>>>> set value item 0 to HS_NONE 39430>>>>> set value item 1 to HS_DIAGCROSS 39431>>>>> set value item 2 to HS_CROSS 39432>>>>> set value item 3 to HS_FDIAGONAL 39433>>>>> set value item 4 to HS_BDIAGONAL 39434>>>>> set value item 5 to HS_VERTICAL 39435>>>>> set value item 6 to HS_HORIZONTAL 39436>>>>> end_object 39437>>>>> 39437>>>>> object xyObjects is an array 39439>>>>> end_object 39440>>>>> 39440>>>>> Set External_Message WM_PAINT to msg_WMSG_GrphPaint // We want to trap WM_PAINT for efficient painting. 39441>>>>> Set External_Message WM_ERASEBKGND to msg_WMSG_GrphEraseBkGnd // The Windows-Class will not have a brush set, so let's 'brush' the object ourselves. 39442>>>>> Set External_Message WM_LBUTTONDOWN to msg_WMSG_OnMouseDown 39443>>>>> Set External_Message WM_LBUTTONUP to msg_WMSG_OnMouseUp 39444>>>>> Set External_Message WM_MOUSEMOVE to msg_WMSG_OnMouseMove 39445>>>>> Set External_Message WM_RBUTTONDOWN to msg_WMSG_OnMouse2Down 39446>>>>> Set External_Message WM_RBUTTONUP to msg_WMSG_OnMouse2Up 39447>>>>> // This one doesn't work. Why not????: 39447>>>>> Set External_Message WM_LBUTTONDBLCLK to msg_WMSG_OnMouseDblClick 39448>>>>> 39448>>>>> property integer pViewPortX public 0 39449>>>>> property integer pViewPortY public 0 39450>>>>> 39450>>>>> object oTrackableObjects is a cTrackableObjects 39452>>>>> end_object 39453>>>>> 39453>>>>> property integer pbIncrementalPaint public DFFALSE 39454>>>>> property integer pbNeverBeenPainted public DFTRUE 39455>>>>> property integer piPreviousMaxCount public 0 39456>>>>> property integer piPreviousPenColor public 0 39457>>>>> property integer piPreviousPenWidth public 0 39458>>>>> property integer piPreviousFillColor public 0 39459>>>>> property integer piPreviousHatchStyle public 0 39460>>>>> property integer piPreviousPenStyle public 0 39461>>>>> property integer piPreviousRoundRectFactor public 0 39462>>>>> property integer piPreviousBackColor public 0 39463>>>>> property integer piPreviousvCenterActive public 0 39464>>>>> property integer piPreviousDotSize public 0 39465>>>>> property integer piPreviousDotType public 0 39466>>>>> property integer piPreviousDotAlign public 0 39467>>>>> End_Procedure 39468>>>>> 39468>>>>> procedure DoSetPixelCoords 39470>>>>> integer liGuiSize 39470>>>>> get GuiSize to liGuiSize 39471>>>>> set piX_Range to (hi(liGuiSize)) 39472>>>>> set piY_Range to (low(liGuiSize)) 39473>>>>> end_procedure 39474>>>>> 39474>>>>> procedure end_construct_object 39476>>>>> forward send end_construct_object 39478>>>>> Set External_Message WM_PAINT to msg_WMSG_GrphPaint // We want to trap WM_PAINT for efficient painting. 39479>>>>> Set External_Message WM_ERASEBKGND to msg_WMSG_GrphEraseBkGnd // The Windows-Class will not have a brush set, so let's 'brush' the object ourselves. 39480>>>>> Set External_Message WM_LBUTTONDOWN to msg_WMSG_OnMouseDown 39481>>>>> Set External_Message WM_LBUTTONUP to msg_WMSG_OnMouseUp 39482>>>>> Set External_Message WM_MOUSEMOVE to msg_WMSG_OnMouseMove 39483>>>>> Set External_Message WM_RBUTTONDOWN to msg_WMSG_OnMouse2Down 39484>>>>> Set External_Message WM_RBUTTONUP to msg_WMSG_OnMouse2Up 39485>>>>> Set External_Message WM_LBUTTONDBLCLK to msg_WMSG_OnMouseDblClick 39486>>>>> end_procedure 39487>>>>> 39487>>>>> Procedure Reset_Viewport 39489>>>>> set pViewPortX to 0 39490>>>>> set pViewPortY to 0 39491>>>>> End_Procedure 39492>>>>> 39492>>>>> procedure register_xy_object integer obj# // GraphicArea 39494>>>>> integer arr# 39494>>>>> move (xyObjects(self)) to arr# 39495>>>>> set value of arr# item (item_count(arr#)) to obj# 39496>>>>> end_procedure 39497>>>>> 39497>>>>> Function iColor integer color# returns integer 39499>>>>> function_return (value(oColors(self),color#)) 39500>>>>> End_Function 39501>>>>> Function iColorNuance.ii integer color# integer nuance# returns integer 39503>>>>> integer base# 39503>>>>> if nuance# eq 0 move 24 to base# // Very dark 39506>>>>> if nuance# eq 1 move 16 to base# // Dark 39509>>>>> if nuance# eq 2 move 0 to base# // Normal 39512>>>>> if nuance# eq 3 move 8 to base# // Ligth 39515>>>>> function_return (value(oColors(self),base#+color#)) 39516>>>>> End_Function 39517>>>>> Function iColorNuance.iii integer color# integer nuance# integer maxnuance# returns integer 39519>>>>> if maxnuance# ne 3 increment nuance# 39522>>>>> function_return (iColorNuance.ii(self,color#,nuance#)) 39523>>>>> End_Function 39524>>>>> Function iHatch integer hatch# returns integer 39526>>>>> function_return (value(oHatches(self),hatch#)) 39527>>>>> End_Function 39528>>>>> 39528>>>>> Procedure WMSG_GrphEraseBkGnd dWord wParam dWord lParam 39530>>>>> handle hDC# hPen# hBrush# // This msg is sent if the fErase member of tPAINTSTRUCT is TRUE 39530>>>>> integer iSize# // during the WM_PAINT/BeginPaint() phase. This will be set 39530>>>>> Move wParam To hDC# // automatically by Windows, or explicitly by InvalidateRect() with 39531>>>>> Get guiSize To iSize# // TRUE as its 3rd arg 39532>>>>> 39532>>>>> get pBackColor to gr$BackColor 39533>>>>> Move (GetStockObject(NULL_PEN)) To hPen# // we don't want an outline 39534>>>>> Move (CreateSolidBrush(gr$BackColor)) To hBrush# 39535>>>>> 39535>>>>> Move (SelectObject(hDC#,hPen#)) To gr$Void // select into Device Context 39536>>>>> Move (SelectObject(hDC#,hBrush#)) To gr$Void 39537>>>>> 39537>>>>> // Use a rectangle to draw-over entire window. Note the addition of 39537>>>>> // one to both X & Y end-points, this is because Windows' Rectangle() 39537>>>>> // function excludes the end-points in its drawing 39537>>>>> 39537>>>>> //Move (Rectangle(hDC#,0,0,Low(iSize#)+1,Hi(iSize#)+1)) To gr$Void 39537>>>>> 39537>>>>> // we must delete any GDI objects we create. Note, we don't delete the 39537>>>>> // hPen object because it is a Windows' StockObject. 39537>>>>> Move (DeleteObject(hBrush#)) To gr$Void 39538>>>>> graph_res$showln ("DeleteObject 3 "+string(gr$Void)) 39538>>>>> move 1 to gr$PenDirty 39539>>>>> move 1 to gr$BrushDirty 39540>>>>> set pbNeverBeenPainted to DFTRUE 39541>>>>> End_Procedure 39542>>>>> 39542>>>>> // When this message is called the global integers defined in the top 39542>>>>> // of this package are initialized and used by this class. They should 39542>>>>> // be left very much alone while this procedure is running. 39542>>>>> Procedure PaintArea 39544>>>>> integer max# msg# 39544>>>>> get item_count of gr$CPU$RAM to max# 39545>>>>> while gr$CPU$PC lt max# // If this works well, it could be changed to 39549>>>>> get value of gr$CPU$RAM item gr$CPU$PC to msg# // GOSUB label# instead 39550>>>>> increment gr$CPU$PC // Increment beyond op-code 39551>>>>> send msg# 39552>>>>> end 39553>>>>>> 39553>>>>> set piPreviousMaxCount to max# 39554>>>>> End_Procedure 39555>>>>> 39555>>>>> Procedure WMSG_GrphPaint dWord wParam dWord lParam 39557>>>>> handle hWnd# OriginalPen# OriginalBrush# hBrush# 39557>>>>> pointer lpStruc# 39557>>>>> string sStruc# struct# 39557>>>>> integer lbIncrementalPaint cxyValue 39557>>>>> 39557>>>>> handle hDC# //for offscreen 39557>>>>> pointer address# //for offscreen 39557>>>>> handle hdcMem# hbmOld# //for offscreen 39557>>>>> dword hbmMem# //for offscreen 39557>>>>> 39557>>>>> graph$showln "Paint" 39557>>>>> ZeroType tPAINTSTRUCT To sStruc# 39558>>>>> GetAddress of sStruc# To lpStruc# 39559>>>>> Get Window_Handle To hWnd# 39560>>>>> move (piProgram_RAM(self)) to gr$CPU$RAM // Array of instructions 39561>>>>> move (oTrackableObjects(self)) to gr$TrackArray // Array of instructions 39562>>>>> 39562>>>>> Get GuiSize to gr$Tmp# 39563>>>>> move (hi(gr$Tmp#)) to gr$GuiSizeX# 39564>>>>> move (low(gr$Tmp#)) to gr$GuiSizeY# 39565>>>>> 39565>>>>> if (pbPixelScale(self)) send DoSetPixelCoords 39568>>>>> 39568>>>>> get piX_Offset to gr$GuiOffsetX# 39569>>>>> get piY_Offset to gr$GuiOffsetY# 39570>>>>> get piX_Range to gr$X_Range 39571>>>>> get piY_Range to gr$Y_Range 39572>>>>> set pViewPortX to gr$GuiOffsetX# 39573>>>>> set pViewPortY to gr$GuiOffsetY# 39574>>>>> move 0 to gr$GuiOffsetX# 39575>>>>> move 0 to gr$GuiOffsetY# 39576>>>>> 39576>>>>> move (BeginPaint(hWnd#, lpStruc#)) to gr$hCurrentDC 39577>>>>> 39577>>>>> //Double buffered actions: 39577>>>>> Get GuiSize to cxyValue 39578>>>>> move (GetDC(hWnd#)) to hDC# 39579>>>>> 39579>>>>> //make a compatible copy for offscreen processing: 39579>>>>> move (GrphCreateCompatibleDC(hDC#)) to hdcMem# 39580>>>>> move (GrphCreateCompatibleBitmap(hDC#, Low(cxyValue)+1, Hi(cxyValue)+1)) to hbmMem# 39581>>>>> move (SelectObject(hdcMem#,hbmMem#)) to hbmOld# 39582>>>>> 39582>>>>> //fill it with nice white space: 39582>>>>> move (CreateSolidBrush(clWhite)) to hBrush# 39583>>>>> move (SelectObject(hdcMem#,hBrush#)) to gr$Void 39584>>>>> Move (Rectangle(hdcMem#,0,0,Low(cxyValue)+1,Hi(cxyValue)+1)) To gr$Void 39585>>>>> move (DeleteObject(hBrush#)) to gr$Void 39586>>>>> move hdcMem# to gr$hCurrentDC 39587>>>>> 39587>>>>> // The hDC returned by BeginPaint(), will have its 'Clipping-Region' 39587>>>>> // set, and is much more efficient than the old Flex msg_Paint, 39587>>>>> // where a generic hDC had to be obtained. The 'Invalid-region' can 39587>>>>> // be obtained from the tPAINTSTRUCT (sStruc) structure, and used in 39587>>>>> // calculations for optimum efficiency. 39587>>>>> 39587>>>>> get pbIncrementalPaint to lbIncrementalPaint 39588>>>>> if lbIncrementalPaint begin 39590>>>>> get piPreviousMaxCount to gr$CPU$PC 39591>>>>> get piPreviousPenColor to gr$PenColor 39592>>>>> get piPreviousPenWidth to gr$PenWidth 39593>>>>> get piPreviousFillColor to gr$FillColor 39594>>>>> get piPreviousHatchStyle to gr$HatchStyle 39595>>>>> get piPreviousPenStyle to gr$PenStyle 39596>>>>> get piPreviousRoundRectFactor to gr$RoundRectFactor 39597>>>>> get piPreviousBackColor to gr$BackColor 39598>>>>> get piPreviousvCenterActive to gr$vCenterActive 39599>>>>> get piPreviousDotSize to gr$DotSize 39600>>>>> get piPreviousDotType to gr$DotType 39601>>>>> get piPreviousDotAlign to gr$DotAlign 39602>>>>> end 39602>>>>>> 39602>>>>> else begin 39603>>>>> set piPreviousMaxCount to 0 39604>>>>> send delete_data to gr$TrackArray 39605>>>>> move 0 to gr$CPU$PC // Program counter 39606>>>>> get pPenColor to gr$PenColor 39607>>>>> get pPenWidth to gr$PenWidth 39608>>>>> get pFillColor to gr$FillColor 39609>>>>> get pHatchStyle to gr$HatchStyle 39610>>>>> get pPenStyle to gr$PenStyle 39611>>>>> get pRoundRectFactor to gr$RoundRectFactor 39612>>>>> get pBackColor to gr$BackColor 39613>>>>> move 0 to gr$vCenterActive 39614>>>>> move 10 to gr$DotSize 39615>>>>> move DT_SQUARE to gr$DotType 39616>>>>> move (VDFGR_DA_CENTER+VDFGR_DA_VCENTER) to gr$DotAlign 39617>>>>> end 39617>>>>>> 39617>>>>> 39617>>>>> move (GrphSetViewportOrgEx(gr$hCurrentDC,pViewPortY(self),pViewPortX(self),0)) to windowindex 39618>>>>> move (setBkMode(gr$hCurrentDC,TRANSPARENT)) to gr$Void 39619>>>>> 39619>>>>> // Create and select GDI objects 39619>>>>> move (CreatePen(gr$PenStyle,gr$PenWidth,gr$PenColor)) to gr$hCurrentPen 39620>>>>> move (SelectObject(gr$hCurrentDC,gr$hCurrentPen)) to OriginalPen# 39621>>>>> move 0 to gr$PenDirty 39622>>>>> 39622>>>>> move (CreateSolidBrush(gr$FillColor)) to gr$hCurrentBrush 39623>>>>> move (SelectObject(gr$hCurrentDC,gr$hCurrentBrush)) to OriginalBrush# 39624>>>>> move 0 to gr$BrushDirty 39625>>>>> move 0 to gr$hCurrentTTFont 39626>>>>> 39626>>>>> send PaintArea 39627>>>>> 39627>>>>> //here we copy the complete offscreen image to the screen. 39627>>>>> move (GrphBitBlt(hDC#,0,0,Low(cxyValue),Hi(cxyValue),gr$hCurrentDC,0,0,SRCcopy)) to gr$Void 39628>>>>> set pbNeverBeenPainted to DFFALSE 39629>>>>> 39629>>>>> // Delete GDI objects: 39629>>>>> 39629>>>>> move (DeleteObject(hbmMem#)) to gr$Void //for offscreen 39630>>>>> move (GrphDeleteDC(hdcMem#)) to gr$Void //for offscreen 39631>>>>> move (ReleaseDC(hWnd#, hDC#)) to gr$Void //for offscreen 39632>>>>> 39632>>>>> move (SelectObject(gr$hCurrentDC,OriginalPen#)) to gr$Void 39633>>>>> move (DeleteObject(gr$hCurrentPen)) to gr$Void // Overload 39634>>>>> graph_res$showln ("DeleteObject 4 "+string(gr$Void)) 39634>>>>> move (SelectObject(gr$hCurrentDC,OriginalBrush#)) to gr$Void 39635>>>>> move (DeleteObject(gr$hCurrentBrush)) to gr$Void // Overload 39636>>>>> graph_res$showln ("DeleteObject 5 "+string(gr$Void)) 39636>>>>> gosub vdfgraph$DeletePreviousTTFont // Delete TT font, if any 39637>>>>>> 39637>>>>> move (EndPaint(hWnd#, lpStruc#)) To gr$Void 39638>>>>> set pbIncrementalPaint to DFFALSE 39639>>>>> set piPreviousPenColor to gr$PenColor 39640>>>>> set piPreviousPenWidth to gr$PenWidth 39641>>>>> set piPreviousFillColor to gr$FillColor 39642>>>>> set piPreviousHatchStyle to gr$HatchStyle 39643>>>>> set piPreviousPenStyle to gr$PenStyle 39644>>>>> set piPreviousRoundRectFactor to gr$RoundRectFactor 39645>>>>> set piPreviousBackColor to gr$BackColor 39646>>>>> set piPreviousvCenterActive to gr$vCenterActive 39647>>>>> set piPreviousDotSize to gr$DotSize 39648>>>>> set piPreviousDotType to gr$DotType 39649>>>>> set piPreviousDotAlign to gr$DotAlign 39650>>>>> End_Procedure 39651>>>>> 39651>>>>> Procedure Release_All_Content 39653>>>>> //set pbIncrementalPaint to DFFALSE 39653>>>>> //handle hDC# 39653>>>>> //Move (Rectangle(hDC#,0,0,Low(iSize#)+1,Hi(iSize#)+1)) To gr$Void 39653>>>>> Move 0 to gr$CPU$PC 39654>>>>> send delete_data to gr$CPU$RAM 39655>>>>> End_Procedure 39656>>>>> 39656>>>>> 39656>>>>> Procedure RePaint 39658>>>>> handle hWnd hVoid 39658>>>>> Get Window_Handle To hWnd 39659>>>>> If hWnd Move (InvalidateRect(hWnd, 0, FALSE)) To hVoid 39662>>>>> // InvalidateRect() inflates the Invalid-Region for the hWnd. 39662>>>>> // the second arg, 0, means invalidate the whole window-rect. 39662>>>>> // the third arg, TRUE|FALSE, determines if window cleared prior 39662>>>>> // to re-draw. 39662>>>>> End_Procedure 39663>>>>> 39663>>>>> Procedure RePaintFull 39665>>>>> handle hWnd hVoid 39665>>>>> Get Window_Handle To hWnd 39666>>>>> If hWnd Move (InvalidateRect(hWnd, 0, TRUE)) To hVoid 39669>>>>> End_Procedure 39670>>>>> 39670>>>>> Procedure RePaintIncremental 39672>>>>> handle hWnd hVoid 39672>>>>> if (pbNeverBeenPainted(self)) send RePaintFull 39675>>>>> else begin 39676>>>>> Get Window_Handle To hWnd 39677>>>>> If hWnd begin 39679>>>>> set pbIncrementalPaint to DFTRUE 39680>>>>> Move (InvalidateRect(hWnd, 0, DFFALSE)) To hVoid 39681>>>>> end 39681>>>>>> 39681>>>>> end 39681>>>>>> 39681>>>>> End_Procedure 39682>>>>> 39682>>>>> Procedure Draw_Background 39684>>>>> //send SetFillColor (pBackColor(self)) 39684>>>>> //send SetPenStyle PS_NULL 39684>>>>> //send AddRectangleBackground 0 0 10000 10000 39684>>>>> //send SetPenStyle PS_SOLID 39684>>>>> send SetFillColor (pBackColor(self)) 39685>>>>> send SetPenColor (pBackColor(self)) 39686>>>>> send SetPenStyle PS_SOLID 39687>>>>> send AddRectangleBackground 0 0 (piX_Range(self)) (piY_Range(self)) 39688>>>>> 39688>>>>> send SetPenColor (pPenColor(self)) 39689>>>>> End_Procedure 39690>>>>> 39690>>>>> Procedure Draw_Data // GraphicArea 39692>>>>> integer arr# itm# max# obj# 39692>>>>> string title# 39692>>>>> send BeginDraw 39693>>>>> send Draw_Background 39694>>>>> get pTitle to title# 39695>>>>> 39695>>>>> if title# ne "" begin 39697>>>>> send SetTextAlign (VDFGR_TA_CENTER+VDFGR_TA_BOTTOM) 39698>>>>> send SetTextColor clBlack 39699>>>>> send SetStockFont SYSTEM_FONT 39700>>>>> send AddText title# 800 5000 39701>>>>> end 39701>>>>>> 39701>>>>> move (xyObjects(self)) to arr# 39702>>>>> get item_count of arr# to max# 39703>>>>> for itm# from 0 to (max#-1) 39709>>>>>> 39709>>>>> send Draw_Data to (value(arr#,itm#)) 39710>>>>> loop 39711>>>>>> 39711>>>>> End_Procedure 39712>>>>> 39712>>>>> procedure mthd_MakeAreaTrackable 39714>>>>> integer cb_val# type# 39714>>>>> move (value(gr$CPU$RAM,gr$CPU$PC)) to type# 39715>>>>> increment gr$CPU$PC 39716>>>>> gosub vdfgraph$Prepare2Points 39717>>>>>> 39717>>>>> move (value(gr$CPU$RAM,gr$CPU$PC)) to cb_val# 39718>>>>> increment gr$CPU$PC 39719>>>>> send add_track to gr$TrackArray type# (low(gr$CoordXY1#)) (hi(gr$CoordXY1#)) (low(gr$CoordXY2#)) (hi(gr$CoordXY2#)) cb_val# 39720>>>>> end_procedure 39721>>>>> procedure mthd_SetPenColor 39723>>>>> get value of gr$CPU$RAM item gr$CPU$PC to gr$PenColor 39724>>>>> move 1 to gr$PenDirty 39725>>>>> increment gr$CPU$PC 39726>>>>> end_procedure 39727>>>>> procedure mthd_SetPenWidth 39729>>>>> get value of gr$CPU$RAM item gr$CPU$PC to gr$PenWidth 39730>>>>> move 1 to gr$PenDirty 39731>>>>> increment gr$CPU$PC 39732>>>>> end_procedure 39733>>>>> procedure mthd_SetPenStyle 39735>>>>> get value of gr$CPU$RAM item gr$CPU$PC to gr$PenStyle 39736>>>>> move 1 to gr$PenDirty 39737>>>>> increment gr$CPU$PC 39738>>>>> end_procedure 39739>>>>> procedure mthd_SetFillColor 39741>>>>> get value of gr$CPU$RAM item gr$CPU$PC to gr$FillColor 39742>>>>> move 1 to gr$BrushDirty 39743>>>>> increment gr$CPU$PC 39744>>>>> end_procedure 39745>>>>> procedure mthd_SetHatchStyle 39747>>>>> get value of gr$CPU$RAM item gr$CPU$PC to gr$HatchStyle 39748>>>>> move 1 to gr$BrushDirty 39749>>>>> increment gr$CPU$PC 39750>>>>> end_procedure 39751>>>>> procedure mthd_SetBackColor 39753>>>>> get value of gr$CPU$RAM item gr$CPU$PC to gr$BackColor 39754>>>>> increment gr$CPU$PC 39755>>>>> end_procedure 39756>>>>> procedure mthd_SetRoundRectFactor 39758>>>>> get value of gr$CPU$RAM item gr$CPU$PC to gr$RoundRectFactor 39759>>>>> increment gr$CPU$PC 39760>>>>> end_procedure 39761>>>>> procedure mthd_SetPolyGonFillMode 39763>>>>> get value of gr$CPU$RAM item gr$CPU$PC to gr$PolyGonFillMode 39764>>>>> increment gr$CPU$PC 39765>>>>> end_procedure 39766>>>>> procedure mthd_SetTextAlign 39768>>>>> dword tAlign# tmp# vert# horz# 39768>>>>> get value of gr$CPU$RAM item gr$CPU$PC to tAlign# 39769>>>>> increment gr$CPU$PC 39770>>>>> move (tAlign# iand 3) to horz# // 1:left 2:center 3:right 39771>>>>> move ((tAlign# iand 12)/4) to vert# // 1:top 2:vcenter 3:bottom 39772>>>>> if vert# ne 2 begin 39774>>>>> // Left: 39774>>>>> if (horz#=1 and vert#=1) move (TA_LEFT+TA_TOP) to tAlign# 39777>>>>> if (horz#=1 and vert#=2) move (TA_LEFT+TA_BASELINE) to tAlign# 39780>>>>> if (horz#=1 and vert#=3) move (TA_LEFT+TA_BASELINE) to tAlign# 39783>>>>> // Center: 39783>>>>> if (horz#=2 and vert#=1) move (TA_CENTER+TA_TOP) to tAlign# 39786>>>>> if (horz#=2 and vert#=2) move (TA_CENTER+TA_BASELINE) to tAlign# 39789>>>>> if (horz#=2 and vert#=3) move (TA_CENTER+TA_BASELINE) to tAlign# 39792>>>>> // Right: 39792>>>>> if (horz#=3 and vert#=1) move (TA_RIGHT+TA_TOP) to tAlign# 39795>>>>> if (horz#=3 and vert#=2) move (TA_RIGHT+TA_BASELINE) to tAlign# 39798>>>>> if (horz#=3 and vert#=3) move (TA_RIGHT+TA_BASELINE) to tAlign# 39801>>>>> move (GrphSetTextAlign(gr$hCurrentDC,tAlign#)) to gr$Void 39802>>>>> move 0 to gr$vCenterActive 39803>>>>> end 39803>>>>>> 39803>>>>> else begin 39804>>>>> move (GrphSetTextAlign(gr$hCurrentDC,0)) to gr$Void 39805>>>>> if horz# eq 1 move (XDT_LEFT +XDT_VCENTER+XDT_NOCLIP+XDT_SINGLELINE) to gr$vCenterActive // Left 39808>>>>> if horz# eq 2 move (XDT_CENTER+XDT_VCENTER+XDT_NOCLIP+XDT_SINGLELINE) to gr$vCenterActive // Center 39811>>>>> if horz# eq 3 move (XDT_RIGHT +XDT_VCENTER+XDT_NOCLIP+XDT_SINGLELINE) to gr$vCenterActive // Right 39814>>>>> end 39814>>>>>> 39814>>>>> end_procedure 39815>>>>> procedure mthd_SetTextColor 39817>>>>> dword tColor# 39817>>>>> get value of gr$CPU$RAM item gr$CPU$PC to tColor# 39818>>>>> increment gr$CPU$PC 39819>>>>> move (SetTextColor(gr$hCurrentDC,tColor#)) to gr$Void 39820>>>>> end_procedure 39821>>>>> procedure mthd_SetStockFont 39823>>>>> handle hFont# 39823>>>>> integer StockFont# 39823>>>>> get value of gr$CPU$RAM item gr$CPU$PC to StockFont# 39824>>>>> increment gr$CPU$PC 39825>>>>> gosub vdfgraph$DeletePreviousTTFont 39826>>>>>> 39826>>>>> Move (GetStockObject(StockFont#)) To hFont# 39827>>>>> Move (SelectObject(gr$hCurrentDC, hFont#)) To gr$Void // select into Device Context 39828>>>>> end_procedure 39829>>>>> procedure mthd_SetTTFont 39831>>>>> handle hFont# 39831>>>>> integer pitch# angle# bold# italic# underline# 39831>>>>> pointer address# 39831>>>>> string name# 39831>>>>> gosub vdfgraph$DeletePreviousTTFont 39832>>>>>> 39832>>>>> get value of gr$CPU$RAM item (gr$CPU$PC) to name# 39833>>>>> get value of gr$CPU$RAM item (gr$CPU$PC+1) to pitch# 39834>>>>> get value of gr$CPU$RAM item (gr$CPU$PC+2) to angle# 39835>>>>> get value of gr$CPU$RAM item (gr$CPU$PC+3) to bold# 39836>>>>> get value of gr$CPU$RAM item (gr$CPU$PC+4) to italic# 39837>>>>> get value of gr$CPU$RAM item (gr$CPU$PC+5) to underline# 39838>>>>> move (gr$CPU$PC+6) to gr$CPU$PC 39839>>>>> getaddress of name# to address# 39840>>>>> move (GrphCFA(-pitch#,0,angle#,0,if(bold#,700,0),italic#,underline#,0,ANSI_CHARSET,OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,DEFAULT_PITCH ior FF_DONTCARE,address#)) to hFont# 39841>>>>> move (SelectObject(gr$hCurrentDC, hFont#)) To gr$PreviousFont // select into Device Context 39842>>>>> move hFont# to gr$hCurrentTTFont 39843>>>>> end_procedure 39844>>>>> procedure mthd_AddDot 39846>>>>> integer dsz# address# type# corr_x# corr_y# just# x# y# 39846>>>>> string struct# 39846>>>>> move (gr$DotSize/2) to dsz# 39847>>>>> if type# eq DT_SQUARE move (dsz#/1.2) to dsz# 39850>>>>> if dsz# lt 1 move 1 to dsz# 39853>>>>> move gr$DotType to type# 39854>>>>> gosub vdfgraph$PreparePoint 39855>>>>>> 39855>>>>> if type# eq DT_PIXEL begin 39857>>>>> move 1 to dsz# 39858>>>>> move DT_PLUS to type# 39859>>>>> end 39859>>>>>> 39859>>>>> 39859>>>>> if type# ne DT_PIXEL begin // If dot type is pixel, we do no aligning 39861>>>>> // Check for horizontal alignment 39861>>>>> if type# ne DT_VERTICAL begin 39863>>>>> move (gr$DotAlign iand 7) to just# // 1:left_sp 2:left 3:center 4:right 5:right_sp 39864>>>>> if just# eq 1 move (dsz#*2) to corr_y# 39867>>>>> if just# eq 2 move dsz# to corr_y# 39870>>>>> if just# eq 4 move (-dsz#) to corr_y# 39873>>>>> if just# eq 5 move (-dsz#*2) to corr_y# 39876>>>>> end 39876>>>>>> 39876>>>>> // Check for vertical alignment 39876>>>>> if type# ne DT_HORIZONTAL begin 39878>>>>> move ((gr$DotAlign iand 56)/8) to just# // 1:top_sp 2:top 3:vcenter 4:bottom 5:bottom_sp 39879>>>>> if just# eq 1 move (-dsz#*2) to corr_x# 39882>>>>> if just# eq 2 move (-dsz#) to corr_x# 39885>>>>> if just# eq 4 move dsz# to corr_x# 39888>>>>> if just# eq 5 move (dsz#*2) to corr_x# 39891>>>>> end 39891>>>>>> 39891>>>>> end 39891>>>>>> 39891>>>>> move (low(gr$CoordXY1#)+corr_y#) to y# 39892>>>>> move (hi(gr$CoordXY1#)+corr_x#) to x# 39893>>>>> if type# eq DT_CROSS begin 39895>>>>> move (MoveTo(gr$hCurrentDC,y#-dsz#+1,x#-dsz#+1,0)) to gr$Void 39896>>>>> move (LineTo(gr$hCurrentDC,y#+dsz#,x#+dsz#)) to gr$Void 39897>>>>> move (MoveTo(gr$hCurrentDC,y#-dsz#+1,x#+dsz#-1,0)) to gr$Void 39898>>>>> move (LineTo(gr$hCurrentDC,y#+dsz#,x#-dsz#)) to gr$Void 39899>>>>> end 39899>>>>>> 39899>>>>> if type# eq DT_PLUS begin 39901>>>>> move (MoveTo(gr$hCurrentDC,y#-dsz#+1,x#,0)) to gr$Void 39902>>>>> move (LineTo(gr$hCurrentDC,y#+dsz#,x#)) to gr$Void 39903>>>>> move (MoveTo(gr$hCurrentDC,y#,x#+dsz#-1,0)) to gr$Void 39904>>>>> move (LineTo(gr$hCurrentDC,y#,x#-dsz#)) to gr$Void 39905>>>>> end 39905>>>>>> 39905>>>>> if type# eq DT_HORIZONTAL begin 39907>>>>> move (MoveTo(gr$hCurrentDC,y#-dsz#+1,x#,0)) to gr$Void 39908>>>>> move (LineTo(gr$hCurrentDC,y#+dsz#,x#)) to gr$Void 39909>>>>> end 39909>>>>>> 39909>>>>> if type# eq DT_VERTICAL begin 39911>>>>> move (MoveTo(gr$hCurrentDC,y#,x#+dsz#-1,0)) to gr$Void 39912>>>>> move (LineTo(gr$hCurrentDC,y#,x#-dsz#)) to gr$Void 39913>>>>> end 39913>>>>>> 39913>>>>> if type# eq DT_CIRCLE begin 39915>>>>> move (Ellipse(gr$hCurrentDC,y#-dsz#,x#-dsz#,y#+dsz#,x#+dsz#)) To gr$Void 39916>>>>> end 39916>>>>>> 39916>>>>> if type# eq DT_TRIANGLE_UP begin 39918>>>>> zerotype tPOINTS3 to struct# 39919>>>>> put (y#+dsz#) to struct# at tPOINTS3.x1 39920>>>>> put (x#+dsz#) to struct# at tPOINTS3.y1 39921>>>>> put y# to struct# at tPOINTS3.x2 39922>>>>> put (x#-dsz#) to struct# at tPOINTS3.y2 39923>>>>> put (y#-dsz#) to struct# at tPOINTS3.x3 39924>>>>> put (x#+dsz#) to struct# at tPOINTS3.y3 39925>>>>> getaddress of struct# to address# 39926>>>>> move (GrphPolyGon(gr$hCurrentDC,address#,3)) to gr$Void 39927>>>>> end 39927>>>>>> 39927>>>>> if type# eq DT_TRIANGLE_DOWN begin 39929>>>>> zerotype tPOINTS3 to struct# 39930>>>>> put (y#-dsz#) to struct# at tPOINTS3.x1 39931>>>>> put (x#-dsz#) to struct# at tPOINTS3.y1 39932>>>>> put y# to struct# at tPOINTS3.x2 39933>>>>> put (x#+dsz#) to struct# at tPOINTS3.y2 39934>>>>> put (y#+dsz#) to struct# at tPOINTS3.x3 39935>>>>> put (x#-dsz#) to struct# at tPOINTS3.y3 39936>>>>> getaddress of struct# to address# 39937>>>>> move (GrphPolyGon(gr$hCurrentDC,address#,3)) to gr$Void 39938>>>>> end 39938>>>>>> 39938>>>>> if type# eq DT_TRIANGLE_RIGHT begin 39940>>>>> zerotype tPOINTS3 to struct# 39941>>>>> put (y#-dsz#) to struct# at tPOINTS3.x1 39942>>>>> put (x#-dsz#) to struct# at tPOINTS3.y1 39943>>>>> put (y#+dsz#) to struct# at tPOINTS3.x2 39944>>>>> put x# to struct# at tPOINTS3.y2 39945>>>>> put (y#-dsz#) to struct# at tPOINTS3.x3 39946>>>>> put (x#+dsz#) to struct# at tPOINTS3.y3 39947>>>>> getaddress of struct# to address# 39948>>>>> move (GrphPolyGon(gr$hCurrentDC,address#,3)) to gr$Void 39949>>>>> end 39949>>>>>> 39949>>>>> if type# eq DT_TRIANGLE_LEFT begin 39951>>>>> zerotype tPOINTS3 to struct# 39952>>>>> put (y#+dsz#) to struct# at tPOINTS3.x1 39953>>>>> put (x#+dsz#) to struct# at tPOINTS3.y1 39954>>>>> put (y#-dsz#) to struct# at tPOINTS3.x2 39955>>>>> put x# to struct# at tPOINTS3.y2 39956>>>>> put (y#+dsz#) to struct# at tPOINTS3.x3 39957>>>>> put (x#-dsz#) to struct# at tPOINTS3.y3 39958>>>>> getaddress of struct# to address# 39959>>>>> move (GrphPolyGon(gr$hCurrentDC,address#,3)) to gr$Void 39960>>>>> end 39960>>>>>> 39960>>>>> if type# eq DT_SQUARE begin 39962>>>>> zerotype tPOINTS4 to struct# 39963>>>>> move (dsz#/1.2) to dsz# 39964>>>>> if dsz# lt 1 move 1 to dsz# 39967>>>>> put (y#-dsz#) to struct# at tPOINTS4.x1 39968>>>>> put (x#-dsz#) to struct# at tPOINTS4.y1 39969>>>>> put (y#-dsz#) to struct# at tPOINTS4.x2 39970>>>>> put (x#+dsz#) to struct# at tPOINTS4.y2 39971>>>>> put (y#+dsz#) to struct# at tPOINTS4.x3 39972>>>>> put (x#+dsz#) to struct# at tPOINTS4.y3 39973>>>>> put (y#+dsz#) to struct# at tPOINTS4.x4 39974>>>>> put (x#-dsz#) to struct# at tPOINTS4.y4 39975>>>>> getaddress of struct# to address# 39976>>>>> move (GrphPolyGon(gr$hCurrentDC,address#,4)) to gr$Void 39977>>>>> end 39977>>>>>> 39977>>>>> if type# eq DT_DIAMOND begin 39979>>>>> zerotype tPOINTS4 to struct# 39980>>>>> put (y#-dsz#) to struct# at tPOINTS4.x1 39981>>>>> put x# to struct# at tPOINTS4.y1 39982>>>>> put y# to struct# at tPOINTS4.x2 39983>>>>> put (x#+dsz#) to struct# at tPOINTS4.y2 39984>>>>> put (y#+dsz#) to struct# at tPOINTS4.x3 39985>>>>> put x# to struct# at tPOINTS4.y3 39986>>>>> put y# to struct# at tPOINTS4.x4 39987>>>>> put (x#-dsz#) to struct# at tPOINTS4.y4 39988>>>>> getaddress of struct# to address# 39989>>>>> move (GrphPolyGon(gr$hCurrentDC,address#,4)) to gr$Void 39990>>>>> end 39990>>>>>> 39990>>>>> end_procedure 39991>>>>> procedure mthd_SetDotStyle 39993>>>>> move (value(gr$CPU$RAM,gr$CPU$PC)) to gr$DotType 39994>>>>> increment gr$CPU$PC 39995>>>>> end_procedure 39996>>>>> procedure mthd_SetDotSize 39998>>>>> move (value(gr$CPU$RAM,gr$CPU$PC)) to gr$DotSize 39999>>>>> increment gr$CPU$PC 40000>>>>> end_procedure 40001>>>>> procedure mthd_SetDotAlign 40003>>>>> move (value(gr$CPU$RAM,gr$CPU$PC)) to gr$DotAlign 40004>>>>> increment gr$CPU$PC 40005>>>>> end_procedure 40006>>>>> procedure mthd_Rectangle 40008>>>>> gosub vdfgraph$Prepare2Points 40009>>>>>> 40009>>>>> move (Rectangle(gr$hCurrentDC,low(gr$CoordXY1#),hi(gr$CoordXY1#),Low(gr$CoordXY2#),Hi(gr$CoordXY2#))) To gr$Void 40010>>>>> end_procedure 40011>>>>> procedure mthd_RectangleBackground // The only point about this is that we can kill it in the VPE version 40013>>>>> gosub vdfgraph$Prepare2Points 40014>>>>>> 40014>>>>> move (Rectangle(gr$hCurrentDC,low(gr$CoordXY1#),hi(gr$CoordXY1#),Low(gr$CoordXY2#),Hi(gr$CoordXY2#))) To gr$Void 40015>>>>> end_procedure 40016>>>>> procedure mthd_Ellipse 40018>>>>> gosub vdfgraph$Prepare2Points 40019>>>>>> 40019>>>>> move (Ellipse(gr$hCurrentDC,low(gr$CoordXY1#),hi(gr$CoordXY1#),Low(gr$CoordXY2#),Hi(gr$CoordXY2#))) To gr$Void 40020>>>>> end_procedure 40021>>>>> procedure mthd_RoundRect 40023>>>>> gosub vdfgraph$Prepare2Points 40024>>>>>> 40024>>>>> move (RoundRect(gr$hCurrentDC,low(gr$CoordXY1#),hi(gr$CoordXY1#),Low(gr$CoordXY2#),Hi(gr$CoordXY2#),Low(gr$RoundRectFactor),Hi(gr$RoundRectFactor))) To gr$Void 40025>>>>> end_procedure 40026>>>>> procedure mthd_LineTo 40028>>>>> gosub vdfgraph$PreparePoint 40029>>>>>> 40029>>>>> move (LineTo(gr$hCurrentDC,low(gr$CoordXY1#),hi(gr$CoordXY1#))) to gr$Void 40030>>>>> end_procedure 40031>>>>> procedure mthd_MoveTo 40033>>>>> gosub vdfgraph$PreparePoint 40034>>>>>> 40034>>>>> move (MoveTo(gr$hCurrentDC,low(gr$CoordXY1#),hi(gr$CoordXY1#),0)) to gr$Void 40035>>>>> end_procedure 40036>>>>> procedure mthd_TextOut 40038>>>>> pointer address# pRect# 40038>>>>> string str# rect# 40038>>>>> get value of gr$CPU$RAM item gr$CPU$PC to str# 40039>>>>> if (pOemToAnsi_State(self)) move (Grph_OemToChar(str#)) to str# 40042>>>>> getaddress of str# to address# 40043>>>>> increment gr$CPU$PC 40044>>>>> gosub vdfgraph$PreparePoint 40045>>>>>> 40045>>>>> if gr$vCenterActive begin 40047>>>>> zerotype tRECT to rect# 40048>>>>> put (low(gr$CoordXY1#)) to rect# at tRECT.left 40049>>>>> put (low(gr$CoordXY1#)) to rect# at tRECT.right 40050>>>>> put (hi(gr$CoordXY1#)) to rect# at tRECT.top 40051>>>>> put (hi(gr$CoordXY1#)) to rect# at tRECT.bottom 40052>>>>> getaddress of rect# to pRect# 40053>>>>> move (DrawText(gr$hCurrentDC,address#,-1,pRect#,gr$vCenterActive)) to gr$Void 40054>>>>> end 40054>>>>>> 40054>>>>> else move (TextOut(gr$hCurrentDC,low(gr$CoordXY1#),hi(gr$CoordXY1#),address#,length(str#))) to gr$Void 40056>>>>> end_procedure 40057>>>>> 40057>>>>> procedure do_polygonline integer line# 40059>>>>> // Creates a string of (x,y) points and returns a pointer to the string 40059>>>>> // This value can then be used as the array argument to the Polygon WinGDI 40059>>>>> // function 40059>>>>> pointer address# 40059>>>>> integer Points# iPoint argument_size# size_needed# 40059>>>>> gosub vdfgraph$Update_GDI_Objects 40060>>>>>> 40060>>>>> get value of gr$CPU$RAM item gr$CPU$PC to Points# 40061>>>>> move (Points#*8) to size_needed# 40062>>>>> get_argument_size to argument_size# 40063>>>>> if argument_size# lt size_needed# set_argument_size size_needed# 40066>>>>> string gr$Polygon_Points# // Must be declared here, I think (I don't know) 40066>>>>> increment gr$CPU$PC 40067>>>>> ZeroType tPOINT To gr$Point 40068>>>>> move (repeat(character(0),Points#*8)) to gr$Polygon_Points# 40069>>>>> for iPoint from 0 To (Points#-1) 40075>>>>>> 40075>>>>> get value of gr$CPU$RAM item gr$CPU$PC to gr$CoordXY1# 40076>>>>> increment gr$CPU$PC 40077>>>>> gosub vdfgraph$ConvertToGUI1 40078>>>>>> 40078>>>>> put (low(gr$CoordXY1#)) To gr$Point at tPOINT.X 40079>>>>> put (hi(gr$CoordXY1#)) To gr$Point at tPOINT.Y 40080>>>>> move (overstrike(gr$Point,gr$Polygon_Points#,iPoint*8+1)) to gr$Polygon_Points# 40081>>>>> loop 40082>>>>>> 40082>>>>> append gr$Polygon_Points# (character(0)) // Add a null-terminator character to end of the string/array 40083>>>>> GetAddress Of gr$Polygon_Points# To address# 40084>>>>> 40084>>>>> if line# move (GrphPolyline(gr$hCurrentDC,address#,points#)) to gr$Void 40087>>>>> else move (GrphPolyGon(gr$hCurrentDC,address#,points#)) to gr$Void 40089>>>>> set_argument_size argument_size# 40090>>>>>> 40090>>>>> end_procedure 40091>>>>> 40091>>>>> procedure mthd_PolyLine 40093>>>>> send do_polygonline 1 40094>>>>> end_procedure 40095>>>>> 40095>>>>> procedure mthd_PolyGon 40097>>>>> Move (GrphSetPolyFillMode(gr$hCurrentDC,gr$PolyGonFillMode)) To gr$Void 40098>>>>> send do_polygonline 0 40099>>>>> end_procedure 40100>>>>> 40100>>>>> procedure BeginDraw 40102>>>>> move (piProgram_RAM(self)) to gr$CPU$RAM 40103>>>>> move (oTrackableObjects(self)) to gr$TrackArray 40104>>>>> send delete_data to gr$CPU$RAM 40105>>>>> send delete_data to gr$TrackArray 40106>>>>> move 0 to gr$CPU$PC 40107>>>>> end_procedure 40108>>>>> 40108>>>>> procedure AddRectangleTrack integer x1# integer y1# integer x2# integer y2# integer cb_val# 40110>>>>> send AddRectangle x1# y1# x2# y2# 40111>>>>> send MakeAreaTrackable GR_TRACK_RECTANGLE x1# y1# x2# y2# cb_val# 40112>>>>> end_procedure 40113>>>>> procedure MakeAreaTrackable integer type# integer x1# integer y1# integer x2# integer y2# integer trackobjid# 40115>>>>> integer liTemp 40115>>>>> set value of gr$CPU$RAM item gr$CPU$PC to msg_mthd_MakeAreaTrackable 40116>>>>> set value of gr$CPU$RAM item (gr$CPU$PC+1) to type# 40117>>>>> if (x1#>x2#) begin 40119>>>>> move x2# to liTemp 40120>>>>> move x1# to x2# 40121>>>>> move liTemp to x1# 40122>>>>> end 40122>>>>>> 40122>>>>> if (y1#>y2#) begin 40124>>>>> move y2# to liTemp 40125>>>>> move y1# to y2# 40126>>>>> move liTemp to y1# 40127>>>>> end 40127>>>>>> 40127>>>>> set value of gr$CPU$RAM item (gr$CPU$PC+2) to (x1#*65536+y1#) 40128>>>>> set value of gr$CPU$RAM item (gr$CPU$PC+3) to (x2#*65536+y2#) 40129>>>>> set value of gr$CPU$RAM item (gr$CPU$PC+4) to trackobjid# 40130>>>>> move (gr$CPU$PC+5) to gr$CPU$PC 40131>>>>> end_procedure 40132>>>>> 40132>>>>> vdfgraph$Procedure_OneArg SetPenColor msg_mthd_SetPenColor 40138>>>>> vdfgraph$Procedure_OneArg SetPenWidth msg_mthd_SetPenWidth 40144>>>>> vdfgraph$Procedure_OneArg SetPenStyle msg_mthd_SetPenStyle 40150>>>>> vdfgraph$Procedure_OneArg SetFillColor msg_mthd_SetFillColor 40156>>>>> vdfgraph$Procedure_OneArg SetHatchStyle msg_mthd_SetHatchStyle 40162>>>>> vdfgraph$Procedure_OneArg SetBackColor msg_mthd_SetBackColor 40168>>>>> vdfgraph$Procedure_OneArg SetTextAlign msg_mthd_SetTextAlign 40174>>>>> vdfgraph$Procedure_OneArg SetTextColor msg_mthd_SetTextColor 40180>>>>> vdfgraph$Procedure_OneArg SetStockFont msg_mthd_SetStockFont 40186>>>>> 40186>>>>> procedure SetTTFont string name# integer pitch# integer angle# integer bold# integer italic# integer underline# 40188>>>>> set value of gr$CPU$RAM item gr$CPU$PC to msg_mthd_SetTTFont 40189>>>>> set value of gr$CPU$RAM item (gr$CPU$PC+1) to name# 40190>>>>> set value of gr$CPU$RAM item (gr$CPU$PC+2) to pitch# 40191>>>>> set value of gr$CPU$RAM item (gr$CPU$PC+3) to angle# 40192>>>>> set value of gr$CPU$RAM item (gr$CPU$PC+4) to bold# 40193>>>>> set value of gr$CPU$RAM item (gr$CPU$PC+5) to italic# 40194>>>>> set value of gr$CPU$RAM item (gr$CPU$PC+6) to underline# 40195>>>>> move (gr$CPU$PC+7) to gr$CPU$PC 40196>>>>> end_procedure 40197>>>>> vdfgraph$Procedure_OneArg SetRoundRectFactor msg_mthd_SetRoundRectFactor 40203>>>>> vdfgraph$Procedure_OneArg SetPolyGonFillMode msg_mthd_SetPolyGonFillMode 40209>>>>> vdfgraph$Procedure_PlaneArg AddRectangle msg_mthd_Rectangle 40216>>>>> vdfgraph$Procedure_PlaneArg AddRectangleBackground msg_mthd_RectangleBackground 40223>>>>> procedure Add4Angle integer x1# integer y1# integer x2# integer y2# integer x3# integer y3# integer x4# integer y4# 40225>>>>> send AddPolyPoint x1# y1# 40226>>>>> send AddPolyPoint x2# y2# 40227>>>>> send AddPolyPoint x3# y3# 40228>>>>> send AddPolyPoint x4# y4# 40229>>>>> send AddPolyGon 40230>>>>> end_procedure 40231>>>>> vdfgraph$Procedure_PlaneArg AddEllipse msg_mthd_Ellipse 40238>>>>> vdfgraph$Procedure_PlaneArg AddRoundRect msg_mthd_RoundRect 40245>>>>> vdfgraph$Procedure_LineArg AddLineMvTo msg_mthd_MoveTo 40251>>>>> vdfgraph$Procedure_LineArg AddLineGoTo msg_mthd_LineTo 40257>>>>> 40257>>>>> procedure AddLine integer x1# integer y1# integer x2# integer y2# 40259>>>>> send AddLineMvTo x1# y1# 40260>>>>> send AddLineGoTo x2# y2# 40261>>>>> graph$showln ("Line: "+string(x1#)+","+string(y1#)+" to "+string(x2#)+","+string(y2#)) 40261>>>>> end_procedure 40262>>>>> 40262>>>>> procedure AddText string str# integer x1# integer y1# 40264>>>>> if str# ne "" begin // If an empty string is added the program may GPF 40266>>>>> set value of gr$CPU$RAM item gr$CPU$PC to msg_mthd_TextOut 40267>>>>> set value of gr$CPU$RAM item (gr$CPU$PC+1) to str# 40268>>>>> set value of gr$CPU$RAM item (gr$CPU$PC+2) to (x1#*65536+y1#) 40269>>>>> move (gr$CPU$PC+3) to gr$CPU$PC 40270>>>>> end 40270>>>>>> 40270>>>>> end_procedure 40271>>>>> 40271>>>>> procedure AddPolyLine 40273>>>>> integer iPolyPointsOffS# 40273>>>>> get pPolyPointsOffS to iPolyPointsOffS# 40274>>>>> ifnot iPolyPointsOffS# error 666 "No points specified for polyline! (vdfgraph.utl)" 40277>>>>> set value of gr$CPU$RAM item (iPolyPointsOffS#-1) to msg_mthd_PolyLine 40278>>>>> set value of gr$CPU$RAM item iPolyPointsOffS# to (gr$CPU$PC-iPolyPointsOffS#-1) 40279>>>>> set pPolyPointsOffS to 0 40280>>>>> end_procedure 40281>>>>> 40281>>>>> procedure AddPolyGon 40283>>>>> integer iPolyPointsOffS# 40283>>>>> get pPolyPointsOffS to iPolyPointsOffS# 40284>>>>> ifnot iPolyPointsOffS# error 666 "No points specified for polygon! (vdfgraph.utl)" 40287>>>>> set value of gr$CPU$RAM item (iPolyPointsOffS#-1) to msg_mthd_PolyGon 40288>>>>> set value of gr$CPU$RAM item iPolyPointsOffS# to (gr$CPU$PC-iPolyPointsOffS#-1) 40289>>>>> set pPolyPointsOffS to 0 40290>>>>> end_procedure 40291>>>>> 40291>>>>> procedure AddDot integer x# integer y# 40293>>>>> set value of gr$CPU$RAM item gr$CPU$PC to msg_mthd_AddDot 40294>>>>> set value of gr$CPU$RAM item (gr$CPU$PC+1) to (x#*65536+y#) 40295>>>>> move (gr$CPU$PC+2) to gr$CPU$PC 40296>>>>> end_procedure 40297>>>>> procedure SetDotStyle integer x# 40299>>>>> set value of gr$CPU$RAM item gr$CPU$PC to msg_mthd_SetDotStyle 40300>>>>> set value of gr$CPU$RAM item (gr$CPU$PC+1) to x# 40301>>>>> move (gr$CPU$PC+2) to gr$CPU$PC 40302>>>>> end_procedure 40303>>>>> procedure SetDotSize integer x# 40305>>>>> set value of gr$CPU$RAM item gr$CPU$PC to msg_mthd_SetDotSize 40306>>>>> set value of gr$CPU$RAM item (gr$CPU$PC+1) to x# 40307>>>>> move (gr$CPU$PC+2) to gr$CPU$PC 40308>>>>> end_procedure 40309>>>>> procedure SetDotAlign integer x# 40311>>>>> set value of gr$CPU$RAM item gr$CPU$PC to msg_mthd_SetDotAlign 40312>>>>> set value of gr$CPU$RAM item (gr$CPU$PC+1) to x# 40313>>>>> move (gr$CPU$PC+2) to gr$CPU$PC 40314>>>>> end_procedure 40315>>>>> 40315>>>>> procedure AddPolyPoint integer x# integer y# 40317>>>>> ifnot (pPolyPointsOffS(self)) begin 40319>>>>> set pPolyPointsOffS to (gr$CPU$PC+1) 40320>>>>> move (gr$CPU$PC+2) to gr$CPU$PC // Reserve space for method and number of points 40321>>>>> end 40321>>>>>> 40321>>>>> set value of gr$CPU$RAM item gr$CPU$PC to (x#*65536+y#) 40322>>>>> increment gr$CPU$PC 40323>>>>> end_procedure 40324>>>>> 40324>>>>> procedure onMouseUp integer x# integer y# 40326>>>>> end_procedure 40327>>>>> procedure onMouseDown integer x# integer y# 40329>>>>> end_procedure 40330>>>>> procedure onMouse2Up integer x# integer y# 40332>>>>> end_procedure 40333>>>>> procedure onMouse2Down integer x# integer y# 40335>>>>> end_procedure 40336>>>>> procedure onMouseDrag integer x# integer y# 40338>>>>> end_procedure 40339>>>>> procedure onMouseMove integer x# integer y# 40341>>>>> end_procedure 40342>>>>> procedure onMouseDblClick integer x# integer y# 40344>>>>> end_procedure 40345>>>>> procedure onMouseUpTrack integer cb_value# integer level# 40347>>>>> end_procedure 40348>>>>> procedure onMouseDownTrack integer cb_value# integer level# 40350>>>>> end_procedure 40351>>>>> procedure onMouse2UpTrack integer cb_value# integer level# 40353>>>>> end_procedure 40354>>>>> procedure onMouse2DownTrack integer cb_value# integer level# 40356>>>>> end_procedure 40357>>>>> procedure onMouseDragTrack integer cb_value# integer level# 40359>>>>> end_procedure 40360>>>>> procedure onMouseMoveTrack integer cb_value# integer level# 40362>>>>> end_procedure 40363>>>>> procedure onMouseDblClickTrack integer cb_value# integer level# 40365>>>>> end_procedure 40366>>>>> 40366>>>>> procedure translate_to_onEvent integer msg# integer track_msg# 40368>>>>> get absolute_mouse_location to gr$CoordXY1# 40369>>>>> // In this place it would make more sense to ask if high and low 40369>>>>> // 16 bits were gt 0, but that you can't. Instead we ask if they 40369>>>>> // are less than 5000 (pixels from the edge): 40369>>>>> 40369>>>>>// Three of the lines below were taken out for test purposes on 2/10-2001: 40369>>>>> 40369>>>>>// if (hi(gr$CoordXY1#)<=5000 and low(gr$CoordXY1#)<5000) begin 40369>>>>> 40369>>>>> get piX_Offset to gr$GuiOffsetX# 40370>>>>> get piY_Offset to gr$GuiOffsetY# 40371>>>>> get piX_Range to gr$X_Range 40372>>>>> get piY_Range to gr$Y_Range 40373>>>>> 40373>>>>> Get GuiSize to gr$Tmp# 40374>>>>> move (hi(gr$Tmp#)) to gr$GuiSizeX# 40375>>>>> move (low(gr$Tmp#)) to gr$GuiSizeY# 40376>>>>> move (oTrackableObjects(self)) to gr$TrackArray 40377>>>>> send TestTrackHit to gr$TrackArray track_msg# 40378>>>>> gosub vdfgraph$ConvertToVirtual 40379>>>>>> 40379>>>>>// if (hi(gr$CoordXY1#)<=10000 and low(gr$CoordXY1#)<=10000) ; 40379>>>>> send msg# (hi(gr$CoordXY1#)) (low(gr$CoordXY1#)) 40380>>>>>// end 40380>>>>> end_procedure 40381>>>>> // Left mouse button down: 40381>>>>> procedure WMSG_OnMouseDown Integer wParam Integer lParam 40383>>>>> send translate_to_onEvent msg_onMouseDown msg_onMouseDownTrack 40384>>>>> end_procedure 40385>>>>> // Left mouse button up: 40385>>>>> procedure WMSG_OnMouseUp Integer wParam Integer lParam 40387>>>>> send translate_to_onEvent msg_onMouseUp msg_onMouseUpTrack 40388>>>>> end_procedure 40389>>>>> // Right mouse button down: 40389>>>>> procedure WMSG_OnMouse2Down Integer wParam Integer lParam 40391>>>>> send translate_to_onEvent msg_onMouse2Down msg_onMouse2DownTrack 40392>>>>> end_procedure 40393>>>>> // right mouse button down: 40393>>>>> procedure WMSG_OnMouse2Up Integer wParam Integer lParam 40395>>>>> send translate_to_onEvent msg_onMouse2Up msg_onMouse2UpTrack 40396>>>>> end_procedure 40397>>>>> // Mouse move: 40397>>>>> procedure WMSG_OnMouseMove Integer wParam Integer lParam 40399>>>>> // If left mouse button is depressed: 40399>>>>> if (wParam iand MK_LBUTTON) send translate_to_onEvent msg_onMouseDrag msg_onMouseDragTrack 40402>>>>> else send translate_to_onEvent msg_onMouseMove msg_onMouseMoveTrack 40404>>>>> end_procedure 40405>>>>> procedure WMSG_OnMouseDblClick Integer wParam Integer lParam 40407>>>>> send translate_to_onEvent msg_onMouseDblClick msg_onMouseDblClickTrack 40408>>>>> end_procedure 40409>>>>> 40409>>>>> procedure Read_From_File integer channel# integer reset_tmp# 40411>>>>> integer grb# reset# 40411>>>>> if num_arguments gt 1 move reset_tmp# to reset# 40414>>>>> else move 0 to reset# 40416>>>>> if reset# send BeginDraw 40419>>>>> get Read_Program_RAM of (oGraphOperationMsgTabel(self)) (piProgram_RAM(self)) 1 to grb# 40420>>>>> end_procedure 40421>>>>> procedure Write_To_File integer channel# 40423>>>>> integer grb# 40423>>>>> get Write_Program_RAM of (oGraphOperationMsgTabel(self)) (piProgram_RAM(self)) channel# to grb# 40424>>>>> end_procedure 40425>>>>> 40425>>>>> procedure DoZoom number lnZoomFactorX number lnZoomFactorY 40427>>>>> send RepaintFull 40428>>>>> end_procedure 40429>>>>> procedure DoViewPort integer lhVert integer lhHorz 40431>>>>> end_procedure 40432>>>>> procedure ResetZoom 40434>>>>> end_procedure 40435>>>>> procedure ResetViewPort 40437>>>>> end_procedure 40438>>>>>end_class // GraphicArea 40439>>>>> 40439>>>>>//> The purpose of the oGraphOperationMsgTabel object is to facilitate 40439>>>>>//> writing the graphics stored in out useal array to a sequential file. 40439>>>>>//> The reason that we cannot just dump our array to file, is that the array 40439>>>>>//> contains message identifiers that may change each time we compile. 40439>>>>>//> Therefore a mechanism, that will translate message ID's to recognizable 40439>>>>>//> symbols is needed to do this. 40439>>>>>object oGraphOperationMsgTabel is an array 40441>>>>> item_property_list 40441>>>>> item_property string psName.i 40441>>>>> item_property integer piMsg_Id.i 40441>>>>> item_property integer piNum_Arguments.i 40441>>>>> end_item_property_list #REM 40481 DEFINE FUNCTION PINUM_ARGUMENTS.I INTEGER LIROW RETURNS INTEGER #REM 40486 DEFINE PROCEDURE SET PINUM_ARGUMENTS.I INTEGER LIROW INTEGER VALUE #REM 40491 DEFINE FUNCTION PIMSG_ID.I INTEGER LIROW RETURNS INTEGER #REM 40496 DEFINE PROCEDURE SET PIMSG_ID.I INTEGER LIROW INTEGER VALUE #REM 40501 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING #REM 40506 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE 40512>>>>> procedure Define_Graphic_Message integer no# string name# integer msg# integer args# 40515>>>>> set psName.i no# to name# 40516>>>>> set piMsg_Id.i no# to msg# 40517>>>>> set piNum_Arguments.i no# to args# 40518>>>>> end_procedure 40519>>>>> send Define_Graphic_Message GO_SetPenColor "Pen color" msg_mthd_SetPenColor 1 40520>>>>> send Define_Graphic_Message GO_SetPenWidth "Pen width" msg_mthd_SetPenWidth 1 40521>>>>> send Define_Graphic_Message GO_SetPenStyle "Pen style" msg_mthd_SetPenStyle 1 40522>>>>> send Define_Graphic_Message GO_SetFillColor "Fill color" msg_mthd_SetFillColor 1 40523>>>>> send Define_Graphic_Message GO_SetHatchStyle "Hatch style" msg_mthd_SetHatchStyle 1 40524>>>>> send Define_Graphic_Message GO_SetBackColor "Back color" msg_mthd_SetBackColor 1 40525>>>>> send Define_Graphic_Message GO_SetRoundRectFactor "Round rect factor" msg_mthd_SetRoundRectFactor 1 40526>>>>> send Define_Graphic_Message GO_SetPolyGonFillMode "Polygon fill mode" msg_mthd_SetPolyGonFillMode 1 40527>>>>> send Define_Graphic_Message GO_SetTextAlign "Text alignment" msg_mthd_SetTextAlign 1 40528>>>>> send Define_Graphic_Message GO_SetTextColor "Text color" msg_mthd_SetTextColor 1 40529>>>>> send Define_Graphic_Message GO_SetStockFont "Stock font" msg_mthd_SetStockFont 1 40530>>>>> send Define_Graphic_Message GO_SetTTFont "TT font" msg_mthd_SetTTFont 6 40531>>>>> send Define_Graphic_Message GO_AddDot "Dot" msg_mthd_AddDot 1 40532>>>>> send Define_Graphic_Message GO_SetDotStyle "Dot style" msg_mthd_SetDotStyle 1 40533>>>>> send Define_Graphic_Message GO_SetDotSize "Dot size" msg_mthd_SetDotSize 1 40534>>>>> send Define_Graphic_Message GO_SetDotAlign "Dot alignment" msg_mthd_SetDotAlign 1 40535>>>>> send Define_Graphic_Message GO_Rectangle "Rectangle" msg_mthd_Rectangle 2 40536>>>>> send Define_Graphic_Message GO_Ellipse "Ellipse" msg_mthd_Ellipse 2 40537>>>>> send Define_Graphic_Message GO_RoundRect "Round rectangle" msg_mthd_RoundRect 2 40538>>>>> send Define_Graphic_Message GO_LineTo "Line to" msg_mthd_LineTo 1 40539>>>>> send Define_Graphic_Message GO_MoveTo "Move to" msg_mthd_MoveTo 1 40540>>>>> send Define_Graphic_Message GO_TextOut "Text" msg_mthd_TextOut 2 40541>>>>> send Define_Graphic_Message GO_Polygon "Polygon" msg_mthd_Polygon -1 40542>>>>> send Define_Graphic_Message GO_PolyLine "Polyline" msg_mthd_PolyLine -1 40543>>>>> function MsgToGO integer msg# returns integer 40546>>>>> integer row# max# 40546>>>>> move 0 to row# 40547>>>>> get row_count to max# 40548>>>>> while row# lt max# 40552>>>>> if (piMsg_Id.i(self,row#)) eq msg# function_return row# 40555>>>>> increment row# 40556>>>>> loop 40557>>>>>> 40557>>>>> function_return -1 40558>>>>> end_function 40559>>>>> function Write_Program_RAM integer obj# integer ch# returns integer 40562>>>>> integer itm# max# msg# err# GO# args# 40562>>>>> string str# 40562>>>>> get item_count of obj# to max# 40563>>>>> move 0 to itm# 40564>>>>> move 0 to err# 40565>>>>> while itm# lt max# 40569>>>>> get value of obj# item itm# to msg# 40570>>>>> increment itm# 40571>>>>> move (MsgToGO(self,msg#)) to GO# 40572>>>>> if GO# ne -1 begin 40574>>>>> writeln channel ch# GO# 40577>>>>> move (piNum_Arguments.i(self,GO#)) to args# 40578>>>>> if args# eq -1 begin 40580>>>>> get value of obj# item itm# to args# 40581>>>>> increment itm# 40582>>>>> writeln args# 40584>>>>> end 40584>>>>>> 40584>>>>> while args# gt 0 40588>>>>> get value of obj# item itm# to str# 40589>>>>> increment itm# 40590>>>>> writeln str# 40592>>>>> decrement args# 40593>>>>> loop 40594>>>>>> 40594>>>>> end 40594>>>>>> 40594>>>>> else move 1 to err# 40596>>>>> loop 40597>>>>>> 40597>>>>> function_return err# 40598>>>>> end_function 40599>>>>> function Read_Program_RAM integer obj# integer ch# returns integer 40602>>>>> integer msg# err# GO# args# seqeof# 40602>>>>> string str# 40602>>>>> move 0 to err# 40603>>>>> repeat 40603>>>>>> 40603>>>>> readln channel ch# GO# 40605>>>>> move (seqeof) to seqeof# 40606>>>>> ifnot seqeof# begin 40608>>>>> move (piMsg_Id.i(self,GO#)) to msg# 40609>>>>> if msg# begin 40611>>>>> set value of obj# item (item_count(obj#)) to msg# 40612>>>>> move (piNum_Arguments.i(self,GO#)) to args# 40613>>>>> if args# eq -1 begin 40615>>>>> readln args# 40616>>>>> set value of obj# item (item_count(obj#)) to args# 40617>>>>> end 40617>>>>>> 40617>>>>> while args# gt 0 40621>>>>> readln str# 40622>>>>> set value of obj# item (item_count(obj#)) to str# 40623>>>>> decrement args# 40624>>>>> loop 40625>>>>>> 40625>>>>> end 40625>>>>>> 40625>>>>> else move 1 to err# 40627>>>>> end 40627>>>>>> 40627>>>>> until seqeof# 40629>>>>> function_return err# 40630>>>>> end_function 40631>>>>>end_object 40632>>>>> 40632>>>>>class cAutoScaler is an array 40633>>>>> procedure construct_object 40635>>>>> forward send construct_object 40637>>>>> set delegation_mode to delegate_to_parent 40638>>>>> 40638>>>>> // Parameter properties: 40638>>>>> property number pMinValue public 0 // minimum value 40639>>>>> property number pMaxValue public 0 // maximum value 40640>>>>> property integer pZeroBased public 0 // is the scale zero based? 40641>>>>> property number pAirPct public 5 // default: 5% air 40642>>>>> property integer pMinSteps public 8 // lowest acceptable number of steps 40643>>>>> property integer pMaxSteps public 11 // highest acceptable number of steps 40644>>>>> 40644>>>>> // Local properties: 40644>>>>> property number pMinValue private 0 // minimum value 40645>>>>> property number pMaxValue private 0 // maximum value 40646>>>>> property number pMinValueTmp private 0 // minimum value 40647>>>>> property number pMaxValueTmp private 0 // maximum value 40648>>>>> property integer pStepsTmp private 0 // maximum value 40649>>>>> 40649>>>>> property integer pCorrection private 0 // 0=no corr, 1=positive corr, 40650>>>>> // 2=neg corr, -1=negative scale. 40650>>>>> set value item 0 to 0 40651>>>>> set value item 1 to 0.1 40652>>>>> set value item 2 to 0.2 40653>>>>> set value item 3 to 0.25 40654>>>>> set value item 4 to 0.5 40655>>>>> set value item 5 to 1 40656>>>>> set value item 6 to 2 40657>>>>> set value item 7 to 2.5 40658>>>>> set value item 8 to 5 40659>>>>> set value item 9 to 10 40660>>>>> 40660>>>>> // Result properties 40660>>>>> property number pLowValue public 0 // lower value 40661>>>>> property number pStepSize public 0 // step size 40662>>>>> property integer pSteps public 0 // number of steps 40663>>>>> property integer pDecimals public 0 // max number of decimals 40664>>>>> end_procedure 40665>>>>> 40665>>>>> function ScaleEfficiency returns number 40667>>>>> function_return (!$.pMaxValue(self)-!$.pMinValue(self)/(pSteps(self)*pStepSize(self))) 40668>>>>> end_function 40669>>>>> 40669>>>>> function AirAmount returns number 40671>>>>> function_return (!$.pMaxValue(self)-!$.pMinValue(self)*pAirPct(self)/100) 40672>>>>> end_function 40673>>>>> 40673>>>>> procedure ApplyAir // apply air (and zero base, if specified) 40675>>>>> number AirAmount# 40675>>>>> if (pZeroBased(self)) begin 40677>>>>> if (!$.pMinValue(self)>=0 and !$.pMaxValue(self)>=0) begin 40679>>>>> set !$.pMinValue to 0 40680>>>>> set !$.pMaxValue to (!$.pMaxValue(self)+AirAmount(self)) 40681>>>>> end 40681>>>>>> 40681>>>>> else begin 40682>>>>> if (!$.pMinValue(self)<=0 and !$.pMaxValue(self)<=0) begin 40684>>>>> set !$.pMaxValue to 0 40685>>>>> set !$.pMinValue to (!$.pMinValue(self)-AirAmount(self)) 40686>>>>> end 40686>>>>>> 40686>>>>> else begin 40687>>>>> get AirAmount to AirAmount# 40688>>>>> set !$.pMaxValue to (!$.pMaxValue(self)+AirAmount#) 40689>>>>> set !$.pMinValue to (!$.pMinValue(self)-AirAmount#) 40690>>>>> end 40690>>>>>> 40690>>>>> end 40690>>>>>> 40690>>>>> end 40690>>>>>> 40690>>>>> else begin 40691>>>>> get AirAmount to AirAmount# 40692>>>>> set !$.pMaxValue to (!$.pMaxValue(self)+AirAmount#) 40693>>>>> set !$.pMinValue to (!$.pMinValue(self)-AirAmount#) 40694>>>>> end 40694>>>>>> 40694>>>>> end_procedure 40695>>>>> 40695>>>>> procedure UndoCorrections // Undo corrections done by SetupScaleParams 40697>>>>> integer correction# 40697>>>>> number tmp# 40697>>>>> get !$.pCorrection to correction# 40698>>>>> // Negative scale: 40698>>>>> if correction# eq -1 set pLowValue to (0-(pLowValue(self)+(pStepSize(self)*pSteps(self)))) 40701>>>>> // Scale based on positive part: 40701>>>>> if correction# eq 1 set pLowValue to (pLowValue(self)-(pStepSize(self)*(pSteps(self)-!$.pStepsTmp(self)))) 40704>>>>> // Scale based on negative part: 40704>>>>> if correction# eq 2 begin 40706>>>>> move (pLowValue(self)-(pStepSize(self)*(pSteps(self)-!$.pStepsTmp(self)))) to tmp# 40707>>>>> set pLowValue to (0-tmp#-(pSteps(self)*pStepSize(self))) 40708>>>>> end 40708>>>>>> 40708>>>>> end_procedure 40709>>>>> 40709>>>>> procedure SetupScaleParams integer steps# 40711>>>>> number temp# 40711>>>>> // This procedure acts only if there is both positive and negativ values 40711>>>>> // on the scale. Then the number of steps# passed to the procedure is 40711>>>>> // distributed between the positive and the negative part. 40711>>>>> // 40711>>>>> // The effect is that the scaling problem is reduced to one with only 40711>>>>> // positive values in a way that ensures that the value 0 is included 40711>>>>> 40711>>>>> set !$.pMinValueTmp to (!$.pMinValue(self)) 40712>>>>> set !$.pMaxValueTmp to (!$.pMaxValue(self)) 40713>>>>> set pSteps to steps# 40714>>>>> set !$.pStepsTmp to steps# 40715>>>>> set !$.pCorrection to 0 // no correction 40716>>>>> if (!$.pMaxValueTmp(self)>0 and !$.pMinValueTmp(self)<0) begin 40718>>>>> if (!$.pMaxValueTmp(self)>(0-!$.pMinValueTmp(self))) begin // major part on positive side 40720>>>>> move (!$.pMaxValueTmp(self)/(!$.pMaxValueTmp(self)-!$.pMinValueTmp(self))) to temp# // fraction on positive side 40721>>>>> set !$.pStepsTmp to (integer(temp#*steps#)) 40722>>>>> set !$.pMinValueTmp to 0 40723>>>>> set !$.pCorrection to 1 // scale based on positive part 40724>>>>> end 40724>>>>>> 40724>>>>> else begin // major part on negative side 40725>>>>> move (!$.pMinValueTmp(self)/(!$.pMinValueTmp(self)-!$.pMaxValueTmp(self))) to temp# // fraction on negative side 40726>>>>> set !$.pStepsTmp to (integer(temp#*steps#)) 40727>>>>> set !$.pMaxValueTmp to (0-!$.pMinValueTmp(self)) 40728>>>>> set !$.pMinValueTmp to 0 40729>>>>> set !$.pCorrection to 2 // scale based on negative part 40730>>>>> end 40730>>>>>> 40730>>>>> end 40730>>>>>> 40730>>>>> if (!$.pMaxValueTmp(self)<0 and !$.pMinValueTmp(self)<0) begin 40732>>>>> move (-!$.pMaxValueTmp(self)) to temp# 40733>>>>> set !$.pMaxValueTmp to (-!$.pMinValueTmp(self)) 40734>>>>> set !$.pMinValueTmp to temp# 40735>>>>> set !$.pCorrection to -1 // scale negation 40736>>>>> end 40736>>>>>> 40736>>>>> end_procedure 40737>>>>> 40737>>>>> function StepSize number StepSize# integer OffSet# returns number 40739>>>>> integer itm# max# 40739>>>>> get item_count to max# 40740>>>>> for itm# from 0 to (max#-1-OffSet#) 40746>>>>>> 40746>>>>> if (StepSize#>number_value(self,itm#) and ; StepSize#>>>> loop 40750>>>>>> 40750>>>>> if OffSet# begin 40752>>>>> for itm# from 0 to (max#-1-OffSet#) 40758>>>>>> 40758>>>>> if StepSize# eq (number_value(self,itm#)) ; function_return (number_value(self,itm#+OffSet#)) 40761>>>>> loop 40762>>>>>> 40762>>>>> end 40762>>>>>> 40762>>>>> function_return StepSize# 40763>>>>> end_function 40764>>>>> 40764>>>>> function RoundOff number temp# returns number 40766>>>>> function_return (integer((temp#+0.00005)*10000)/10000.0) 40767>>>>> end_function 40768>>>>> 40768>>>>> function Exp10 integer base# returns number 40770>>>>> integer count# 40770>>>>> number rval# 40770>>>>> move 1 to rval# 40771>>>>> if base# ge 0 begin 40773>>>>> for count# from 1 to base# 40779>>>>>> 40779>>>>> move (rval#*10) to rval# 40780>>>>> loop 40781>>>>>> 40781>>>>> end 40781>>>>>> 40781>>>>> else begin 40782>>>>> for count# from 1 to (0-base#) 40788>>>>>> 40788>>>>> move (rval#/10) to rval# 40789>>>>> loop 40790>>>>>> 40790>>>>> end 40790>>>>>> 40790>>>>> function_return rval# 40791>>>>> end_function 40792>>>>> 40792>>>>> // This procedure acts on the values of !$.pMinValueTmp, !$.pMaxValueTmp 40792>>>>> // and !$.pStepsTmp setting the values of pLowValue and pStepSize. 40792>>>>> // The OffSet# variable is used to make the StepSize function return a 40792>>>>> // larger step size than necessary to cover the range passed to it. This 40792>>>>> // happens when the correction of the LowValue makes the MaxValue go off 40792>>>>> // the top. 40792>>>>> procedure TmpScale 40794>>>>> number StepSize# Range# LowValue# 40794>>>>> integer Base# OffSet# Max# MaxOffSet# 40794>>>>> move 0 to OffSet# 40795>>>>> move (item_count(self)-2) to MaxOffSet# 40796>>>>> repeat 40796>>>>>> 40796>>>>> // Calculate step size: 40796>>>>> move ((!$.pMaxValueTmp(self)-!$.pMinValueTmp(self))/!$.pStepsTmp(self)) to Range# 40797>>>>> if range# gt 0 begin 40799>>>>> move (log(range#)/log(10)) to base# 40800>>>>> move (range#/(Exp10(self,base#))) to StepSize# 40801>>>>> //showln (string(range#)) " " (string(base#)) " " (string(StepSize#)) 40801>>>>> move (RoundOff(self,StepSize#)) to StepSize# 40802>>>>> move (StepSize(self,StepSize#,OffSet#)) to StepSize# 40803>>>>> move (StepSize#*Exp10(self,base#)) to StepSize# 40804>>>>> move (StepSize#*(integer(!$.pMinValueTmp(self)/StepSize#))) to LowValue# 40805>>>>> if (StepSize#*!$.pStepsTmp(self)+LowValue#) ge (!$.pMaxValueTmp(self)) begin 40807>>>>> set pLowValue to (StepSize#*(integer(!$.pMinValueTmp(self)/StepSize#))) 40808>>>>> set pStepSize to StepSize# 40809>>>>> procedure_return 40810>>>>> end 40810>>>>>> 40810>>>>> end 40810>>>>>> 40810>>>>> increment OffSet# 40811>>>>> until OffSet# gt MaxOffSet# 40813>>>>> end_procedure 40814>>>>> 40814>>>>> procedure MaxDecimals 40816>>>>> // This procedure sets the property maximum number of decimals (pDecimals) 40816>>>>> integer count# dec# maxdec# 40816>>>>> number value# 40816>>>>> move 0 to dec# 40817>>>>> move -20 to maxdec# 40818>>>>> for count# from 0 to (pSteps(self)) 40824>>>>>> 40824>>>>> move (pLowValue(self)+(count#*pStepSize(self))) to value# 40825>>>>> if value# ne 0 begin 40827>>>>> move (NumberOfDecs(value#)) to dec# 40828>>>>> if dec# gt maxdec# move dec# to maxdec# 40831>>>>> end 40831>>>>>> 40831>>>>> loop 40832>>>>>> 40832>>>>> set pDecimals to (maxdec# max 0) 40833>>>>> end_procedure 40834>>>>> 40834>>>>> procedure AutoScale 40836>>>>> integer count# best_eff_stps# 40836>>>>> number best_eff# best_eff_tmp# 40836>>>>> set !$.pMinValue to (pMinValue(self)) 40837>>>>> set !$.pMaxValue to (pMaxValue(self)) 40838>>>>> send ApplyAir 40839>>>>> move 0 to best_eff# 40840>>>>> move 0 to best_eff_stps# 40841>>>>> for count# from (pMinSteps(self)) to (pMaxSteps(self)) 40847>>>>>> 40847>>>>> send SetupScaleParams count# 40848>>>>> send TmpScale 40849>>>>> send UndoCorrections 40850>>>>> get ScaleEfficiency to best_eff_tmp# 40851>>>>> if best_eff_tmp# gt best_eff# begin 40853>>>>> move best_eff_tmp# to best_eff# 40854>>>>> move count# to best_eff_stps# 40855>>>>> end 40855>>>>>> 40855>>>>> loop 40856>>>>>> 40856>>>>> send SetupScaleParams best_eff_stps# 40857>>>>> send TmpScale 40858>>>>> send UndoCorrections 40859>>>>> send MaxDecimals 40860>>>>> end_procedure 40861>>>>>end_class // cAutoScaler 40862>>>>> 40862>>>>> 40862>>>>>//#REPLACE GLS_None 1 40862>>>>>//#REPLACE GLS_Major 2 40862>>>>>//#REPLACE GLS_Minor 3 40862>>>>> 40862>>>>>integer gr$xCoordMin 40862>>>>>number gr$xLowValue 40862>>>>>number gr$xFactor 40862>>>>>number gr$xConvValue 40862>>>>>integer gr$yCoordMin 40862>>>>>number gr$yHiValue 40862>>>>>number gr$yFactor 40862>>>>>number gr$yConvValue 40862>>>>>number gr$yConvValueTemp 40862>>>>> 40862>>>>>if dfFalse begin // Do not execution this on program start up. 40864>>>>> vdfgraph$Convert: 40864>>>>> move (gr$yHiValue-gr$yConvValue*gr$yFactor+gr$xCoordMin) to gr$yConvValueTemp 40865>>>>> move (gr$xConvValue-gr$xLowValue*gr$xFactor+gr$yCoordMin) to gr$yConvValue 40866>>>>> move gr$yConvValueTemp to gr$xConvValue 40867>>>>> return 40868>>>>>end 40868>>>>>> 40868>>>>> 40868>>>>>object oGridStyles is an array 40870>>>>> item_property_list 40870>>>>> item_property string psName.i 40870>>>>> item_property integer piColor.i 40870>>>>> item_property integer pixMajorScale.i 40870>>>>> item_property integer pixMinorScale.i 40870>>>>> item_property integer pixMinorDiv.i 40870>>>>> item_property integer piyMajorScale.i 40870>>>>> item_property integer piyMinorScale.i 40870>>>>> item_property integer piyMinorDiv.i 40870>>>>> item_property integer piMajorScaleColor.i 40870>>>>> item_property integer piMinorScaleColor.i 40870>>>>> end_item_property_list #REM 40931 DEFINE FUNCTION PIMINORSCALECOLOR.I INTEGER LIROW RETURNS INTEGER #REM 40936 DEFINE PROCEDURE SET PIMINORSCALECOLOR.I INTEGER LIROW INTEGER VALUE #REM 40941 DEFINE FUNCTION PIMAJORSCALECOLOR.I INTEGER LIROW RETURNS INTEGER #REM 40946 DEFINE PROCEDURE SET PIMAJORSCALECOLOR.I INTEGER LIROW INTEGER VALUE #REM 40951 DEFINE FUNCTION PIYMINORDIV.I INTEGER LIROW RETURNS INTEGER #REM 40956 DEFINE PROCEDURE SET PIYMINORDIV.I INTEGER LIROW INTEGER VALUE #REM 40961 DEFINE FUNCTION PIYMINORSCALE.I INTEGER LIROW RETURNS INTEGER #REM 40966 DEFINE PROCEDURE SET PIYMINORSCALE.I INTEGER LIROW INTEGER VALUE #REM 40971 DEFINE FUNCTION PIYMAJORSCALE.I INTEGER LIROW RETURNS INTEGER #REM 40976 DEFINE PROCEDURE SET PIYMAJORSCALE.I INTEGER LIROW INTEGER VALUE #REM 40981 DEFINE FUNCTION PIXMINORDIV.I INTEGER LIROW RETURNS INTEGER #REM 40986 DEFINE PROCEDURE SET PIXMINORDIV.I INTEGER LIROW INTEGER VALUE #REM 40991 DEFINE FUNCTION PIXMINORSCALE.I INTEGER LIROW RETURNS INTEGER #REM 40996 DEFINE PROCEDURE SET PIXMINORSCALE.I INTEGER LIROW INTEGER VALUE #REM 41001 DEFINE FUNCTION PIXMAJORSCALE.I INTEGER LIROW RETURNS INTEGER #REM 41006 DEFINE PROCEDURE SET PIXMAJORSCALE.I INTEGER LIROW INTEGER VALUE #REM 41011 DEFINE FUNCTION PICOLOR.I INTEGER LIROW RETURNS INTEGER #REM 41016 DEFINE PROCEDURE SET PICOLOR.I INTEGER LIROW INTEGER VALUE #REM 41021 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING #REM 41026 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE 41032>>>>> function iAddGridStyle string name# integer Col# integer xMajScl# integer xMinScl# integer xMinDiv# integer yMajScl# integer yMinScl# integer yMinDiv# integer MajSclCol# integer MinSclCol# returns integer 41035>>>>> integer rval# 41035>>>>> get row_count to rval# 41036>>>>> set psName.i item rval# to name# 41037>>>>> set piColor.i item rval# to Col# 41038>>>>> set pixMajorScale.i item rval# to xMajScl# 41039>>>>> set pixMinorScale.i item rval# to xMinScl# 41040>>>>> set pixMinorDiv.i item rval# to xMinDiv# 41041>>>>> set piyMajorScale.i item rval# to yMajScl# 41042>>>>> set piyMinorScale.i item rval# to yMinScl# 41043>>>>> set piyMinorDiv.i item rval# to yMinDiv# 41044>>>>> set piMajorScaleColor.i item rval# to MajSclCol# 41045>>>>> set piMinorScaleColor.i item rval# to MinSclCol# 41046>>>>> function_return rval# 41047>>>>> end_function 41048>>>>> procedure ApplyGridStyle integer row# integer obj# 41051>>>>> set pColor of obj# to (piColor.i(self,row#)) // Backgnd color 41052>>>>> set pxMajorScale of obj# to (pixMajorScale.i(self,row#)) // 41053>>>>> set pxMinorScale of obj# to (pixMinorScale.i(self,row#)) // 41054>>>>> set pxMinorDiv of obj# to (pixMinorDiv.i(self,row#)) // Number of minors per major 41055>>>>> set pyMajorScale of obj# to (piyMajorScale.i(self,row#)) // 41056>>>>> set pyMinorScale of obj# to (piyMinorScale.i(self,row#)) // 41057>>>>> set pyMinorDiv of obj# to (piyMinorDiv.i(self,row#)) // Number of minors per major 41058>>>>> set pMajorScaleColor of obj# to (piMajorScaleColor.i(self,row#)) // Color (x and y) 41059>>>>> set pMinorScaleColor of obj# to (piMinorScaleColor.i(self,row#)) // Color (x and y) 41060>>>>> end_procedure 41061>>>>> procedure AddDefaults 41064>>>>> integer grb# 41064>>>>> DEFINE GS_DEFAULT FOR 0 41064>>>>> get iAddGridStyle "Default" -1 GLS_Line GLS_Dot 2 GLS_Line GLS_Dot 2 clDkGray clGray to grb# 41065>>>>> DEFINE GS_BARCHART1 FOR 1 41065>>>>> get iAddGridStyle "Barchart 1" clWhite GLS_None GLS_None 2 GLS_Line GLS_Dot 1 clBlack clGray to grb# 41066>>>>> DEFINE GS_BARCHART_YMARKERS_ONLY FOR 2 41066>>>>> get iAddGridStyle "Y-markers only" clWhite GLS_None GLS_None 2 GLS_Line GLS_None 1 clBlack clGray to grb# 41067>>>>> end_procedure 41068>>>>> send AddDefaults 41069>>>>>end_object // oGridStyles 41070>>>>> 41070>>>>>Class cCoordinateSystem is an array 41071>>>>> procedure construct_object 41073>>>>> forward send construct_object 41075>>>>> set delegation_mode to delegate_to_parent 41076>>>>> 41076>>>>> // Properties regarding the grid: 41076>>>>> property integer pxAreaLoc public 2000 // These values indicates 41077>>>>> property integer pyAreaLoc public 2000 // inside the graph area. 41078>>>>> property integer pxAreaSiz public 6000 // the area of the graph 41079>>>>> property integer pyAreaSiz public 7000 // 41080>>>>> 41080>>>>> property integer pColor public -1 // Transparent 41081>>>>> property integer pxMajorScale public GLS_Line // 41082>>>>> property integer pxMinorScale public GLS_Dot // 41083>>>>> property integer pxMinorDiv public 2 // number of minors per major 41084>>>>> property integer pyMajorScale public GLS_Line // 41085>>>>> property integer pyMinorScale public GLS_Dot // 41086>>>>> property integer pyMinorDiv public 2 // number of minors per major 41087>>>>> property integer pMinorScaleColor public clGray // color (x and y) 41088>>>>> property integer pMajorScaleColor public clDkGray // color (x and y) 41089>>>>> 41089>>>>> // ******************************************************************** 41089>>>>> // *** Properties regarding scaling *** 41089>>>>> // ******************************************************************** 41089>>>>> 41089>>>>> property integer pxAutoScale public 0 // automatic auto scale (x)? 41090>>>>> property number pxMinValue public 0 // minimum value 41091>>>>> property number pxMaxValue public 100 // maximum value 41092>>>>> property integer pxZeroBased public 0 // is the scale zero based? 41093>>>>> property number pxAirPct public 0 // default: 0% air 41094>>>>> property integer pxMinSteps public 8 // lowest acceptable number of steps 41095>>>>> property integer pxMaxSteps public 11 // highest acceptable number of steps 41096>>>>> property number pxLowValue public 0 // lower value 41097>>>>> property integer pxSteps public 10 // number of steps 41098>>>>> property number pxStepSize public 10 // step size 41099>>>>> property integer pxDecimals public 0 // max number of decimals 41100>>>>> 41100>>>>> property integer pyAutoScale public 1 // automatic auto scale (y)? 41101>>>>> property number pyMinValue public 0 // minimum value 41102>>>>> property number pyMaxValue public 100 // maximum value 41103>>>>> property integer pyZeroBased public 1 // is the scale zero based? 41104>>>>> property number pyAirPct public 5 // default: 5% air 41105>>>>> property integer pyMinSteps public 8 // lowest acceptable number of steps 41106>>>>> property integer pyMaxSteps public 11 // highest acceptable number of steps 41107>>>>> property number pyLowValue public 0 // lower value 41108>>>>> property integer pySteps public 10 // number of steps 41109>>>>> property number pyStepSize public 10 // step size 41110>>>>> property integer pyDecimals public 0 // max number of decimals 41111>>>>> 41111>>>>> object AutoScaler is an cAutoScaler 41113>>>>> end_object 41114>>>>> 41114>>>>> property integer pBarChartState public 0 41115>>>>> property integer pxAutoAxisText public AT_AUTO 41116>>>>> property integer pyAutoAxisText public AT_AUTO 41117>>>>> 41117>>>>> property string pTitleX public "" 41118>>>>> property string pTitleY public "" 41119>>>>> 41119>>>>> object xyObjects is an array 41121>>>>> end_object 41122>>>>> 41122>>>>> object oAxisTexts is an array 41124>>>>> end_object 41125>>>>> 41125>>>>> property integer pxTextStockFont public ANSI_VAR_FONT 41126>>>>> property string pxTextTTFontName private "Arial" 41127>>>>> property integer pxTextTTFontSize public 14 41128>>>>> property integer pxTextTTFontAngle public 0 41129>>>>> property integer pxTextTTFontBold public 0 41130>>>>> property integer pxTextTTFontItalic public 0 41131>>>>> property integer pxTextColor public clBlack 41132>>>>> property integer pxTextAlign public 0 41133>>>>> property integer pxTextOffSet public 50 41134>>>>> property integer pyTextStockFont public ANSI_VAR_FONT 41135>>>>> property string pyTextTTFontName private "Arial" 41136>>>>> property integer pyTextTTFontSize public 14 41137>>>>> property integer pyTextTTFontAngle public 0 41138>>>>> property integer pyTextTTFontBold public 0 41139>>>>> property integer pyTextTTFontItalic public 0 41140>>>>> property integer pyTextColor public clBlack 41141>>>>> property integer pyTextAlign public 0 41142>>>>> property integer pyTextOffSet public 50 41143>>>>> end_procedure 41144>>>>> 41144>>>>> procedure set pxTextTTFontName string str# 41146>>>>> set !$.pxTextTTFontName to str# 41147>>>>> set pxTextStockFont to 0 41148>>>>> end_procedure 41149>>>>> function pxTextTTFontName returns string 41151>>>>> if (pxTextStockFont(self)) function_return 0 41154>>>>> function_return (!$.pxTextTTFontName(self)) 41155>>>>> end_function 41156>>>>> procedure set pyTextTTFontName string str# 41158>>>>> set !$.pyTextTTFontName to str# 41159>>>>> set pyTextStockFont to 0 41160>>>>> end_procedure 41161>>>>> function pyTextTTFontName returns string 41163>>>>> if (pyTextStockFont(self)) function_return 0 41166>>>>> function_return (!$.pyTextTTFontName(self)) 41167>>>>> end_function 41168>>>>> 41168>>>>> procedure set area_location integer x# integer y# 41170>>>>> set pxAreaLoc to x# 41171>>>>> set pyAreaLoc to y# 41172>>>>> end_procedure 41173>>>>> procedure set area_size integer x# integer y# 41175>>>>> set pxAreaSiz to x# 41176>>>>> set pyAreaSiz to y# 41177>>>>> end_procedure 41178>>>>> 41178>>>>> procedure ApplyGridStyle integer no# 41180>>>>> integer self# 41180>>>>> move self to self# 41181>>>>> send ApplyGridStyle to (oGridStyles(self)) no# self# 41182>>>>> end_procedure 41183>>>>> 41183>>>>> procedure Set AxisTextX integer column# string str# 41185>>>>> set pxAutoAxisText to AT_TEXT 41186>>>>> set value of (oAxisTexts(self)) item (column#*2) to str# 41187>>>>> end_procedure 41188>>>>> procedure Set AxisTextY integer column# string str# 41190>>>>> set pyAutoAxisText to AT_TEXT 41191>>>>> set value of (oAxisTexts(self)) item (column#*2+1) to str# 41192>>>>> end_procedure 41193>>>>> function AxisTextX integer column# returns string 41195>>>>> function_return (value(oAxisTexts(self),column#*2)) 41196>>>>> end_function 41197>>>>> function AxisTextY integer column# returns string 41199>>>>> function_return (value(oAxisTexts(self),column#*2+1)) 41200>>>>> end_function 41201>>>>> procedure DeleteAxisText 41203>>>>> send delete_data to (oAxisTexts(self)) 41204>>>>> end_procedure 41205>>>>> 41205>>>>> procedure register_xy_object integer obj# // cCoordinateSystem 41207>>>>> integer arr# 41207>>>>> move (xyObjects(self)) to arr# 41208>>>>> set value of arr# item (item_count(arr#)) to obj# 41209>>>>> end_procedure 41210>>>>> 41210>>>>> procedure end_construct_object 41212>>>>> integer self# 41212>>>>> move self to self# 41213>>>>> forward send end_construct_object 41215>>>>> delegate send register_xy_object self# 41217>>>>> end_procedure 41218>>>>> 41218>>>>> procedure DrawGraphFrame 41220>>>>> integer x1# y1# x2# y2# 41220>>>>> move (pxAreaLoc(self)) to x1# 41221>>>>> move (pyAreaLoc(self)) to y1# 41222>>>>> move (x1#+pxAreaSiz(self)) to x2# 41223>>>>> move (y1#+pyAreaSiz(self)) to y2# 41224>>>>> delegate send AddLineMvTo x1# y1# 41226>>>>> delegate send AddLineGoTo x1# y2# 41228>>>>> delegate send AddLineGoTo x2# y2# 41230>>>>> delegate send AddLineGoTo x2# y1# 41232>>>>> delegate send AddLineGoTo x1# y1# 41234>>>>> end_procedure 41235>>>>> 41235>>>>> 41235>>>>> procedure MakeAreaTrackable integer type# number x1# number y1# number x2# number y2# integer trackobjid# 41237>>>>> move x1# to gr$xConvValue 41238>>>>> move y1# to gr$yConvValue 41239>>>>> gosub vdfgraph$Convert 41240>>>>>> 41240>>>>> move gr$xConvValue to x1# 41241>>>>> move gr$yConvValue to y1# 41242>>>>> move x2# to gr$xConvValue 41243>>>>> move y2# to gr$yConvValue 41244>>>>> gosub vdfgraph$Convert 41245>>>>>> 41245>>>>> delegate send MakeAreaTrackable type# x1# y1# gr$xConvValue gr$yConvValue trackobjid# 41247>>>>> end_procedure 41248>>>>> procedure AddRectangleTrack number x1# number y1# number x2# number y2# integer cb_val# 41250>>>>> send AddRectangle x1# y1# x2# y2# 41251>>>>> send MakeAreaTrackable GR_TRACK_RECTANGLE x1# y1# x2# y2# cb_val# 41252>>>>> end_procedure 41253>>>>> procedure AddRectangle number x1# number y1# number x2# number y2# 41255>>>>> delegate_send$Coord2 AddRectangle 41265>>>>> end_procedure 41266>>>>> procedure AddEllipse number x1# number y1# number x2# number y2# 41268>>>>> delegate_send$Coord2 AddEllipse 41278>>>>> end_procedure 41279>>>>> procedure AddRoundRect number x1# number y1# number x2# number y2# 41281>>>>> delegate_send$Coord2 AddRoundRect 41291>>>>> end_procedure 41292>>>>> procedure AddLine number x1# number y1# number x2# number y2# 41294>>>>> graph$showln ("Line: "+string(x1#)+","+string(y1#)+" to "+string(x2#)+","+string(y2#)) 41294>>>>> delegate_send$Coord2 AddLine 41304>>>>> end_procedure 41305>>>>> procedure AddLineMvTo number x1# number y1# 41307>>>>> delegate_send$Coord1 AddLineMvTo 41312>>>>> end_procedure 41313>>>>> procedure AddLineGoTo number x1# number y1# 41315>>>>> delegate_send$Coord1 AddLineGoTo 41320>>>>> end_procedure 41321>>>>> procedure AddDot number x1# number y1# 41323>>>>> delegate_send$Coord1 AddDot 41328>>>>> end_procedure 41329>>>>> procedure AddText string str# integer x1# integer y1# 41331>>>>> move x1# to gr$xConvValue 41332>>>>> move y1# to gr$yConvValue 41333>>>>> gosub vdfgraph$Convert 41334>>>>>> 41334>>>>> delegate send AddText str# gr$xConvValue gr$yConvValue 41336>>>>> end_procedure 41337>>>>> procedure AddPolyPoint integer x1# integer y1# 41339>>>>> delegate_send$Coord1 AddPolyPoint 41344>>>>> end_procedure 41345>>>>> function nxHighValue returns number 41347>>>>> function_return (pxSteps(self)*pxStepSize(self)+pxLowValue(self)) 41348>>>>> end_function 41349>>>>> function nyHighValue returns number 41351>>>>> function_return (pySteps(self)*pyStepSize(self)+pyLowValue(self)) 41352>>>>> end_function 41353>>>>> function nxRange returns number 41355>>>>> function_return (pxSteps(self)*pxStepSize(self)) 41356>>>>> end_function 41357>>>>> function nyRange returns number 41359>>>>> function_return (pySteps(self)*pyStepSize(self)) 41360>>>>> end_function 41361>>>>> 41361>>>>> procedure InitConversionGlobals // This represents a change of coordinate system 41363>>>>> move (pxLowValue(self)) to gr$xLowValue 41364>>>>> move (pyStepSize(self)*pySteps(self)+pyLowValue(self)) to gr$yHiValue 41365>>>>> move (pyAreaSiz(self)/(pxSteps(self)*pxStepSize(self))) to gr$xFactor 41366>>>>> move (pxAreaSiz(self)/(pySteps(self)*pyStepSize(self))) to gr$yFactor 41367>>>>> move (pxAreaLoc(self)) to gr$xCoordMin 41368>>>>> move (pyAreaLoc(self)) to gr$yCoordMin 41369>>>>> graph$showln (string(gr$xLowValue)) 41369>>>>> graph$showln (string(gr$yHiValue)) 41369>>>>> graph$showln (string(gr$xFactor)) 41369>>>>> graph$showln (string(gr$yFactor)) 41369>>>>> graph$showln (string(gr$xCoordMin)) 41369>>>>> graph$showln (string(gr$yCoordMin)) 41369>>>>> end_procedure 41370>>>>> 41370>>>>> procedure BroadcastNotifyAutoScale 41372>>>>> integer arr# itm# max# obj# 41372>>>>> move (xyObjects(self)) to arr# 41373>>>>> get item_count of arr# to max# 41374>>>>> for itm# from 0 to (max#-1) 41380>>>>>> 41380>>>>> send NotifyAutoScale to (value(arr#,itm#)) 41381>>>>> loop 41382>>>>>> 41382>>>>> end_procedure 41383>>>>> 41383>>>>> procedure AutoScale 41385>>>>> integer obj# 41385>>>>> send BroadcastNotifyAutoScale 41386>>>>> move (AutoScaler(self)) to obj# 41387>>>>> if (pxAutoScale(self)) begin 41389>>>>> set pMinValue of obj# to (pxMinValue(self)) 41390>>>>> set pMaxValue of obj# to (pxMaxValue(self)) 41391>>>>> set pZeroBased of obj# to (pxZeroBased(self)) 41392>>>>> set pAirPct of obj# to (pxAirPct(self)) 41393>>>>> set pMinSteps of obj# to (pxMinSteps(self)) 41394>>>>> set pMaxSteps of obj# to (pxMaxSteps(self)) 41395>>>>> send AutoScale to obj# 41396>>>>> set pxLowValue to (pLowValue(obj#)) 41397>>>>> set pxStepSize to (pStepSize(obj#)) 41398>>>>> set pxSteps to (pSteps(obj#)) 41399>>>>> set pxDecimals to (pDecimals(obj#)) 41400>>>>> end 41400>>>>>> 41400>>>>> if (pyAutoScale(self)) begin 41402>>>>> set pMinValue of obj# to (pyMinValue(self)) 41403>>>>> set pMaxValue of obj# to (pyMaxValue(self)) 41404>>>>> set pZeroBased of obj# to (pyZeroBased(self)) 41405>>>>> set pAirPct of obj# to (pyAirPct(self)) 41406>>>>> set pMinSteps of obj# to (pyMinSteps(self)) 41407>>>>> set pMaxSteps of obj# to (pyMaxSteps(self)) 41408>>>>> send AutoScale to obj# 41409>>>>> set pyLowValue to (pLowValue(obj#)) 41410>>>>> set pyStepSize to (pStepSize(obj#)) 41411>>>>> set pySteps to (pSteps(obj#)) 41412>>>>> set pyDecimals to (pDecimals(obj#)) 41413>>>>> end 41413>>>>>> 41413>>>>> end_procedure 41414>>>>> procedure DrawGridLines 41416>>>>> integer MajorStep# MinorStep# 41416>>>>> integer MajorStepMax# MinorStepMax# 41416>>>>> integer MajorSteps# MinorSteps# 41416>>>>> number MajorLowValue# MinorLowValue# 41416>>>>> number MajorStepSize# MinorStepSize# 41416>>>>> number MaxValue# MinValue# 41416>>>>> 41416>>>>> send SetPenWidth 1 41417>>>>> 41417>>>>> if (pColor(self)<>-1) begin 41419>>>>> send SetFillColor (pColor(self)) 41420>>>>> send SetPenColor (pColor(self)) 41421>>>>> delegate send AddRectangle (pxAreaLoc(self)) (pyAreaLoc(self)) (pxAreaLoc(self)+pxAreaSiz(self)) (pyAreaLoc(self)+pyAreaSiz(self)) 41423>>>>> end 41423>>>>>> 41423>>>>> 41423>>>>> send SetPenColor (pMinorScaleColor(self)) 41424>>>>> // If minor grids, they must be drawn first: 41424>>>>> if (pxMinorScale(self)<>GLS_None) begin 41426>>>>> send SetPenStyle (pxMinorScale(self)) 41427>>>>> get pxSteps to MajorStepMax# 41428>>>>> get pxLowValue to MajorLowValue# 41429>>>>> get pxStepSize to MajorStepSize# 41430>>>>> get pxMinorDiv to MinorStepMax# 41431>>>>> move (MajorStepSize#/MinorStepMax#) to MinorStepSize# 41432>>>>> get pyLowValue to MinValue# 41433>>>>> get nyHighValue to MaxValue# 41434>>>>> for MajorStep# from 0 to (MajorStepMax#-1) 41440>>>>>> 41440>>>>> move (MajorStep#*MajorStepSize#+MajorLowValue#) to MinorLowValue# 41441>>>>> for MinorStep# from 1 to (MinorStepMax#-1) 41447>>>>>> 41447>>>>> send AddLine (MinorStep#*MinorStepSize#+MinorLowValue#) MinValue# (MinorStep#*MinorStepSize#+MinorLowValue#) MaxValue# 41448>>>>> loop 41449>>>>>> 41449>>>>> loop 41450>>>>>> 41450>>>>> end 41450>>>>>> 41450>>>>> if (pyMinorScale(self)<>GLS_None) begin 41452>>>>> send SetPenStyle (pyMinorScale(self)) 41453>>>>> get pySteps to MajorStepMax# 41454>>>>> get pyLowValue to MajorLowValue# 41455>>>>> get pyStepSize to MajorStepSize# 41456>>>>> get pyMinorDiv to MinorStepMax# 41457>>>>> move (MajorStepSize#/MinorStepMax#) to MinorStepSize# 41458>>>>> get pxLowValue to MinValue# 41459>>>>> get nxHighValue to MaxValue# 41460>>>>> for MajorStep# from 0 to (MajorStepMax#-1) 41466>>>>>> 41466>>>>> move (MajorStep#*MajorStepSize#+MajorLowValue#) to MinorLowValue# 41467>>>>> for MinorStep# from 1 to (MinorStepMax#-1) 41473>>>>>> 41473>>>>> send AddLine MinValue# (MinorStep#*MinorStepSize#+MinorLowValue#) MaxValue# (MinorStep#*MinorStepSize#+MinorLowValue#) 41474>>>>> loop 41475>>>>>> 41475>>>>> loop 41476>>>>>> 41476>>>>> end 41476>>>>>> 41476>>>>> 41476>>>>> // Then we draw the major grid lines: 41476>>>>> send SetPenColor (pMajorScaleColor(self)) 41477>>>>> if (pxMajorScale(self)<>GLS_None) begin 41479>>>>> get pxSteps to MajorStepMax# 41480>>>>> get pxLowValue to MajorLowValue# 41481>>>>> get pxStepSize to MajorStepSize# 41482>>>>> get pyLowValue to MinValue# 41483>>>>> get nyHighValue to MaxValue# 41484>>>>> 41484>>>>> if (pxMajorScale(self)) eq GLS_Base begin 41486>>>>> send SetPenStyle PS_Solid 41487>>>>> move 0 to MajorStepMax# 41488>>>>> end 41488>>>>>> 41488>>>>> else send SetPenStyle (pxMajorScale(self)) 41490>>>>> 41490>>>>> for MajorStep# from 0 to MajorStepMax# 41496>>>>>> 41496>>>>> send AddLine (MajorStep#*MajorStepSize#+MajorLowValue#) MinValue# (MajorStep#*MajorStepSize#+MajorLowValue#) MaxValue# 41497>>>>> loop 41498>>>>>> 41498>>>>> end 41498>>>>>> 41498>>>>> if (pyMajorScale(self)<>GLS_None) begin 41500>>>>> get pySteps to MajorStepMax# 41501>>>>> get pyLowValue to MajorLowValue# 41502>>>>> get pyStepSize to MajorStepSize# 41503>>>>> get pxLowValue to MinValue# 41504>>>>> get nxHighValue to MaxValue# 41505>>>>> 41505>>>>> if (pyMajorScale(self)) eq GLS_Base begin 41507>>>>> send SetPenStyle PS_Solid 41508>>>>> move 0 to MajorStepMax# 41509>>>>> end 41509>>>>>> 41509>>>>> else send SetPenStyle (pyMajorScale(self)) 41511>>>>> 41511>>>>> for MajorStep# from 0 to MajorStepMax# 41517>>>>>> 41517>>>>> send AddLine MinValue# (MajorStep#*MajorStepSize#+MajorLowValue#) MaxValue# (MajorStep#*MajorStepSize#+MajorLowValue#) 41518>>>>> loop 41519>>>>>> 41519>>>>> end 41519>>>>>> 41519>>>>> end_procedure 41520>>>>> 41520>>>>> procedure DrawAxisTextX integer stp# string str# 41522>>>>> delegate send AddText str# (pxAreaLoc(self)+pxAreaSiz(self)+pxTextOffSet(self)) (stp#+if(pBarChartState(self),0.5,0.0)*pyAreaSiz(self)/pxSteps(self)+pyAreaLoc(self)) 41524>>>>> end_procedure 41525>>>>> procedure DrawAxisTextY integer stp# string str# 41527>>>>> delegate send AddText str# (-stp#*pxAreaSiz(self)/pySteps(self)+pxAreaLoc(self)+pxAreaSiz(self)) (pyAreaLoc(self)-pyTextOffSet(self)) 41529>>>>> end_procedure 41530>>>>> 41530>>>>> procedure DrawAxisTextsSetupX 41532>>>>> integer angle# 41532>>>>> send SetTextColor (pxTextColor(self)) 41533>>>>> if (pxTextStockFont(self)) begin 41535>>>>> send SetStockFont (pxTextStockFont(self)) 41536>>>>> move 0 to angle# 41537>>>>> end 41537>>>>>> 41537>>>>> else begin 41538>>>>> get pxTextTTFontAngle to angle# 41539>>>>> send SetTTFont (pxTextTTFontName(self)) (pxTextTTFontSize(self)) angle# (pxTextTTFontBold(self)) (pxTextTTFontItalic(self)) 0 41540>>>>> end 41540>>>>>> 41540>>>>> if angle# eq 0 send SetTextAlign (VDFGR_TA_CENTER+VDFGR_TA_TOP) 41543>>>>> else begin 41544>>>>> if angle# ge 1800 send SetTextAlign (VDFGR_TA_LEFT +VDFGR_TA_BOTTOM) 41547>>>>> else begin 41548>>>>> if angle# gt 900 send SetTextAlign (VDFGR_TA_RIGHT +VDFGR_TA_BOTTOM) 41551>>>>> else send SetTextAlign (VDFGR_TA_RIGHT +VDFGR_TA_TOP) 41553>>>>> end 41553>>>>>> 41553>>>>> end 41553>>>>>> 41553>>>>> end_procedure 41554>>>>> procedure DrawAxisTextsSetupY 41556>>>>> integer angle# 41556>>>>> send SetTextColor (pyTextColor(self)) 41557>>>>> if (pyTextStockFont(self)) begin 41559>>>>> send SetStockFont (pyTextStockFont(self)) 41560>>>>> move 0 to angle# 41561>>>>> end 41561>>>>>> 41561>>>>> else begin 41562>>>>> get pyTextTTFontAngle to angle# 41563>>>>> send SetTTFont (pyTextTTFontName(self)) (pyTextTTFontSize(self)) angle# (pyTextTTFontBold(self)) (pyTextTTFontItalic(self)) 0 41564>>>>> end 41564>>>>>> 41564>>>>> if angle# eq 0 send SetTextAlign (VDFGR_TA_RIGHT+VDFGR_TA_VCENTER) 41567>>>>> else begin 41568>>>>> if angle# ge 1800 send SetTextAlign (VDFGR_TA_LEFT+VDFGR_TA_VCENTER) 41571>>>>> else send SetTextAlign (VDFGR_TA_RIGHT +VDFGR_TA_TOP) 41573>>>>> end 41573>>>>>> 41573>>>>> end_procedure 41574>>>>> 41574>>>>> procedure DrawAxisTexts 41576>>>>> integer decs# stp# self# 41576>>>>> number ssz# low# max# 41576>>>>> string title# 41576>>>>> if (pxAutoAxisText(self)<>AT_NONE) begin 41578>>>>> send DrawAxisTextsSetupX 41579>>>>> get pxDecimals to decs# 41580>>>>> get pxSteps to max# 41581>>>>> if (pBarChartState(self)) decrement max# 41584>>>>> get pxStepSize to ssz# 41585>>>>> get pxLowValue to low# 41586>>>>> if (pxAutoAxisText(self)=AT_AUTO) begin 41588>>>>> for stp# from 0 to max# 41594>>>>>> 41594>>>>> send DrawAxisTextX stp# (NumToStr(stp#*ssz#+low#,decs#)) 41595>>>>> loop 41596>>>>>> 41596>>>>> end 41596>>>>>> 41596>>>>> else begin // AT_TEXT 41597>>>>> for stp# from 0 to max# 41603>>>>>> 41603>>>>> send DrawAxisTextX stp# (AxisTextX(self,stp#)) 41604>>>>> loop 41605>>>>>> 41605>>>>> end 41605>>>>>> 41605>>>>> end 41605>>>>>> 41605>>>>> if (pyAutoAxisText(self)<>AT_NONE) begin 41607>>>>> send DrawAxisTextsSetupY 41608>>>>> get pyDecimals to decs# 41609>>>>> get pySteps to max# 41610>>>>> get pyStepSize to ssz# 41611>>>>> get pyLowValue to low# 41612>>>>> if (pyAutoAxisText(self)=AT_AUTO) begin 41614>>>>> for stp# from 0 to max# 41620>>>>>> 41620>>>>> send DrawAxisTextY stp# (NumToStr(stp#*ssz#+low#,decs#)) 41621>>>>> loop 41622>>>>>> 41622>>>>> end 41622>>>>>> 41622>>>>> else begin 41623>>>>> for stp# from 0 to max# 41629>>>>>> 41629>>>>> send DrawAxisTextY stp# (AxisTextY(self,stp#)) 41630>>>>> loop 41631>>>>>> 41631>>>>> end 41631>>>>>> 41631>>>>> end 41631>>>>>> 41631>>>>> get pTitleX to title# 41632>>>>> if title# ne "" begin 41634>>>>> move self to self# 41635>>>>> send SetTextAlign (VDFGR_TA_CENTER+VDFGR_TA_TOP) 41636>>>>> send SetTextColor clBlack 41637>>>>> send SetStockFont ANSI_VAR_FONT 41638>>>>>// send AddText title# (nxRange(self#)*0.01+nxHighValue(self#)) (pyLowValue(self#)) 41638>>>>> send AddText title# (nxHighValue(self#)-(nxRange(self#)/2.0)) (pyLowValue(self#)-(nyRange(self#)/10.0)) 41639>>>>> end 41639>>>>>> 41639>>>>> get pTitleY to title# 41640>>>>> if title# ne "" begin 41642>>>>> move self to self# 41643>>>>> send SetTextAlign (VDFGR_TA_CENTER+VDFGR_TA_BOTTOM) 41644>>>>> send SetTextColor clBlack 41645>>>>> send SetStockFont ANSI_VAR_FONT 41646>>>>> send AddText title# (pxLowValue(self#)) (nyRange(self#)*0.05+nyHighValue(self#)) 41647>>>>>// send AddText title# (pxLowValue(self#)) (nyRange(self#)*0.12+nyHighValue(self#)) 41647>>>>> end 41647>>>>>> 41647>>>>> end_procedure 41648>>>>> procedure DrawGraph 41650>>>>> integer arr# itm# max# obj# 41650>>>>> move (xyObjects(self)) to arr# 41651>>>>> get item_count of arr# to max# 41652>>>>> for itm# from 0 to (max#-1) 41658>>>>>> 41658>>>>> send Draw_Data to (value(arr#,itm#)) 41659>>>>> loop 41660>>>>>> 41660>>>>> end_procedure 41661>>>>> procedure Draw_Data // cCoordinateSystem 41663>>>>> send AutoScale 41664>>>>> send InitConversionGlobals 41665>>>>> send DrawGridLines 41666>>>>> send DrawAxisTexts 41667>>>>> send DrawGraph 41668>>>>> end_procedure 41669>>>>>end_class // cCoordinateSystem 41670>>>>> 41670>>>>>class cBoxSignatures is a cArray 41671>>>>> procedure construct_object 41673>>>>> forward send construct_object 41675>>>>> property integer pDeltaRow public 900 41676>>>>> property integer pDeltaCol public 2000 41677>>>>> property integer pLocRow public 1800 41678>>>>> property integer pLocCol public 500 41679>>>>> property integer pBoxSizeR public 800 41680>>>>> property integer pBoxSizeC public 400 41681>>>>> property integer pMaxRow public 5 41682>>>>> property integer pFrameCol public clWhite 41683>>>>> property integer pBackCol public -1 // Transparent 41684>>>>> end_procedure 41685>>>>> item_property_list 41685>>>>> item_property string psLabel.i 41685>>>>> item_property integer piFrameColor.i 41685>>>>> item_property integer piBackColor.i 41685>>>>> item_property integer piHatchStyle.i 41685>>>>> item_property integer piHatchColor.i 41685>>>>> end_item_property_list cBoxSignatures #REM 41726 DEFINE FUNCTION PIHATCHCOLOR.I INTEGER LIROW RETURNS INTEGER #REM 41730 DEFINE PROCEDURE SET PIHATCHCOLOR.I INTEGER LIROW INTEGER VALUE #REM 41734 DEFINE FUNCTION PIHATCHSTYLE.I INTEGER LIROW RETURNS INTEGER #REM 41738 DEFINE PROCEDURE SET PIHATCHSTYLE.I INTEGER LIROW INTEGER VALUE #REM 41742 DEFINE FUNCTION PIBACKCOLOR.I INTEGER LIROW RETURNS INTEGER #REM 41746 DEFINE PROCEDURE SET PIBACKCOLOR.I INTEGER LIROW INTEGER VALUE #REM 41750 DEFINE FUNCTION PIFRAMECOLOR.I INTEGER LIROW RETURNS INTEGER #REM 41754 DEFINE PROCEDURE SET PIFRAMECOLOR.I INTEGER LIROW INTEGER VALUE #REM 41758 DEFINE FUNCTION PSLABEL.I INTEGER LIROW RETURNS STRING #REM 41762 DEFINE PROCEDURE SET PSLABEL.I INTEGER LIROW STRING VALUE 41767>>>>> procedure add_signature string str# integer color_frame# integer color_back# integer hatch# integer color_hatch# 41769>>>>> integer row# 41769>>>>> get row_count to row# 41770>>>>> set psLabel.i item row# to str# 41771>>>>> set piFrameColor.i item row# to color_frame# 41772>>>>> set piBackColor.i item row# to color_back# 41773>>>>> set piHatchStyle.i item row# to hatch# 41774>>>>> set piHatchColor.i item row# to color_hatch# 41775>>>>> end_procedure 41776>>>>> procedure draw_frame 41778>>>>> integer itm# max# row_offset# col_offset# rows# columns# 41778>>>>> integer x1# y1# x2# y2# 41778>>>>> move (row_count(self)) to max# 41779>>>>> 41779>>>>> move (max#/pMaxRow(self)+1) to columns# 41780>>>>> move (pMaxRow(self) min max#) to rows# 41781>>>>> move (pLocRow(self)) to x1# 41782>>>>> move (pLocCol(self)) to y1# 41783>>>>> move (rows#*pDeltaRow(self)+x1#) to x2# 41784>>>>> move (columns#*pDeltaCol(self)+y1#) to y2# 41785>>>>> if (pBackCol(self)<>-1) begin 41787>>>>> send SetFillColor (pBackCol(self)) 41788>>>>> send SetPenColor (pFrameCol(self)) 41789>>>>> send AddRectangle x1# y1# x2# y2# 41790>>>>> end 41790>>>>>> 41790>>>>> end_procedure 41791>>>>> procedure Draw_Data // cBoxSignatures 41793>>>>> integer row# max# row_offset# col_offset# 41793>>>>> integer x1# y1# x2# y2# base# LocRow# LocCol# 41793>>>>> integer DeltaRow# DeltaCol# BoxSizeR# BoxSizeC# MaxRow# 41793>>>>> integer color_frame# color_back# hatch# color_hatch# 41793>>>>> string str# 41793>>>>> 41793>>>>> send draw_frame 41794>>>>> 41794>>>>> get pDeltaRow to DeltaRow# 41795>>>>> get pDeltaCol to DeltaCol# 41796>>>>> get pBoxSizeR to BoxSizeR# 41797>>>>> get pBoxSizeC to BoxSizeC# 41798>>>>> get pMaxRow to MaxRow# 41799>>>>> get pLocRow to LocRow# 41800>>>>> get pLocCol to LocCol# 41801>>>>> 41801>>>>> get row_count to max# 41802>>>>> move 0 to row_offset# 41803>>>>> move 0 to col_offset# 41804>>>>> for row# from 0 to (max#-1) 41810>>>>>> 41810>>>>> if row_offset# ge MaxRow# begin 41812>>>>> move 0 to row_offset# 41813>>>>> increment col_offset# 41814>>>>> end 41814>>>>>> 41814>>>>> move (row_offset#*DeltaRow#+LocRow#) to x1# 41815>>>>> move (col_offset#*DeltaCol#+LocCol#) to y1# 41816>>>>> move (x1#+BoxSizeR#) to x2# 41817>>>>> move (y1#+BoxSizeC#) to y2# 41818>>>>> 41818>>>>> get psLabel.i item row# to str# 41819>>>>> if (str#<>"") begin 41821>>>>> get piFrameColor.i item row# to color_frame# 41822>>>>> get piBackColor.i item row# to color_back# 41823>>>>> get piHatchStyle.i item row# to hatch# 41824>>>>> get piHatchColor.i item row# to color_hatch# 41825>>>>> 41825>>>>> send SetFillColor color_back# 41826>>>>> if (color_frame#>-1) begin 41828>>>>> send SetPenColor color_frame# 41829>>>>> send AddRectangle x1# y1# x2# y2# 41830>>>>> end 41830>>>>>> 41830>>>>> send SetTextAlign (VDFGR_TA_LEFT+VDFGR_TA_TOP) 41831>>>>> send SetTextColor clBlack 41832>>>>> send SetStockFont ANSI_VAR_FONT 41833>>>>> send AddText str# x1# (y1#+BoxSizeC#+100) 41834>>>>> end 41834>>>>>> 41834>>>>> 41834>>>>> increment row_offset# 41835>>>>> loop 41836>>>>>> 41836>>>>> end_procedure 41837>>>>>end_class // cBoxSignatures 41838>>>>> 41838>>>>> 41838>>>>>// This class is designed to hold the data for a bar chart. Data may by 41838>>>>>// stored, recalled and summed using these messages: 41838>>>>>// 41838>>>>>// Procedure Sto_Data 41838>>>>>// Function nRcl_Data.iii 41838>>>>>// Procedure Sum_Data 41838>>>>>// 41838>>>>>class cBarChartData is an array 41839>>>>> procedure construct_object 41841>>>>> forward send construct_object 41843>>>>> set delegation_mode to delegate_to_parent 41844>>>>> property integer pStacks public 1 41845>>>>> property integer pSeries public 1 41846>>>>> 41846>>>>> property integer pMinColumnUsed public 0 41847>>>>> property integer pMaxColumnUsed public -1 41848>>>>> 41848>>>>> property number pMinY public 0 41849>>>>> property number pMaxY public 0 41850>>>>> 41850>>>>> object oSignatures is an array 41852>>>>> end_object 41853>>>>> property integer pSignatures_Object public 0 41854>>>>> end_procedure 41855>>>>> 41855>>>>> Function iData_Index.iii integer column# integer serie# integer stack# returns integer 41857>>>>> function_return (column#*pSeries(self)+serie#*pStacks(self)+stack#) 41858>>>>> End_Function 41859>>>>> 41859>>>>> Procedure UpdateColumnsUsed integer column# 41861>>>>> if column# gt (pMaxColumnUsed(self)) set pMaxColumnUsed to column# 41864>>>>> if column# lt (pMinColumnUsed(self)) set pMinColumnUsed to column# 41867>>>>> End_Procedure 41868>>>>> 41868>>>>> Procedure Sto_Data number value# integer column# integer serie# integer stack# 41870>>>>> set value item (iData_Index.iii(self,column#,serie#,stack#)) to value# 41871>>>>> send UpdateColumnsUsed column# 41872>>>>> End_Procedure 41873>>>>> Function nRcl_Data.iii integer column# integer serie# integer stack# returns number 41875>>>>> integer idx# 41875>>>>> get iData_Index.iii column# serie# stack# to idx# 41876>>>>> function_return (number_value(self,idx#)) 41877>>>>> End_Function 41878>>>>> Procedure Sum_Data number value# integer column# integer serie# integer stack# 41880>>>>> integer idx# 41880>>>>> get iData_Index.iii column# serie# stack# to idx# 41881>>>>> set value item idx# to (value#+number_value(self,idx#)) 41882>>>>> send UpdateColumnsUsed column# 41883>>>>> End_Procedure 41884>>>>> 41884>>>>> Function iColumns returns integer 41886>>>>> number rval# 41886>>>>> move (1.0*item_count(self)/(pSeries(self)*pStacks(self))) to rval# 41887>>>>> if rval# ne (integer(rval#)) move (rval#+1) to rval# 41890>>>>> function_return rval# 41891>>>>> End_Function 41892>>>>> 41892>>>>> Function nColumnSum integer column# integer serie# integer code# returns number 41894>>>>> integer stack# 41894>>>>> number rval# tmp# 41894>>>>> move 0 to rval# 41895>>>>> for stack# from 0 to (pStacks(self)-1) 41901>>>>>> 41901>>>>> move (nRcl_Data.iii(self,column#,serie#,stack#)) to tmp# 41902>>>>> // top: 41902>>>>> if code# eq 0 if tmp# ge 0 move (rval#+tmp#) to rval# 41907>>>>> // bottom: 41907>>>>> if code# eq 1 if tmp# le 0 move (rval#+tmp#) to rval# 41912>>>>> // top reduced with negative bottom: 41912>>>>> if code# eq 2 move (rval#+tmp#) to rval# 41915>>>>> loop 41916>>>>>> 41916>>>>> function_return rval# 41917>>>>> End_Function 41918>>>>> 41918>>>>> Procedure CalculateRange 41920>>>>> integer column# stack# serie# 41920>>>>> integer max_column# max_stack# max_serie# 41920>>>>> number min# max# tmp_neg# tmp_pos# value# 41920>>>>> get pStacks to max_stack# 41921>>>>> get pSeries to max_serie# 41922>>>>> get iColumns to max_column# 41923>>>>> move 0 to min# 41924>>>>> move 0 to max# 41925>>>>> for column# from 0 to (max_column#-1) 41931>>>>>> 41931>>>>> for serie# from 0 to (max_serie#-1) 41937>>>>>> 41937>>>>> move 0 to tmp_neg# 41938>>>>> move 0 to tmp_pos# 41939>>>>> for stack# from 0 to (max_stack#-1) 41945>>>>>> 41945>>>>> get nRcl_Data.iii column# serie# stack# to value# 41946>>>>> if value# ge 0 move (tmp_pos#+value#) to tmp_pos# 41949>>>>> else move (tmp_neg#+value#) to tmp_neg# 41951>>>>> loop 41952>>>>>> 41952>>>>> if tmp_pos# gt max# move tmp_pos# to max# 41955>>>>> if tmp_neg# lt min# move tmp_neg# to min# 41958>>>>> loop 41959>>>>>> 41959>>>>> loop 41960>>>>>> 41960>>>>> set pMinY to min# 41961>>>>> set pMaxY to max# 41962>>>>> End_Procedure 41963>>>>> 41963>>>>> Procedure Reset_Data 41965>>>>> send delete_data 41966>>>>> set pMinColumnUsed to 0 41967>>>>> set pMaxColumnUsed to -1 41968>>>>> set pMinY to 0 41969>>>>> set pMaxY to 0 41970>>>>> End_Procedure 41971>>>>> 41971>>>>> procedure Add_Serie_Signature integer serie# string str# 41973>>>>> set value of (oSignatures(self)) item (serie#*2+0) to str# 41974>>>>> end_procedure 41975>>>>> procedure Add_Stack_Signature integer stack# string str# 41977>>>>> set value of (oSignatures(self)) item (stack#*2+1) to str# 41978>>>>> end_procedure 41979>>>>> procedure Reset_Signatures 41981>>>>> send delete_data to (oSignatures(self)) 41982>>>>> end_procedure 41983>>>>>end_class // cBarChartData 41984>>>>> 41984>>>>>class cGraphData is an array 41985>>>>> procedure construct_object 41987>>>>> forward send construct_object 41989>>>>> set delegation_mode to delegate_to_parent 41990>>>>> property integer pIndexedData_State public 0 41991>>>>> end_procedure 41992>>>>>end_class 41993>>>>> 41993>>>>>// Coloring strategy for bar charts. 41993>>>>>// --------------------------------- 41993>>>>>// If there are 4 or less stacks and 8 or less series then stacks will be 41993>>>>>// nuance coded. Otherwise ugly hatches are used 41993>>>>> 41993>>>>>// Bar Chart Coloring Strategies 41993>>>>> 41993>>>>>class cBarChart is a cBarChartData 41994>>>>> procedure construct_object 41996>>>>> forward send construct_object 41998>>>>> set delegation_mode to delegate_to_parent 41999>>>>> property integer pAir public 10 // Percent air between columns 42000>>>>> property integer pBarFrameColor public clBlack // -1 => no frame 42001>>>>> property integer pxAutoScale public 1 42002>>>>> property integer pyAutoScale public 1 42003>>>>> property integer pHatchState public BC_HATCH_ON_STACKS 42004>>>>> property integer pColorState public BC_COLOR_ON_SERIES 42005>>>>> property integer pSmartColor_State public true 42006>>>>> property integer private.pSmartColor public true 42007>>>>> end_procedure 42008>>>>> 42008>>>>> procedure end_construct_object 42010>>>>> integer self# 42010>>>>> move self to self# 42011>>>>> forward send end_construct_object 42013>>>>> delegate send register_xy_object self# 42015>>>>> end_procedure 42016>>>>> 42016>>>>> procedure Transfer_Signature 42018>>>>> integer max_stack# max_serie# stack# serie# obj# 42018>>>>> get pSignatures_Object to obj# 42019>>>>> if obj# begin 42021>>>>> get pStacks to max_stack# 42022>>>>> get pSeries to max_serie# 42023>>>>> if max_serie# gt 1 begin 42025>>>>> for serie# from 0 to (max_serie#-1) 42031>>>>>> 42031>>>>>// send add_signature to obj# string str# integer color_frame# integer color_back# integer hatch# integer color_hatch# 42031>>>>> loop 42032>>>>>> 42032>>>>> end 42032>>>>>> 42032>>>>> if max_stack# gt 1 begin 42034>>>>> for stack# from 0 to (max_stack#-1) 42040>>>>>> 42040>>>>> loop 42041>>>>>> 42041>>>>> end 42041>>>>>> 42041>>>>> end 42041>>>>>> 42041>>>>> end_procedure 42042>>>>>//procedure add_signature string str# integer color_frame# integer color_back# integer hatch# integer color_hatch# 42042>>>>> 42042>>>>> procedure NotifyAutoScale 42044>>>>> if (pxAutoScale(self)) begin 42046>>>>> delegate set pxAutoScale to false 42048>>>>> set pxLowValue to 0 42049>>>>> set pxSteps to (iColumns(self)) 42050>>>>> set pxStepSize to 10 42051>>>>> set pBarChartState to true 42052>>>>> end 42052>>>>>> 42052>>>>> if (pyAutoScale(self)) begin 42054>>>>> send CalculateRange 42055>>>>> set pyMinValue to (pMinY(self)) 42056>>>>> set pyMaxValue to (pMaxY(self)) 42057>>>>> end 42057>>>>>> 42057>>>>> end_procedure 42058>>>>> 42058>>>>> function iColor.iii integer column# integer serie# integer stack# returns integer 42060>>>>> integer ColorState# 42060>>>>> if (private.pSmartColor(self)) function_return (iColorNuance.iii(self,serie#,stack#,pStacks(self)-1)) 42063>>>>> get pColorState to ColorState# 42064>>>>> if ColorState# ge 0 function_return ColorState# // Constant color 42067>>>>> if ColorState# eq BC_COLOR_ON_SERIES function_return (iColor(self,serie#)) 42070>>>>> if ColorState# eq BC_COLOR_ON_STACKS function_return (iColor(self,stack#)) 42073>>>>> end_function 42074>>>>> function iHatch.iii integer column# integer serie# integer stack# returns integer 42076>>>>> integer HatchState# 42076>>>>> if (private.pSmartColor(self)) function_return HS_NONE 42079>>>>> get pHatchState to HatchState# 42080>>>>> if HatchState# ge -1 function_return HatchState# // Constant hatch 42083>>>>> if HatchState# eq BC_HATCH_ON_SERIES function_return (iHatch(self,serie#)) 42086>>>>> if HatchState# eq BC_HATCH_ON_STACKS function_return (iHatch(self,stack#)) 42089>>>>> end_function 42090>>>>> 42090>>>>> function nColumnWidth returns number 42092>>>>> integer liColumns 42092>>>>> number lnRange 42092>>>>> get nxRange to lnRange // This will delegate to an object of class cCoordinateSystem 42093>>>>> get iColumns to liColumns 42094>>>>> function_return (lnRange/liColumns) 42095>>>>> end_function 42096>>>>> function nBarWidth returns number 42098>>>>> integer liAir liSeries 42098>>>>> number lnColumnWidth 42098>>>>> get pAir to liAir 42099>>>>> get pSeries to liSeries 42100>>>>> get nColumnWidth to lnColumnWidth 42101>>>>> move (lnColumnWidth*(100-liAir)/100) to lnColumnWidth 42102>>>>> function_return (lnColumnWidth/liSeries) 42103>>>>> end_function 42104>>>>> function nColumnOffsetX integer column# returns number 42106>>>>> number lnColumnWidth 42106>>>>> get nColumnWidth to lnColumnWidth 42107>>>>> function_return (lnColumnWidth*column#+pxLowValue(self)) 42108>>>>> end_function 42109>>>>> function nBarOffsetX integer column# integer serie# returns number 42111>>>>> number lnColumnOffsetX lnBarWidth 42111>>>>> get nColumnOffsetX column# to lnColumnOffsetX 42112>>>>> get nBarWidth to lnBarWidth 42113>>>>> move (pAir(self)*nColumnWidth(self)/200+lnColumnOffsetX) to lnColumnOffsetX 42114>>>>> function_return (serie#*lnBarWidth+lnColumnOffsetX) 42115>>>>> end_function 42116>>>>> 42116>>>>> // liWhere: 0=left 1=mid 2=right 42116>>>>> function nBarCoordX integer column# integer serie# integer liWhere returns number 42118>>>>> number lnX 42118>>>>> get nBarOffsetX column# serie# to lnX 42119>>>>> if (liWhere=1) move (nBarWidth(self)/2.0+lnX) to lnX // Mid 42122>>>>> if (liWhere=2) move (nBarWidth(self)+lnX) to lnX // Right 42125>>>>> function_return lnX 42126>>>>> end_function 42127>>>>> 42127>>>>> // liWhere: 0=Buttom 1=Mid 2=Top, liStack -1:upper stack -2=lower stack 42127>>>>> function nBarCoordY integer liColumn integer liSerie integer liStack integer liWhere returns number 42129>>>>> number lnNegativeSum lnPositiveSum lnValue 42129>>>>> integer liMaxStack liTestStack 42129>>>>> 42129>>>>> get pStacks to liMaxStack 42130>>>>> move 0 to lnNegativeSum 42131>>>>> move 0 to lnPositiveSum 42132>>>>> decrement liMaxStack 42133>>>>> for liTestStack from 0 to liMaxStack 42139>>>>>> 42139>>>>> get nRcl_Data.iii liColumn liSerie liTestStack to lnValue 42140>>>>> if lnValue ne 0 begin // Only if there is something to draw# 42142>>>>> if lnValue ge 0 begin 42144>>>>> if (liTestStack=liStack) begin 42146>>>>> if (liWhere=0) function_return lnPositiveSum 42149>>>>> if (liWhere=1) function_return (lnValue/2+lnPositiveSum) 42152>>>>> if (liWhere=2) function_return (lnPositiveSum+lnValue) 42155>>>>> end 42155>>>>>> 42155>>>>> move (lnPositiveSum+lnValue) to lnPositiveSum 42156>>>>> end 42156>>>>>> 42156>>>>> else begin 42157>>>>> if (liTestStack=liStack) begin 42159>>>>> if (liWhere=2) function_return lnNegativeSum 42162>>>>> if (liWhere=1) function_return (lnValue/2+lnNegativeSum) 42165>>>>> if (liWhere=0) function_return (lnNegativeSum+lnValue) 42168>>>>> end 42168>>>>>> 42168>>>>> move (lnNegativeSum+lnValue) to lnNegativeSum 42169>>>>> end 42169>>>>>> 42169>>>>> end 42169>>>>>> 42169>>>>> loop // liStack 42170>>>>>> 42170>>>>> if (liStack=-1) function_return lnPositiveSum 42173>>>>> if (liStack=-2) function_return lnNegativeSum 42176>>>>> function_return 0 42177>>>>> end_function 42178>>>>> 42178>>>>> procedure draw_bar integer column# integer serie# integer stack# number from# number to# 42180>>>>> integer self# hatch# BarFrameColor# color# 42180>>>>> number width# OffsetX# 42180>>>>> get nBarWidth to width# 42181>>>>> get nBarOffsetX column# serie# to OffsetX# 42182>>>>> move self to self# 42183>>>>> get iHatch.iii column# serie# stack# to hatch# 42184>>>>> get iColor.iii column# serie# stack# to color# 42185>>>>> get pBarFrameColor to BarFrameColor# 42186>>>>> if BarFrameColor# eq -1 send SetPenColor Color# 42189>>>>> else send SetPenColor BarFrameColor# 42191>>>>> if hatch# ne HS_NONE begin 42193>>>>> send SetHatchStyle HS_NONE 42194>>>>> send SetFillColor clWhite 42195>>>>> send AddRectangle OffsetX# from# (OffsetX#+width#) to# 42196>>>>> end 42196>>>>>> 42196>>>>> send SetHatchStyle hatch# 42197>>>>> send SetFillColor color# 42198>>>>> send AddRectangle OffsetX# from# (OffsetX#+width#) to# 42199>>>>> end_procedure 42200>>>>> 42200>>>>> procedure SetupColorScheme 42202>>>>> if (pSmartColor_State(self) and pStacks(self)<5 and pSeries(self)<9) set private.pSmartColor to true 42205>>>>> else set private.pSmartColor to false 42207>>>>> end_procedure 42208>>>>> 42208>>>>> procedure Draw_Data // cBarChart 42210>>>>> integer column# stack# serie# 42210>>>>> integer max_column# max_stack# max_serie# 42210>>>>> number min# max# tmp_neg# tmp_pos# value# 42210>>>>> 42210>>>>> send SetupColorScheme 42211>>>>> 42211>>>>> get pStacks to max_stack# 42212>>>>> get pSeries to max_serie# 42213>>>>> get iColumns to max_column# 42214>>>>> for column# from 0 to (max_column#-1) 42220>>>>>> 42220>>>>> for serie# from 0 to (max_serie#-1) 42226>>>>>> 42226>>>>> move 0 to tmp_neg# 42227>>>>> move 0 to tmp_pos# 42228>>>>> for stack# from 0 to (max_stack#-1) 42234>>>>>> 42234>>>>> get nRcl_Data.iii column# serie# stack# to value# 42235>>>>> if value# ne 0 begin // Only if there is something to draw# 42237>>>>> if value# ge 0 begin 42239>>>>> send draw_bar column# serie# stack# tmp_pos# (tmp_pos#+value#) 42240>>>>> move (tmp_pos#+value#) to tmp_pos# 42241>>>>> end 42241>>>>>> 42241>>>>> else begin 42242>>>>> send draw_bar column# serie# stack# tmp_neg# (tmp_neg#+value#) 42243>>>>> move (tmp_neg#+value#) to tmp_neg# 42244>>>>> end 42244>>>>>> 42244>>>>> end 42244>>>>>> 42244>>>>> loop // stack 42245>>>>>> 42245>>>>> // send end_draw_serie 42245>>>>> loop 42246>>>>>> 42246>>>>> // send end_draw_column 42246>>>>> loop 42247>>>>>> 42247>>>>> end_procedure 42248>>>>> 42248>>>>>//function private.Replace_Column_Del string str# string del# returns string 42248>>>>>// function_return (replaces(del#,str#,"")) 42248>>>>>//end_function 42248>>>>>// 42248>>>>>//procedure Export_To_SpreadSheet string Column_Del# string DecPoint# 42248>>>>>// integer column# serie# stack# max_stack# max_serie# max_column# 42248>>>>>// number temp_value# 42248>>>>>// string tmp_str# 42248>>>>>// get pStacks to max_stack# 42248>>>>>// get pSeries to max_serie# 42248>>>>>// get iColumns to max_column# 42248>>>>>// 42248>>>>>// writeln '"' (private.Replace_Column_Del(self,pTitle(self),Column_Del#)) '"' 42248>>>>>// 42248>>>>>// writeln 42248>>>>>// writeln '"' (private.Replace_Column_Del(self,"X: "+pTitleX(self),Column_Del#)) '"' 42248>>>>>// writeln '"' (private.Replace_Column_Del(self,"Y: "+pTitleY(self),Column_Del#)) '"' 42248>>>>>// writeln 42248>>>>>// 42248>>>>>// for stack# from 0 to (max_stack#-1) 42248>>>>>// writeln '"' (trim(private.Replace_Column_Del(self,(Rcl_Hst_Sign_Stack(self,stack#)),Column_Del#))) '"' 42248>>>>>// 42248>>>>>// write Column_Del# // an empty field 42248>>>>>// // For every series, write name of series: 42248>>>>>// if (sgn_ser#(self)) begin 42248>>>>>// for serie# from 0 to (max_serie#-1) 42248>>>>>// write '"' (trim(Replace_Column_Del(self,(Rcl_Hst_Sign_Serie(self,serie#)),Column_Del#))) '"' 42248>>>>>// if serie# ne (max_serie#-1) write Column_Del# 42248>>>>>// loop 42248>>>>>// end 42248>>>>>// writeln // new line 42248>>>>>// 42248>>>>>// for column# from 0 to (pxSteps(self)-1) 42248>>>>>// 42248>>>>>// //write column name: 42248>>>>>// move (AxisTextX(self,column#)) to tmp_str# 42248>>>>>// move (trim(string_value(self,(column#*4+1)))) to tmp_str# 42248>>>>>// write '"' (trim(private.Replace_Column_Del(self,tmp_str#,Column_Del#))) '"' Column_Del# 42248>>>>>// 42248>>>>>// //write data: 42248>>>>>// for serie# from 0 to (max_serie#-1) 42248>>>>>// move (Rcl_Hst_Data(self,column#,serie#,stack#)) to temp_value# 42248>>>>>// move (NumToStr(temp_value#,(y_val_dec(self)+1))) to tmp_str# 42248>>>>>// replace "." in tmp_str# with decpoint# 42248>>>>>// replace "," in tmp_str# with decpoint# 42248>>>>>// write (Replace_Column_Del(self,tmp_str#,Column_Del#)) 42248>>>>>// ifnot serie# eq (max_serie#-1) write Column_Del# 42248>>>>>// loop 42248>>>>>// writeln "" 42248>>>>>// loop 42248>>>>>// loop 42248>>>>>//end_procedure 42248>>>>>end_class // cBarChart 42249>>>>> 42249>>>>> 42249>>>>> 42249>>>>> 42249>>>>>number gr$viewer.x gr$viewer.y gr$viewer.z // location of viewer's eye 42249>>>>>number gr$plane.a gr$plane.b gr$plane.c gr$plane.d // plane = {(x,y,z) | ax+by+cz+d=0} 42249>>>>>number gr$return.x gr$return.y // return values 42249>>>>>number gr$origo_2d.x gr$origo_2d.y gr$origo_2d.z // 2d origo in the 3d system 42249>>>>>number gr$xaxis_2d.x gr$xaxis_2d.y gr$xaxis_2d.z // vector embedded in 2d x-axis of length 1 42249>>>>>number gr$yaxis_2d.x gr$yaxis_2d.y gr$yaxis_2d.z // vector embedded in 2d y-axis of length 1 42249>>>>> 42249>>>>>class GraphicArea3D is a GraphicArea 42250>>>>> procedure construct_object 42252>>>>> forward send construct_object 42254>>>>> property number pViewer.x public 30000 42255>>>>> property number pViewer.y public 30000 42256>>>>> property number pViewer.z public 30000 42257>>>>> property number pPlane.a public 1 42258>>>>> property number pPlane.b public 1 42259>>>>> property number pPlane.c public 1 42260>>>>> property number pPlane.d public -20000 42261>>>>> property number pOrigo_2d.x public 2000 42262>>>>> property number pOrigo_2d.y public 2000 42263>>>>> property number pOrigo_2d.z public 16000 42264>>>>> property number pXaxis_2d.x public 0.707106781 42265>>>>> property number pXaxis_2d.y public 0 42266>>>>> property number pXaxis_2d.z public -0.707106781 42267>>>>> property number pYaxis_2d.x public -0.408248291 42268>>>>> property number pYaxis_2d.y public 0.816496581 42269>>>>> property number pYaxis_2d.z public -0.408248291 42270>>>>> end_procedure 42271>>>>> procedure BeginDraw 42273>>>>> get pViewer.x to gr$Viewer.x 42274>>>>> get pViewer.y to gr$Viewer.y 42275>>>>> get pViewer.z to gr$Viewer.z 42276>>>>> get pPlane.a to gr$Plane.a 42277>>>>> get pPlane.b to gr$Plane.b 42278>>>>> get pPlane.c to gr$Plane.c 42279>>>>> get pPlane.d to gr$Plane.d 42280>>>>> get pOrigo_2d.x to gr$Origo_2d.x 42281>>>>> get pOrigo_2d.y to gr$Origo_2d.y 42282>>>>> get pOrigo_2d.z to gr$Origo_2d.z 42283>>>>> get pXaxis_2d.x to gr$Xaxis_2d.x 42284>>>>> get pXaxis_2d.y to gr$Xaxis_2d.y 42285>>>>> get pXaxis_2d.z to gr$Xaxis_2d.z 42286>>>>> get pYaxis_2d.x to gr$Yaxis_2d.x 42287>>>>> get pYaxis_2d.y to gr$Yaxis_2d.y 42288>>>>> get pYaxis_2d.z to gr$Yaxis_2d.z 42289>>>>> forward send BeginDraw 42291>>>>> end_procedure 42292>>>>> procedure Convert3d_XYZ number px number py number pz 42294>>>>> number line.p line.q line.r line.t 42294>>>>> number intersec.x intersec.y intersec.z 42294>>>>> number q_minus_r0.x q_minus_r0.y q_minus_r0.z q_minus_r0.len 42294>>>>> number helpvar 42294>>>>> 42294>>>>> // line between point and eye: (x,y,z) = (px,py,pz) + t(p,q,r) 42294>>>>> 42294>>>>> move (gr$viewer.x-px) to line.p 42295>>>>> move (gr$viewer.y-py) to line.q 42296>>>>> move (gr$viewer.z-pz) to line.r 42297>>>>> 42297>>>>> move (-((gr$plane.a*px) + (gr$plane.b*py) + (gr$plane.c*pz) + gr$plane.d)) to line.t 42298>>>>> move (line.t/((gr$plane.a*line.p) + (gr$plane.b*line.q) + (gr$plane.c*line.r))) to line.t 42299>>>>> 42299>>>>> // Intersection: 42299>>>>> 42299>>>>> move (line.t*line.p+px) to intersec.x 42300>>>>> move (line.t*line.q+py) to intersec.y 42301>>>>> move (line.t*line.r+pz) to intersec.z 42302>>>>> 42302>>>>> // calculate distance gr$return.x to x-akse in the plane 42302>>>>> 42302>>>>> // As vector we use xaxis_2d 42302>>>>> // Vector q is (intersec.x,intersec.y,intersec.z) 42302>>>>> // As vector r0 (point on the line) we use origo_2d 42302>>>>> 42302>>>>> move (intersec.x-gr$origo_2d.x) to q_minus_r0.x 42303>>>>> move (intersec.y-gr$origo_2d.y) to q_minus_r0.y 42304>>>>> move (intersec.z-gr$origo_2d.z) to q_minus_r0.z 42305>>>>> move ((q_minus_r0.x*q_minus_r0.x)+(q_minus_r0.y*q_minus_r0.y)+(q_minus_r0.z*q_minus_r0.z)) to q_minus_r0.len 42306>>>>> //  Note: It is in fact the squared length we have calculated! 42306>>>>> move ((q_minus_r0.x*gr$xaxis_2d.x)+(q_minus_r0.y*gr$xaxis_2d.y)+(q_minus_r0.z*gr$xaxis_2d.z)) to helpvar 42307>>>>> move (((sqrt(q_minus_r0.len-(helpvar*helpvar)))/2.0)+0.5) to gr$return.x 42308>>>>> move ((q_minus_r0.x*gr$yaxis_2d.x)+(q_minus_r0.y*gr$yaxis_2d.y)+(q_minus_r0.z*gr$yaxis_2d.z)) to helpvar 42309>>>>> move (((sqrt(q_minus_r0.len-(helpvar*helpvar)))/2.0)+0.5) to gr$return.y 42310>>>>> end_procedure 42311>>>>> 42311>>>>> procedure Add3dLine ; integer x1# integer x2# integer x3# ; integer y1# integer y2# integer y3# 42313>>>>> send Convert3d_XYZ x1# x2# x3# 42314>>>>> send AddLineMvTo gr$return.x gr$return.y 42315>>>>> send Convert3d_XYZ y1# y2# y3# 42316>>>>> send AddLineGoTo gr$return.x gr$return.y 42317>>>>> end_procedure 42318>>>>> 42318>>>>> procedure Add3dPlane ; integer x1# integer y1# integer z1# ; integer x2# integer y2# integer z2# ; integer x3# integer y3# integer z3# ; integer x4# integer y4# integer z4# 42320>>>>> send Convert3d_XYZ x1# y1# z1# 42321>>>>> move gr$return.x to x1# 42322>>>>> move gr$return.y to y1# 42323>>>>> send Convert3d_XYZ x2# y2# z2# 42324>>>>> move gr$return.x to x2# 42325>>>>> move gr$return.y to y2# 42326>>>>> send Convert3d_XYZ x3# y3# z3# 42327>>>>> move gr$return.x to x3# 42328>>>>> move gr$return.y to y3# 42329>>>>> send Convert3d_XYZ x4# y4# z4# 42330>>>>> move gr$return.x to x4# 42331>>>>> move gr$return.y to y4# 42332>>>>> send Add4Angle x1# y1# x2# y2# x3# y3# x4# y4# 42333>>>>>// showln x1# "," y1# " " x2# "," y2# " " x3# "," y3# " " x4# "," y4# 42333>>>>> end_procedure 42334>>>>> 42334>>>>> procedure Add3dBox ; integer x1# integer y1# integer z1# ; integer x2# integer y2# integer z2# 42336>>>>> send Add3dPlane x1# y1# z2# x1# y2# z2# x2# y2# z2# x2# y1# z2# 42337>>>>> send Add3dPlane x2# y1# z2# x2# y2# z2# x2# y2# z1# x2# y1# z1# 42338>>>>> send Add3dPlane x1# y2# z1# x2# y2# z1# x2# y2# z2# x1# y2# z2# 42339>>>>> end_procedure 42340>>>>>end_class // GraphicArea3D 42341>>>>> 42341>>>Use AppInfo.utl // Setup application information Including file: appinfo.utl (C:\projects\BRS\VDFQuery\AppSrc\appinfo.utl) 42341>>>>>// Use AppInfo.utl // Setup application information 42341>>>>> 42341>>>>>enumeration_list 42341>>>>> define AI_TITLE // Application title 42341>>>>> define AI_SUBTITLE // Application sub-title 42341>>>>> define AI_SUBTITLE2 // Application sub-title 2 42341>>>>> define AI_VERSION // Version 42341>>>>> define AI_REVISION // Revision 42341>>>>> define AI_AUTHOR // Author or Company 42341>>>>> define AI_WATERMARK // Set to "Beta" or "Demo" (May be used for splashes) 42341>>>>> define AI_RELEASEDATE // 42341>>>>> define AI_LOG_IMAGE // 42341>>>>> define AI_KNOWN_ISSUES // 42341>>>>> define TMP_GA_OBJECTID // Used internally by the packages to hold an object id 42341>>>>> define AI_CONTACT1 42341>>>>> define AI_CONTACT2 42341>>>>> define AI_CONTACT3 42341>>>>>end_enumeration_list 42341>>>>> 42341>>>>>object oApplicationInfo is an Array no_image 42343>>>>>end_object 42344>>>>>procedure set AppInfo global integer type# string value# 42346>>>>> set value of (oApplicationInfo(self)) item type# to value# 42347>>>>>end_procedure 42348>>>>>function AppInfo global integer type# returns string 42350>>>>> function_return (value(oApplicationInfo(self),type#)) 42351>>>>>end_function 42352>>>>> 42352>>> 42352>>>class cSplashGraphicArea is a GraphicArea 42353>>> procedure construct_object integer img# 42355>>> forward send construct_object img# 42357>>> set location to 0 0 42358>>> set size to 200 300 42359>>> end_procedure 42360>>> procedure Draw_AppInfo_Item integer itm# 42362>>> integer color# 42362>>> string str# 42362>>> get AppInfo itm# to str# 42363>>> if str# ne "" begin 42365>>> if itm# eq AI_TITLE begin 42367>>> send SetTTFont "Arial" 80 0 1 1 0 42368>>> send SetTextColor clBlack 42369>>> send SetTextAlign (VDFGR_TA_CENTER+VDFGR_TA_VCENTER) 42370>>> send AddText str# 2500 5000 42371>>> end 42371>>>> 42371>>> if itm# eq AI_SUBTITLE begin 42373>>> send SetTTFont "Arial" 50 0 1 1 0 42374>>> send SetTextColor clBlack 42375>>> send SetTextAlign (VDFGR_TA_CENTER+VDFGR_TA_VCENTER) 42376>>> send AddText "for" 5000 5000 42377>>> send AddText str# 7500 5000 42378>>> end 42378>>>> 42378>>> if itm# eq AI_SUBTITLE2 begin 42380>>> send SetTTFont "Arial" 12 0 1 0 0 42381>>> send SetTextColor clWhite 42382>>> send SetTextAlign (VDFGR_TA_CENTER+VDFGR_TA_VCENTER) 42383>>> send AddText str# 8700 5000 42384>>> end 42384>>>> 42384>>> if itm# eq AI_VERSION begin 42386>>> send SetTTFont "Arial" 12 0 1 0 0 42387>>> send SetTextColor clWhite 42388>>> send SetTextAlign (VDFGR_TA_LEFT+VDFGR_TA_BOTTOM) 42389>>> send AddText ("Version "+str#) 9500 500 42390>>> end 42390>>>> 42390>>> if itm# eq AI_REVISION begin 42392>>> end 42392>>>> 42392>>> if itm# eq AI_AUTHOR begin 42394>>> send SetTextAlign (VDFGR_TA_RIGHT+VDFGR_TA_BOTTOM) 42395>>> send SetTextColor clWhite 42396>>> send AddText str# 9500 9500 42397>>> end 42397>>>> 42397>>> if itm# eq AI_WATERMARK begin 42399>>> get iWaterMarkColor to color# 42400>>> send SetTTFont "Arial" 180 0 1 1 0 42401>>> send SetTextAlign (VDFGR_TA_CENTER+VDFGR_TA_VCENTER) 42402>>> send SetTextColor color# 42403>>> send AddText str# 5000 5000 42404>>> end 42404>>>> 42404>>> if itm# eq AI_RELEASEDATE begin 42406>>> end 42406>>>> 42406>>> end 42406>>>> 42406>>> end_procedure 42407>>> procedure Draw_BackGround.i integer color# 42409>>> integer count# 42409>>> send SetPenStyle PS_NULL 42410>>> send SetPenWidth 0 42411>>> for count# from 0 to 39 42417>>>> 42417>>> send SetFillColor color# 42418>>> send SetPenColor color# 42419>>> send AddRectangle (count#*250) 0 (count#+1*250+100) 10000 42420>>> move (RGB_Darken(color#,2)) to color# // Darken by 2 percent 42421>>> loop 42422>>>> 42422>>> end_procedure 42423>>> procedure Draw_Data 42425>>> integer color# 42425>>> forward send draw_data 42427>>> get iRandomBackColor to color# 42428>>> delegate send Draw_BackGround.i color# 42430>>> send Draw_AppInfo_Item AI_WATERMARK 42431>>> send Draw_AppInfo_Item AI_TITLE 42432>>> send Draw_AppInfo_Item AI_SUBTITLE 42433>>> send Draw_AppInfo_Item AI_SUBTITLE2 42434>>> send Draw_AppInfo_Item AI_VERSION 42435>>> send Draw_AppInfo_Item AI_REVISION 42436>>> send Draw_AppInfo_Item AI_AUTHOR 42437>>> send Draw_AppInfo_Item AI_RELEASEDATE 42438>>> end_procedure 42439>>> procedure end_construct_object 42441>>> integer ram# 42441>>> forward send end_construct_object 42443>>> get piProgram_RAM to ram# 42444>>> set AppInfo TMP_GA_OBJECTID to (piProgram_RAM(self)) 42445>>> end_procedure 42446>>>end_class // cSplashGraphicArea 42447>>> 42447>>>class cGraphicSplash is a ToolPanel 42448>>> procedure construct_object integer img# 42450>>> forward send construct_object img# 42452>>> set Size to 200 300 42453>>> set Caption_Bar to false 42454>>> set Border_Style to BORDER_DIALOG 42455>>> property integer piBackColor public 0 42456>>> object oGA is a cSplashGraphicArea 42458>>> set location to 0 0 42459>>> set size to 200 300 42460>>> end_object 42461>>> end_procedure 42462>>> procedure Draw_BackGround.i integer color# 42464>>> send Draw_BackGround.i to (oGA(self)) color# 42465>>> end_procedure 42466>>> function iRandomBackColor returns integer 42468>>> integer rval# 42468>>> sysdate rval# rval# rval# rval# 42472>>> move (mod(rval#,5)) to rval# 42473>>> if rval# eq 0 move clRed to rval# 42476>>> if rval# eq 1 move clGreen to rval# 42479>>> if rval# eq 2 move clBlue to rval# 42482>>> if rval# eq 3 move clYellow to rval# 42485>>> if rval# eq 4 move clWhite to rval# 42488>>> set piBackColor to rval# 42489>>> function_return rval# 42490>>> end_function 42491>>> function iWaterMarkColor returns integer 42493>>> function_return (RGB_Brighten(piBackColor(self),2)) 42494>>> end_function 42495>>> procedure activate 42497>>> send Draw_Data to (oGA(self)) 42498>>> forward send activate 42500>>> end_procedure 42501>>>end_class // cGraphicSplash 42502>>> 42502>>> 42502>>>//object oGraphicSplash is a ToolPanel 42502>>>// set size to 200 300 42502>>>// set caption_bar to false 42502>>>// set Border_Style to BORDER_DIALOG 42502>>>// object oGA is a GraphicArea 42502>>>// set location to 0 0 42502>>>// set size to 200 300 42502>>>// procedure draw_data 42502>>>// integer count# color# 42502>>>// integer watermark_color# 42502>>>// forward send draw_data 42502>>>// // This command will land the seconds in the color# variable: 42502>>>// sysdate color# color# color# color# 42502>>>// move (mod(color#,5)) to color# 42502>>>// if color# eq 0 move clRed to color# 42502>>>// if color# eq 1 move clGreen to color# 42502>>>// if color# eq 2 move clBlue to color# 42502>>>// if color# eq 3 move clYellow to color# 42502>>>// if color# eq 4 move clWhite to color# 42502>>>// move (RGB_Brighten(color#,2)) to watermark_color# 42502>>>// send SetPenStyle PS_NULL 42502>>>// send SetPenWidth 0 42502>>>// for count# from 0 to 39 42502>>>// send SetFillColor color# 42502>>>// send SetPenColor color# 42502>>>// send AddRectangle (count#*250) 0 (count#+1*250+100) 10000 42502>>>// move (RGB_Darken(color#,2)) to color# // Darken by 2 percent 42502>>>// loop 42502>>>// send SetTTFont "Courier New" 12 0 0 0 0 42502>>>// send SetTextAlign (VDFGR_TA_CENTER+VDFGR_TA_VCENTER) 42502>>>// send SetTextColor watermark_color# 42502>>>// send AddText "8213 9921 9050 3853 0023 8127 8213 9921 9050 3853 4580 0893 0599" 500 5000 42502>>>// send AddText "7401 7049 2039 5072 0892 3823 7401 7049 2039 5072 3059 0293 2570" 1000 5000 42502>>>// send AddText "2798 1359 2159 5023 4050 2348 2798 1359 2159 5023 5324 8090 9313" 1500 5000 42502>>>// send AddText "9934 6897 7567 5712 4312 9593 9921 6897 7567 5712 0827 9862 4668" 2000 5000 42502>>>// send AddText "8230 0109 4197 0704 0912 0230 8230 0109 4197 0704 0214 9273 4901" 2500 5000 42502>>>// send AddText "3908 9028 2308 0928 3592 5097 3908 9028 2308 0928 0984 9820 8090" 3000 5000 42502>>>// send AddText "7401 7049 2039 5072 0892 3823 7401 7049 2039 5072 3059 0293 2570" 3500 5000 42502>>>// send AddText "2397 0197 4972 3975 7250 9273 2397 0197 4972 3975 7213 5970 9301" 4000 5000 42502>>>// send AddText "8490 8323 8509 8309 2350 7239 8490 8323 8509 8309 4098 0980 5983" 4500 5000 42502>>>// send AddText "3068 3040 0994 9740 0490 1290 3068 3040 0994 9740 0470 1409 7330" 5000 5000 42502>>>// send AddText "4568 7875 7657 2708 2095 3099 4568 7875 7657 2708 7398 2346 3178" 5500 5000 42502>>>// send AddText "2798 1359 2159 5023 4050 2348 2798 1359 2159 5023 5324 8090 9313" 6000 5000 42502>>>// send AddText "4568 7875 7657 2708 2095 3099 4568 7875 7657 2708 7398 2346 3178" 6500 5000 42502>>>// send AddText "3068 3040 0994 9740 0490 1290 3068 3040 0994 9740 0470 1409 7330" 7000 5000 42502>>>// send AddText "8490 8323 8509 8309 2350 7239 8490 8323 8509 8309 4098 0980 5983" 7500 5000 42502>>>// send AddText "2397 0197 4972 3975 7250 9273 2397 0197 4972 3975 7213 5970 9301" 8000 5000 42502>>>// send AddText "7401 7049 2039 5072 0892 3823 7401 7049 2039 5072 3059 0293 2570" 8500 5000 42502>>>// send AddText "3908 9028 2308 0928 3592 5097 3908 9028 2308 0928 0984 9820 8090" 9000 5000 42502>>>// send AddText "8230 0109 4197 0704 0912 0230 8230 0109 4197 0704 0214 9273 4901" 9500 5000 42502>>>// send AddText "9934 6897 7567 5712 4312 9593 9921 6897 7567 5712 0827 9862 4668" 10000 5000 42502>>>// 42502>>>// send SetTTFont "Arial" 180 0 1 1 0 42502>>>// send SetTextAlign (VDFGR_TA_CENTER+VDFGR_TA_VCENTER) 42502>>>// send SetTextColor watermark_color# 42502>>>// send AddText (AppInfo(AI_WATERMARK)) 5000 5000 42502>>>// send SetTTFont "Arial" 80 0 1 1 0 42502>>>// send SetTextColor clBlack 42502>>>// send AddText (AppInfo(AI_TITLE)) 2500 5000 42502>>>// send SetTTFont "Arial" 50 0 1 1 0 42502>>>// send AddText "for" 5000 5000 42502>>>// send AddText (AppInfo(AI_SUBTITLE)) 7500 5000 42502>>>// send SetTTFont "Arial" 12 0 1 0 0 42502>>>// send SetTextAlign (VDFGR_TA_LEFT+VDFGR_TA_BOTTOM) 42502>>>// send AddText (AppInfo(AI_VERSION)) 9500 500 42502>>>// send SetTextAlign (VDFGR_TA_RIGHT+VDFGR_TA_BOTTOM) 42502>>>// send SetTextColor clWhite 42502>>>// send AddText (AppInfo(AI_AUTHOR)) 9500 9500 42502>>>// end_procedure 42502>>>// end_object 42502>>>// procedure activate 42502>>>// send draw_data to (oGA(self)) 42502>>>// forward send activate 42502>>>// end_procedure 42502>>>//end_object 42502>>> 42502>>>// procedure Splash_On global 42502>>>// send activate to (oGraphicSplash(self)) 42502>>>// end_procedure 42502>>>// procedure Splash_Off global 42502>>>// send deactivate to (oGraphicSplash(self)) 42502>>>// end_procedure 42502>Use About.utl // About dialog Including file: about.utl (C:\projects\BRS\VDFQuery\AppSrc\about.utl) 42502>>>// Use About.utl 42502>>> 42502>>>Use AppInfo.utl // Setup application information 42502>>>Use Buttons.utl // Button texts Including file: buttons.utl (C:\projects\BRS\VDFQuery\AppSrc\buttons.utl) 42502>>>>>// Use Buttons.utl // Button texts 42502>>>>>Use Language Including file: language.pkg (C:\projects\BRS\VDFQuery\AppSrc\language.pkg) 42502>>>>>>>// Use Language // Default language setup 42502>>>>>>>// Sets default languange 42502>>>>>>> 42502>>>>>>>Use LangSymb.pkg // Language symbols 42502>>>>>>> 42502>>>>>>> 42502>>>>>>> define _LANGUAGE_ for $ENGLISH$ 42502>>>>>>> #REM LANGUAGE SET BY LANGUAGE.PKG: $ENGLISH$ 42502>>>>>>> 42502>>>>>>> 42502>>>>>>>integer giLanguage 42502>>>>>>>move LNG_DEFAULT to giLanguage 42503>>>>>>> 42503>>>>>>>class cLanguageValues is an Array NO_IMAGE 42504>>>>>>> procedure set language_value integer liLanguage integer liConst string lsValue 42506>>>>>>> set value item (liLanguage*LNG_MAX+liConst) to lsValue 42507>>>>>>> end_procedure 42508>>>>>>> function language_value integer liConst returns string 42510>>>>>>> string lsValue 42510>>>>>>> get value item (giLanguage*LNG_MAX+liConst) to lsValue 42511>>>>>>> if (lsValue="") function_return (value(self,LNG_DEFAULT*LNG_MAX+liConst)) 42514>>>>>>> function_return lsValue 42515>>>>>>> end_function 42516>>>>>>> function language_coded_value integer liConst returns string 42518>>>>>>> function_return ("LV."+string(liConst)) 42519>>>>>>> end_function 42520>>>>>>> function language_decoded_value string lsValue returns string 42522>>>>>>> if (left(lsValue,3)="LV.") begin 42524>>>>>>> move (replace("LV.",lsValue,"")) to lsValue 42525>>>>>>> get language_value (integer(lsValue)) to lsValue 42526>>>>>>> end 42526>>>>>>>> 42526>>>>>>> function_return lsValue 42527>>>>>>> end_function 42528>>>>>>>end_class 42529>>>>> 42529>>>>> define t.btn.apply for "Apply" // LNG_ENGLISH 42529>>>>> define t.btn.help for "Help" // LNG_ENGLISH 42529>>>>> define t.btn.ok for "OK" // LNG_ENGLISH 42529>>>>> define t.btn.continue for "Continue" // LNG_ENGLISH 42529>>>>> define t.btn.cancel for "Cancel" // LNG_ENGLISH 42529>>>>> define t.btn.prompt for "Prompt" // LNG_ENGLISH 42529>>>>> define t.btn.create for "Create" // LNG_ENGLISH 42529>>>>> define t.btn.save for "Save" // LNG_ENGLISH 42529>>>>> define t.btn.delete for "Delete" // LNG_ENGLISH 42529>>>>> define t.btn.clear for "Clear" // LNG_ENGLISH 42529>>>>> define t.btn.exit for "Exit" // LNG_ENGLISH 42529>>>>> define t.btn.zoom for "Zoom" // LNG_ENGLISH 42529>>>>> define t.btn.close for "Close" // LNG_ENGLISH 42529>>>>> define t.btn.print for "Print" // LNG_ENGLISH 42529>>>>> define t.btn.reset for "Reset" // LNG_ENGLISH 42529>>>>> define t.btn.reset_all for "Reset all" // LNG_ENGLISH 42529>>>>> define t.btn.redraw for "Redraw" // LNG_ENGLISH 42529>>>>> define t.btn.remove for "Remove" // LNG_ENGLISH 42529>>>>> define t.btn.change for "Change" // LNG_ENGLISH 42529>>>>> define t.btn.insert for "Insert" // LNG_ENGLISH 42529>>>>> define t.btn.append for "Append" // LNG_ENGLISH 42529>>>>> define t.btn.restart for "Re-start" // LNG_ENGLISH 42529>>>>> define t.btn.display for "Display" // LNG_ENGLISH 42529>>>>> define t.btn.add for "Add" // LNG_ENGLISH 42529>>>>> define t.btn.edit for "Edit" // LNG_ENGLISH 42529>>>>> define t.btn.open for "Open" // LNG_ENGLISH 42529>>>>> define t.btn.properties for "Properties" // LNG_ENGLISH 42529>>>>> define t.btn.refresh for "Refresh" // LNG_ENGLISH 42529>>>>> define t.btn.select for "Select" // LNG_ENGLISH 42529>>>>> define t.btn.yes for "Yes" // LNG_ENGLISH 42529>>>>> define t.btn.no for "No" // LNG_ENGLISH 42529>>>>> define t.btn.move_up for "Move up" // LNG_ENGLISH 42529>>>>> define t.btn.move_down for "Move down" // LNG_ENGLISH 42529>>>>> define t.key.return for "Return" // LNG_ENGLISH 42529>>>>> define t.key.esc for "Esc" // LNG_ENGLISH 42529>>>>> 42529>>>Use Spec0007.utl // Display modal text (DoDisplayText) Including file: spec0007.utl (C:\projects\BRS\VDFQuery\AppSrc\spec0007.utl) 42529>>>>>// Use Spec0007.utl // Display modal text (DoDisplayText) 42529>>>>> 42529>>>>>Use Strings.utl // String manipulation for VDF Including file: strings.utl (C:\projects\BRS\VDFQuery\AppSrc\strings.utl) 42529>>>>>>>// Use Strings.utl // String manipulation for VDF 42529>>>>>>>// 42529>>>>>>>// NOTE that the bigger part of this package has been moved to STRINGS.NUI 42529>>>>>>>// 42529>>>>>>>Use Strings.nui // String manipulation for VDF (Non User Interface) 42529>>>>>>> 42529>>>>>>>function Text_EditObjectValue global integer lhEdit returns string 42531>>>>>>> integer liMax liItm liMargin liFormatSize lbActive 42531>>>>>>> string lsRval lsLine 42531>>>>>>> get active_state of lhEdit to lbActive // In windows Edit objects behave 42532>>>>>>> if lbActive begin // differently when they are 42534>>>>>>> get format_size of lhEdit to liFormatSize // active. If active we have to 42535>>>>>>> set format_size of lhEdit to 32000 32000 // do some mysterious stuff to 42536>>>>>>> set dynamic_update_state of lhEdit to true // get the correct value from it. 42537>>>>>>> end // Tsk tsk. 42537>>>>>>>> 42537>>>>>>> get line_count of lhEdit to liMax 42538>>>>>>> move "" to lsRval 42539>>>>>>> for liItm from 0 to (liMax-1) 42545>>>>>>>> 42545>>>>>>> get value of lhEdit item liItm to lsLine 42546>>>>>>> move (replaces(character(10),lsLine,"")) to lsLine 42547>>>>>>> move (replaces(character(13),lsLine,"")) to lsLine 42548>>>>>>> move (lsRval+lsLine) to lsRval 42549>>>>>>> if liItm ne (liMax-1) move (lsRval+character(10)) to lsRval 42552>>>>>>> loop 42553>>>>>>>> 42553>>>>>>> if lbActive begin // Tsk tsk... 42555>>>>>>> set format_size of lhEdit to (hi(liFormatSize)) (low(liFormatSize)) 42556>>>>>>> set dynamic_update_state of lhEdit to DFTRUE 42557>>>>>>> end 42557>>>>>>>> 42557>>>>>>> function_return lsRval 42558>>>>>>>end_function 42559>>>>>>> 42559>>>>>>>procedure Text_SetEditObjectValue global integer lhEdit string lsValue 42561>>>>>>> integer liLen liPos liMargin liItm 42561>>>>>>> string lsLine lsChar lsTen 42561>>>>>>> send delete_data to lhEdit 42562>>>>>>> move (character(10)) to lsTen 42563>>>>>>> move 0 to liItm 42564>>>>>>> move "" to lsLine 42565>>>>>>> move (length(lsValue)) to liLen 42566>>>>>>> for liPos from 1 to liLen 42572>>>>>>>> 42572>>>>>>> move (mid(lsValue,1,liPos)) to lsChar 42573>>>>>>> if lsChar eq lsTen begin 42575>>>>>>> set value of lhEdit item liItm to lsLine 42576>>>>>>> increment liItm 42577>>>>>>> move "" to lsLine 42578>>>>>>> end 42578>>>>>>>> 42578>>>>>>> else move (lsLine+lsChar) to lsLine 42580>>>>>>> loop 42581>>>>>>>> 42581>>>>>>> if lsLine ne "" set value of lhEdit item liItm to lsLine 42584>>>>>>>end_procedure 42585>>>>>>> 42585>>>>>>> 42585>>>>> 42585>>>>>Use APS // Auto Positioning and Sizing classes for VDF 42585>>>>>Use Buttons.utl // Button texts 42585>>>>>object oDisplayText is a aps.ModalPanel 42587>>>>> set locate_mode to CENTER_ON_SCREEN 42588>>>>> on_key kcancel send close_panel 42589>>>>> object oEdt is a aps.Edit 42591>>>>> set size to 170 250 42592>>>>> set TypeFace to "Courier New" 42593>>>>> //set FontWeight to 900 42593>>>>> set object_shadow_state to true 42594>>>>> set border_style to BORDER_NONE 42595>>>>> end_object 42596>>>>> object oBtn is a aps.Multi_Button 42598>>>>> on_item t.btn.close send close_panel 42599>>>>> end_object 42600>>>>> send aps_locate_multi_buttons 42601>>>>> set Border_Style to BORDER_THICK // Make panel resizeable 42602>>>>> set pMinimumSize to 0 75 42603>>>>> procedure aps_onResize integer delta_rw# integer delta_cl# 42606>>>>> send aps_resize (oEdt(self)) delta_rw# delta_cl# 42607>>>>> send aps_register_multi_button (oBtn(self)) 42608>>>>> send aps_locate_multi_buttons 42609>>>>> send aps_auto_size_container 42610>>>>> end_procedure 42611>>>>> procedure display.ss string title# string text# 42614>>>>> set label to title# 42615>>>>> send Text_SetEditObjectValue (oEdt(self)) text# 42616>>>>> send popup 42617>>>>> end_procedure 42618>>>>>end_object // oDisplayText 42619>>>>> 42619>>>>>object oDisplayTextAskQuestion is a aps.ModalPanel 42621>>>>> set locate_mode to CENTER_ON_SCREEN 42622>>>>> on_key kcancel send close_panel 42623>>>>> on_key kSave_Record send close_panel_ok 42624>>>>> property integer pbResult public 0 42626>>>>> procedure close_panel_ok 42629>>>>> set pbResult to DFTRUE 42630>>>>> send close_panel 42631>>>>> end_procedure 42632>>>>> object oEdt is a aps.Edit 42634>>>>> set size to 170 250 42635>>>>> set TypeFace to "Courier New" 42636>>>>> //set FontWeight to 900 42636>>>>> set object_shadow_state to true 42637>>>>> set border_style to BORDER_NONE 42638>>>>> end_object 42639>>>>> object oBtn1 is a aps.Multi_Button 42641>>>>> on_item t.btn.ok send close_panel_ok 42642>>>>> end_object 42643>>>>> object oBtn2 is a aps.Multi_Button 42645>>>>> on_item t.btn.cancel send close_panel 42646>>>>> end_object 42647>>>>> send aps_locate_multi_buttons 42648>>>>> set Border_Style to BORDER_THICK // Make panel resizeable 42649>>>>> set pMinimumSize to 0 75 42650>>>>> procedure aps_onResize integer delta_rw# integer delta_cl# 42653>>>>> send aps_resize (oEdt(self)) delta_rw# delta_cl# 42654>>>>> send aps_register_multi_button (oBtn1(self)) 42655>>>>> send aps_register_multi_button (oBtn2(self)) 42656>>>>> send aps_locate_multi_buttons 42657>>>>> send aps_auto_size_container 42658>>>>> end_procedure 42659>>>>> function iDisplay.ss string title# string text# returns integer 42662>>>>> set label to title# 42663>>>>> send Text_SetEditObjectValue (oEdt(self)) text# 42664>>>>> set pbResult to DFFALSE 42665>>>>> send popup 42666>>>>> function_return (pbResult(self)) 42667>>>>> end_function 42668>>>>>end_object // oDisplayTextAskQuestion 42669>>>>> 42669>>>>>procedure DoDisplayText global string title# string text# 42671>>>>> send display.ss to (oDisplayText(self)) title# text# 42672>>>>>end_procedure 42673>>>>> 42673>>>>>desktop_section 42678>>>>> object oDoDisplayTextLines is a cArray NO_IMAGE 42680>>>>> function sCombinedValue returns string 42683>>>>> integer liMax liItem 42683>>>>> string lsRval lsChar10 42683>>>>> move "" to lsRval 42684>>>>> move (character(10)) to lsChar10 42685>>>>> get item_count to liMax 42686>>>>> decrement liMax 42687>>>>> for liItem from 0 to liMax 42693>>>>>> 42693>>>>> move (lsRval+value(self,liItem)) to lsRval 42694>>>>> if (liItem<>liMax) move (lsRval+lsChar10) to lsRval 42697>>>>> loop 42698>>>>>> 42698>>>>> function_return lsRval 42699>>>>> end_function 42700>>>>> end_object 42701>>>>>end_desktop_section 42706>>>>> 42706>>>>>function DoDisplayTextConfirm global string title# string text# returns integer 42708>>>>> if (text#="") get sCombinedValue of (oDoDisplayTextLines(self)) to text# 42711>>>>> function_return (iDisplay.ss(oDisplayTextAskQuestion(self),title#,text#)) 42712>>>>>end_function 42713>>>>> 42713>>>>>procedure DoDisplayTextConfirm_Reset global 42715>>>>> send delete_data to (oDoDisplayTextLines(self)) 42716>>>>>end_procedure 42717>>>>>procedure DoDisplayTextConfirm_AddLine global string lsLine 42719>>>>> set value of (oDoDisplayTextLines(self)) item (item_count(oDoDisplayTextLines(self))) to lsLine 42720>>>>>end_procedure 42721>>>Use Spec0012.utl // Read image to string (sTextDfFromImage function) Including file: spec0012.utl (C:\projects\BRS\VDFQuery\AppSrc\spec0012.utl) 42721>>>>>// Use Spec0012.utl // Read image to string (sTextDfFromImage function) 42721>>>>> 42721>>>>>Use Files.nui // Utilities for handling file related stuff Including file: files.nui (C:\projects\BRS\VDFQuery\AppSrc\files.nui) 42721>>>>>>>// Use Files.nui // Utilities for handling file related stuff (No User Interface) 42721>>>>>>> 42721>>>>>>>// Sat 06-09-2003 - From 9.1 direct_input/direct_output and 42721>>>>>>>// append_output performs OEM to versions. 42721>>>>>>>// This is now reflected in the code (search _91_) 42721>>>>>>>// Wed 10-09-2003 - Added procedure SEQ_ReadRecordBufferToArray_LD 42721>>>>>>>// - Added function SEQ_InputChannelLineCount (and taken out again) 42721>>>>>>>// Mon 12-01-2004 - Function SEQ_CurrentFolder added 42721>>>>>>>// Thu 15-01-2004 - Procedure SEQ_CallBack_ItemsInDir no longer loads [.] and [..] items 42721>>>>>>>// - Function SEQ_NumberFiles now takes a parameter. 42721>>>>>>>// Sat 15-02-2004 - A long time Oem/ANSI issue with respect to filenames in DIRECT_INPUT/ 42721>>>>>>>// DIRECT_OUTPUT commands, that was apparently fixed in 9.1 beta, was 42721>>>>>>>// un-fixed in the final 9.1 release. Therefore the original fix to the 42721>>>>>>>// problem has been re-introduced (look for _91_) 42721>>>>>>>// Mon 01-03-2004 - Function SEQ_FindFileAlongPath has been fixed to let it handle 42721>>>>>>>// UNC pathing. 42721>>>>>>> 42721>>>>>>>// More exotic file functions may be found in the following packages: 42721>>>>>>>// 42721>>>>>>>// Use files01.nui // SEQ_DoChannelPositionsToLineCount - stuff 42721>>>>>>>// 42721>>>>>>> 42721>>>>>>>Use Seq_Chnl // Defines global sequential device management operations (DAW) 42721>>>>>>>Use Strings.nui // String manipulation for VDF 42721>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes 42721>>>>>>>Use Dates.nui // Date routines Including file: dates.nui (C:\projects\BRS\VDFQuery\AppSrc\dates.nui) 42721>>>>>>>>>// Use Dates.nui // Date routines (No User Interface) 42721>>>>>>>>> 42721>>>>>>>>>// The functions and procedures of this packages may be used with WebApp, VDF 7 or higher and DF3.2 or higher 42721>>>>>>>>> 42721>>>>>>>>>// Update: Tue 02-10-2001 - Fixed Module_Compile_Date function for VDF7 42721>>>>>>>>>// Mon 21-02-2002 - Error in 2 digit year datecompose fixed (Jan Morgils) 42721>>>>>>>>>// Fri 24-02-2002 - New function DateIsValid 42721>>>>>>>>>// Thu 14-11-2002 - Function DateDistance added 42721>>>>>>>>>// Fri 13-02-2004 - Procedure MilliSeconds_Wait added 42721>>>>>>>>>// Mon 01-08-2005 - Added #DN2 code to DateAsText function (Pieter van Dieren) 42721>>>>>>>>> 42721>>>>>>>>>Use ui 42721>>>>>>>>>Use Language // Set default languange if not set by compiler command line 42721>>>>>>>>>Use Seq_Chnl // Defines global sequential device management operations (DAW) 42721>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface) 42721>>>>>>>>>Use Strings.nui // String manipulation for VDF (No User Interface) 42721>>>>>>>>>Use ErrorHnd.nui // cErrorHandlerRedirector class and oErrorHandlerQuiet object (No User Interface) Including file: errorhnd.nui (C:\projects\BRS\VDFQuery\AppSrc\errorhnd.nui) 42721>>>>>>>>>>>// Use ErrorHnd.nui // cErrorHandlerRedirector class and oErrorHandlerQuiet object (No User Interface) 42721>>>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes 42721>>>>>>>>>>> 42721>>>>>>>>>>>use dfError 42721>>>>>>>>>>>define ErrorHnd$NES for 1 // NES = New Error System 42721>>>>>>>>>>> 42721>>>>>>>>>>>use Version.nui 42721>>>>>>>>>>> 42721>>>>>>>>>>>class cErrorHandlerRedirector is a cArray 42722>>>>>>>>>>> procedure construct_object integer liImg 42724>>>>>>>>>>> forward send construct_object liImg 42726>>>>>>>>>>> property integer phPreviousErrorHandler public -1 42727>>>>>>>>>>> property integer error_processing_state public DFFALSE 42728>>>>>>>>>>> // These properties are used internally to enable forwarding of 42728>>>>>>>>>>> // errors to the previous error handler. 42728>>>>>>>>>>> property integer piError public 0 42729>>>>>>>>>>> property integer piErrorLine public 0 42730>>>>>>>>>>> property string psErrMsg public "" 42731>>>>>>>>>>> end_procedure 42732>>>>>>>>>>> 42732>>>>>>>>>>> item_property_list 42732>>>>>>>>>>> item_property integer piError.i 42732>>>>>>>>>>> item_property string psErrorText.i 42732>>>>>>>>>>> item_property integer piErrorLine.i 42732>>>>>>>>>>> end_item_property_list cErrorHandlerRedirector #REM 42767 DEFINE FUNCTION PIERRORLINE.I INTEGER LIROW RETURNS INTEGER #REM 42771 DEFINE PROCEDURE SET PIERRORLINE.I INTEGER LIROW INTEGER VALUE #REM 42775 DEFINE FUNCTION PSERRORTEXT.I INTEGER LIROW RETURNS STRING #REM 42779 DEFINE PROCEDURE SET PSERRORTEXT.I INTEGER LIROW STRING VALUE #REM 42783 DEFINE FUNCTION PIERROR.I INTEGER LIROW RETURNS INTEGER #REM 42787 DEFINE PROCEDURE SET PIERROR.I INTEGER LIROW INTEGER VALUE 42792>>>>>>>>>>> 42792>>>>>>>>>>> procedure Forward_Error_Report 42794>>>>>>>>>>> integer lhPreviousErrorHandler 42794>>>>>>>>>>> get phPreviousErrorHandler to lhPreviousErrorHandler 42795>>>>>>>>>>> if (lhPreviousErrorHandler<>-1) send error_report to lhPreviousErrorHandler (piError(self)) (piErrorLine(self)) (psErrMsg(self)) 42798>>>>>>>>>>> end_procedure 42799>>>>>>>>>>> 42799>>>>>>>>>>> procedure OnError integer liError string lsErrorText integer liErrorLine 42801>>>>>>>>>>> integer liRow 42801>>>>>>>>>>> get row_count to liRow 42802>>>>>>>>>>> set piError.i liRow to liError 42803>>>>>>>>>>> set psErrorText.i liRow to lsErrorText 42804>>>>>>>>>>> set piErrorLine.i liRow to liErrorLine 42805>>>>>>>>>>> end_procedure 42806>>>>>>>>>>> 42806>>>>>>>>>>> procedure DoReset 42808>>>>>>>>>>> send delete_data 42809>>>>>>>>>>> end_procedure 42810>>>>>>>>>>> 42810>>>>>>>>>>> procedure DoActivate 42812>>>>>>>>>>> send delete_data 42813>>>>>>>>>>> if (phPreviousErrorHandler(self)=-1) begin 42815>>>>>>>>>>> set phPreviousErrorHandler to Error_Object_Id 42816>>>>>>>>>>> move self to Error_Object_Id 42817>>>>>>>>>>> end 42817>>>>>>>>>>>> 42817>>>>>>>>>>> end_procedure 42818>>>>>>>>>>> procedure DoDeactivate 42820>>>>>>>>>>> if (phPreviousErrorHandler(self)<>-1) begin 42822>>>>>>>>>>> get phPreviousErrorHandler to Error_Object_Id 42823>>>>>>>>>>> set phPreviousErrorHandler to -1 42824>>>>>>>>>>> end 42824>>>>>>>>>>>> 42824>>>>>>>>>>> end_procedure 42825>>>>>>>>>>> //#IFDEF msg_Extended_Error_Message // New error system 42825>>>>>>>>>>> procedure Error_Report integer liError integer liErrorLine string lsErrMsg 42827>>>>>>>>>>> string lsErrorText 42827>>>>>>>>>>> integer lhObj 42827>>>>>>>>>>> if (error_processing_state(self)) procedure_return // this prevents recursion 42830>>>>>>>>>>> set error_processing_state to DFTRUE 42831>>>>>>>>>>> 42831>>>>>>>>>>> set piError to liError 42832>>>>>>>>>>> set piErrorLine to liErrorLine 42833>>>>>>>>>>> set psErrMsg to lsErrMsg 42834>>>>>>>>>>> 42834>>>>>>>>>>> get phPreviousErrorHandler to lhObj 42835>>>>>>>>>>> 42835>>>>>>>>>>> move (Error_Description(lhObj,liError,lsErrMsg)) to lsErrorText 42836>>>>>>>>>>> send OnError liError lsErrorText liErrorLine 42837>>>>>>>>>>> set error_processing_state to DFFALSE 42838>>>>>>>>>>> end_procedure 42839>>>>>>>>>>>end_class // cErrorHandlerRedirector 42840>>>>>>>>>>> 42840>>>>>>>>>>>desktop_section 42845>>>>>>>>>>> object oErrorHandlerQuiet is a cErrorHandlerRedirector NO_IMAGE 42847>>>>>>>>>>> end_object 42848>>>>>>>>>>>end_desktop_section 42853>>>>>>>>>>> 42853>>>>>>>>>>>procedure ErrorHnd_Quiet_Activate global 42855>>>>>>>>>>> send DoActivate to (oErrorHandlerQuiet(self)) 42856>>>>>>>>>>>end_procedure 42857>>>>>>>>>>>procedure ErrorHnd_Quiet_Deactivate global 42859>>>>>>>>>>> send DoDeactivate to (oErrorHandlerQuiet(self)) 42860>>>>>>>>>>>end_procedure 42861>>>>>>>>>>>function ErrorHnd_Quiet_ErrorCount global returns integer 42863>>>>>>>>>>> function_return (row_count(oErrorHandlerQuiet(self))) 42864>>>>>>>>>>>end_function 42865>>>>>>>>>>> 42865>>>>>>>>>>>// This commmand is only for use after "open"ing a table that 42865>>>>>>>>>>>// has all the listed fields as columns. Unfortunately, this 42865>>>>>>>>>>>// package does not include the means of making use of that. 42865>>>>>>>>>>> 42865>>>>>>>>> 42865>>>>>>>>>// Pske sndag: Forrsjvndgn -> Fuldmne -> Sndag 42865>>>>>>>>> 42865>>>>>>>>> define t.calendar.year for "Year" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.month for "Month" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.day for "Day" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.week for "Wk." // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.calendar_popup for "Calendar Popup" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.Monday for "Monday" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.Tuesday for "Tuesday" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.Wednesday for "Wednesday" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.Thursday for "Thursday" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.Friday for "Friday" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.Saturday for "Saturday" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.Sunday for "Sunday" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.January for "January" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.February for "February" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.March for "March" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.April for "April" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.May for "May" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.June for "June" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.July for "July" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.August for "August" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.September for "September" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.October for "October" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.November for "November" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.December for "December" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.ok for "OK" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.Cancel for "Cancel" // LNG_ENGLISH 42865>>>>>>>>> define t.calendar.Activate for "Activate popup calendar (Ctrl+D)" // LNG_ENGLISH 42865>>>>>>>>> 42865>>>>>>>>>define LargestPossibleDate for 913490 // December 31st 2500 42865>>>>>>>>>define Jan1st1900 for 693975 42865>>>>>>>>>define Jan1st2000 for 730500 42865>>>>>>>>>define Jan1st1930 for 704933 42865>>>>>>>>>define Jan1st1000 for 365250 42865>>>>>>>>>define Jan1st105 for 38352 42865>>>>>>>>>define Jan1st100 for 36525 42865>>>>>>>>> 42865>>>>>>>>>enumeration_list // Date Segments 42865>>>>>>>>> define DS_DAY 42865>>>>>>>>> define DS_WEEK 42865>>>>>>>>> define DS_MONTH 42865>>>>>>>>> define DS_YEAR 42865>>>>>>>>> define DS_QUARTER 42865>>>>>>>>>end_enumeration_list 42865>>>>>>>>> 42865>>>>>>>>>integer Dates$Year Dates$Month Dates$Day // internal use 42865>>>>>>>>> 42865>>>>>>>>>procedure DateDecompose global date ldDate //very internal!! 42867>>>>>>>>> integer liPos1 liPos2 liFormat 42867>>>>>>>>> string lsValue lsSep 42867>>>>>>>>> move (date(ldDate)) to ldDate 42868>>>>>>>>> get_attribute DF_DATE_FORMAT to liFormat 42871>>>>>>>>> get_attribute DF_DATE_SEPARATOR to liPos1 // overload 42874>>>>>>>>> character liPos1 to lsSep // end overload 42875>>>>>>>>>> 42875>>>>>>>>> move ldDate to lsValue 42876>>>>>>>>> replace lsSep in lsValue with "$" 42878>>>>>>>>> move strmark to liPos1 42879>>>>>>>>> if [found] begin 42881>>>>>>>>> replace lsSep in lsValue with "$" 42883>>>>>>>>> move strmark to liPos2 42884>>>>>>>>> end 42884>>>>>>>>>> 42884>>>>>>>>> else begin 42885>>>>>>>>> move 0 to Dates$Year 42886>>>>>>>>> move 0 to Dates$Month 42887>>>>>>>>> move 0 to Dates$Day 42888>>>>>>>>> end 42888>>>>>>>>>> 42888>>>>>>>>> [ found] begin 42890>>>>>>>>>> 42890>>>>>>>>> if liFormat eq DF_DATE_EUROPEAN ; left lsValue to Dates$Day (liPos1-1) 42894>>>>>>>>> if liFormat eq DF_DATE_USA begin 42896>>>>>>>>> mid lsValue to Dates$Day (liPos2-liPos1-1) (liPos1+1) 42899>>>>>>>>>> 42899>>>>>>>>> left lsValue to Dates$Month (liPos1-1) 42901>>>>>>>>>> 42901>>>>>>>>> end 42901>>>>>>>>>> 42901>>>>>>>>> else mid lsValue to Dates$Month (liPos2-liPos1-1) (liPos1+1) 42905>>>>>>>>> 42905>>>>>>>>> if liFormat eq DF_DATE_MILITARY begin 42907>>>>>>>>> mid lsValue to Dates$Day 2 (liPos2+1) 42910>>>>>>>>>> 42910>>>>>>>>> left lsValue to Dates$Year (liPos1-1) 42912>>>>>>>>>> 42912>>>>>>>>> end 42912>>>>>>>>>> 42912>>>>>>>>> else mid lsValue to Dates$Year 4 (liPos2+1) 42916>>>>>>>>> end 42916>>>>>>>>>> 42916>>>>>>>>> //showln "" 42916>>>>>>>>> //showln (string(date#)+": "+string(Dates$Day)+","+string(Dates$Month)+","+string(Dates$Year)) 42916>>>>>>>>>end_procedure 42917>>>>>>>>> 42917>>>>>>>>>function DateCompose global integer liDay integer liMonth integer liYear returns date 42919>>>>>>>>> integer liFormat 42919>>>>>>>>> date ldDate 42919>>>>>>>>> string lsSep 42919>>>>>>>>> ifnot (liDay*liMonth) function_return 0 42922>>>>>>>>>// ifnot (liDay*liMonth*liYear) function_return 0 42922>>>>>>>>> get_attribute DF_DATE_SEPARATOR to liFormat // overload 42925>>>>>>>>> character liFormat to lsSep // end overload 42926>>>>>>>>>> 42926>>>>>>>>> get_attribute DF_DATE_FORMAT to liFormat 42929>>>>>>>>> if liDay gt 28 begin 42931>>>>>>>>> if liFormat eq DF_DATE_EUROPEAN move (date(string(liDay)+lsSep+string(liMonth)+lsSep+string(liYear))) to ldDate // DMY 42934>>>>>>>>> if liFormat eq DF_DATE_USA move (date(string(liMonth)+lsSep+string(liDay)+lsSep+string(liYear))) to ldDate // MDY 42937>>>>>>>>> if liFormat eq DF_DATE_MILITARY move (date(string(liYear)+lsSep+string(liMonth)+lsSep+string(liDay))) to ldDate // YMD 42940>>>>>>>>> send DateDecompose ldDate 42941>>>>>>>>> if Dates$Month ne liMonth move (liDay-Dates$Day) to liDay 42944>>>>>>>>> end 42944>>>>>>>>>> 42944>>>>>>>>> if liFormat eq DF_DATE_EUROPEAN function_return (date(string(liDay)+lsSep+string(liMonth)+lsSep+string(liYear))) // DMY 42947>>>>>>>>> if liFormat eq DF_DATE_USA function_return (date(string(liMonth)+lsSep+string(liDay)+lsSep+string(liYear))) // MDY 42950>>>>>>>>> function_return (date(string(liYear)+lsSep+string(liMonth)+lsSep+string(liDay))) // YMD 42951>>>>>>>>>end_function 42952>>>>>>>>> 42952>>>>>>>>>function DateIsLegalComponents global integer liDay integer liMonth integer liYear returns integer 42954>>>>>>>>> date ldDate 42954>>>>>>>>> get Year2to4 liYear to liYear 42955>>>>>>>>> if liDay gt 31 function_return DFFALSE 42958>>>>>>>>> if liMonth gt 12 function_return DFFALSE 42961>>>>>>>>> get DateCompose liDay liMonth liYear to ldDate 42962>>>>>>>>> send DateDecompose ldDate 42963>>>>>>>>> function_return (Dates$Year=liYear and Dates$Month=liMonth and Dates$Day=liDay) 42964>>>>>>>>>end_function 42965>>>>>>>>> 42965>>>>>>>>>function DateFormatName global integer liFormat returns string 42967>>>>>>>>> if liFormat eq DF_DATE_EUROPEAN function_return "European" 42970>>>>>>>>> if liFormat eq DF_DATE_USA function_return "United States" 42973>>>>>>>>> if liFormat eq DF_DATE_MILITARY function_return "Military" 42976>>>>>>>>>end_function 42977>>>>>>>>> 42977>>>>>>>>>function DateCurrentSeparator global returns string 42979>>>>>>>>> integer liRval 42979>>>>>>>>> get_attribute DF_DATE_SEPARATOR to liRval 42982>>>>>>>>> function_return (character(liRval)) 42983>>>>>>>>>end_function 42984>>>>>>>>> 42984>>>>>>>>>function DateCurrentFormat global returns integer 42986>>>>>>>>> integer liRval 42986>>>>>>>>> get_attribute DF_DATE_FORMAT to liRval 42989>>>>>>>>> function_return liRval 42990>>>>>>>>>end_function 42991>>>>>>>>> 42991>>>>>>>>>function DateFormatAsString global integer liFormat integer lbLong string lsSep returns string 42993>>>>>>>>> string lsRval lsLetter 42993>>>>>>>>> if liFormat eq DF_DATE_EUROPEAN move "3342241111" to lsRval 42996>>>>>>>>> if liFormat eq DF_DATE_USA move "2243341111" to lsRval 42999>>>>>>>>> if liFormat eq DF_DATE_MILITARY move "1111422433" to lsRval 43002>>>>>>>>> left t.calendar.year to lsLetter 1 43004>>>>>>>>>> 43004>>>>>>>>> replace "1" in lsRval with lsLetter 43006>>>>>>>>> replace "1" in lsRval with lsLetter 43008>>>>>>>>> ifnot lbLong move "" to lsLetter 43011>>>>>>>>> move (replaces("1",lsRval,lsLetter)) to lsRval 43012>>>>>>>>> move (replaces("2",lsRval,left(t.calendar.month,1))) to lsRval 43013>>>>>>>>> move (replaces("3",lsRval,left(t.calendar.day,1))) to lsRval 43014>>>>>>>>> if lsSep eq "" begin 43016>>>>>>>>> get_attribute DF_DATE_SEPARATOR to liFormat 43019>>>>>>>>> character liFormat to lsSep 43020>>>>>>>>>> 43020>>>>>>>>> end 43020>>>>>>>>>> 43020>>>>>>>>> move (replaces("4",lsRval,lsSep)) to lsRval 43021>>>>>>>>> function_return lsRval 43022>>>>>>>>>end_function 43023>>>>>>>>> 43023>>>>>>>>>function StringToDate global string lsDate integer liFormat integer lbLong string lsSep returns date 43025>>>>>>>>> integer liSepLen liDay liMonth liYear 43025>>>>>>>>> move (length(lsSep)) to liSepLen 43026>>>>>>>>> if lbLong move 4 to lbLong // ugly overload 43029>>>>>>>>> else move 2 to lbLong 43031>>>>>>>>> if liFormat eq DF_DATE_EUROPEAN begin // DMY 43033>>>>>>>>> move (mid(lsDate,2,1)) to liDay 43034>>>>>>>>> move (mid(lsDate,2,3+liSepLen)) to liMonth 43035>>>>>>>>> move (mid(lsDate,lbLong,5+liSepLen+liSepLen)) to liYear 43036>>>>>>>>> end 43036>>>>>>>>>> 43036>>>>>>>>> if liFormat eq DF_DATE_USA begin // MDY 43038>>>>>>>>> move (mid(lsDate,2,1)) to liMonth 43039>>>>>>>>> move (mid(lsDate,2,3+liSepLen)) to liDay 43040>>>>>>>>> move (mid(lsDate,lbLong,5+liSepLen+liSepLen)) to liYear 43041>>>>>>>>> end 43041>>>>>>>>>> 43041>>>>>>>>> if liFormat eq DF_DATE_MILITARY begin // YMD 43043>>>>>>>>> move (mid(lsDate,lbLong,1)) to liYear 43044>>>>>>>>> move (mid(lsDate,2,1+lbLong+liSepLen)) to liMonth 43045>>>>>>>>> move (mid(lsDate,2,3+lbLong+liSepLen+liSepLen)) to liDay 43046>>>>>>>>> end 43046>>>>>>>>>> 43046>>>>>>>>> get Year2to4 liYear to liYear 43047>>>>>>>>> function_return (DateCompose(liDay,liMonth,liYear)) 43048>>>>>>>>>end_function 43049>>>>>>>>> 43049>>>>>>>>>function DateToString global date ldDate integer liFormat integer lbLong string lsSep returns string 43051>>>>>>>>> string lsRval lsDay lsMonth lsYear 43051>>>>>>>>> get Date2to4 ldDate to ldDate 43052>>>>>>>>> if (integer(ldDate)) begin 43054>>>>>>>>> send DateDecompose ldDate 43055>>>>>>>>> move Dates$Day to lsDay 43056>>>>>>>>> if Dates$Day lt 10 insert "0" in lsDay at 1 43060>>>>>>>>> move Dates$Month to lsMonth 43061>>>>>>>>> if Dates$Month lt 10 insert "0" in lsMonth at 1 43065>>>>>>>>> move Dates$Year to lsYear 43066>>>>>>>>> ifnot lbLong move (right(lsYear,2)) to lsYear 43069>>>>>>>>> if liFormat eq DF_DATE_EUROPEAN move (lsDay+lsSep+lsMonth+lsSep+lsYear) to lsRval // DMY 43072>>>>>>>>> if liFormat eq DF_DATE_USA move (lsMonth+lsSep+lsDay+lsSep+lsYear) to lsRval // MDY 43075>>>>>>>>> if liFormat eq DF_DATE_MILITARY move (lsYear+lsSep+lsMonth+lsSep+lsDay) to lsRval // YMD 43078>>>>>>>>> end 43078>>>>>>>>>> 43078>>>>>>>>> else move "" to lsRval 43080>>>>>>>>> function_return lsRval 43081>>>>>>>>>end_function 43082>>>>>>>>> 43082>>>>>>>>>//> The DateIsValid takes one string parameter and returns TRUE if its value 43082>>>>>>>>>//> constitutes a date. 43082>>>>>>>>>function DateIsValid global string lsValue returns integer 43084>>>>>>>>> date ldDate 43084>>>>>>>>> send ErrorHnd_Quiet_Activate // Deactivate error handler 43085>>>>>>>>> move lsValue to ldDate // Move the value to a date variable 43086>>>>>>>>> send ErrorHnd_Quiet_Deactivate // Re-activate the normal error handler 43087>>>>>>>>> ifnot (ErrorHnd_Quiet_ErrorCount()) function_return (integer(ldDate)) 43090>>>>>>>>> function_return DFFALSE 43091>>>>>>>>>end_function 43092>>>>>>>>> 43092>>>>>>>>>// Function DateAsString is only here for compatibility with earlier versions. 43092>>>>>>>>>// Use function DateToString instead. 43092>>>>>>>>>function DateAsString global date ldDate integer liFormat integer lbLong string lsSep returns string 43094>>>>>>>>> function_return (DateToString(ldDate,liFormat,lbLong,lsSep)) 43095>>>>>>>>>end_function 43096>>>>>>>>> 43096>>>>>>>>>//> Use DateIncrement to add or subtract a number of months, years, days or 43096>>>>>>>>>//> weeks from a given date. 43096>>>>>>>>>//> 43096>>>>>>>>>//> date ldDate is the date to which the time interval will be added or subtracted 43096>>>>>>>>>//> 43096>>>>>>>>>//> integer liSegment may be one of these constants: DS_YEAR, DS_MONTH, DS_DAY or DS_WEEK 43096>>>>>>>>>//> 43096>>>>>>>>>//> integer liAmount is the (positive or negative) amount of units (indicated by liSegment) to be added. 43096>>>>>>>>>function DateIncrement global date ldDate integer liSegment integer liAmount returns date 43098>>>>>>>>> if (ldDate=0) function_return 0 43101>>>>>>>>> if liSegment eq DS_QUARTER function_return (DateIncrement(ldDate,DS_MONTH,liAmount*3)) 43104>>>>>>>>> if liSegment eq DS_WEEK function_return (ldDate+(liAmount*7)) //weeks 43107>>>>>>>>> if (liSegment<>DS_DAY) begin // months or years 43109>>>>>>>>> send DateDecompose ldDate 43110>>>>>>>>> if liSegment eq DS_MONTH begin //months 43112>>>>>>>>> move (Dates$Month+liAmount) to Dates$Month 43113>>>>>>>>> if liAmount ge 0 function_return (DateCompose(Dates$Day,Dates$Month-(((Dates$Month-1)/12)*12),Dates$Year+((Dates$Month-1)/12))) 43116>>>>>>>>> function_return (DateCompose(Dates$Day,Dates$Month-(((Dates$Month-12)/12)*12),Dates$Year+((Dates$Month-12)/12))) 43117>>>>>>>>> end //years: 43117>>>>>>>>>> 43117>>>>>>>>> if liSegment eq DS_YEAR function_return (DateCompose(Dates$Day,Dates$Month,Dates$Year+liAmount)) 43120>>>>>>>>> end 43120>>>>>>>>>> 43120>>>>>>>>> else function_return (ldDate+liAmount) //days 43122>>>>>>>>>end_function 43123>>>>>>>>> 43123>>>>>>>>>function DateSegment global date ldDate integer liSegment returns integer 43125>>>>>>>>> send DateDecompose ldDate 43126>>>>>>>>> if liSegment eq DS_DAY function_return Dates$Day 43129>>>>>>>>> if liSegment eq DS_MONTH function_return Dates$Month 43132>>>>>>>>> if liSegment eq DS_YEAR function_return Dates$Year 43135>>>>>>>>> if liSegment eq DS_QUARTER function_return (Dates$Month+2/3) 43138>>>>>>>>>end_function 43139>>>>>>>>> 43139>>>>>>>>>function DateToInteger global date ldDate returns integer // 20011231 43141>>>>>>>>> send DateDecompose ldDate 43142>>>>>>>>> function_return (Dates$Year*100+Dates$Month*100+Dates$Day) 43143>>>>>>>>>end_function 43144>>>>>>>>> 43144>>>>>>>>>function FirstDayInMonth global date ldDate returns date 43146>>>>>>>>> integer liMonth liYear 43146>>>>>>>>> move (DateSegment(ldDate,DS_MONTH)) to liMonth 43147>>>>>>>>> move (DateSegment(ldDate,DS_YEAR)) to liYear 43148>>>>>>>>> function_return (DateCompose(1,liMonth,liYear)) 43149>>>>>>>>>end_function 43150>>>>>>>>> 43150>>>>>>>>>function LastDayInMonth global date ldDate returns date 43152>>>>>>>>> move (DateIncrement(ldDate,DS_MONTH,1)) to ldDate 43153>>>>>>>>> function_return (FirstDayInMonth(ldDate)-1) 43154>>>>>>>>>end_function 43155>>>>>>>>> 43155>>>>>>>>>function FirstDayInYear global date ldDate returns date 43157>>>>>>>>> integer liYear 43157>>>>>>>>> move (DateSegment(ldDate,DS_YEAR)) to liYear 43158>>>>>>>>> function_return (DateCompose(1,1,liYear)) 43159>>>>>>>>>end_function 43160>>>>>>>>> 43160>>>>>>>>>function LastDayInYear global date ldDate returns date 43162>>>>>>>>> move (DateIncrement(ldDate,DS_YEAR,1)) to ldDate 43163>>>>>>>>> function_return (FirstDayInYear(ldDate)-1) 43164>>>>>>>>>end_function 43165>>>>>>>>> 43165>>>>>>>>>function DateDistance global date ldDate1 date ldDate2 integer liSegment returns integer 43167>>>>>>>>> integer lbNegative liDistance liDay liYear1 liYear2 liMonth1 liMonth2 43167>>>>>>>>> date ldTemp 43167>>>>>>>>> if (ldDate1>ldDate2) begin 43169>>>>>>>>> move ldDate1 to ldTemp 43170>>>>>>>>> move ldDate2 to ldDate1 43171>>>>>>>>> move ldTemp to ldDate2 43172>>>>>>>>> move DFTRUE to lbNegative 43173>>>>>>>>> end 43173>>>>>>>>>> 43173>>>>>>>>> else move DFFALSE to lbNegative 43175>>>>>>>>> if (liSegment=DS_DAY) move (integer(ldDate2)-integer(ldDate1)) to liDistance 43178>>>>>>>>> if (liSegment=DS_WEEK) begin 43180>>>>>>>>> get DateDayNumber ldDate1 to liDay 43181>>>>>>>>> move (date(integer(ldDate1)-liDay+1)) to ldDate1 // Now a monday 43182>>>>>>>>> get DateDayNumber ldDate2 to liDay 43183>>>>>>>>> move (date(integer(ldDate2)-liDay+1)) to ldDate2 // Now a monday 43184>>>>>>>>> move (integer(ldDate2)-integer(ldDate1)) to liDistance 43185>>>>>>>>> move (liDistance/7) to liDistance 43186>>>>>>>>> end 43186>>>>>>>>>> 43186>>>>>>>>> if (liSegment=DS_MONTH) begin 43188>>>>>>>>> move (DateSegment(ldDate1,DS_MONTH)) to liMonth1 43189>>>>>>>>> move (DateSegment(ldDate1,DS_YEAR)) to liYear1 43190>>>>>>>>> move (DateSegment(ldDate2,DS_MONTH)) to liMonth2 43191>>>>>>>>> move (DateSegment(ldDate2,DS_YEAR)) to liYear2 43192>>>>>>>>> move (liYear2-liYear1*12+liMonth2-liMonth1) to liDistance 43193>>>>>>>>> end 43193>>>>>>>>>> 43193>>>>>>>>> if (liSegment=DS_QUARTER) begin 43195>>>>>>>>> move (DateSegment(ldDate1,DS_QUARTER)) to liMonth1 // Overload 43196>>>>>>>>> move (DateSegment(ldDate1,DS_YEAR)) to liYear1 43197>>>>>>>>> move (DateSegment(ldDate2,DS_QUARTER)) to liMonth2 // Overload 43198>>>>>>>>> move (DateSegment(ldDate2,DS_YEAR)) to liYear2 43199>>>>>>>>> move (liYear2-liYear1*4+liMonth2-liMonth1) to liDistance 43200>>>>>>>>> end 43200>>>>>>>>>> 43200>>>>>>>>> if (liSegment=DS_YEAR) begin 43202>>>>>>>>> move (DateSegment(ldDate1,DS_YEAR)) to liYear1 43203>>>>>>>>> move (DateSegment(ldDate2,DS_YEAR)) to liYear2 43204>>>>>>>>> move (liYear2-liYear1) to liDistance 43205>>>>>>>>> end 43205>>>>>>>>>> 43205>>>>>>>>> if lbNegative move (0-liDistance) to liDistance 43208>>>>>>>>> function_return liDistance 43209>>>>>>>>>end_function 43210>>>>>>>>> 43210>>>>>>>>>function DateWeekNumber global date ldDate returns integer 43212>>>>>>>>> integer liWeek liFirstWeekDay liDayOfYear liYear liWeekDay 43212>>>>>>>>> if (integer(ldDate)=0) function_return 0 43215>>>>>>>>> 43215>>>>>>>>> get Date2to4 ldDate to ldDate 43216>>>>>>>>> get DateDayNumber ldDate to liWeekDay 43217>>>>>>>>> move (DateSegment(ldDate-liWeekDay+1,DS_YEAR)) to liYear 43218>>>>>>>>> 43218>>>>>>>>> get DateDayNumber (FirstDayInYear(ldDate)) to liFirstWeekDay 43219>>>>>>>>> move (ldDate-FirstDayInYear(ldDate)) to liDayOfYear 43220>>>>>>>>> move (liDayOfYear-1-7+liFirstWeekDay) to liDayOfYear 43221>>>>>>>>> if (liDayOfYear/7.0) ge 0 move (liDayOfYear/7+1) to liWeek 43224>>>>>>>>> else move 0 to liWeek 43226>>>>>>>>> if liFirstWeekDay le 4 increment liWeek 43229>>>>>>>>> if liWeek gt 52 begin 43231>>>>>>>>> move 1 to liWeek 43232>>>>>>>>> if liFirstWeekDay eq 4 move 53 to liWeek 43235>>>>>>>>> if liFirstWeekDay eq 3 if ((liYear/4)*4) eq liYear ifnot ((liYear/100)*100) eq liYear move 53 to liWeek 43242>>>>>>>>> end 43242>>>>>>>>>> 43242>>>>>>>>> if liWeek eq 0 begin 43244>>>>>>>>> // Week 52 or 53 43244>>>>>>>>> get DateDayNumber (DateIncrement(FirstDayInYear(ldDate),DS_YEAR,-1)) to liFirstWeekDay 43245>>>>>>>>> move 52 to liWeek 43246>>>>>>>>> if liFirstWeekDay eq 4 move 53 to liWeek 43249>>>>>>>>> if liFirstWeekDay eq 3 if ((liYear/4)*4) eq liYear ifnot ((liYear/100)*100) eq liYear move 53 to liWeek 43256>>>>>>>>> end 43256>>>>>>>>>> 43256>>>>>>>>> function_return liWeek 43257>>>>>>>>>end_function 43258>>>>>>>>> 43258>>>>>>>>>function DayName global integer liWeekDay returns string 43260>>>>>>>>> if liWeekDay eq 1 function_return t.calendar.Monday 43263>>>>>>>>> if liWeekDay eq 2 function_return t.calendar.Tuesday 43266>>>>>>>>> if liWeekDay eq 3 function_return t.calendar.Wednesday 43269>>>>>>>>> if liWeekDay eq 4 function_return t.calendar.Thursday 43272>>>>>>>>> if liWeekDay eq 5 function_return t.calendar.Friday 43275>>>>>>>>> if liWeekDay eq 6 function_return t.calendar.Saturday 43278>>>>>>>>> if liWeekDay eq 7 function_return t.calendar.Sunday 43281>>>>>>>>> function_return "" 43282>>>>>>>>>end_function 43283>>>>>>>>> 43283>>>>>>>>>function DateDayNumber global date ldDate returns integer 43285>>>>>>>>> integer liRval // 1=Monday, ... , 7=Sunday 43285>>>>>>>>> get Date2to4 ldDate to ldDate 43286>>>>>>>>> move ldDate to liRval 43287>>>>>>>>> if liRval begin 43289>>>>>>>>> if liRval gt 693975 move (liRval-2) to liRval 43292>>>>>>>>> move (liRval-((liRval/7)*7)) to liRval 43293>>>>>>>>> if liRval eq 0 move 7 to liRval 43296>>>>>>>>> end 43296>>>>>>>>>> 43296>>>>>>>>> function_return liRval 43297>>>>>>>>>end_function 43298>>>>>>>>> 43298>>>>>>>>>function DateDayName global date ldDate returns string 43300>>>>>>>>> function_return (DayName(DateDayNumber(ldDate))) 43301>>>>>>>>>end_function 43302>>>>>>>>> 43302>>>>>>>>>function YearMaxWeek global integer liYear returns integer 43304>>>>>>>>> integer liWeek1 liWeek2 43304>>>>>>>>> get DateWeekNumber (DateCompose(31,12,liYear)) to liWeek1 43305>>>>>>>>> get DateWeekNumber (DateCompose(24,12,liYear)) to liWeek2 43306>>>>>>>>> function_return (liWeek1 max liWeek2) 43307>>>>>>>>>end_function 43308>>>>>>>>> 43308>>>>>>>>>function WeekToDate global integer liYear integer liWeek returns date 43310>>>>>>>>> date ldDate 43310>>>>>>>>> move (DateCompose(1,1,liYear)) to ldDate 43311>>>>>>>>> if (DateWeekNumber(ldDate)) ne 1 move (ldDate+7) to ldDate // week 52 or 53 43314>>>>>>>>> move (ldDate-DateDayNumber(ldDate)+1) to ldDate // Now it's a Monday 43315>>>>>>>>> function_return (liWeek-1*7+ldDate) 43316>>>>>>>>>end_function 43317>>>>>>>>> 43317>>>>>>>>>function MonthName global integer liMonth returns string 43319>>>>>>>>> if liMonth eq 1 function_return t.calendar.January 43322>>>>>>>>> if liMonth eq 2 function_return t.calendar.February 43325>>>>>>>>> if liMonth eq 3 function_return t.calendar.March 43328>>>>>>>>> if liMonth eq 4 function_return t.calendar.April 43331>>>>>>>>> if liMonth eq 5 function_return t.calendar.May 43334>>>>>>>>> if liMonth eq 6 function_return t.calendar.June 43337>>>>>>>>> if liMonth eq 7 function_return t.calendar.July 43340>>>>>>>>> if liMonth eq 8 function_return t.calendar.August 43343>>>>>>>>> if liMonth eq 9 function_return t.calendar.September 43346>>>>>>>>> if liMonth eq 10 function_return t.calendar.October 43349>>>>>>>>> if liMonth eq 11 function_return t.calendar.November 43352>>>>>>>>> if liMonth eq 12 function_return t.calendar.December 43355>>>>>>>>> function_return "" 43356>>>>>>>>>end_function 43357>>>>>>>>> 43357>>>>>>>>>function DateMonthName global date ldDate returns string 43359>>>>>>>>> function_return (MonthName(DateSegment(ldDate,DS_MONTH))) 43360>>>>>>>>>end_function 43361>>>>>>>>> 43361>>>>>>>>>// May be used like this: 43361>>>>>>>>>// get DateAsText 06/06/2006 "#D-#MN3-#Y4" to lsValue 43361>>>>>>>>>// => lsValue = 6-Jul-2006 43361>>>>>>>>>function DateAsText global date ldDate string lsFormat returns string 43363>>>>>>>>> integer liDay liMonth liYear liYearTmp 43363>>>>>>>>> if ldDate eq 0 function_return "" 43366>>>>>>>>> move (replace("#DN3",lsFormat,left(DateDayName(ldDate),3))) to lsFormat 43367>>>>>>>>> move (replace("#DN2",lsFormat,left(DateDayName(ldDate),2))) to lsFormat // Dutch request. 01/08/2005 43368>>>>>>>>> move (replace("#MN3",lsFormat,left(DateMonthName(ldDate),3))) to lsFormat 43369>>>>>>>>> move (replace("#DN", lsFormat,DateDayName(ldDate))) to lsFormat 43370>>>>>>>>> move (replace("#MN", lsFormat,DateMonthName(ldDate))) to lsFormat 43371>>>>>>>>> move (replace("#WN", lsFormat,DateWeekNumber(ldDate))) to lsFormat 43372>>>>>>>>> move (DateSegment(ldDate,DS_DAY)) to liDay 43373>>>>>>>>> move (DateSegment(ldDate,DS_MONTH)) to liMonth 43374>>>>>>>>> move (DateSegment(ldDate,DS_YEAR)) to liYear 43375>>>>>>>>> move (replace("#D2", lsFormat,if(liDay<10,"0"+string(liDay),string(liDay)))) to lsFormat 43376>>>>>>>>> move (replace("#D", lsFormat,string(liDay))) to lsFormat 43377>>>>>>>>> 43377>>>>>>>>> get Year4to2 liYear to liYearTmp 43378>>>>>>>>> move (replace("#Y2", lsFormat,if(liYearTmp<10,"0"+string(liYearTmp),string(liYearTmp)))) to lsFormat 43379>>>>>>>>> 43379>>>>>>>>> get Year2to4 liYear to liYearTmp 43380>>>>>>>>> move (replace("#Y4", lsFormat,string(liYearTmp))) to lsFormat 43381>>>>>>>>> 43381>>>>>>>>> move (replace("#M2", lsFormat,if(liMonth<10,"0"+string(liMonth),string(liMonth)))) to lsFormat 43382>>>>>>>>> move (replace("#M", lsFormat,string(liMonth))) to lsFormat 43383>>>>>>>>> function_return lsFormat 43384>>>>>>>>>end_function 43385>>>>>>>>> 43385>>>>>>>>>function Year2to4 global integer liYear returns integer 43387>>>>>>>>> integer liEpochValue 43387>>>>>>>>> get_date_attribute EPOCH_VALUE to liEpochValue 43388>>>>>>>>> if liYear lt 100 begin 43390>>>>>>>>> if liYear gt liEpochValue function_return (liYear+1900) 43393>>>>>>>>> function_return (liYear+2000) 43394>>>>>>>>> end 43394>>>>>>>>>> 43394>>>>>>>>> function_return liYear // No conversion done! 43395>>>>>>>>>end_function 43396>>>>>>>>> 43396>>>>>>>>>function Year4to2 global integer liYear returns integer 43398>>>>>>>>> function_return (right(string(liYear),2)) 43399>>>>>>>>>end_function 43400>>>>>>>>> 43400>>>>>>>>>function Date2to4 global date ldDate returns date 43402>>>>>>>>> integer liEpochValue 43402>>>>>>>>> move (date(ldDate)) to ldDate 43403>>>>>>>>> get_date_attribute EPOCH_VALUE to liEpochValue 43404>>>>>>>>> if ldDate gt 0 begin // Only if there is a date to convert 43406>>>>>>>>> if (DateSegment(ldDate,DS_YEAR)) lt 105 begin 43408>>>>>>>>> if Dates$Year gt liEpochValue function_return (DateIncrement(ldDate,DS_YEAR,1900)) 43411>>>>>>>>> function_return (DateIncrement(ldDate,DS_YEAR,2000)) 43412>>>>>>>>> end 43412>>>>>>>>>> 43412>>>>>>>>> function_return ldDate // No conversion done! 43413>>>>>>>>> end 43413>>>>>>>>>> 43413>>>>>>>>>end_function 43414>>>>>>>>> 43414>>>>>>>>>function Date4to2 global date ldDate returns date 43416>>>>>>>>> integer liEpochValue liYear 43416>>>>>>>>> get_date_attribute EPOCH_VALUE to liEpochValue 43417>>>>>>>>> if ldDate gt 0 begin // Only if there is a date to convert 43419>>>>>>>>> move (DateSegment(ldDate,DS_YEAR)) to liYear 43420>>>>>>>>> if liYear ge 100 begin // Only then conversion is needed! 43422>>>>>>>>> if (liYear>=(1900+liEpochValue) and liYear<(2000+liEpochValue)) begin 43424>>>>>>>>> if liYear lt 2000 function_return (DateIncrement(ldDate,DS_YEAR,-1900)) 43427>>>>>>>>> else function_return (DateIncrement(ldDate,DS_YEAR,-2000)) 43429>>>>>>>>> end 43429>>>>>>>>>> 43429>>>>>>>>> else error 301 "Date is out of epoch range" 43431>>>>>>>>> end 43431>>>>>>>>>> 43431>>>>>>>>> end 43431>>>>>>>>>> 43431>>>>>>>>> function_return ldDate // No conversion done! 43432>>>>>>>>>end_function 43433>>>>>>>>> 43433>>>>>>>>>function dSysDate global returns date 43435>>>>>>>>> date ldDate 43435>>>>>>>>> sysdate4 ldDate 43436>>>>>>>>> function_return ldDate 43437>>>>>>>>>end_function 43438>>>>>>>>> 43438>>>>>>>>>function iSysYear global returns integer 43440>>>>>>>>> date ldDate 43440>>>>>>>>> sysdate4 ldDate 43441>>>>>>>>> function_return (DateSegment(ldDate,DS_YEAR)) 43442>>>>>>>>>end_function 43443>>>>>>>>> 43443>>>>>>>>> procedure FieldSysdate for DataDictionary integer liField 43445>>>>>>>>> date ldDate 43445>>>>>>>>> get field_current_value liField to ldDate 43446>>>>>>>>> if ldDate eq 0 begin 43448>>>>>>>>> sysdate4 ldDate 43449>>>>>>>>> set field_changed_value liField to ldDate 43450>>>>>>>>> end 43450>>>>>>>>>> 43450>>>>>>>>> end_procedure 43451>>>>>>>>> 43451>>>>>>>>> procedure FieldDate2to4 for DataDictionary integer liField 43453>>>>>>>>> integer liYear 43453>>>>>>>>> date ldDate ldNewDate 43453>>>>>>>>> get field_current_value liField to ldDate 43454>>>>>>>>> 43454>>>>>>>>> move (DateSegment(ldDate,DS_YEAR)) to liYear 43455>>>>>>>>> if (liYear=0 and ldDate<>0) move (DateIncrement(ldDate,3,iSysYear())) to ldNewDate 43458>>>>>>>>> else move ldDate to ldNewDate 43460>>>>>>>>> 43460>>>>>>>>> move (Date2to4(ldNewDate)) to ldNewDate 43461>>>>>>>>> move (DateSegment(ldNewDate,3)) to liYear 43462>>>>>>>>> if (liYear>99 and liYear <=999) begin 43464>>>>>>>>> error 15 // Illegal entry in this window 43465>>>>>>>>>> 43465>>>>>>>>> procedure_return 1 43466>>>>>>>>> end 43466>>>>>>>>>> 43466>>>>>>>>> if ldNewDate ne ldDate set field_changed_value liField to ldNewDate 43469>>>>>>>>> end_procedure 43470>>>>>>>>> 43470>>>>>>>>> procedure FieldYear2to4 for DataDictionary integer liField 43472>>>>>>>>> integer liYear liNewYear lbChanged 43472>>>>>>>>> get field_current_value liField to liYear 43473>>>>>>>>> get field_changed_state liField to lbChanged 43474>>>>>>>>> if lbChanged begin 43476>>>>>>>>> if (liYear>99 and liYear<1000) begin 43478>>>>>>>>> error 15 // Illegal entry in this window 43479>>>>>>>>>> 43479>>>>>>>>> procedure_return 1 43480>>>>>>>>> end 43480>>>>>>>>>> 43480>>>>>>>>> move (Year2to4(liYear)) to liNewYear 43481>>>>>>>>> if liNewYear ne liYear set field_changed_value liField to liNewYear 43484>>>>>>>>> end 43484>>>>>>>>>> 43484>>>>>>>>> end_procedure 43485>>>>>>>>> 43485>>>>>>>>> function SysDate global returns date 43487>>>>>>>>> function_return (dSysDate()) 43488>>>>>>>>> end_function 43489>>>>>>>>> 43489>>>>>>>>>function sSysTime global returns string 43491>>>>>>>>> integer h# m# s# 43491>>>>>>>>> sysdate4 h# h# m# s# 43495>>>>>>>>> function_return (if(h#<10,"0","")+string(h#)+":"+if(m#<10,"0","")+string(m#)+":"+if(s#<10,"0","")+string(s#)) 43496>>>>>>>>>end_function 43497>>>>>>>>> 43497>>>>>>>>>function TS_SysTime global returns number 43499>>>>>>>>> integer liDate liHour liMinute liSecond 43499>>>>>>>>> sysdate4 liDate liHour liMinute liSecond 43503>>>>>>>>> function_return (liDate*24.0+liHour*60+liMinute*60+liSecond) 43504>>>>>>>>>end_function 43505>>>>>>>>> 43505>>>>>>>>>//> This function returns a TS value composed from the date and time 43505>>>>>>>>>//> passed to it. Note that the time variable must be of the format 43505>>>>>>>>>//> "hh:mm:ss". 43505>>>>>>>>>function TS_Compose global date ldDate string lsTime returns number 43507>>>>>>>>> integer liHour liMinute liSecond 43507>>>>>>>>> left lsTime to liHour 2 43509>>>>>>>>>> 43509>>>>>>>>> mid lsTime to liMinute 2 4 43512>>>>>>>>>> 43512>>>>>>>>> mid lsTime to liSecond 2 7 43515>>>>>>>>>> 43515>>>>>>>>> function_return (integer(ldDate)*24.0+liHour*60+liMinute*60+liSecond) 43516>>>>>>>>>end_function 43517>>>>>>>>> 43517>>>>>>>>>function TS_Compose2 global date ldDate integer liHour integer liMinute integer liSecond returns number 43519>>>>>>>>> function_return (integer(ldDate)*24.0+liHour*60+liMinute*60+liSecond) 43520>>>>>>>>>end_function 43521>>>>>>>>> 43521>>>>>>>>>function TS_ExtractDate global number lnTime returns date 43523>>>>>>>>> function_return (lnTime/86400) // 86400=24*60*60 43524>>>>>>>>>end_function 43525>>>>>>>>> 43525>>>>>>>>>function TS_ExtractTime global number lnTime returns string 43527>>>>>>>>> integer liHour liMinute liSecond 43527>>>>>>>>> move (lnTime-(86400.0*integer(TS_ExtractDate(lnTime)))) to liSecond 43528>>>>>>>>> move (liSecond/3600) to liHour 43529>>>>>>>>> move (liSecond-(liHour*3600)) to liSecond 43530>>>>>>>>> move (liSecond/60) to liMinute 43531>>>>>>>>> move (liSecond-(liMinute*60)) to liSecond 43532>>>>>>>>> function_return (if(liHour<10,"0","")+string(liHour)+":"+if(liMinute<10,"0","")+string(liMinute)+":"+if(liSecond<10,"0","")+string(liSecond)) 43533>>>>>>>>>end_function 43534>>>>>>>>> 43534>>>>>>>>>function TS_ConvertToString global number lnTime returns string 43536>>>>>>>>> date ldDate 43536>>>>>>>>> if (lnTime=0) function_return "" 43539>>>>>>>>> move (TS_ExtractDate(lnTime)) to ldDate 43540>>>>>>>>> if (integer(ldDate)) function_return (string(ldDate)+" "+TS_ExtractTime(lnTime)) 43543>>>>>>>>> else function_return (TS_ExtractTime(lnTime)) 43545>>>>>>>>>end_function 43546>>>>>>>>> 43546>>>>>>>>>function TS_ConvertStringToTS global string lsValue returns number 43548>>>>>>>>> string lsDate lsTime 43548>>>>>>>>> move (ExtractWord(lsValue," ",1)) to lsDate 43549>>>>>>>>> move (ExtractWord(lsValue," ",2)) to lsTime 43550>>>>>>>>> function_return (TS_Compose(lsDate,lsTime)) 43551>>>>>>>>>end_function 43552>>>>>>>>> 43552>>>>>>>>>function TS_ConvertToStringNoDate global number lnTS returns string 43554>>>>>>>>> integer liHour liMinute 43554>>>>>>>>> if (lnTS=0) function_return "" 43557>>>>>>>>> move (lnTS/3600) to liHour 43558>>>>>>>>> move (lnTS-(liHour*3600)) to lnTS 43559>>>>>>>>> move (lnTS/60) to liMinute 43560>>>>>>>>> move (lnTS-(liMinute*60)) to lnTS 43561>>>>>>>>> function_return (if(liHour<10,"0","")+string(liHour)+":"+if(liMinute<10,"0","")+string(liMinute)+":"+if(lnTS<10,"0","")+string(lnTS)) 43562>>>>>>>>>end_function 43563>>>>>>>>> 43563>>>>>>>>>// This procedure is used when a TS-variable must be displayed on screen. 43563>>>>>>>>>procedure TS_UI_Update global number lnTS integer lhObj1 integer liItm1 integer lhTmpObj2 integer liTmpItm2 43565>>>>>>>>> integer lhObj2 liItm2 43565>>>>>>>>> if num_arguments gt 3 begin 43567>>>>>>>>> move lhTmpObj2 to lhObj2 43568>>>>>>>>> move liTmpItm2 to liItm2 43569>>>>>>>>> end 43569>>>>>>>>>> 43569>>>>>>>>> else begin 43570>>>>>>>>> move lhObj1 to lhObj2 43571>>>>>>>>> move (liItm1+1) to liItm2 43572>>>>>>>>> end 43572>>>>>>>>>> 43572>>>>>>>>> set value of lhObj1 item liItm1 to (TS_ExtractDate(lnTS)) 43573>>>>>>>>> set value of lhObj2 item liItm2 to (TS_ExtractTime(lnTS)) 43574>>>>>>>>>end_procedure 43575>>>>>>>>> 43575>>>>>>>>>class TS_TimeEstimator is an array 43576>>>>>>>>> procedure construct_object 43578>>>>>>>>> forward send construct_object 43580>>>>>>>>> set delegation_mode to delegate_to_parent 43581>>>>>>>>> property number pnTotal public 0 // Seconds needed to run the loop. 43582>>>>>>>>> property number pnElapsed public 0 // Seconds elapsed so far. 43583>>>>>>>>> property number pnLeft public 0 // Number of seconds left 43584>>>>>>>>> property number pnStart public 0 43585>>>>>>>>> property number pnPause public 0 43586>>>>>>>>> property number pnPercent public 0 43587>>>>>>>>> property integer piMin public 0 43588>>>>>>>>> property integer piMax public 0 43589>>>>>>>>> end_procedure 43590>>>>>>>>> 43590>>>>>>>>> procedure TS_Start integer liMin integer liMax 43592>>>>>>>>> set piMin to liMin 43593>>>>>>>>> set piMax to liMax 43594>>>>>>>>> set pnStart to (TS_SysTime()) 43595>>>>>>>>> set pnElapsed to 0 43596>>>>>>>>> set pnPercent to 0 43597>>>>>>>>> end_procedure 43598>>>>>>>>> 43598>>>>>>>>> procedure TS_Calculate integer liPos 43600>>>>>>>>> integer liMin liMax 43600>>>>>>>>> get piMin to liMin 43601>>>>>>>>> get piMax to liMax 43602>>>>>>>>> set pnElapsed to (TS_SysTime()-pnStart(self)) 43603>>>>>>>>> set pnTotal to (pnElapsed(self)*(liMax-liMin)/number(liPos-liMin)) 43604>>>>>>>>> set pnLeft to (pnTotal(self)-pnElapsed(self)) 43605>>>>>>>>> set pnPercent to (100.0*(liPos-liMin)/(liMax-liMin)) 43606>>>>>>>>> end_procedure 43607>>>>>>>>> 43607>>>>>>>>> procedure TS_Pause 43609>>>>>>>>> set pnPause to (TS_SysTime()) 43610>>>>>>>>> end_procedure 43611>>>>>>>>> 43611>>>>>>>>> procedure TS_Continue 43613>>>>>>>>> set pnStart to (pnStart(self)+TS_SysTime()-pnPause(self)) 43614>>>>>>>>> end_procedure 43615>>>>>>>>>end_class 43616>>>>>>>>> 43616>>>>>>>>>function TS_Module_Compile_Time global string lsPath returns number 43618>>>>>>>>> date ldDate 43618>>>>>>>>> integer liHour liMin liSec 43618>>>>>>>>> string lsAppName 43618>>>>>>>>> move (ToOem(SysConf(SYSCONF_RUNTIME_NAME))) to lsAppName 43619>>>>>>>>> get_file_mod_time (ToOem(lsAppName)) to ldDate liHour liMin liSec 43623>>>>>>>>> function_return (TS_Compose2(ldDate,liHour,liMin,liSec)) 43624>>>>>>>>>end_function 43625>>>>>>>>> 43625>>>>>>>>>string Dates$Module_Compile_Time 43625>>>>>>>>>move "" to Dates$Module_Compile_Time 43626>>>>>>>>> 43626>>>>>>>>>function Module_Compile_Date global returns date 43628>>>>>>>>> number lnTS 43628>>>>>>>>> string lsValue 43628>>>>>>>>> get module_name to lsValue // 'module_name' is most likely the name of the .flx file. 43629>>>>>>>>> get TS_Module_Compile_Time lsValue to lnTS 43630>>>>>>>>> move (TS_ExtractTime(lnTS)) to Dates$Module_Compile_Time 43631>>>>>>>>> function_return (TS_ExtractDate(lnTS)) 43632>>>>>>>>>end_function 43633>>>>>>>>> 43633>>>>>>>>>function Module_Compile_Time global returns string 43635>>>>>>>>> date ldGarbage 43635>>>>>>>>> // Module_Compile_Date must be called before this one! 43635>>>>>>>>> if Dates$Module_Compile_Time eq "" move (Module_Compile_Date()) to ldGarbage 43638>>>>>>>>> function_return Dates$Module_Compile_Time 43639>>>>>>>>>end_function 43640>>>>>>>>> 43640>>>>>>>>>date Dates$ModuleStartDate 43640>>>>>>>>>string Dates$ModuleStartTime 8 43640>>>>>>>>>move (dSysDate()) to Dates$ModuleStartDate 43641>>>>>>>>>move (sSysTime()) to Dates$ModuleStartTime 43642>>>>>>>>> 43642>>>>>>>>>function Module_Start_Date global returns date 43644>>>>>>>>> function_return Dates$ModuleStartDate 43645>>>>>>>>>end_function 43646>>>>>>>>> 43646>>>>>>>>>function Module_Start_Time global returns string 43648>>>>>>>>> function_return Dates$ModuleStartTime 43649>>>>>>>>>end_function 43650>>>>>>>>> 43650>>>>>>>>> 43650>>>>>>>>>// The necessary information to do the following comes from Oliver Nelson 43650>>>>>>>>> 43650>>>>>>>>>Type Dates$SystemTime 43650>>>>>>>>> field Dates$SystemTime.iYear As Word 43650>>>>>>>>> field Dates$SystemTime.iMonth As Word 43650>>>>>>>>> field Dates$SystemTime.iDayOfWeek As Word 43650>>>>>>>>> field Dates$SystemTime.iDay As Word 43650>>>>>>>>> field Dates$SystemTime.iHour As Word 43650>>>>>>>>> field Dates$SystemTime.iMinute As Word 43650>>>>>>>>> field Dates$SystemTime.iSecond As Word 43650>>>>>>>>> field Dates$SystemTime.iMilliseconds As Word 43650>>>>>>>>>End_Type 43650>>>>>>>>>external_function Dates.GetSystemTime "GetSystemTime" kernel32.dll Pointer lpGST Returns VOID_TYPE 43651>>>>>>>>> 43651>>>>>>>>>function MilliSeconds_Systime global returns string 43653>>>>>>>>> integer liGrb 43653>>>>>>>>> string lsTimeData 43653>>>>>>>>> pointer lpST 43653>>>>>>>>> ZeroType Dates$SystemTime to lsTimeData 43654>>>>>>>>> getAddress of lsTimeData to lpST 43655>>>>>>>>> move (Dates.GetSystemTime(lpST)) to liGrb 43656>>>>>>>>> function_return lsTimeData 43657>>>>>>>>> //getbuff from TimeData as SystemTime.IVAL to var 43657>>>>>>>>>end_function 43658>>>>>>>>> 43658>>>>>>>>>function MilliSeconds_Elapsed global string lsStart string lsStop returns integer 43660>>>>>>>>> integer liYear1 liMonth1 liDay1 liHour1 liMinute1 liSecond1 liMilli1 43660>>>>>>>>> integer liYear2 liMonth2 liDay2 liHour2 liMinute2 liSecond2 liMilli2 43660>>>>>>>>> date ldDate1 ldDate2 43660>>>>>>>>> 43660>>>>>>>>> getbuff from lsStart at Dates$SystemTime.iYear to liYear1 43661>>>>>>>>> getbuff from lsStart at Dates$SystemTime.iMonth to liMonth1 43662>>>>>>>>> getbuff from lsStart at Dates$SystemTime.iDay to liDay1 43663>>>>>>>>> getbuff from lsStart at Dates$SystemTime.iHour to liHour1 43664>>>>>>>>> getbuff from lsStart at Dates$SystemTime.iMinute to liMinute1 43665>>>>>>>>> getbuff from lsStart at Dates$SystemTime.iSecond to liSecond1 43666>>>>>>>>> getbuff from lsStart at Dates$SystemTime.iMilliseconds to liMilli1 43667>>>>>>>>> getbuff from lsStop at Dates$SystemTime.iYear to liYear2 43668>>>>>>>>> getbuff from lsStop at Dates$SystemTime.iMonth to liMonth2 43669>>>>>>>>> getbuff from lsStop at Dates$SystemTime.iDay to liDay2 43670>>>>>>>>> getbuff from lsStop at Dates$SystemTime.iHour to liHour2 43671>>>>>>>>> getbuff from lsStop at Dates$SystemTime.iMinute to liMinute2 43672>>>>>>>>> getbuff from lsStop at Dates$SystemTime.iSecond to liSecond2 43673>>>>>>>>> getbuff from lsStop at Dates$SystemTime.iMilliseconds to liMilli2 43674>>>>>>>>> get DateCompose liDay1 liMonth1 liYear1 to ldDate1 43675>>>>>>>>> get DateCompose liDay2 liMonth2 liYear2 to ldDate2 43676>>>>>>>>> 43676>>>>>>>>> move (ldDate2 -ldDate1 ) to liDay1 43677>>>>>>>>> move (liHour2 -liHour1 ) to liHour1 43678>>>>>>>>> move (liMinute2-liMinute1) to liMinute1 43679>>>>>>>>> move (liSecond2-liSecond1) to liSecond1 43680>>>>>>>>> move (liMilli2 -liMilli1 ) to liMilli1 43681>>>>>>>>> 43681>>>>>>>>> function_return (liDay1*24+liHour1*60+liMinute1*60+liSecond1*1000+liMilli1) 43682>>>>>>>>>end_function 43683>>>>>>>>> 43683>>>>>>>>>procedure MilliSeconds_Wait global integer liMS 43685>>>>>>>>> string lsSys lsNow 43685>>>>>>>>> get MilliSeconds_Systime to lsSys 43686>>>>>>>>> repeat 43686>>>>>>>>>> 43686>>>>>>>>> get MilliSeconds_Systime to lsNow 43687>>>>>>>>> until (MilliSeconds_Elapsed(lsSys,lsNow)>=liMS) 43689>>>>>>>>>end_procedure 43690>>>>>>>>> 43690>>>>>>>Use ErrorHnd.nui // cErrorHandlerRedirector class and oErrorHandlerQuiet object 43690>>>>>>>Use Version.nui 43690>>>>>>> 43690>>>>>>>use WinFolder.nui // WinFolder_ReadFolder message Including file: winfolder.nui (C:\projects\BRS\VDFQuery\AppSrc\winfolder.nui) 43690>>>>>>>>>// use WinFolder.nui // WinFolder_ReadFolder message 43690>>>>>>>>> 43690>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface) 43690>>>>>>>>>Use Files.nui // Utilities for handling file related stuff (No User Interface) 43690>>>>>>>>>Use Dates.nui // Date routines (No User Interface) 43690>>>>>>>>>Use vWin32fh.pkg // Win API functions by Wil van Antwerpen of VDF-GuiDance Including file: vWin32fh.pkg (C:\projects\BRS\VDFQuery\AppSrc\vWin32fh.pkg) 43690>>>>>>>>>>>// This code is part of VDF GUIdance 43690>>>>>>>>>>>// Visit us @ http://www.vdf-guidance.com 43690>>>>>>>>>>>// e-Mail us @ info@vdf-guidance.com 43690>>>>>>>>>>>// VDF GUIdance is a mutual project of 43690>>>>>>>>>>>// Frank Vandervelpen - Vandervelpen Systems and 43690>>>>>>>>>>>// Wil van Antwerpen - Antwise Solutions 43690>>>>>>>>>>>// All software source code should be used <> without any warranty. 43690>>>>>>>>>>>// 43690>>>>>>>>>>>// 43690>>>>>>>>>>>// *** Windows 32 bit file handling wrapper class *** 43690>>>>>>>>>>>// 43690>>>>>>>>>>> 43690>>>>>>>>>>>// 05-09-2000 **WvA: Changed namingconvention of all classes and methods to new standard 43690>>>>>>>>>>>// This may be painfull for some of you, but it was really needed as it was 43690>>>>>>>>>>>// getting messy. The "vs" -prefix we used before was confusing and could 43690>>>>>>>>>>>// unintentionally have been interpreted as "Vdf-GUIdance String". 43690>>>>>>>>>>>// 43690>>>>>>>>>>>// The used naming-convention is: 43690>>>>>>>>>>>// - a prefix of "vWin32_" for every external function declaration 43690>>>>>>>>>>>// - a prefix of the letter "v" for the full API name for the vdf-wrapper function. 43690>>>>>>>>>>>// 43690>>>>>>>>>>>// By using this we are guarding ourselves for conflicts with variable declarations 43690>>>>>>>>>>>// of DataAccess in the future. 43690>>>>>>>>>>>// 43690>>>>>>>>>>>// mm-dd-yyyy Author Description 43690>>>>>>>>>>>// 43690>>>>>>>>>>>// vSHGetFolderPath added to retrieve the new shell folders 43690>>>>>>>>>>>// vGetWindowsDirectory 43690>>>>>>>>>>>// 43690>>>>>>>>>>>// vGetTempFileName 43690>>>>>>>>>>>// vGetTempPath 43690>>>>>>>>>>>// 11-17-2001 **WvA: Removed User Interface Error popups such as Error handling. 43690>>>>>>>>>>>// This is an absolute need for WebApp. We expect you to handle the 43690>>>>>>>>>>>// error in your application anyways. Changed this for: 43690>>>>>>>>>>>// vDeleteFile, vCopyFile, vMoveFile and vRenameFile 43690>>>>>>>>>>>// 03-02-2002 **WvA: vRemoveDirectory added 43690>>>>>>>>>>>// 03-11-2002 **WvA: The parameter lpdword in the external function declaration for 43690>>>>>>>>>>>// vWin32_SHBrowsForFolder can cause compiler errors. 43690>>>>>>>>>>>// It is renamed too avoid this. 43690>>>>>>>>>>>// 11-11-2002 **WvA: Codecleanup, vcSelectFile_Dialog is now cvSelectFile_Dialog, its 43690>>>>>>>>>>>// function vSelectedFileName is now just SelectedFileName 43690>>>>>>>>>>>// Removed the local keyword in the variable declarations 43690>>>>>>>>>>>// 02-12-2004 **WvA: Allan Ankerstjeme pointed me into a bug for the vCreateTempFileInPath 43690>>>>>>>>>>>// in that it didn't exactly return the correct filename of the file created. 43690>>>>>>>>>>>// This has now been taken care of. 43690>>>>>>>>>>>// ??-??-???? Also fixed are a number of other errors, like a memoryleak for the openfolders dialog and an addition of a missing 43690>>>>>>>>>>>// parameter when handling DDE errors. 43690>>>>>>>>>>> 43690>>>>>>>>>>>Use Case.mac 43690>>>>>>>>>>>Use File_Dlg.pkg // Contains OpenDialog class definition 43690>>>>>>>>>>>Use Seq_chnl.pkg 43690>>>>>>>>>>> 43690>>>>>>>>>>>Use windows 43690>>>>>>>>>>>Use Dferror 43690>>>>>>>>>>>Use Dll 43690>>>>>>>>>>> 43690>>>>>>>>>>>Define vMax_Path For |CI260 43690>>>>>>>>>>>Define vMinChar For |CI$80 43690>>>>>>>>>>>Define vMaxChar For |CI$7F 43690>>>>>>>>>>>Define vMinShort For |CI$8000 43690>>>>>>>>>>>Define vMaxShort For |CI$7FFF 43690>>>>>>>>>>>Define vMinLong For |CI$80000000 43690>>>>>>>>>>>Define vMaxLong For |CI$7FFFFFFF 43690>>>>>>>>>>>Define vMaxByte For |CI$FF 43690>>>>>>>>>>>Define vMaxWord For |CI$FFFF 43690>>>>>>>>>>>Define vMaxDword For |CI$FFFFFFFF 43690>>>>>>>>>>> 43690>>>>>>>>>>> 43690>>>>>>>>>>> 43690>>>>>>>>>>>// For FindFirstFile 43690>>>>>>>>>>>Define vINVALID_HANDLE_VALUE For |CI-1 43690>>>>>>>>>>>Define vINVALID_FILE_SIZE For |CI$FFFFFFFF 43690>>>>>>>>>>>Define vERROR_NO_MORE_FILES For |CI18 43690>>>>>>>>>>> 43690>>>>>>>>>>>// The defines below can be used to find out what kind of error has occured if 43690>>>>>>>>>>>// the API-call ShellExecute is used. 43690>>>>>>>>>>>Define vERROR_FILE_NOT_FOUND For |CI0002 43690>>>>>>>>>>>Define vERROR_PATH_NOT_FOUND For |CI0003 43690>>>>>>>>>>>Define vERROR_BAD_FORMAT For |CI0011 43690>>>>>>>>>>>Define vSE_ERR_ACCESSDENIED For |CI0005 43690>>>>>>>>>>>Define vSE_ERR_ASSOCINCOMPLETE For |CI0027 43690>>>>>>>>>>>Define vSE_ERR_DDEBUSY For |CI0030 43690>>>>>>>>>>>Define vSE_ERR_DDEFAIL For |CI0029 43690>>>>>>>>>>>Define vSE_ERR_DDETIMEOUT For |CI0028 43690>>>>>>>>>>>Define vSE_ERR_DLLNOTFOUND For |CI0032 43690>>>>>>>>>>>Define vSE_ERR_FNF For |CI0002 43690>>>>>>>>>>>Define vSE_ERR_NOASSOC For |CI0031 43690>>>>>>>>>>>Define vSE_ERR_OOM For |CI0008 43690>>>>>>>>>>>Define vSE_ERR_PNF For |CI0003 43690>>>>>>>>>>>Define vSE_ERR_SHARE For |CI0026 43690>>>>>>>>>>> 43690>>>>>>>>>>> 43690>>>>>>>>>>> 43690>>>>>>>>>>> 43690>>>>>>>>>>>// *WvA: 13-01-1999 Created 43690>>>>>>>>>>>// The Class cSelectFile_Dialog is created to support the function Select_File 43690>>>>>>>>>>>// This function opens the Windows standard file open dialog and returns the selected 43690>>>>>>>>>>>// file_name. 43690>>>>>>>>>>>Class cvSelectFile_Dialog Is An OpenDialog 43691>>>>>>>>>>> 43691>>>>>>>>>>> Procedure Construct_Object Integer iImage_Id 43693>>>>>>>>>>> Forward Send Construct_Object iImage_Id 43695>>>>>>>>>>> Set HideReadOnly_State To True 43696>>>>>>>>>>> End_Procedure // Construct_Object 43697>>>>>>>>>>> 43697>>>>>>>>>>> Function SelectedFileName Returns String 43699>>>>>>>>>>> String sFileName 43699>>>>>>>>>>> Move "" To sFileName 43700>>>>>>>>>>> If (Show_Dialog(Self)) Begin 43702>>>>>>>>>>> Move (RTrim(File_Name(Self))) To sFileName 43703>>>>>>>>>>> End 43703>>>>>>>>>>>> 43703>>>>>>>>>>> Function_Return sFileName 43704>>>>>>>>>>> End_Function // SelectedFileName 43705>>>>>>>>>>>End_Class // cvSelectFile_Dialog 43706>>>>>>>>>>> 43706>>>>>>>>>>>// *WvA: 13-01-1999 Created 43706>>>>>>>>>>>// This function opens the Windows standard file open dialog and returns the selected 43706>>>>>>>>>>>// file_name. Returns '' if the user didn't make a selection. 43706>>>>>>>>>>>// **WvA: 17-10-2003 Cleaned up and added code to destroy the dynamically created 43706>>>>>>>>>>>// file-open dialog 43706>>>>>>>>>>>Function vSelect_File Global String sSupportedFileTypes String sCaptionText ; String sInitialFolder Returns String 43708>>>>>>>>>>> String sSelectedFile 43708>>>>>>>>>>> Integer hoOpenFileDialog 43708>>>>>>>>>>> 43708>>>>>>>>>>> Object oOpenFileDialog Is A cvSelectFile_Dialog 43710>>>>>>>>>>> Set Dialog_Caption To sCaptionText 43711>>>>>>>>>>> Set Filter_String To sSupportedFileTypes 43712>>>>>>>>>>> Set Initial_Folder To sInitialFolder 43713>>>>>>>>>>> 43713>>>>>>>>>>> Move Self To hoOpenFileDialog 43714>>>>>>>>>>> End_Object // oOpenFileDialog 43715>>>>>>>>>>> 43715>>>>>>>>>>> Get SelectedFileName Of hoOpenFileDialog To sSelectedFile 43716>>>>>>>>>>> Send Destroy_Object To hoOpenFileDialog 43717>>>>>>>>>>> Function_Return sSelectedFile 43718>>>>>>>>>>>End_Function // vSelect_File 43719>>>>>>>>>>> 43719>>>>>>>>>>>// These functions will only work if you include the packages of vdfquery 43719>>>>>>>>>>>// 43719>>>>>>>>>>>//// Pre: sFileName contains the complete path of the file. 43719>>>>>>>>>>>//// Post: returns the complete path of the file. 43719>>>>>>>>>>>//// This function is inspired on function SEQ_ExtractPathFromFileName of Sture Andersen. 43719>>>>>>>>>>>//Function ParseFolderName Global String sFileName Returns String 43719>>>>>>>>>>>// String sFolderName 43719>>>>>>>>>>>// String sDirSeperator // this is "\" for windows, or "/" for unix 43719>>>>>>>>>>>// Move (sysconf(SYSCONF_DIR_SEPARATOR)) to sDirSeperator 43719>>>>>>>>>>>// If sDirSeperator in sFileName function_return (StripFromLastOccurance(sFileName,sDirSeperator)) 43719>>>>>>>>>>>// if ":" in sFileName function_return (StripFromLastOccurance(sFileName,":")) 43719>>>>>>>>>>>// Function_Return sFolderName 43719>>>>>>>>>>>//End_Function // ParseFolderName 43719>>>>>>>>>>> 43719>>>>>>>>>>> 43719>>>>>>>>>>>//// Pre: sFileName contains the complete path of the file. 43719>>>>>>>>>>>//// post: The returned filename will have a extension 43719>>>>>>>>>>>//Function ParseFileName Global String sFileName Returns String 43719>>>>>>>>>>>// String sFolderName 43719>>>>>>>>>>>// String sDirSeperator // this is "\" for windows, or "/" for unix 43719>>>>>>>>>>>// Move (sysconf(SYSCONF_DIR_SEPARATOR)) to sDirSeperator 43719>>>>>>>>>>>// Get ParseFolderName sFileName To sFolderName 43719>>>>>>>>>>>// If (sFolderName NE "") replace sFolderName in sFileName with "" 43719>>>>>>>>>>>// replace sDirSeperator in sFileName with "" 43719>>>>>>>>>>>// Function_Return sFilename 43719>>>>>>>>>>>//End_Function // ParseFileName 43719>>>>>>>>>>> 43719>>>>>>>>>>> 43719>>>>>>>>>>>// Pre: sFileName may contain the complete path of the file. 43719>>>>>>>>>>>// or contain multiple dots in the filename, so temp.gif.bak will 43719>>>>>>>>>>>// return "bak" as the extension and not "gif" 43719>>>>>>>>>>>// Post: returns the extension only, this extension can be a valid unixlike extension 43719>>>>>>>>>>>// such as "html" or "java" 43719>>>>>>>>>>>Function ParseFileExtension Global String sFileName Returns String 43721>>>>>>>>>>> String sFileExtension 43721>>>>>>>>>>> String sChar 43721>>>>>>>>>>> Integer iLength 43721>>>>>>>>>>> Integer iPos 43721>>>>>>>>>>> Boolean bIsDot 43721>>>>>>>>>>> Move "" To sFileExtension 43722>>>>>>>>>>> Move (Length(sFileName)) To iLength 43723>>>>>>>>>>> If ((iLength>0) And (Pos(".",sFileName) <> 0)) Begin 43725>>>>>>>>>>> Move iLength To iPos 43726>>>>>>>>>>> Move (False) To bIsDot 43727>>>>>>>>>>> While Not bIsDot 43731>>>>>>>>>>> Move (Mid(sFileName,1,iPos)) To sChar 43732>>>>>>>>>>> Decrement iPos 43733>>>>>>>>>>> If ((sChar=".") Or (iPos<1)) Begin 43735>>>>>>>>>>> Move (True) To bIsDot 43736>>>>>>>>>>> End 43736>>>>>>>>>>>> 43736>>>>>>>>>>> Else Begin 43737>>>>>>>>>>> Move (sChar+sFileExtension) To sFileExtension 43738>>>>>>>>>>> End 43738>>>>>>>>>>>> 43738>>>>>>>>>>> Loop 43739>>>>>>>>>>>> 43739>>>>>>>>>>> End 43739>>>>>>>>>>>> 43739>>>>>>>>>>> Function_Return sFileExtension 43740>>>>>>>>>>>End_Function // ParseFileExtension 43741>>>>>>>>>>> 43741>>>>>>>>>>> 43741>>>>>>>>>>> 43741>>>>>>>>>>>Function DDE_Error_To_String Integer iErrorID Returns String #REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE) 43743>>>>>>>>>>> String sMessage 43743>>>>>>>>>>> Case begin 43743>>>>>>>>>>> Case (iErrorID = vERROR_FILE_NOT_FOUND) 43745>>>>>>>>>>> Append sMessage "The specified file was not found.\n" 43746>>>>>>>>>>> Case Break 43747>>>>>>>>>>> Case (iErrorID = vERROR_PATH_NOT_FOUND) 43750>>>>>>>>>>> Append sMessage "The specified path was not found.\n" 43751>>>>>>>>>>> Case Break 43752>>>>>>>>>>> Case (iErrorID = vERROR_BAD_FORMAT) 43755>>>>>>>>>>> Append sMessage "The .EXE file is invalid.\n" 43756>>>>>>>>>>> Case Break 43757>>>>>>>>>>> Case (iErrorID = vSE_ERR_ACCESSDENIED) 43760>>>>>>>>>>> Append sMessage "The operating system denied access to the specified file.\n" 43761>>>>>>>>>>> Case Break 43762>>>>>>>>>>> Case (iErrorID = vSE_ERR_ASSOCINCOMPLETE) 43765>>>>>>>>>>> Append sMessage "The filename association is incomplete or invalid.\n" 43766>>>>>>>>>>> Case Break 43767>>>>>>>>>>> Case (iErrorID = vSE_ERR_DDEBUSY) 43770>>>>>>>>>>> Append sMessage "The DDE transaction could not be completed because other DDE\n" 43771>>>>>>>>>>> Append sMessage "transactions were being processed.\n" 43772>>>>>>>>>>> Case Break 43773>>>>>>>>>>> Case (iErrorID = vSE_ERR_DDEFAIL) 43776>>>>>>>>>>> Append sMessage "The DDE transaction failed.\n" 43777>>>>>>>>>>> Case Break 43778>>>>>>>>>>> Case (iErrorID = vSE_ERR_DDETIMEOUT) 43781>>>>>>>>>>> Append sMessage "The DDE transaction could not be completed,\n" 43782>>>>>>>>>>> Append sMessage "because the request timed out.\n" 43783>>>>>>>>>>> Case Break 43784>>>>>>>>>>> Case (iErrorID = vSE_ERR_DLLNOTFOUND) 43787>>>>>>>>>>> Append sMessage "The specified dynamic-link library was not found.\n" 43788>>>>>>>>>>> Case Break 43789>>>>>>>>>>> Case (iErrorID = vSE_ERR_NOASSOC) 43792>>>>>>>>>>> Append sMessage "There is no application associated with the given filename extension.\n" 43793>>>>>>>>>>> Case Break 43794>>>>>>>>>>> Case ((iErrorID = vSE_ERR_OOM) OR (iErrorID = 0)) 43797>>>>>>>>>>> Append sMessage "There is not enough free memory available to complete the operation.\n" 43798>>>>>>>>>>> Case Break 43799>>>>>>>>>>> Case (iErrorID = vSE_ERR_PNF) 43802>>>>>>>>>>> Append sMessage "The specified path was not found.\n" 43803>>>>>>>>>>> Case Break 43804>>>>>>>>>>> Case (iErrorID = vSE_ERR_SHARE) 43807>>>>>>>>>>> Append sMessage "A sharing violation occurred.\n" 43808>>>>>>>>>>> Case Break 43809>>>>>>>>>>> Case Else 43809>>>>>>>>>>> Append sMessage "Unknown DDE-error occurred.\n" 43810>>>>>>>>>>> Append sMessage ("Errornumber"*trim(iErrorID)*".\n") 43811>>>>>>>>>>> Case Break 43812>>>>>>>>>>> Case end 43812>>>>>>>>>>> Function_Return sMessage 43813>>>>>>>>>>>End_Function // DDE_Error_To_String 43814>>>>>>>>>>> 43814>>>>>>>>>>> 43814>>>>>>>>>>>Procedure vDDE_Error_Handler Integer iErrorID #REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE) 43816>>>>>>>>>>> String sMessage 43816>>>>>>>>>>> Get DDE_Error_To_String iErrorID To sMessage 43817>>>>>>>>>>> Append sMessage "\nPress a key to continue...\n\n" 43818>>>>>>>>>>> Send Stop_Box sMessage "a DDE-error occured" 43819>>>>>>>>>>>End_Procedure // vDDE_Error_Handler hInstance 43820>>>>>>>>>>> 43820>>>>>>>>>>> 43820>>>>>>>>>>>// Does the directory exist? - No = 0, Yes = 1 43820>>>>>>>>>>>// This also works with UNC path encoding and wildcards 43820>>>>>>>>>>>Function vFolderExists Global String sFolderName returns Integer 43822>>>>>>>>>>> String sFolder sTmp 43822>>>>>>>>>>> Integer bFolderExists iCh 43822>>>>>>>>>>> 43822>>>>>>>>>>> Move dfTrue to bFolderExists 43823>>>>>>>>>>> Move "dir:" to sFolder 43824>>>>>>>>>>> Append sFolder sFolderName 43825>>>>>>>>>>> Get Seq_New_Channel to iCh // get free channel for input 43826>>>>>>>>>>> Direct_input channel iCh sFolder 43828>>>>>>>>>>> Repeat 43828>>>>>>>>>>>> 43828>>>>>>>>>>> Readln channel iCh sTmp 43830>>>>>>>>>>> If (trim(sTmp)="") Move dfFalse to bFolderExists 43833>>>>>>>>>>> Else Begin 43834>>>>>>>>>>> Move dfTrue to bFolderExists 43835>>>>>>>>>>> indicate seqeof True // end loop 43836>>>>>>>>>>> End 43836>>>>>>>>>>>> 43836>>>>>>>>>>> Until (seqeof) 43838>>>>>>>>>>> Close_input channel iCh 43840>>>>>>>>>>> Send Seq_Release_Channel iCh 43841>>>>>>>>>>> Function_Return bFolderExists 43842>>>>>>>>>>>End_Function // vFolderExists 43843>>>>>>>>>>> 43843>>>>>>>>>>> 43843>>>>>>>>>>> 43843>>>>>>>>>>>// C-Structure 43843>>>>>>>>>>>//typedef struct _browseinfo { 43843>>>>>>>>>>>// HWND hwndOwner; 43843>>>>>>>>>>>// LPCITEMIDLIST pidlRoot; 43843>>>>>>>>>>>// LPSTR pszDisplayName; 43843>>>>>>>>>>>// LPCSTR lpszTitle; 43843>>>>>>>>>>>// UINT ulFlags; 43843>>>>>>>>>>>// BFFCALLBACK lpfn; 43843>>>>>>>>>>>// LPARAM lParam; 43843>>>>>>>>>>>// int iImage; 43843>>>>>>>>>>>//} BROWSEINFO, *PBROWSEINFO, *LPBROWSEINFO; 43843>>>>>>>>>>> 43843>>>>>>>>>>>//declare C structure struct_browseinfo 43843>>>>>>>>>>>//as documented in MSDN under Windows Shell API 43843>>>>>>>>>>>Type vtBrowseInfo 43843>>>>>>>>>>> Field vtBrowseInfo.hWndOwner as handle 43843>>>>>>>>>>> Field vtBrowseInfo.pIDLRoot as Pointer 43843>>>>>>>>>>> Field vtBrowseInfo.pszDisplayName as Pointer 43843>>>>>>>>>>> Field vtBrowseInfo.lpszTitle as Pointer 43843>>>>>>>>>>> Field vtBrowseInfo.ulFlags as dWord 43843>>>>>>>>>>> Field vtBrowseInfo.lpfnCallback as Pointer 43843>>>>>>>>>>> Field vtBrowseInfo.lParam as dWord 43843>>>>>>>>>>> Field vtBrowseInfo.iImage as dWord 43843>>>>>>>>>>>End_Type // tBrowseInfo 43843>>>>>>>>>>> 43843>>>>>>>>>>>// Browsing for directory. 43843>>>>>>>>>>>Define vBIF_RETURNONLYFSDIRS For |CI$0001 // For finding a folder to start document searching 43843>>>>>>>>>>>Define vBIF_DONTGOBELOWDOMAIN For |CI$0002 // For starting the Find Computer 43843>>>>>>>>>>>Define vBIF_STATUSTEXT For |CI$0004 // Includes a status area in the dialog box. 43843>>>>>>>>>>> // The callback function can set the status text by 43843>>>>>>>>>>> // sending messages to the dialog box. 43843>>>>>>>>>>>Define vBIF_RETURNFSANCESTORS For |CI$0008 // Only returns file system ancestors. 43843>>>>>>>>>>> 43843>>>>>>>>>>>Define vBIF_BROWSEFORCOMPUTER For |CI$1000 // Browsing for Computers. 43843>>>>>>>>>>>Define vBIF_BROWSEFORPRINTER For |CI$2000 // Browsing for Printers 43843>>>>>>>>>>> 43843>>>>>>>>>>>// message from browser 43843>>>>>>>>>>>//Define BFFM_INITIALIZED 1 43843>>>>>>>>>>>//Define BFFM_SELCHANGED 2 43843>>>>>>>>>>> 43843>>>>>>>>>>>// messages to browser 43843>>>>>>>>>>>//Define BFFM_SETSTATUSTEXT (WM_USER + 100) 43843>>>>>>>>>>>//Define BFFM_ENABLEOK (WM_USER + 101) 43843>>>>>>>>>>>//Define BFFM_SETSELECTION (WM_USER + 102) 43843>>>>>>>>>>> 43843>>>>>>>>>>> 43843>>>>>>>>>>>External_Function vWin32_SHBrowseForFolder "SHBrowseForFolder" shell32.dll ; pointer lpsBrowseInfo returns dWord 43844>>>>>>>>>>> 43844>>>>>>>>>>>External_Function vWin32_SHGetPathFromIDList "SHGetPathFromIDList" shell32.dll ; pointer pidList pointer lpBuffer returns dWord 43845>>>>>>>>>>> 43845>>>>>>>>>>>External_Function vWin32_CoTaskMemFree "CoTaskMemFree" ole32.dll pointer pV returns Integer 43846>>>>>>>>>>> 43846>>>>>>>>>>>// returns folder name if a folder was selected, otherwise returns "" 43846>>>>>>>>>>>Function vSHBrowseForFolder Global String sDialogTitle returns String 43848>>>>>>>>>>> string sFolder sBrowseInfo sTitle 43848>>>>>>>>>>> pointer lpItemIdList lpsFolder lpsBrowseInfo lpsTitle 43848>>>>>>>>>>> integer iFolderSelected iRetval 43848>>>>>>>>>>> 43848>>>>>>>>>>> // fill string variable with null characters 43848>>>>>>>>>>> ZeroType vtBrowseInfo to sBrowseInfo 43849>>>>>>>>>>> 43849>>>>>>>>>>> If (sDialogTitle<>"") Begin 43851>>>>>>>>>>> Move sDialogTitle to sTitle 43852>>>>>>>>>>> // Torben Lund suggested converting the string with toansi. Doing it like that 43852>>>>>>>>>>> // disables showing some commonly used ascii characters like ascii 137 () 43852>>>>>>>>>>> // These chars are correctly shown if no toansi is used. 43852>>>>>>>>>>> // I can imagine that he wanted to path to be ANSI, but as long as it isa just 43852>>>>>>>>>>> // selected it will always be valid. 43852>>>>>>>>>>> GetAddress of sTitle to lpsTitle 43853>>>>>>>>>>> Put lpsTitle to sBrowseInfo at vtBrowseInfo.lpszTitle 43854>>>>>>>>>>> End 43854>>>>>>>>>>>> 43854>>>>>>>>>>> 43854>>>>>>>>>>> Put vBIF_RETURNONLYFSDIRS to sBrowseInfo at vtBrowseInfo.ulFlags 43855>>>>>>>>>>> 43855>>>>>>>>>>> // Torben Lund added line below. Move handle of focus object to structure before 43855>>>>>>>>>>> // calling function. Otherwise, the folderdialog will be started as a seperate task. 43855>>>>>>>>>>> Put (window_handle(focus(desktop))) to sBrowseInfo at vtBrowseInfo.hWndOwner 43856>>>>>>>>>>> 43856>>>>>>>>>>> GetAddress of sBrowseInfo to lpsBrowseInfo 43857>>>>>>>>>>> 43857>>>>>>>>>>> // null 128 chars into var (make space) 43857>>>>>>>>>>> move (repeat(character(0), vMAX_PATH)) to sFolder 43858>>>>>>>>>>> GetAddress of sFolder to lpsFolder 43859>>>>>>>>>>> 43859>>>>>>>>>>> // select folder 43859>>>>>>>>>>> move (vWin32_SHBrowseForFolder(lpsBrowseInfo)) to lpItemIdList 43860>>>>>>>>>>> // get selected folder name 43860>>>>>>>>>>> move (vWin32_SHGetPathFromIDList(lpItemIdList, lpsFolder)) to iFolderSelected 43861>>>>>>>>>>> 43861>>>>>>>>>>> // release memory resources that are used by the ItemIdList 43861>>>>>>>>>>> move (vWin32_CoTaskMemFree(lpItemIdList)) to iRetval 43862>>>>>>>>>>> 43862>>>>>>>>>>> If (iFolderSelected<>0) function_return (CString(sFolder)) 43865>>>>>>>>>>> Else Function_Return "" 43867>>>>>>>>>>>End_Function // vSHBrowseForFolder 43868>>>>>>>>>>> 43868>>>>>>>>>>> 43868>>>>>>>>>>> 43868>>>>>>>>>>>Type vtSecurity_attributes 43868>>>>>>>>>>> Field vtSecurity_attributes.nLength as dWord 43868>>>>>>>>>>> Field vtSecurity_attributes.lpDescriptor as Pointer 43868>>>>>>>>>>> Field vtSecurity_attributes.bInheritHandle as Integer 43868>>>>>>>>>>>End_Type // vtSecurity_attributes 43868>>>>>>>>>>> 43868>>>>>>>>>>>//nLength: 43868>>>>>>>>>>>// Specifies the size, in bytes, of this structure. Set this value to the size of the 43868>>>>>>>>>>>// SECURITY_ATTRIBUTES structure. 43868>>>>>>>>>>>// Windows NT: Some functions that use the SECURITY_ATTRIBUTES structure do not verify the 43868>>>>>>>>>>>// value of the nLength member. However, an application should still set it properly. 43868>>>>>>>>>>>// That ensures current, future, and cross-platform compatibility. 43868>>>>>>>>>>>// 43868>>>>>>>>>>>//lpSecurityDescriptor: 43868>>>>>>>>>>>// Points to a security descriptor for the object that controls the sharing of it. 43868>>>>>>>>>>>// If NULL is specified for this member, the object may be assigned the default security 43868>>>>>>>>>>>// descriptor of the calling process. 43868>>>>>>>>>>>// 43868>>>>>>>>>>>//bInheritHandle: 43868>>>>>>>>>>>// Specifies whether the returned handle is inherited when a new process is created. 43868>>>>>>>>>>>// If this member is TRUE, the new process inherits the handle. 43868>>>>>>>>>>> 43868>>>>>>>>>>> 43868>>>>>>>>>>>// BOOL CreateDirectory( 43868>>>>>>>>>>>// LPCTSTR lpPathName, 43868>>>>>>>>>>>// LPSECURITY_ATTRIBUTES lpSecurityAttributes // pointer to a security descriptor 43868>>>>>>>>>>>// ); 43868>>>>>>>>>>>// 43868>>>>>>>>>>>// lpPathName 43868>>>>>>>>>>>// Points to a null-terminated string that specifies the path of the directory 43868>>>>>>>>>>>// to be created. 43868>>>>>>>>>>>// There is a default string size limit for paths of MAX_PATH characters. 43868>>>>>>>>>>>// This limit is related to how the CreateDirectory function parses paths. 43868>>>>>>>>>>>// lpSecurityAttributes 43868>>>>>>>>>>>// Pointer to a SECURITY_ATTRIBUTES structure als called a security descriptor that 43868>>>>>>>>>>>// determines whether the returned handle can be inherited by child processes. 43868>>>>>>>>>>>// If lpSecurityAttributes is NULL, the handle cannot be inherited. 43868>>>>>>>>>>>// Returns: 43868>>>>>>>>>>>// If the function succeeds, the return value is nonzero. 43868>>>>>>>>>>>// If the function fails, the return value is zero. To get extended error information, call GetLastError. 43868>>>>>>>>>>>External_Function vWin32_CreateDirectory "CreateDirectoryA" kernel32.dll ; Pointer lpPathName Pointer lpSecurity_Attributes returns Integer 43869>>>>>>>>>>> 43869>>>>>>>>>>> 43869>>>>>>>>>>>// lpPathName 43869>>>>>>>>>>>// Points to a null-terminated string that specifies the path of the directory 43869>>>>>>>>>>>// to be removed. 43869>>>>>>>>>>>// There is a default string size limit for paths of MAX_PATH characters. 43869>>>>>>>>>>>// Returns: 43869>>>>>>>>>>>// If the function succeeds, the return value is nonzero. 43869>>>>>>>>>>>// If the function fails, the return value is zero. To get extended error information, call GetLastError. 43869>>>>>>>>>>>External_Function vWin32_RemoveDirectory "RemoveDirectoryA" kernel32.dll ; Pointer lpPathName returns Integer 43870>>>>>>>>>>> 43870>>>>>>>>>>> 43870>>>>>>>>>>>// returns 0 if the folder is created. 43870>>>>>>>>>>>// 1 if the API-call returned an error. 43870>>>>>>>>>>>Function vCreateDirectory Global String sNewFolder Returns Integer 43872>>>>>>>>>>> String sFolder sSA 43872>>>>>>>>>>> Pointer lpsFolder lpsSecurity_Attributes lpDescriptor 43872>>>>>>>>>>> Integer iRetval bFolderCreated bInheritHandle 43872>>>>>>>>>>> 43872>>>>>>>>>>> Move (False) To bFolderCreated 43873>>>>>>>>>>> // fill string variable with null characters 43873>>>>>>>>>>> ZeroType vtSecurity_attributes To sSA 43874>>>>>>>>>>> 43874>>>>>>>>>>> // null MAX_PATH chars into var (make space) 43874>>>>>>>>>>> Move (repeat(character(0), vMAX_PATH)) To sFolder 43875>>>>>>>>>>> 43875>>>>>>>>>>> If (sNewFolder <> "") Begin 43877>>>>>>>>>>> 43877>>>>>>>>>>> Move dfTrue To bInheritHandle 43878>>>>>>>>>>> // Setting this to NULL is already done by the zerotype command 43878>>>>>>>>>>> // Move NULL To lpDescriptor 43878>>>>>>>>>>> Put (length(sSA)) To sSA at vtSecurity_attributes.nLength 43879>>>>>>>>>>> //Put lpDescriptor To sSA at vtSecurity_attributes.lpDescriptor 43879>>>>>>>>>>> Put bInheritHandle To sSA at vtSecurity_attributes.bInheritHandle 43880>>>>>>>>>>> 43880>>>>>>>>>>> GetAddress Of sSA To lpsSecurity_Attributes 43881>>>>>>>>>>> 43881>>>>>>>>>>> // 43881>>>>>>>>>>> Move sNewFolder to sFolder 43882>>>>>>>>>>> GetAddress of sFolder to lpsFolder 43883>>>>>>>>>>> Move (vWin32_CreateDirectory(lpsFolder, lpsSecurity_Attributes)) to bFolderCreated 43884>>>>>>>>>>> End 43884>>>>>>>>>>>> 43884>>>>>>>>>>> 43884>>>>>>>>>>> IfNot bFolderCreated Move 1 To iRetVal 43887>>>>>>>>>>> Function_Return iRetVal 43888>>>>>>>>>>>End_Function // vCreateDirectory 43889>>>>>>>>>>> 43889>>>>>>>>>>> 43889>>>>>>>>>>>// **WvA: 03-02-2002 Function created. 43889>>>>>>>>>>>// With this function one can remove a directory. 43889>>>>>>>>>>>// returns 0 if the folder is removed. 43889>>>>>>>>>>>// 1 if the API-call returned an error (Use GetLastError API to get the details) 43889>>>>>>>>>>>// 2 if the folder did not exist 43889>>>>>>>>>>>// 3 if the sFolder parameter passed is equal to "" 43889>>>>>>>>>>>Function vRemoveDirectory Global String sFolder Returns Integer 43891>>>>>>>>>>> String sPath 43891>>>>>>>>>>> Pointer lpsPath 43891>>>>>>>>>>> Integer iRetval bRemoved bExists 43891>>>>>>>>>>> 43891>>>>>>>>>>> Move (False) To bRemoved 43892>>>>>>>>>>> Move 0 To iRetVal 43893>>>>>>>>>>> Move (Trim(sFolder)) To sFolder 43894>>>>>>>>>>> If (sFolder="") Begin 43896>>>>>>>>>>> Move 3 To iRetVal 43897>>>>>>>>>>> End 43897>>>>>>>>>>>> 43897>>>>>>>>>>> If (vFolderExists(sFolder)=False) Begin 43899>>>>>>>>>>> Move 2 To iRetVal 43900>>>>>>>>>>> End 43900>>>>>>>>>>>> 43900>>>>>>>>>>> If (iRetVal=0) Begin 43902>>>>>>>>>>> // null MAX_PATH chars into var (make space) 43902>>>>>>>>>>> Move (repeat(character(0), vMAX_PATH)) To sPath 43903>>>>>>>>>>> // 43903>>>>>>>>>>> Move (Insert(sFolder,sPath,1)) To sPath 43904>>>>>>>>>>> GetAddress of sPath to lpsPath 43905>>>>>>>>>>> Move (vWin32_RemoveDirectory(lpsPath)) to bRemoved 43906>>>>>>>>>>> End 43906>>>>>>>>>>>> 43906>>>>>>>>>>> 43906>>>>>>>>>>> If ((iRetVal=0) And (bRemoved=False)) Begin 43908>>>>>>>>>>> Move 1 To iRetVal 43909>>>>>>>>>>> End 43909>>>>>>>>>>>> 43909>>>>>>>>>>> Function_Return iRetVal 43910>>>>>>>>>>>End_Function // vRemoveDirectory 43911>>>>>>>>>>> 43911>>>>>>>>>>> 43911>>>>>>>>>>> 43911>>>>>>>>>>>// This function informs the user that he entered a yet unknown folder and 43911>>>>>>>>>>>// asks if he/she wants to create the folder (Yes/No) 43911>>>>>>>>>>>// Choice: "Yes" - this creates the folder 43911>>>>>>>>>>>// if successful, the function returns false 43911>>>>>>>>>>>// else it will be true. 43911>>>>>>>>>>>// Choice: "No" - returns TRUE, This allows the programmer to take action 43911>>>>>>>>>>>// For example: to stop a save 43911>>>>>>>>>>>// Precondition: A foldername must be entered. We do not check for empty paths 43911>>>>>>>>>>>// This function returns a non-zero value if the folder isn't created afterwards 43911>>>>>>>>>>>Function vVerifyNewFolder Global String sFolderName Returns Integer 43913>>>>>>>>>>> Integer bIsNotValid 43913>>>>>>>>>>> Integer iUsers_Choice 43913>>>>>>>>>>> String sMessage 43913>>>>>>>>>>> 43913>>>>>>>>>>> If (vFolderExists(sFolderName) EQ 0) Begin 43915>>>>>>>>>>> Move "The folder '" To sMessage 43916>>>>>>>>>>> Append sMessage sFolderName 43917>>>>>>>>>>> Append sMessage "' does not yet exist,\n" 43918>>>>>>>>>>> Append sMessage "Do you want to create it now?" 43919>>>>>>>>>>> Get YesNo_Box sMessage "Confirm" MB_DefButton1 To iUsers_Choice 43920>>>>>>>>>>> Case Begin 43920>>>>>>>>>>> Case (iUsers_Choice = MBR_Yes) 43922>>>>>>>>>>> Move (vCreateDirectory(sFolderName)) to bIsNotValid 43923>>>>>>>>>>> If bIsNotValid Begin 43925>>>>>>>>>>> Move "An error occurred while trying to create folder '" To sMessage 43926>>>>>>>>>>> Append sMessage sFolderName "'.\n\n" 43928>>>>>>>>>>> Send Info_Box sMessage "Info" 43929>>>>>>>>>>> End 43929>>>>>>>>>>>> 43929>>>>>>>>>>> Case Break 43930>>>>>>>>>>> Case (iUsers_Choice = MBR_No) 43933>>>>>>>>>>> Move dfTrue To bIsNotValid // Cancel the save 43934>>>>>>>>>>> Case Break 43935>>>>>>>>>>> Case End 43935>>>>>>>>>>> End 43935>>>>>>>>>>>> 43935>>>>>>>>>>> Function_return bIsNotValid 43936>>>>>>>>>>>End_Function // vVerifyNewFolder 43937>>>>>>>>>>> 43937>>>>>>>>>>> 43937>>>>>>>>>>>// The ShellExecute function opens or prints a specified file. The file can be an 43937>>>>>>>>>>>// executable file or a document file. 43937>>>>>>>>>>>// 43937>>>>>>>>>>>// Operation can be one of the following: 43937>>>>>>>>>>>// "OPEN" The function opens the file specified by lpFile. 43937>>>>>>>>>>>// The file can be an executable file or a document file. 43937>>>>>>>>>>>// The file can be a folder to open. 43937>>>>>>>>>>>// "PRINT" The function prints the file specified by lpFile. 43937>>>>>>>>>>>// The file should be a document file. If the file is an executable file, 43937>>>>>>>>>>>// the function opens the file, as if open had been specified. 43937>>>>>>>>>>>// "EXPLORE" The function explores the folder specified by lpFile. 43937>>>>>>>>>>>// 43937>>>>>>>>>>>// Return Values: 43937>>>>>>>>>>>// 43937>>>>>>>>>>>// If the function succeeds, the return value is the instance handle of the application that 43937>>>>>>>>>>>// was run, or the handle of a dynamic data exchange (DDE) server application. 43937>>>>>>>>>>>// If the function fails, the return value is an error value that is less than or equal to 32. 43937>>>>>>>>>>>// 43937>>>>>>>>>>>// The following table lists these error values: 43937>>>>>>>>>>>// Public Const ERROR_FILE_NOT_FOUND = 2& 43937>>>>>>>>>>>// Public Const ERROR_PATH_NOT_FOUND = 3& 43937>>>>>>>>>>>// Public Const ERROR_BAD_FORMAT = 11& 43937>>>>>>>>>>>// Public Const SE_ERR_ACCESSDENIED = 5 43937>>>>>>>>>>>// Public Const SE_ERR_ASSOCINCOMPLETE = 27 43937>>>>>>>>>>>// Public Const SE_ERR_DDEBUSY = 30 43937>>>>>>>>>>>// Public Const SE_ERR_DDEFAIL = 29 43937>>>>>>>>>>>// Public Const SE_ERR_DDETIMEOUT = 28 43937>>>>>>>>>>>// Public Const SE_ERR_DLLNOTFOUND = 32 43937>>>>>>>>>>>// Public Const SE_ERR_FNF = 2 43937>>>>>>>>>>>// Public Const SE_ERR_NOASSOC = 31 43937>>>>>>>>>>>// Public Const SE_ERR_OOM = 8 43937>>>>>>>>>>>// Public Const SE_ERR_PNF = 3 43937>>>>>>>>>>>// Public Const SE_ERR_SHARE = 26 43937>>>>>>>>>>> 43937>>>>>>>>>>> 43937>>>>>>>>>>> 43937>>>>>>>>>>>// Code to open the program that is associated with the selected file. 43937>>>>>>>>>>>// 43937>>>>>>>>>>>// External function call used in Procedure DoStartDocument 43937>>>>>>>>>>>External_Function vWin32_ShellExecute "ShellExecuteA" shell32.dll ; Handle hWnd ; Pointer lpOperation ; Pointer lpFile ; Pointer lpParameters ; Pointer lpDirectory ; Dword iShowCmd Returns Handle 43938>>>>>>>>>>> 43938>>>>>>>>>>> 43938>>>>>>>>>>>// This will perform an operation on a file (e.g. open) with the application 43938>>>>>>>>>>>// registered in the Windows Registry to open that type of file (via its extension) 43938>>>>>>>>>>>// sOperation would be "OPEN" (it could also be "PRINT" etc). 43938>>>>>>>>>>>Procedure vShellExecute global String sOperation String sDocument String sParameters String sPath 43940>>>>>>>>>>> Handle hInstance hWnd 43940>>>>>>>>>>> Pointer lpsOperation 43940>>>>>>>>>>> Pointer lpsDocument 43940>>>>>>>>>>> Pointer lpsParameters 43940>>>>>>>>>>> Pointer lpsPath 43940>>>>>>>>>>> // remove any leading/trailing spaces in the string 43940>>>>>>>>>>> Move (Trim(sDocument)) To sDocument 43941>>>>>>>>>>> Move (Trim(sPath)) To sPath 43942>>>>>>>>>>> // Make the strings readable for windows API, by converting them to null-terminated 43942>>>>>>>>>>> Append sOperation (Character(0)) 43943>>>>>>>>>>> Append sDocument (Character(0)) 43944>>>>>>>>>>> Append sParameters (Character(0)) 43945>>>>>>>>>>> Append sPath (Character(0)) 43946>>>>>>>>>>> // Connect the corresponding pointers to the strings 43946>>>>>>>>>>> GetAddress Of sOperation to lpsOperation 43947>>>>>>>>>>> GetAddress Of sDocument to lpsDocument 43948>>>>>>>>>>> GetAddress Of sParameters to lpsParameters 43949>>>>>>>>>>> GetAddress Of sPath to lpsPath 43950>>>>>>>>>>> 43950>>>>>>>>>>> Get Window_Handle To hWnd 43951>>>>>>>>>>> Move (vWin32_ShellExecute (hWnd, lpsOperation, lpsDocument, lpsParameters, lpsPath, 1)) To hInstance 43952>>>>>>>>>>> If (hInstance <= 32) Begin 43954>>>>>>>>>>> Send vDDE_Error_Handler hInstance 43955>>>>>>>>>>> End 43955>>>>>>>>>>>> 43955>>>>>>>>>>>End_Procedure // vShellExecute 43956>>>>>>>>>>> 43956>>>>>>>>>>> 43956>>>>>>>>>>> 43956>>>>>>>>>>> 43956>>>>>>>>>>> // Must be freed using SHFreeNameMappings 43956>>>>>>>>>>> 43956>>>>>>>>>>>Type vtShFileOpStruct 43956>>>>>>>>>>> Field vtShFileOpStruct.hWnd as Handle 43956>>>>>>>>>>> Field vtShFileOpStruct.wFunc as Integer 43956>>>>>>>>>>> Field vtShFileOpStruct.pFrom as Pointer 43956>>>>>>>>>>> Field vtShFileOpStruct.pTo as Pointer 43956>>>>>>>>>>> Field vtShFileOpStruct.fFlags as Short 43956>>>>>>>>>>> Field vtShFileOpStruct.fAnyOperationsAborted as Short 43956>>>>>>>>>>> Field vtShFileOpStruct.hNameMappings as Pointer 43956>>>>>>>>>>> Field vtShFileOpStruct.lpszProgressTitle as Pointer // only used if FOF_SIMPLEPROGRESS 43956>>>>>>>>>>>End_Type // tShFileOpStruct 43956>>>>>>>>>>> 43956>>>>>>>>>>>// hwnd 43956>>>>>>>>>>>// Handle of the dialog box to use to display information about the status of the operation. 43956>>>>>>>>>>> 43956>>>>>>>>>>>// wFunc 43956>>>>>>>>>>>// Operation to perform. This member can be one of the following values: 43956>>>>>>>>>>>// FO_COPY Copies the files specified by pFrom to the location specified by pTo. 43956>>>>>>>>>>>// FO_DELETE Deletes the files specified by pFrom (pTo is ignored). 43956>>>>>>>>>>>// FO_MOVE Moves the files specified by pFrom to the location specified by pTo. 43956>>>>>>>>>>>// FO_RENAME Renames the files specified by pFrom. 43956>>>>>>>>>>> 43956>>>>>>>>>>>// pFrom 43956>>>>>>>>>>>// Pointer to a buffer that specifies one or more source file names. Multiple names must 43956>>>>>>>>>>>// be null-separated. The list of names must be double null-terminated. 43956>>>>>>>>>>> 43956>>>>>>>>>>>// pTo 43956>>>>>>>>>>>// Pointer to a buffer that contains the name of the destination file or directory. The 43956>>>>>>>>>>>// buffer can contain mutiple destination file names if the fFlags member specifies 43956>>>>>>>>>>>// FOF_MULTIDESTFILES. Multiple names must be null-separated. The list of names must be 43956>>>>>>>>>>>// double null-terminated. 43956>>>>>>>>>>> 43956>>>>>>>>>>>// fAnyOperationsAborted 43956>>>>>>>>>>>// Value that receives TRUE if the user aborted any file operations before they 43956>>>>>>>>>>>// were completed or FALSE otherwise. 43956>>>>>>>>>>> 43956>>>>>>>>>>> 43956>>>>>>>>>>>// Performs a copy, move, rename, or delete operation on a file system object. 43956>>>>>>>>>>>// This can be a file or a folder. 43956>>>>>>>>>>>// With thanks to Andrew S Kaplan 43956>>>>>>>>>>>External_Function vWin32_SHFileOperation "SHFileOperationA" Shell32.dll ; pointer lpFileOp returns integer 43957>>>>>>>>>>> 43957>>>>>>>>>>> 43957>>>>>>>>>>> 43957>>>>>>>>>>>Function vDeleteFile Global String sFileName Returns Integer 43959>>>>>>>>>>> String sShFileOp 43959>>>>>>>>>>> Pointer lpShFileOp 43959>>>>>>>>>>> Pointer lpsFileName 43959>>>>>>>>>>> Integer iFlags 43959>>>>>>>>>>> Integer iRetVal 43959>>>>>>>>>>> Integer bUserAbort 43959>>>>>>>>>>> 43959>>>>>>>>>>> ZeroType vtShFileOpStruct To sShFileOp 43960>>>>>>>>>>> Append sFileName (Character(0)) (Character(0)) 43962>>>>>>>>>>> GetAddress of sFileName to lpsFileName 43963>>>>>>>>>>> Move (vFOF_SILENT iOr vFOF_NOCONFIRMATION iOr vFOF_ALLOWUNDO) To iFlags 43964>>>>>>>>>>> 43964>>>>>>>>>>> Put vFO_DELETE To sShFileOp at vtShFileOpStruct.wFunc 43965>>>>>>>>>>> Put lpsFileName To sShFileOp at vtShFileOpStruct.pFrom 43966>>>>>>>>>>> Put iFlags To sShFileOp at vtShFileOpStruct.fFlags 43967>>>>>>>>>>> GetAddress of sShFileOp To lpShFileOp 43968>>>>>>>>>>> 43968>>>>>>>>>>> Move (vWin32_SHFileOperation(lpShFileOp)) To iRetVal 43969>>>>>>>>>>> GetBuff from sShFileOp At vtShFileOpStruct.fAnyOperationsAborted To bUserAbort 43970>>>>>>>>>>> If (bUserAbort <> 0) Begin 43972>>>>>>>>>>> Move 80 To iRetVal // Deletefile Operation Aborted by USER 43973>>>>>>>>>>> End 43973>>>>>>>>>>>> 43973>>>>>>>>>>> Function_return iRetVal 43974>>>>>>>>>>>End_Function // vDeleteFile 43975>>>>>>>>>>> 43975>>>>>>>>>>> 43975>>>>>>>>>>>Function vCopyFile Global String sSource String sDestination returns Integer 43977>>>>>>>>>>> String sShFileOp 43977>>>>>>>>>>> Pointer lpShFileOp 43977>>>>>>>>>>> Pointer lpsSource 43977>>>>>>>>>>> Pointer lpsDestination 43977>>>>>>>>>>> Integer iFlags 43977>>>>>>>>>>> Integer iRetVal 43977>>>>>>>>>>> Integer bUserAbort 43977>>>>>>>>>>> 43977>>>>>>>>>>> ZeroType vtShFileOpStruct To sShFileOp 43978>>>>>>>>>>> Append sSource (Character(0)) (Character(0)) 43980>>>>>>>>>>> Append sDestination (Character(0)) (Character(0)) 43982>>>>>>>>>>> GetAddress of sSource To lpsSource 43983>>>>>>>>>>> GetAddress of sDestination To lpsDestination 43984>>>>>>>>>>> Move (vFOF_SILENT iOr vFOF_NOCONFIRMATION iOr vFOF_ALLOWUNDO) To iFlags 43985>>>>>>>>>>> 43985>>>>>>>>>>> Put vFO_COPY To sShFileOp at vtShFileOpStruct.wFunc 43986>>>>>>>>>>> Put lpsSource To sShFileOp at vtShFileOpStruct.pFrom 43987>>>>>>>>>>> Put lpsDestination To sShFileOp at vtShFileOpStruct.pTo 43988>>>>>>>>>>> Put iFlags To sShFileOp at vtShFileOpStruct.fFlags 43989>>>>>>>>>>> 43989>>>>>>>>>>> GetAddress of sShFileOp To lpShFileOp 43990>>>>>>>>>>> 43990>>>>>>>>>>> Move (vWin32_SHFileOperation(lpShFileOp)) To iRetVal 43991>>>>>>>>>>> GetBuff from sShFileOp At vtShFileOpStruct.fAnyOperationsAborted To bUserAbort 43992>>>>>>>>>>> If (bUserAbort <> 0) Begin 43994>>>>>>>>>>> Move 80 To iRetVal // Copyfile Operation Aborted by USER 43995>>>>>>>>>>> End 43995>>>>>>>>>>>> 43995>>>>>>>>>>> Function_return (iRetVal) 43996>>>>>>>>>>>End_Function // vCopyFile 43997>>>>>>>>>>> 43997>>>>>>>>>>> 43997>>>>>>>>>>>Function vMoveFile Global String sSource String sDestination returns Integer 43999>>>>>>>>>>> String sShFileOp 43999>>>>>>>>>>> Pointer lpShFileOp 43999>>>>>>>>>>> Pointer lpsSource 43999>>>>>>>>>>> Pointer lpsDestination 43999>>>>>>>>>>> Integer iFlags 43999>>>>>>>>>>> Integer iRetVal 43999>>>>>>>>>>> Integer bUserAbort 43999>>>>>>>>>>> 43999>>>>>>>>>>> ZeroType vtShFileOpStruct To sShFileOp 44000>>>>>>>>>>> Append sSource (Character(0)) (Character(0)) 44002>>>>>>>>>>> Append sDestination (Character(0)) (Character(0)) 44004>>>>>>>>>>> GetAddress of sSource To lpsSource 44005>>>>>>>>>>> GetAddress of sDestination To lpsDestination 44006>>>>>>>>>>> Move (vFOF_SILENT iOr vFOF_NOCONFIRMATION iOr vFOF_ALLOWUNDO) To iFlags 44007>>>>>>>>>>> 44007>>>>>>>>>>> Put vFO_MOVE To sShFileOp at vtShFileOpStruct.wFunc 44008>>>>>>>>>>> Put lpsSource To sShFileOp at vtShFileOpStruct.pFrom 44009>>>>>>>>>>> Put lpsDestination To sShFileOp at vtShFileOpStruct.pTo 44010>>>>>>>>>>> Put iFlags To sShFileOp at vtShFileOpStruct.fFlags 44011>>>>>>>>>>> 44011>>>>>>>>>>> GetAddress of sShFileOp To lpShFileOp 44012>>>>>>>>>>> 44012>>>>>>>>>>> Move (vWin32_SHFileOperation(lpShFileOp)) To iRetVal 44013>>>>>>>>>>> GetBuff from sShFileOp At vtShFileOpStruct.fAnyOperationsAborted To bUserAbort 44014>>>>>>>>>>> If (bUserAbort <> 0) Begin 44016>>>>>>>>>>> Move 80 To iRetVal // Movefile Operation Aborted by USER 44017>>>>>>>>>>> End 44017>>>>>>>>>>>> 44017>>>>>>>>>>> Function_return (iRetVal) 44018>>>>>>>>>>>End_Function // vMoveFile 44019>>>>>>>>>>> 44019>>>>>>>>>>>// Rename a file or folder 44019>>>>>>>>>>>// Returns a nonzero value if the operation failed. 44019>>>>>>>>>>>Function vRenameFile Global String sSource String sDestination returns Integer 44021>>>>>>>>>>> String sShFileOp 44021>>>>>>>>>>> Pointer lpShFileOp 44021>>>>>>>>>>> Pointer lpsSource 44021>>>>>>>>>>> Pointer lpsDestination 44021>>>>>>>>>>> Integer iFlags 44021>>>>>>>>>>> Integer iRetVal 44021>>>>>>>>>>> Integer bUserAbort 44021>>>>>>>>>>> 44021>>>>>>>>>>> ZeroType vtShFileOpStruct To sShFileOp 44022>>>>>>>>>>> Append sSource (Character(0)) (Character(0)) 44024>>>>>>>>>>> Append sDestination (Character(0)) (Character(0)) 44026>>>>>>>>>>> GetAddress of sSource To lpsSource 44027>>>>>>>>>>> GetAddress of sDestination To lpsDestination 44028>>>>>>>>>>> Move (vFOF_SILENT iOr vFOF_NOCONFIRMATION iOr vFOF_ALLOWUNDO) To iFlags 44029>>>>>>>>>>> 44029>>>>>>>>>>> Put vFO_RENAME To sShFileOp at vtShFileOpStruct.wFunc 44030>>>>>>>>>>> Put lpsSource To sShFileOp at vtShFileOpStruct.pFrom 44031>>>>>>>>>>> Put lpsDestination To sShFileOp at vtShFileOpStruct.pTo 44032>>>>>>>>>>> Put iFlags To sShFileOp at vtShFileOpStruct.fFlags 44033>>>>>>>>>>> 44033>>>>>>>>>>> GetAddress of sShFileOp To lpShFileOp 44034>>>>>>>>>>> 44034>>>>>>>>>>> Move (vWin32_SHFileOperation(lpShFileOp)) To iRetVal 44035>>>>>>>>>>> GetBuff from sShFileOp At vtShFileOpStruct.fAnyOperationsAborted To bUserAbort 44036>>>>>>>>>>> If (bUserAbort <> 0) Begin 44038>>>>>>>>>>> Move 80 To iRetVal // Renamefile Operation Aborted by USER 44039>>>>>>>>>>> End 44039>>>>>>>>>>>> 44039>>>>>>>>>>> Function_return (iRetVal) 44040>>>>>>>>>>>End_Function // vRenameFile 44041>>>>>>>>>>> 44041>>>>>>>>>>> 44041>>>>>>>>>>>// Thanks To Oliver Nelson for posting this code on the newsgroups 44041>>>>>>>>>>>External_function vWin32_GetWindowsDirectory "GetWindowsDirectoryA" kernel32.dll ; Pointer lpBuffer Integer nSize returns integer 44042>>>>>>>>>>> 44042>>>>>>>>>>> 44042>>>>>>>>>>>Function vGetWindowsDirectory Returns String #REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE) 44044>>>>>>>>>>> String sDirectory 44044>>>>>>>>>>> Pointer lpDirectory 44044>>>>>>>>>>> Integer iVoid 44044>>>>>>>>>>> 44044>>>>>>>>>>> ZeroString vMAX_PATH to sDirectory 44045>>>>>>>>>>> GetAddress of sDirectory to lpDirectory 44046>>>>>>>>>>> 44046>>>>>>>>>>> Move (vWin32_GetWindowsDirectory(lpDirectory, vMAX_PATH)) to iVoid 44047>>>>>>>>>>> Function_Return (CString(sDirectory)) // **WvA: Changed to CString() 44048>>>>>>>>>>>End_Function // vGetWindowsDirectory 44049>>>>>>>>>>> 44049>>>>>>>>>>> 44049>>>>>>>>>>> 44049>>>>>>>>>>>// Courtesy Of Vincent Oorsprong 44049>>>>>>>>>>>//External_Function vWin32_GetTempFileName "GetTempFileNameA" Kernel32.Dll ; 44049>>>>>>>>>>>// Pointer lpPathName ; 44049>>>>>>>>>>>// Pointer lpPrefixString ; 44049>>>>>>>>>>>// Integer uUnique ; 44049>>>>>>>>>>>// Pointer lpTempFileName ; 44049>>>>>>>>>>>// Returns Integer 44049>>>>>>>>>>> 44049>>>>>>>>>>>External_Function vWin32_GetTempFileName "GetTempFileNameA" kernel32.dll String sPath ; String sPrefix Integer iUnique Pointer pLoad Returns Integer 44050>>>>>>>>>>> 44050>>>>>>>>>>>External_Function vWin32_GetTempPath "GetTempPathA" Kernel32.Dll ; Dword nBufferLength ; Pointer lpBuffer ; Returns Integer 44051>>>>>>>>>>> 44051>>>>>>>>>>>External_Function vWin32_DeleteFile "DeleteFileA" Kernel32.Dll ; Pointer lpFileName ; Returns Integer 44052>>>>>>>>>>> 44052>>>>>>>>>>>// Courtesy of Marco Kuipers 44052>>>>>>>>>>>Function vMakeTempFile Returns String #REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE) 44054>>>>>>>>>>> Integer iRetval 44054>>>>>>>>>>> String sTempPath sTempFileName sPrefixString 44054>>>>>>>>>>> Pointer lpTempPath lpTempFileName lpPrefixString 44054>>>>>>>>>>> 44054>>>>>>>>>>> Move (Repeat (Character (0), 255)) To sTempPath 44055>>>>>>>>>>> GetAddress Of sTempPath To lpTempPath 44056>>>>>>>>>>> Move (vWin32_GetTempPath (255, lpTempPath)) To iRetVal 44057>>>>>>>>>>> 44057>>>>>>>>>>> If (sTempPath = "") Begin 44059>>>>>>>>>>> Get_Current_Directory To sTempPath 44060>>>>>>>>>>> End 44060>>>>>>>>>>>> 44060>>>>>>>>>>> 44060>>>>>>>>>>> Move (Repeat (Character (0), 255)) To sTempFileName 44061>>>>>>>>>>> GetAddress Of sTempFileName To lpTempFileName 44062>>>>>>>>>>> Move "tmp" To sPrefixString // TMP 44063>>>>>>>>>>> GetAddress Of sPrefixString To lpPrefixString 44064>>>>>>>>>>> GetAddress Of sTempPath To lpTempPath 44065>>>>>>>>>>> Move (vWin32_GetTempFileName (lpTempPath, lpPrefixString, 0, lpTempFileName)) To iRetval 44066>>>>>>>>>>> If (iRetval <> 0) Begin 44068>>>>>>>>>>> Move "" To sTempFileName 44069>>>>>>>>>>> End 44069>>>>>>>>>>>> 44069>>>>>>>>>>> 44069>>>>>>>>>>> Function_Return sTempFileName 44070>>>>>>>>>>>End_Function // vMakeTempFile 44071>>>>>>>>>>> 44071>>>>>>>>>>>// This function creates a uniquely named temporary file in folder sPath 44071>>>>>>>>>>>// The file created will have a prefix based on the first 3 characters in sPrefix 44071>>>>>>>>>>>// Note that you will have to cleanup the tempfile yourself as the function 44071>>>>>>>>>>>// does not take care of that. 44071>>>>>>>>>>>Function vCreateTempFileInPath String sPath String sPrefix Returns String #REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE) 44073>>>>>>>>>>> String sTempFileName 44073>>>>>>>>>>> Integer iCnt iRetVal 44073>>>>>>>>>>> Pointer lpTempFileName 44073>>>>>>>>>>> 44073>>>>>>>>>>> Move (ToAnsi(sPath)+Character(0)) To sPath 44074>>>>>>>>>>> Move (ToAnsi(sPrefix)+Character(0)) To sPrefix 44075>>>>>>>>>>> Move (pad("", vMAX_PATH)) To sTempFileName 44076>>>>>>>>>>> GetAddress Of sTempFileName To lpTempFileName 44077>>>>>>>>>>> 44077>>>>>>>>>>> Move (vWin32_GetTempFileName(sPath, sPrefix, 0, lpTempFileName)) To iRetVal 44078>>>>>>>>>>> Move (Trim(Cstring(sTempFileName))) To sTempFileName 44079>>>>>>>>>>> Function_Return sTempFileName 44080>>>>>>>>>>>End_Function // vCreateTempFileInPath 44081>>>>>>>>>>> 44081>>>>>>>>>>> 44081>>>>>>>>>>>Define vCSIDL_DESKTOP For |CI$00 44081>>>>>>>>>>>Define vCSIDL_PROGRAMS For |CI$02 44081>>>>>>>>>>>Define vCSIDL_CONTROLS For |CI$03 44081>>>>>>>>>>>Define vCSIDL_PRINTERS For |CI$04 44081>>>>>>>>>>>Define vCSIDL_PERSONAL For |CI$05 // (Documents folder) 44081>>>>>>>>>>>Define vCSIDL_FAVORITES For |CI$06 44081>>>>>>>>>>>Define vCSIDL_STARTUP For |CI$07 44081>>>>>>>>>>>Define vCSIDL_RECENT For |CI$08 // (Recent folder) 44081>>>>>>>>>>>Define vCSIDL_SENDTO For |CI$09 44081>>>>>>>>>>>Define vCSIDL_BITBUCKET For |CI$0A 44081>>>>>>>>>>>Define vCSIDL_STARTMENU For |CI$0B 44081>>>>>>>>>>>Define vCSIDL_DESKTOPDIRECTORY For |CI$10 44081>>>>>>>>>>>Define vCSIDL_DRIVES For |CI$11 44081>>>>>>>>>>>Define vCSIDL_NETWORK For |CI$12 44081>>>>>>>>>>>Define vCSIDL_NETHOOD For |CI$13 44081>>>>>>>>>>>Define vCSIDL_FONTS For |CI$14 44081>>>>>>>>>>>Define vCSIDL_TEMPLATES For |CI$15 // (ShellNew folder) 44081>>>>>>>>>>> 44081>>>>>>>>>>> 44081>>>>>>>>>>>//HRESULT SHGetFolderPath( 44081>>>>>>>>>>>// HWND hwndOwner, 44081>>>>>>>>>>>// int nFolder, 44081>>>>>>>>>>>// HANDLE hToken, 44081>>>>>>>>>>>// DWORD dwFlags, 44081>>>>>>>>>>>// LPTSTR pszPath 44081>>>>>>>>>>>//); 44081>>>>>>>>>>>// This function is a superset of SHGetSpecialFolderPath, included with earlier versions of 44081>>>>>>>>>>>// the shell. It is implemented in a redistributable DLL, SHFolder.dll, that also simulates 44081>>>>>>>>>>>// many of the new shell folders on older platforms such as Windows 95, Windows 98, and 44081>>>>>>>>>>>// Windows NT 4.0. This DLL always calls the current platform's version of this function. 44081>>>>>>>>>>>// If that fails, it will try to simulate the appropriate behavior. 44081>>>>>>>>>>>// 44081>>>>>>>>>>>External_Function vWin32_SHGetFolderPath "SHGetFolderPathA" SHFolder.Dll ; Pointer hWnd ; Integer nFolder ; Pointer hToken ; DWord dwFlags ; Pointer lpszPath ; Returns Integer 44082>>>>>>>>>>> 44082>>>>>>>>>>>Function vSHGetFolderPath Integer nFolder Returns String #REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE) 44084>>>>>>>>>>> String sFolder 44084>>>>>>>>>>> Integer iVoid 44084>>>>>>>>>>> Pointer lpsFolder 44084>>>>>>>>>>> Handle hWnd 44084>>>>>>>>>>> Move (Window_Handle(focus(desktop))) to hWnd 44085>>>>>>>>>>> 44085>>>>>>>>>>> move (repeat(character(0), vMAX_PATH)) to sFolder 44086>>>>>>>>>>> GetAddress of sFolder to lpsFolder 44087>>>>>>>>>>> 44087>>>>>>>>>>> Move (vWin32_SHGetFolderPath(hWnd,nFolder, 0, 0,lpsFolder)) To iVoid 44088>>>>>>>>>>> Function_Return (CString(sFolder)) 44089>>>>>>>>>>>End_Function // vSHGetFolderPAth 44090>>>>>>>>>>> 44090>>>>>>>>>>> 44090>>>>>>>>>>> 44090>>>>>>>>>>> 44090>>>>>>>>>>>Type vWin32_Find_Data 44090>>>>>>>>>>> Field vWin32_Find_Data.dwFileAttributes As Dword 44090>>>>>>>>>>> Field vWin32_Find_Data.ftCreationLowDateTime As Dword 44090>>>>>>>>>>> Field vWin32_Find_Data.ftCreationHighDateTime As Dword 44090>>>>>>>>>>> Field vWin32_Find_Data.ftLastAccessLowDateTime As dword 44090>>>>>>>>>>> Field vWin32_Find_Data.ftLastAccessHighDateTime As Dword 44090>>>>>>>>>>> Field vWin32_Find_Data.ftLastWriteLowDateTime As Dword 44090>>>>>>>>>>> Field vWin32_Find_Data.ftLastWriteHighDateTime As Dword 44090>>>>>>>>>>> Field vWin32_Find_Data.nFileSizeHigh As Dword 44090>>>>>>>>>>> Field vWin32_Find_Data.nFileSizeLow As Dword 44090>>>>>>>>>>> Field vWin32_Find_Data.dwReserved0 As Dword 44090>>>>>>>>>>> Field vWin32_Find_Data.dwReserved1 As Dword 44090>>>>>>>>>>> Field vWin32_Find_Data.cFileName As Char vMax_Path 44090>>>>>>>>>>> Field vWin32_Find_Data.cAlternateFileName As Char 14 44090>>>>>>>>>>>End_Type // vWin32_Find_Data 44090>>>>>>>>>>> 44090>>>>>>>>>>>// Courtesy Of Vincent Oorsprong 44090>>>>>>>>>>>// lpFileName : address of name of file to search for 44090>>>>>>>>>>>// lpFindFileData : address of returned information 44090>>>>>>>>>>>External_Function vWin32_FindFirstFile "FindFirstFileA" Kernel32.dll Pointer lpFileName ; Pointer lpFindFileData Returns Handle 44091>>>>>>>>>>> 44091>>>>>>>>>>>// Courtesy Of Vincent Oorsprong 44091>>>>>>>>>>>// hFindFile : handle of search 44091>>>>>>>>>>>// lpFindFileData : address of structure for data on found file 44091>>>>>>>>>>>External_Function vWin32_FindNextFile "FindNextFileA" Kernel32.dll Handle hFindFile ; Pointer lpFindFileData Returns Integer 44092>>>>>>>>>>> 44092>>>>>>>>>>>// Courtesy Of Vincent Oorsprong 44092>>>>>>>>>>>// hFindFile : file search handle 44092>>>>>>>>>>>External_Function vWin32_FindClose "FindClose" Kernel32.dll Handle hFindFile Returns Integer 44093>>>>>>>>>>> 44093>>>>>>>>>>> 44093>>>>>>>>>>> 44093>>>>>>>>>>>Type vFileTime 44093>>>>>>>>>>> Field vFileTime.dwLowDateTime As Dword 44093>>>>>>>>>>> FIeld vFileTime.dwHighDateTime As Dword 44093>>>>>>>>>>>End_Type // vFileTime 44093>>>>>>>>>>> 44093>>>>>>>>>>> 44093>>>>>>>>>>>Type vSystemTime 44093>>>>>>>>>>> Field vSystemTime.wYear As Word 44093>>>>>>>>>>> Field vSystemTime.wMonth As Word 44093>>>>>>>>>>> Field vSystemTime.wDayOfWeek As Word 44093>>>>>>>>>>> Field vSystemTime.wDay As Word 44093>>>>>>>>>>> Field vSystemTime.wHour As Word 44093>>>>>>>>>>> Field vSystemTime.wMinute As Word 44093>>>>>>>>>>> Field vSystemTime.wSecond As Word 44093>>>>>>>>>>> Field vSystemTime.wMilliSeconds As Word 44093>>>>>>>>>>>End_Type // vSystemTime 44093>>>>>>>>>>> 44093>>>>>>>>>>> 44093>>>>>>>>>>>// Courtesy Of Vincent Oorsprong 44093>>>>>>>>>>>// lpFileTime : pointer to file time to convert 44093>>>>>>>>>>>// lpSystemTime : pointer to structure to receive system time 44093>>>>>>>>>>>External_Function vWin32_FileTimeToSystemTime "FileTimeToSystemTime" Kernel32.Dll ; Pointer lpFileTime Pointer lpsystemTime Returns Integer 44094>>>>>>>>>>> 44094>>>>>>>>>>>// Courtesy Of Vincent Oorsprong 44094>>>>>>>>>>>// This function formats the time in a picture-string passed 44094>>>>>>>>>>>// 44094>>>>>>>>>>>// Picture Meaning 44094>>>>>>>>>>>// h Hours with no leading zero for single-digit hours; 12-hour clock 44094>>>>>>>>>>>// hh Hours with leading zero for single-digit hours; 12-hour clock 44094>>>>>>>>>>>// H Hours with no leading zero for single-digit hours; 24-hour clock 44094>>>>>>>>>>>// HH Hours with leading zero for single-digit hours; 24-hour clock 44094>>>>>>>>>>>// m Minutes with no leading zero for single-digit minutes 44094>>>>>>>>>>>// mm Minutes with leading zero for single-digit minutes 44094>>>>>>>>>>>// s Seconds with no leading zero for single-digit seconds 44094>>>>>>>>>>>// ss Seconds with leading zero for single-digit seconds 44094>>>>>>>>>>>// t One character time marker string, such as A or P 44094>>>>>>>>>>>// tt Multicharacter time marker string, such as AM or PM 44094>>>>>>>>>>>// 44094>>>>>>>>>>>// For example, to get the time string "11:29:40 PM" 44094>>>>>>>>>>>// use the following picture string: "hh" : "mm" : "ss tt" 44094>>>>>>>>>>> 44094>>>>>>>>>>>External_Function vWin32_GetTimeFormat "GetTimeFormatA" Kernel32.Dll ; Dword LCID Dword dwFlags Pointer lpsSystemTime Pointer lpFormat Pointer lpTimeStr ; Integer cchTime Returns Integer 44095>>>>>>>>>>> 44095>>>>>>>>>>> 44095>>>>>>>>>>>// Courtesy Of Vincent Oorsprong 44095>>>>>>>>>>>// This function formats the date in a picture-string passed 44095>>>>>>>>>>>// 44095>>>>>>>>>>>// Picture Meaning 44095>>>>>>>>>>>// d Day of month as digits with no leading zero for single-digit days. 44095>>>>>>>>>>>// dd Day of month as digits with leading zero for single-digit days. 44095>>>>>>>>>>>// ddd Day of week as a three-letter abbreviation. The function uses the 44095>>>>>>>>>>>// LOCALE_SABBREVOAYMAME value associated with the specified locale. 44095>>>>>>>>>>>// dddd Day of week as its full name. The function uses the LOCALE_SDAYNAME 44095>>>>>>>>>>>// value associated with the specified locale. 44095>>>>>>>>>>>// M Month as digits with no leading zero for single-digit months. 44095>>>>>>>>>>>// MM Month as digits with leading zero for single-digit months. 44095>>>>>>>>>>>// MMM Month as a three-letter abbreviation. The function uses the 44095>>>>>>>>>>>// LOCALE_SABBREVMONTHNAME value associated with the specified locale. 44095>>>>>>>>>>>// MMMM Month as its full name. The function uses the LOCALE_SMONTHNAME value 44095>>>>>>>>>>>// associated with the specified locale. 44095>>>>>>>>>>>// y Year as last two digits, but with no leading zero for years less than 10. 44095>>>>>>>>>>>// yy Year as last two digits, but with leading zero for years less than 10. 44095>>>>>>>>>>>// yyyy Year represented hy full four digits. 44095>>>>>>>>>>>// gg Period/era string. The function uses the CAL_SERASTRING value associated 44095>>>>>>>>>>>// with the specified locale. This element is ignored if the date to be formatted 44095>>>>>>>>>>>// does not have an associated era or period string. 44095>>>>>>>>>>>// For example, to get the date string "Wed, Aug 31 94" 44095>>>>>>>>>>>// use the following picture string: "ddd","MMM dd yy" 44095>>>>>>>>>>> 44095>>>>>>>>>>>External_Function vWin32_GetDateFormat "GetDateFormatA" Kernel32.Dll ; Dword LCID Dword dwFlags Pointer lpsSystemTime Pointer lpFormat Pointer lpDateStr ; Integer cchDate Returns Integer 44096>>>>>>>>>>> 44096>>>>>>>>>>>Define LOCALE_NOUSEROVERRIDE For |CI$80000000 // do not use user overrides 44096>>>>>>>>>>>Define TIME_NOMIHUTESORSECONDS For |CI$0000000l // do not use minutes or seconds 44096>>>>>>>>>>>Define TIME_NOSECONDS For |CI$00000002 // do not use seconds 44096>>>>>>>>>>>Define TIME_NOTIMEMARKER For |CI$00000004 // do not use time marker 44096>>>>>>>>>>>Define TIME_FORCE24HOURFORMAT For |CI$00000008 // always use 24 hour format 44096>>>>>>>>>>> 44096>>>>>>>>>>>// Date Flags for GetDateFormatW. 44096>>>>>>>>>>>// 44096>>>>>>>>>>>Define DATE_SHORTDATE For |CI$0000000l // use short date picture 44096>>>>>>>>>>>Define DATE_LONGDATE For |CI$00000002 // use long date picture 44096>>>>>>>>>>>Define DATE_USE_ALT_CALENDAR For |CI$00000004 // use alternate calendar (if any) 44096>>>>>>>>>>> 44096>>>>>>>>>>> 44096>>>>>>>>>>>// Courtesy Of Vincent Oorsprong 44096>>>>>>>>>>>Function vConvertFileDateTime Global Dword dwLowDateTime Dword dwHighDateTime Returns String 44098>>>>>>>>>>> String sftTime sSystemTime sFormattedTime sFormattedDate 44098>>>>>>>>>>> Pointer lpsftTime lpsSystemTime lpsFormattedTime lpsFormattedDate 44098>>>>>>>>>>> Integer iSuccess iLenCcTime iDataLength iLenCcDate 44098>>>>>>>>>>> 44098>>>>>>>>>>> ZeroType vFileTime To sftTime 44099>>>>>>>>>>> Put dwLowDateTime To sftTime At vFileTime.dwLowDateTime 44100>>>>>>>>>>> Put dwHighDateTime To sftTime At vFileTime.dwHighDateTime 44101>>>>>>>>>>> GetAddress Of sftTime To lpsftTime 44102>>>>>>>>>>> 44102>>>>>>>>>>> ZeroType vSystemTime To sSystemTime 44103>>>>>>>>>>> GetAddress Of sSystemTime To lpsSystemTime 44104>>>>>>>>>>> 44104>>>>>>>>>>> Moveint (vWin32_FileTimeToSystemTime (lpsftTime, lpsSystemTime)) To iSuccess 44105>>>>>>>>>>>> 44105>>>>>>>>>>> If iSuccess Eq DfTrue Begin 44107>>>>>>>>>>> ZeroString 255 To sFormattedTime 44108>>>>>>>>>>> GetAddress Of sFormattedTime To lpsFormattedTime 44109>>>>>>>>>>> Length sFormattedTime To iLenCcTime 44110>>>>>>>>>>>> 44110>>>>>>>>>>> Moveint (vWin32_GetTimeFormat (LOCALE_USER_DEFAULT, 0, lpsSystemTime, 0, ; lpsFormattedTime, iLenCcTime)) To iDataLength 44111>>>>>>>>>>>> 44111>>>>>>>>>>> ZeroString 255 To sFormattedDate 44112>>>>>>>>>>> GetAddress Of sFormattedDate To lpsFormattedDate 44113>>>>>>>>>>> Length sFormattedDate To iLenCcDate 44114>>>>>>>>>>>> 44114>>>>>>>>>>> Moveint (vWin32_GetDateFormat (LOCALE_USER_DEFAULT, 0, lpsSystemTime, 0, ; lpsFormattedDate, iLenCcDate)) To iDataLength 44115>>>>>>>>>>>> 44115>>>>>>>>>>> Function_Return (Cstring (sFormattedDate) * Cstring (sFormattedTime)) 44116>>>>>>>>>>> End // iSuccess 44116>>>>>>>>>>>> 44116>>>>>>>>>>>End_Function // vConvertFileDateTime 44117>>>>>>>>>>> 44117>>>>>>>>>>> 44117>>>>>>>>>>>// **WvA Removed, See the cFileSet class for an alternative 44117>>>>>>>>>>>//Procedure DoBrowseDir String sFilePath 44117>>>>>>>>>>>//End_Procedure // DoBrowseDir 44117>>>>>>>>>>> 44117>>>>>>>>>>>External_Function vWin32_SetLastError "SetLastError" Kernel32.Dll Dword dwLastError Returns integer 44118>>>>>>>>>>> 44118>>>>>>>>>>>// **WvA: 44118>>>>>>>>>>>// A windows replacement for the standard function FileExists. 44118>>>>>>>>>>>// This version will also return (true) for a file when it is open by an application. 44118>>>>>>>>>>>// Note that you can apply normal windows mask-signs in the filename such as * and ? 44118>>>>>>>>>>>// Example: Get vFilePathExists "C:\config.sy?" 44118>>>>>>>>>>>// This will return true if you have a file matching these conditions. (aka config.sys) 44118>>>>>>>>>>>Function vFilePathExists String sFilePathMask Returns Integer #REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE) 44120>>>>>>>>>>> String sWin32FindData 44120>>>>>>>>>>> String sLongFileName 44120>>>>>>>>>>> Pointer lpsFilePathMask lpsWin32FindData 44120>>>>>>>>>>> Handle hFindFile 44120>>>>>>>>>>> Integer iVoid iRetval bFound 44120>>>>>>>>>>> 44120>>>>>>>>>>> GetAddress Of sFilePathMask To lpsFilePathMask 44121>>>>>>>>>>> Zerotype vWin32_Find_Data To sWin32FindData 44122>>>>>>>>>>> GetAddress Of sWin32FindData To lpswin32FindData 44123>>>>>>>>>>> Move (vWin32_FindFirstFile (lpsFilePathMask, lpsWin32FindData)) To hFindFile 44124>>>>>>>>>>> Move (vWin32_FindClose (hFindFile)) To iVoid 44125>>>>>>>>>>> Function_Return (hFindFile <> vINVALID_HANDLE_VALUE) 44126>>>>>>>>>>>End_Function // vFilePathExists 44127>>>>>>>>>>> 44127>>>>>>>>>>>// **WvA 44127>>>>>>>>>>>// Formats a foldername by first trimming it and after that by sticking a 44127>>>>>>>>>>>// directory separator (/\) to the end if it doesn't have one there already. 44127>>>>>>>>>>>// The folder may contain a drive letter or UNC encoding. 44127>>>>>>>>>>>Function vFolderFormat Global String sFolderName Returns String 44129>>>>>>>>>>> String sDirSep 44129>>>>>>>>>>> Move (sysconf(SYSCONF_DIR_SEPARATOR)) To sDirSep // normally \ (backslash) 44130>>>>>>>>>>> Move (Trim(sFolderName)) To sFolderName 44131>>>>>>>>>>> If (Right(sFolderName,1)<>sDirSep) Begin 44133>>>>>>>>>>> Move (sFolderName+sDirSep) To sFolderName 44134>>>>>>>>>>> End 44134>>>>>>>>>>>> 44134>>>>>>>>>>> Function_Return sFolderName 44135>>>>>>>>>>>End_Function // vFolderFormat 44136>>>>>>>>> 44136>>>>>>>>> Define FILE_ATTRIBUTE_READONLY for |CI$00000001 44136>>>>>>>>> Define FILE_ATTRIBUTE_HIDDEN for |CI$00000002 44136>>>>>>>>> Define FILE_ATTRIBUTE_SYSTEM for |CI$00000004 44136>>>>>>>>> Define FILE_ATTRIBUTE_DIRECTORY for |CI$00000010 44136>>>>>>>>> Define FILE_ATTRIBUTE_ARCHIVE for |CI$00000020 44136>>>>>>>>> Define FILE_ATTRIBUTE_ENCRYPTED for |CI$00000040 44136>>>>>>>>> Define FILE_ATTRIBUTE_NORMAL for |CI$00000080 44136>>>>>>>>> Define FILE_ATTRIBUTE_TEMPORARY for |CI$00000100 44136>>>>>>>>> Define FILE_ATTRIBUTE_SPARSEFILE for |CI$00000200 44136>>>>>>>>> Define FILE_ATTRIBUTE_REPARSEPOINT for |CI$00000400 44136>>>>>>>>> Define FILE_ATTRIBUTE_COMPRESSED for |CI$00000800 44136>>>>>>>>> Define FILE_ATTRIBUTE_OFFLINE for |CI$00001000 44136>>>>>>>>> 44136>>>>>>>>>desktop_section 44141>>>>>>>>>object oWinFolderEntries is a cArray 44143>>>>>>>>> property integer piFileCount 44145>>>>>>>>> property integer piFolderCount 44147>>>>>>>>> property string psFolder 44149>>>>>>>>> item_property_list 44149>>>>>>>>> item_property integer pbFolder.i 44149>>>>>>>>> item_property string psFileName.i 44149>>>>>>>>> item_property string psAlternateFileName.i 44149>>>>>>>>> item_property number pnFileSz.i 44149>>>>>>>>> item_property number pnCreated.i 44149>>>>>>>>> item_property number pnLastWrite.i 44149>>>>>>>>> item_property number pnLastAccessed.i 44149>>>>>>>>> item_property integer piAttributes.i 44149>>>>>>>>> end_item_property_list #REM 44204 DEFINE FUNCTION PIATTRIBUTES.I INTEGER LIROW RETURNS INTEGER #REM 44209 DEFINE PROCEDURE SET PIATTRIBUTES.I INTEGER LIROW INTEGER VALUE #REM 44214 DEFINE FUNCTION PNLASTACCESSED.I INTEGER LIROW RETURNS NUMBER #REM 44219 DEFINE PROCEDURE SET PNLASTACCESSED.I INTEGER LIROW NUMBER VALUE #REM 44224 DEFINE FUNCTION PNLASTWRITE.I INTEGER LIROW RETURNS NUMBER #REM 44229 DEFINE PROCEDURE SET PNLASTWRITE.I INTEGER LIROW NUMBER VALUE #REM 44234 DEFINE FUNCTION PNCREATED.I INTEGER LIROW RETURNS NUMBER #REM 44239 DEFINE PROCEDURE SET PNCREATED.I INTEGER LIROW NUMBER VALUE #REM 44244 DEFINE FUNCTION PNFILESZ.I INTEGER LIROW RETURNS NUMBER #REM 44249 DEFINE PROCEDURE SET PNFILESZ.I INTEGER LIROW NUMBER VALUE #REM 44254 DEFINE FUNCTION PSALTERNATEFILENAME.I INTEGER LIROW RETURNS STRING #REM 44259 DEFINE PROCEDURE SET PSALTERNATEFILENAME.I INTEGER LIROW STRING VALUE #REM 44264 DEFINE FUNCTION PSFILENAME.I INTEGER LIROW RETURNS STRING #REM 44269 DEFINE PROCEDURE SET PSFILENAME.I INTEGER LIROW STRING VALUE #REM 44274 DEFINE FUNCTION PBFOLDER.I INTEGER LIROW RETURNS INTEGER #REM 44279 DEFINE PROCEDURE SET PBFOLDER.I INTEGER LIROW INTEGER VALUE 44285>>>>>>>>> 44285>>>>>>>>> function nFileTimeTS dword ldwHi dword ldwLo returns number 44288>>>>>>>>> integer liYear liMonth liDay liHour liMinute liSecond 44288>>>>>>>>> integer lbSuccess 44288>>>>>>>>> pointer lpsftTime lpsSystemTime 44288>>>>>>>>> date ldDate 44288>>>>>>>>> string lsftTime lsSystemTime 44288>>>>>>>>> number lnRval 44288>>>>>>>>> 44288>>>>>>>>> ZeroType vFileTime to lsftTime 44289>>>>>>>>> Put ldwLo to lsftTime at vFileTime.dwLowDateTime 44290>>>>>>>>> Put ldwHi to lsftTime at vFileTime.dwHighDateTime 44291>>>>>>>>> GetAddress of lsftTime to lpsftTime 44292>>>>>>>>> 44292>>>>>>>>> ZeroType vSystemTime to lsSystemTime 44293>>>>>>>>> GetAddress of lsSystemTime to lpsSystemTime 44294>>>>>>>>> 44294>>>>>>>>> move (vWin32_FileTimeToSystemTime(lpsftTime,lpsSystemTime)) to lbSuccess 44295>>>>>>>>> if lbSuccess begin 44297>>>>>>>>> GetBuff from lsSystemTime at vSystemTime.wYear to liYear 44298>>>>>>>>> GetBuff from lsSystemTime at vSystemTime.wMonth to liMonth 44299>>>>>>>>> GetBuff from lsSystemTime at vSystemTime.wDay to liDay 44300>>>>>>>>> GetBuff from lsSystemTime at vSystemTime.wHour to liHour 44301>>>>>>>>> GetBuff from lsSystemTime at vSystemTime.wMinute to liMinute 44302>>>>>>>>> GetBuff from lsSystemTime at vSystemTime.wSecond to liSecond 44303>>>>>>>>> 44303>>>>>>>>> get DateCompose liDay liMonth liYear to ldDate 44304>>>>>>>>> get TS_Compose2 ldDate liHour liMinute liSecond to lnRval 44305>>>>>>>>> function_return lnRval 44306>>>>>>>>> end 44306>>>>>>>>>> 44306>>>>>>>>> function_return 0 44307>>>>>>>>> end_function 44308>>>>>>>>> 44308>>>>>>>>> procedure DoLoad string lsFolderPath 44311>>>>>>>>> handle lhImportFile 44311>>>>>>>>> pointer lpsPath lps32Data 44311>>>>>>>>> dword ldwFileAtt ldwHi ldwLo 44311>>>>>>>>> integer liVoid liRow liFileCount liFolderCount 44311>>>>>>>>> boolean lbRetval lbFolder 44311>>>>>>>>> number lnTS 44311>>>>>>>>> string lsWin32FindData lsFileName 44311>>>>>>>>> 44311>>>>>>>>> move 0 to liFileCount 44312>>>>>>>>> move 0 to liFolderCount 44313>>>>>>>>> set psFolder to lsFolderPath 44314>>>>>>>>> 44314>>>>>>>>> send delete_data 44315>>>>>>>>> 44315>>>>>>>>> ifnot (pos("*",lsFolderPath) or pos("?",lsFolderPath)) ; get Files_AppendPath lsFolderPath "*" to lsFolderPath 44318>>>>>>>>> 44318>>>>>>>>> move (ToAnsi(lsFolderPath)) to lsFolderPath 44319>>>>>>>>> 44319>>>>>>>>> GetAddress of lsFolderPath to lpsPath 44320>>>>>>>>> ZeroType vWin32_Find_Data to lsWin32FindData 44321>>>>>>>>> GetAddress of lsWin32FindData to lps32Data 44322>>>>>>>>> move (vWin32_FindFirstFile(lpsPath,lps32Data)) to lhImportFile 44323>>>>>>>>> if (lhImportFile <> INVALID_HANDLE_VALUE) begin 44325>>>>>>>>> repeat 44325>>>>>>>>>> 44325>>>>>>>>> get row_count to liRow 44326>>>>>>>>> 44326>>>>>>>>> GetBuff_String From lsWin32FindData at vWin32_Find_Data.cFileName to lsFileName 44327>>>>>>>>> 44327>>>>>>>>> if (lsFileName<>"." and lsFileName<>"..") begin 44329>>>>>>>>> set psFileName.i liRow to (ToOem(lsFileName)) 44330>>>>>>>>> 44330>>>>>>>>> GetBuff From lsWin32FindData at vWin32_Find_Data.dwFileAttributes to ldwFileAtt 44331>>>>>>>>> set piAttributes.i liRow to ldwFileAtt 44332>>>>>>>>> 44332>>>>>>>>> move (ldwFileAtt iand FILE_ATTRIBUTE_DIRECTORY) to lbFolder 44333>>>>>>>>> set pbFolder.i liRow to lbFolder 44334>>>>>>>>> 44334>>>>>>>>> if lbFolder increment liFolderCount 44337>>>>>>>>> else increment liFileCount 44339>>>>>>>>> 44339>>>>>>>>> GetBuff_String From lsWin32FindData at vWin32_Find_Data.cAlternateFileName to lsFileName // get attribute 44340>>>>>>>>> set psAlternateFileName.i liRow to lsFileName 44341>>>>>>>>> 44341>>>>>>>>> GetBuff From lsWin32FindData at vWin32_Find_Data.nFileSizeHigh to ldwHi 44342>>>>>>>>> GetBuff From lsWin32FindData at vWin32_Find_Data.nFileSizeLow to ldwLo 44343>>>>>>>>> set pnFileSz.i liRow to (ldwHi*4294967296+ldwLo) 44344>>>>>>>>> 44344>>>>>>>>> GetBuff From lsWin32FindData at vWin32_Find_Data.ftCreationHighDateTime to ldwHi 44345>>>>>>>>> GetBuff From lsWin32FindData at vWin32_Find_Data.ftCreationLowDateTime to ldwLo 44346>>>>>>>>> get nFileTimeTS ldwHi ldwLo to lnTS 44347>>>>>>>>> set pnCreated.i liRow to lnTS 44348>>>>>>>>> 44348>>>>>>>>> GetBuff From lsWin32FindData at vWin32_Find_Data.ftLastWriteHighDateTime to ldwHi 44349>>>>>>>>> GetBuff From lsWin32FindData at vWin32_Find_Data.ftLastWriteLowDateTime to ldwLo 44350>>>>>>>>> get nFileTimeTS ldwHi ldwLo to lnTS 44351>>>>>>>>> set pnLastWrite.i liRow to lnTS 44352>>>>>>>>> 44352>>>>>>>>> GetBuff From lsWin32FindData at vWin32_Find_Data.ftLastAccessHighDateTime to ldwHi 44353>>>>>>>>> GetBuff From lsWin32FindData at vWin32_Find_Data.ftLastAccessLowDateTime to ldwLo 44354>>>>>>>>> get nFileTimeTS ldwHi ldwLo to lnTS 44355>>>>>>>>> set pnLastAccessed.i liRow to lnTS 44356>>>>>>>>> end 44356>>>>>>>>>> 44356>>>>>>>>> Move (vWin32_FindNextFile(lhImportFile,lps32Data)) to lbRetval // get next file in directory 44357>>>>>>>>> Until (lbRetval = False) 44359>>>>>>>>> Move (vWin32_FindClose(lhImportFile)) to liVoid // 44360>>>>>>>>> end 44360>>>>>>>>>> 44360>>>>>>>>> set piFileCount to liFileCount 44361>>>>>>>>> set piFolderCount to liFolderCount 44362>>>>>>>>> end_procedure 44363>>>>>>>>>end_object // oWinFolderEntries 44364>>>>>>>>>end_desktop_section 44369>>>>>>>>> 44369>>>>>>>>>procedure WinFolder_ReadFolder global string lsFolder 44371>>>>>>>>> send DoLoad of oWinFolderEntries lsFolder 44372>>>>>>>>>end_procedure 44373>>>>>>> 44373>>>>>>>string giSeq$Temp 250 44373>>>>>>> 44373>>>>>>>function SEQ_UniqueFileName global string lsPreFix returns string 44375>>>>>>> integer count# unique# loop# ch# 44375>>>>>>> move (left(trim(lsPreFix),4)) to lsPreFix 44376>>>>>>> move 12 to count# // max number of retries 44377>>>>>>> move 1 to loop# 44378>>>>>>> get Seq_New_Channel to ch# // This method and Seq_Release_Channel are 44379>>>>>>> if ch# lt 0 function_return "" // located in seq_chnl.pkg 44382>>>>>>> send Seq_Release_Channel ch# // We only need it for a second 44383>>>>>>> repeat 44383>>>>>>>> 44383>>>>>>> move (random(9999)) to unique# 44384>>>>>>> direct_input channel ch# (lsPreFix+string(unique#)+".tmp") 44386>>>>>>> move (count#-1) to count# 44387>>>>>>> [seqeof] move 0 to loop# 44388>>>>>>> if loop# if count# le 0 move 0 to loop# 44393>>>>>>> close_input channel ch# 44395>>>>>>> until (not(loop#)) 44397>>>>>>> if count# le 0 function_return "" // failure 44400>>>>>>> function_return (lsPreFix+string(unique#)+".tmp") 44401>>>>>>>end_function 44402>>>>>>> 44402>>>>>>>string SEQ_UniqueFileNamePath$ext 5 44402>>>>>>>move "tmp" to SEQ_UniqueFileNamePath$ext 44403>>>>>>> 44403>>>>>>>function SEQ_UniqueFileNamePath global string lsPath string lsPreFix returns string 44405>>>>>>> integer count# unique# loop# ch# 44405>>>>>>> string lsFileName 44405>>>>>>> if (lsPath="." or lsPath="") get SEQ_CurrentFolder to lsPath 44408>>>>>>> move (left(trim(lsPreFix),4)) to lsPreFix 44409>>>>>>> move 12 to count# // max number of retries 44410>>>>>>> move 1 to loop# 44411>>>>>>> get Seq_New_Channel to ch# // This method and Seq_Release_Channel are 44412>>>>>>> if ch# lt 0 function_return "" // located in seq_chnl.pkg 44415>>>>>>> send Seq_Release_Channel ch# // We only need it for a second 44416>>>>>>> repeat 44416>>>>>>>> 44416>>>>>>> move (random(9999)) to unique# 44417>>>>>>> get SEQ_ComposeAbsoluteFileName lsPath (lsPreFix+string(unique#)+"."+SEQ_UniqueFileNamePath$ext) to lsFileName 44418>>>>>>> direct_input channel ch# lsFileName 44420>>>>>>> move (count#-1) to count# 44421>>>>>>> [seqeof] move 0 to loop# 44422>>>>>>> if loop# if count# le 0 move 0 to loop# 44427>>>>>>> close_input channel ch# 44429>>>>>>> until (not(loop#)) 44431>>>>>>> if count# le 0 function_return "" // failure 44434>>>>>>> function_return lsFileName 44435>>>>>>>end_function 44436>>>>>>> 44436>>>>>>>function SEQ_UniqueFileNamePathAndExt global string lsPath string lsPreFix string lsExt returns string 44438>>>>>>> string lsRval 44438>>>>>>> move lsExt to SEQ_UniqueFileNamePath$ext 44439>>>>>>> get SEQ_UniqueFileNamePath lsPath lsPreFix to lsRval 44440>>>>>>> move "tmp" to SEQ_UniqueFileNamePath$ext 44441>>>>>>> function_return lsRval 44442>>>>>>>end_function 44443>>>>>>> 44443>>>>>>>define FS_KILOBYTE for 1024 44443>>>>>>>define FS_MEGABYTE for 1048576 44443>>>>>>>define FS_GIGABYTE for 1073741824 44443>>>>>>> 44443>>>>>>>define SEQ_FileExists$Test for 0 44443>>>>>>> 44443>>>>>>> 44443>>>>>>>define SEQIT_NONE for 0 44443>>>>>>>define SEQIT_FILE for 1 44443>>>>>>>define SEQIT_DIRECTORY for 2 44443>>>>>>> 44443>>>>>>> function SEQ_FileExists global string lsFile returns integer 44445>>>>>>> integer liRval liChannel 44445>>>>>>> string lsStr 44445>>>>>>> if lsFile eq "" function_return SEQIT_NONE 44448>>>>>>> get Seq_New_Channel to liChannel // This method and Seq_Release_Channel are 44449>>>>>>> if liChannel lt 0 function_return 1 // located in seq_chnl.pkg 44452>>>>>>> 44452>>>>>>> SEQ_FileExists$Test$ShowLn "1 SEQ_FileExists:" (">"+lsFile+"<") "on channel " liChannel 44452>>>>>>> 44452>>>>>>> direct_input channel liChannel ("DIR:"+StringOemToAnsi(lsFile)) 44454>>>>>>> move (not(seqeof)) to liRval 44455>>>>>>> 44455>>>>>>> SEQ_FileExists$Test$ShowLn "2 (liRval): " liRval 44455>>>>>>> 44455>>>>>>> ifnot liRval begin 44457>>>>>>> get SEQ_ExtractPathFromFileName lsFile to lsStr 44458>>>>>>> SEQ_FileExists$Test$ShowLn "3 (lsStr): " lsStr 44458>>>>>>> if lsStr eq "" begin // There's no path in the file name 44460>>>>>>> get SEQ_FindFileAlongDFPath lsFile to lsStr 44461>>>>>>> SEQ_FileExists$Test$ShowLn "4 (lsStr): " lsStr 44461>>>>>>> if lsStr ne "" begin 44463>>>>>>> get SEQ_ComposeAbsoluteFileName lsStr lsFile to lsFile 44464>>>>>>> SEQ_FileExists$Test$ShowLn "5 (lsFile): " lsFile 44464>>>>>>> close_input channel liChannel 44466>>>>>>> send Seq_Release_Channel liChannel // We only need it for a second 44467>>>>>>> function_return (SEQ_FileExists(lsFile)) 44468>>>>>>> end 44468>>>>>>>> 44468>>>>>>> end 44468>>>>>>>> 44468>>>>>>> end 44468>>>>>>>> 44468>>>>>>> SEQ_FileExists$Test$ShowLn "7 (liRval): " liRval 44468>>>>>>> if liRval begin // Item exists! Is it a directory? 44470>>>>>>> move SEQIT_FILE to liRval 44471>>>>>>> readln channel liChannel lsStr 44473>>>>>>> if (left(lsStr,1)="[") move SEQIT_DIRECTORY to liRval 44476>>>>>>> SEQ_FileExists$Test$ShowLn "8 (liRval): " liRval 44476>>>>>>> SEQ_FileExists$Test$ShowLn "9 (lsStr): " lsStr 44476>>>>>>> end 44476>>>>>>>> 44476>>>>>>> close_input channel liChannel 44478>>>>>>> send Seq_Release_Channel liChannel // We only need it for a second 44479>>>>>>> function_return liRval 44480>>>>>>> end_function 44481>>>>>>> 44481>>>>>>>function SEQ_FileSize global string fn# returns number 44483>>>>>>> // This function returns the size of file in bytes. 44483>>>>>>> integer ch# 44483>>>>>>> number rval# 44483>>>>>>> ifnot (SEQ_FileExists(fn#)=SEQIT_FILE) function_return 0 44486>>>>>>> get Seq_New_Channel to ch# 44487>>>>>>> send Seq_Release_Channel ch# 44488>>>>>>> move (StringOemToAnsi(fn#)) to fn# 44489>>>>>>> append_output channel ch# fn# 44491>>>>>>> get_channel_position ch# to rval# 44492>>>>>>>> 44492>>>>>>> close_output channel ch# 44494>>>>>>> function_return rval# 44495>>>>>>>end_function 44496>>>>>>> 44496>>>>>>>function SEQ_SizeToStringHelp global number XB# returns string 44498>>>>>>> if XB# ge 1000 function_return (NumToStr(XB#,0)) 44501>>>>>>> if XB# ge 100 function_return (NumToStr(XB#,1)) 44504>>>>>>> if XB# ge 10 function_return (NumToStr(XB#,2)) 44507>>>>>>> function_return (NumToStr(XB#,3)) 44508>>>>>>>end_function 44509>>>>>>> 44509>>>>>>>function SEQ_FileSizeToString global number bytes# returns string 44511>>>>>>> if bytes# ge FS_GIGABYTE function_return (SEQ_SizeToStringHelp(bytes#/FS_GIGABYTE)+" GB") 44514>>>>>>> else if bytes# ge FS_MEGABYTE function_return (SEQ_SizeToStringHelp(bytes#/FS_MEGABYTE)+" MB") 44518>>>>>>> else if bytes# ge FS_KILOBYTE function_return (SEQ_SizeToStringHelp(bytes#/FS_KILOBYTE)+" KB") 44522>>>>>>> function_return bytes# 44523>>>>>>>end_function 44524>>>>>>> 44524>>>>>>>function SEQ_FileLineCount global string fn# returns integer 44526>>>>>>> //> This function returns the number of lines in (ascii-) file . 44526>>>>>>> //> Note that this function will read through the entire file (use with 44526>>>>>>> //> caution!). 44526>>>>>>> integer rval# ch# 44526>>>>>>> string str# 44526>>>>>>> get Seq_New_Channel to ch# 44527>>>>>>> send Seq_Release_Channel ch# 44528>>>>>>> move (StringOemToAnsi(fn#)) to fn# 44529>>>>>>> direct_input channel ch# fn# 44531>>>>>>> move 0 to rval# 44532>>>>>>> ifnot [seqeof] begin 44534>>>>>>> repeat 44534>>>>>>>> 44534>>>>>>> readln str# 44535>>>>>>> [~seqeof] increment rval# 44536>>>>>>> [~seqeof] loop 44537>>>>>>>> 44537>>>>>>> end 44537>>>>>>>> 44537>>>>>>> close_input channel ch# 44539>>>>>>> function_return rval# 44540>>>>>>>end_function 44541>>>>>>> 44541>>>>>>>function SEQ_DirectInput global string fn# returns integer 44543>>>>>>> //> The function attempts to open the file fn# for sequential reading. 44543>>>>>>> //> If it succeeds a channel number will be returned, if it fails -1 44543>>>>>>> //> will be returned. If the function succseeds it is the responsability 44543>>>>>>> //> of the caller to release the channel (Seq_Release_Channel) when 44543>>>>>>> //> done. 44543>>>>>>> integer ch# 44543>>>>>>> get Seq_New_Channel to ch# 44544>>>>>>> move (StringOemToAnsi(fn#)) to fn# 44545>>>>>>> direct_input channel ch# fn# 44547>>>>>>> if (seqeof) begin 44549>>>>>>> send Seq_Release_Channel ch# 44550>>>>>>> move -1 to ch# 44551>>>>>>> end 44551>>>>>>>> 44551>>>>>>> function_return ch# 44552>>>>>>>end_function 44553>>>>>>> 44553>>>>>>>procedure SEQ_CloseInput global integer ch# 44555>>>>>>> close_input channel ch# 44557>>>>>>> send Seq_Release_Channel ch# 44558>>>>>>>end_procedure 44559>>>>>>> 44559>>>>>>>function SEQ_DirectOutput global string fn# returns integer 44561>>>>>>> integer ch# 44561>>>>>>> get Seq_New_Channel to ch# 44562>>>>>>> send ErrorHnd_Quiet_Activate 44563>>>>>>> move (StringOemToAnsi(fn#)) to fn# 44564>>>>>>> direct_output channel ch# fn# 44566>>>>>>> send ErrorHnd_Quiet_Deactivate 44567>>>>>>> if (ErrorHnd_Quiet_ErrorCount()) begin 44569>>>>>>> send SEQ_CloseOutput ch# 44570>>>>>>> move -1 to ch# 44571>>>>>>> end 44571>>>>>>>> 44571>>>>>>> function_return ch# 44572>>>>>>>end_function 44573>>>>>>> 44573>>>>>>>function SEQ_AppendOutput global string fn# returns integer 44575>>>>>>> integer ch# 44575>>>>>>> get Seq_New_Channel to ch# 44576>>>>>>> move (StringOemToAnsi(fn#)) to fn# 44577>>>>>>> append_output channel ch# fn# 44579>>>>>>> function_return ch# 44580>>>>>>>end_function 44581>>>>>>> 44581>>>>>>>function SEQ_DirectInputDBMS global integer liFile integer liField returns integer 44583>>>>>>> function_return (SEQ_DirectInput("DBMS:"+string(liFile)+","+string(liField))) 44584>>>>>>>end_function 44585>>>>>>>function SEQ_DirectOutputDBMS global integer liFile integer liField returns integer 44587>>>>>>> function_return (SEQ_DirectOutput("DBMS:"+string(liFile)+","+string(liField))) 44588>>>>>>>end_function 44589>>>>>>> 44589>>>>>>>procedure SEQ_CloseOutput global integer ch# 44591>>>>>>> close_output channel ch# 44593>>>>>>> send Seq_Release_Channel ch# 44594>>>>>>>end_procedure 44595>>>>>>> 44595>>>>>>>//> Just a small function for convenience. Sometimes it's nice not to have 44595>>>>>>>//> to declare a variable just to read a line in a file. Global indicator 44595>>>>>>>//> SeqEof will be false after calling this function if an EOF has been 44595>>>>>>>//> reached. 44595>>>>>>>function SEQ_ReadLn global integer ch# returns string 44597>>>>>>> string rval# 44597>>>>>>> readln channel ch# rval# 44599>>>>>>> function_return rval# 44600>>>>>>>end_function 44601>>>>>>> 44601>>>>>>>//> Reads sequential channel liChannel until the value lsValue is found. 44601>>>>>>>//> Return value 1: OK, 0: Value not found 44601>>>>>>>function SEQ_ReadLnUntilValue global integer liChannel string lsValue returns integer 44603>>>>>>> string lsLine 44603>>>>>>> repeat 44603>>>>>>>> 44603>>>>>>> readln channel liChannel lsLine 44605>>>>>>> if (SeqEof) function_return 0 44608>>>>>>> if (lsLine=lsValue) function_return 1 44611>>>>>>> loop 44612>>>>>>>> 44612>>>>>>>end_function 44613>>>>>>> 44613>>>>>>>//> Function SEQ_ReadLnProbe reads a line from input channel ch# without 44613>>>>>>>//> affecting the current channel position of that channel. The return 44613>>>>>>>//> value is of type string and will be the line read. The function sets 44613>>>>>>>//> indicator [seqeof] as a sideeffect 44613>>>>>>>function SEQ_ReadLnProbe global integer liChannel returns string 44615>>>>>>> integer liPos lbSeqEof lbSneakMode 44615>>>>>>> string lsRval lsValue 44615>>>>>>> get_channel_position liChannel to liPos 44616>>>>>>>> 44616>>>>>>> readln channel liChannel lsRval 44618>>>>>>> move (seqeof) to lbSeqEof 44619>>>>>>> move (liPos>0) to lbSneakMode 44620>>>>>>> if lbSneakMode decrement liPos 44623>>>>>>> set_channel_position liChannel to liPos 44624>>>>>>>> 44624>>>>>>> if lbSneakMode read_block channel liChannel lsValue 1 44628>>>>>>> indicate seqeof as lbSeqEof ne 0 44629>>>>>>> function_return lsRval 44630>>>>>>>end_function 44631>>>>>>> 44631>>>>>>>//> Read entire file into one string and return it. 44631>>>>>>>function SEQ_ReadFileAsOneString global string lsFileName returns string 44633>>>>>>> integer liChannel liArgSz 44633>>>>>>> number lnSize 44633>>>>>>> string lsValue 44633>>>>>>> get SEQ_FileSize lsFileName to lnSize 44634>>>>>>> if (lnSize>0) begin 44636>>>>>>> get_argument_size To liArgSz 44637>>>>>>> if (liArgSz>>>>>> 44640>>>>>>> get SEQ_DirectInput lsFileName to liChannel 44641>>>>>>> if (liChannel>=0) begin 44643>>>>>>> read_block channel liChannel lsValue lnSize 44645>>>>>>> send SEQ_CloseInput liChannel 44646>>>>>>> end 44646>>>>>>>> 44646>>>>>>> end 44646>>>>>>>> 44646>>>>>>> else move "" to lsValue 44648>>>>>>> function_return lsValue 44649>>>>>>>end_function 44650>>>>>>> 44650>>>>>>>procedure SEQ_AppendLineClose global string lsFileName string lsLine 44652>>>>>>> integer liChannel 44652>>>>>>> get SEQ_AppendOutput lsFileName to liChannel 44653>>>>>>> writeln channel liChannel lsLine 44656>>>>>>> send SEQ_CloseOutput liChannel 44657>>>>>>>end_procedure 44658>>>>>>> 44658>>>>>>>procedure SEQ_AppendOutputImageClose global string lsFileName integer liImg 44660>>>>>>> integer liChannel liAuxChannel liSeqEof 44660>>>>>>> string lsLine 44660>>>>>>> get SEQ_DirectInput ("image: "+string(liImg)) to liAuxChannel 44661>>>>>>> if liAuxChannel ge 0 begin 44663>>>>>>> get SEQ_AppendOutput lsFileName to liChannel 44664>>>>>>> 44664>>>>>>> repeat 44664>>>>>>>> 44664>>>>>>> readln channel liAuxChannel lsLine 44666>>>>>>> move (SeqEof) to liSeqEof 44667>>>>>>> ifnot liSeqEof writeln channel liChannel (rtrim(lsLine)) 44672>>>>>>> until liSeqEof 44674>>>>>>> 44674>>>>>>> send SEQ_CloseInput liAuxChannel 44675>>>>>>> send SEQ_CloseOutput liChannel 44676>>>>>>> end 44676>>>>>>>> 44676>>>>>>>end_procedure 44677>>>>>>> 44677>>>>>>>procedure SEQ_WriteImage global integer liChannel integer liImage 44679>>>>>>> integer liAuxChannel liSeqEof 44679>>>>>>> string lsLine 44679>>>>>>> get SEQ_DirectInput ("image: "+string(liImage)) to liAuxChannel 44680>>>>>>> if liAuxChannel ge 0 begin 44682>>>>>>> repeat 44682>>>>>>>> 44682>>>>>>> readln channel liAuxChannel lsLine 44684>>>>>>> move (trim(lsLine)) to lsLine 44685>>>>>>> move (SeqEof) to liSeqEof 44686>>>>>>> ifnot liSeqEof writeln channel liChannel lsLine 44691>>>>>>> until liSeqEof 44693>>>>>>> send SEQ_CloseInput liAuxChannel 44694>>>>>>> end 44694>>>>>>>> 44694>>>>>>>end_procedure 44695>>>>>>> 44695>>>>>>>procedure SEQ_WriteFile global integer liChannel string lsFile 44697>>>>>>> integer liChannelIn liSize liIterations liRest liCount 44697>>>>>>> get SEQ_FileSize lsFile to liSize 44698>>>>>>> if liSize begin 44700>>>>>>> get SEQ_DirectInput ("binary:"+lsFile) to liChannelIn 44701>>>>>>> if liChannelIn ge 0 begin 44703>>>>>>> move (liSize/250) to liIterations 44704>>>>>>> move (liSize-(liIterations*250)) to liRest 44705>>>>>>> for liCount from 1 to liIterations 44711>>>>>>>> 44711>>>>>>> read_block channel liChannelIn giSeq$Temp 250 44713>>>>>>> write channel liChannel giSeq$Temp 44715>>>>>>> loop 44716>>>>>>>> 44716>>>>>>> read_block channel liChannelIn giSeq$Temp liRest 44718>>>>>>> write channel liChannel giSeq$Temp 44720>>>>>>> send SEQ_CloseInput liChannelIn 44721>>>>>>> end 44721>>>>>>>> 44721>>>>>>> end 44721>>>>>>>> 44721>>>>>>>end_procedure 44722>>>>>>> 44722>>>>>>>function SEQ_FindFileAlongPath global string path# string fn# returns string 44724>>>>>>> //> Returns the directory along path# in which the file fn# is found. 44724>>>>>>> integer ch# eof# 44724>>>>>>> string str# tmp# dir_sep# path_sep# cur_dir# 44724>>>>>>> 44724>>>>>>> get Seq_New_Channel to ch# 44725>>>>>>> send Seq_Release_Channel ch# 44726>>>>>>> move (sysconf(SYSCONF_DIR_SEPARATOR)) to dir_sep# // \ 44727>>>>>>> move (sysconf(SYSCONF_PATH_SEPARATOR)) to path_sep# // ; 44728>>>>>>> move (replaces(dir_sep#,fn#,"")) to fn# 44729>>>>>>> while path# ne "" 44733>>>>>>> if path_sep# in path# begin 44735>>>>>>> move (left(path#,pos(path_sep#,path#)-1)) to str# 44736>>>>>>> replace (str#+path_sep#) in path# with "" 44738>>>>>>> end 44738>>>>>>>> 44738>>>>>>> else begin 44739>>>>>>> move path# to str# 44740>>>>>>> move "" to path# 44741>>>>>>> end 44741>>>>>>>> 44741>>>>>>> 44741>>>>>>> get Files_AppendPath str# fn# to tmp# 44742>>>>>>>// move (str#+dir_sep#+fn#) to tmp# 44742>>>>>>>// move (replaces(dir_sep#+dir_sep#,tmp#,dir_sep#)) to tmp# 44742>>>>>>> 44742>>>>>>> direct_input channel ch# ("DIR:"+StringOemToAnsi(tmp#)) 44744>>>>>>> move (seqeof) to eof# 44745>>>>>>> close_input channel ch# 44747>>>>>>> ifnot eof# begin 44749>>>>>>> if (StringBeginsWith(str#,"."+dir_sep#)) begin 44751>>>>>>> get_current_directory to cur_dir# 44752>>>>>>> replace "." in str# with cur_dir# 44754>>>>>>> end 44754>>>>>>>> 44754>>>>>>> function_return str# 44755>>>>>>> end 44755>>>>>>>> 44755>>>>>>> end 44756>>>>>>>> 44756>>>>>>> function_return "" // file not found! 44757>>>>>>>end_function 44758>>>>>>> 44758>>>>>>>function SEQ_DfPath global returns string 44760>>>>>>> string path# 44760>>>>>>> get_attribute DF_OPEN_PATH to path# // Oem fixed! 44763>>>>>>> move (ToOem(path#)) to path# 44764>>>>>>> function_return path# 44765>>>>>>>end_function 44766>>>>>>> 44766>>>>>>>function SEQ_FirstDirInDfPath global returns string 44768>>>>>>> string lsDir lsPathSep 44768>>>>>>> get SEQ_DfPath to lsDir 44769>>>>>>> move (SysConf(SYSCONF_PATH_SEPARATOR)) to lsPathSep 44770>>>>>>> get ExtractItem lsDir lsPathSep 1 to lsDir 44771>>>>>>> function_return (ToOem(lsDir)) 44772>>>>>>>end_function 44773>>>>>>> 44773>>>>>>>function SEQ_FindFileAlongDFPath global string fn# returns string 44775>>>>>>> function_return (SEQ_FindFileAlongPath(SEQ_DfPath(),fn#)) 44776>>>>>>>end_function 44777>>>>>>> 44777>>>>>>>//> Function SEQ_ExtractPathFromFileName expects a file name or a file 44777>>>>>>>//> mask as an argument. Only then will it return the path of that file. 44777>>>>>>>//> Otherwise it will simply strip the last directory from the path. 44777>>>>>>>function SEQ_ExtractPathFromFileName global string lsFile returns string 44779>>>>>>> string lsDirSep 44779>>>>>>> move (sysconf(SYSCONF_DIR_SEPARATOR)) to lsDirSep 44780>>>>>>> if (right(lsFile,1)=lsDirSep) move (StringLeftBut(lsFile,1)) to lsFile 44783>>>>>>> if lsDirSep in lsFile function_return (StripFromLastOccurance(lsFile,lsDirSep)) 44786>>>>>>> if ":" in lsFile function_return (StripFromLastOccurance(lsFile,":")) 44789>>>>>>> function_return "" 44790>>>>>>>end_function 44791>>>>>>> 44791>>>>>>>//> Function SEQ_ExtractExtensionFromFileName expects a file name or a file 44791>>>>>>>//> mask as an argument. Only then will it return the type of that file. 44791>>>>>>>function SEQ_ExtractExtensionFromFileName global string fn# returns string 44793>>>>>>> string dir_sep# 44793>>>>>>> move (sysconf(SYSCONF_DIR_SEPARATOR)) to dir_sep# 44794>>>>>>> if dir_sep# in fn# move (GetFromLastOccurance(fn#,dir_sep#)) to fn# 44797>>>>>>> if "." in fn# function_return (replace(".",GetFromLastOccurance(fn#,"."),"")) 44800>>>>>>> function_return "" 44801>>>>>>>end_function 44802>>>>>>> 44802>>>>>>>//> Function SEQ_ExtractRootNameFromFileName expects a file name or a file !!!! 44802>>>>>>>//> mask as an argument. Only then will it return the rootname of that file. 44802>>>>>>>function SEQ_ExtractRootNameFromFileName global string fn# returns string 44804>>>>>>> string dir_sep# 44804>>>>>>> move (sysconf(SYSCONF_DIR_SEPARATOR)) to dir_sep# 44805>>>>>>> if dir_sep# in fn# move (GetFromLastOccurance(fn#,dir_sep#)) to fn# 44808>>>>>>> if ":" in fn# move (GetFromLastOccurance(fn#,":")) to fn# 44811>>>>>>> if "." in fn# function_return (replace(".",StripFromLastOccurance(fn#,"."),"")) 44814>>>>>>> function_return fn# 44815>>>>>>>end_function 44816>>>>>>> 44816>>>>>>>function SEQ_RemovePathFromFileName global string fn# returns string 44818>>>>>>> string dir_sep# 44818>>>>>>> move (sysconf(SYSCONF_DIR_SEPARATOR)) to dir_sep# 44819>>>>>>> if dir_sep# in fn# begin 44821>>>>>>> move (GetFromLastOccurance(fn#,dir_sep#)) to fn# 44822>>>>>>> function_return (StringRightBut(fn#,1)) 44823>>>>>>> end 44823>>>>>>>> 44823>>>>>>> if ":" in fn# begin 44825>>>>>>> move (GetFromLastOccurance(fn#,dir_sep#)) to fn# 44826>>>>>>> move (GetFromLastOccurance(fn#,":")) to fn# 44827>>>>>>> end 44827>>>>>>>> 44827>>>>>>> function_return fn# 44828>>>>>>>end_function 44829>>>>>>> 44829>>>>>>>function SEQ_TranslatePathToAbsolute global string lsPath returns string 44831>>>>>>> string lsRval lsDirSep lsCurDir 44831>>>>>>> if lsPath eq "" move "." to lsPath 44834>>>>>>> move (sysconf(SYSCONF_DIR_SEPARATOR)) to lsDirSep // "/" or "\" 44835>>>>>>> get_current_directory to lsCurDir 44836>>>>>>> if (StringBeginsWith(lsPath,"."+lsDirSep)) replace "." in lsPath with lsCurDir 44840>>>>>>> if lsPath eq "." move lsCurDir to lsPath 44843>>>>>>> if (right(lsPath,1)=lsDirSep and right(lsPath,2)<>(":"+lsDirSep)) move (StringLeftBut(lsPath,1)) to lsPath 44846>>>>>>> function_return lsPath 44847>>>>>>>end_function 44848>>>>>>> 44848>>>>>>>// The SEQ_ComposeAbsoluteFileName function takes a path (without filename) 44848>>>>>>>// and a file name (without a path) and returns a file name including path. 44848>>>>>>>// It's purpose is to insert a path delimiter if necessary. 44848>>>>>>>function SEQ_ComposeAbsoluteFileName global string sDir string fn# returns string 44850>>>>>>> string dir_sep# 44850>>>>>>> move (replace(SEQ_ExtractPathFromFileName(fn#),fn#,"")) to fn# // Remove path if present anyway! 44851>>>>>>> //move (SEQ_ExtractPathFromFileName(sDir)) to sDir 44851>>>>>>> move (sysconf(SYSCONF_DIR_SEPARATOR)) to dir_sep# 44852>>>>>>> if sDir eq "" get_current_directory to sDir 44855>>>>>>> if (right(sDir,1)<>dir_sep#) move (sDir+dir_sep#) to sDir 44858>>>>>>> function_return (sDir+fn#) 44859>>>>>>>end_function 44860>>>>>>> 44860>>>>>>>//> This function pretty much does the same as SEQ_ComposeAbsoluteFileName. Only 44860>>>>>>>//> the code is less tricky and it's got a nicer name. 44860>>>>>>>function Files_AppendPath global string lsPath1 string lsPath2 returns string 44862>>>>>>> string lsSep 44862>>>>>>> move (trim(lsPath1)) to lsPath1 44863>>>>>>> move (trim(lsPath2)) to lsPath2 44864>>>>>>> move (sysconf(SYSCONF_DIR_SEPARATOR)) to lsSep 44865>>>>>>> if (right(lsPath1,1)=lsSep and left(lsPath2,1)=lsSep) move (replace(lsSep,lsPath2,"")) to lsPath2 44868>>>>>>> if (lsPath1<>"" and lsPath2<>"" and right(lsPath1,1)<>lsSep and left(lsPath2,1)<>lsSep) move (lsSep+lsPath2) to lsPath2 44871>>>>>>> function_return (append(lsPath1,lsPath2)) 44872>>>>>>>end_function 44873>>>>>>> 44873>>>>>>>// This function does the same as Files_AppendPath except here you also 44873>>>>>>>// pass the dir separator to the function. 44873>>>>>>>function Files_AppendPath_Sep global string lsPath1 string lsSep string lsPath2 returns string 44875>>>>>>> move (trim(lsPath1)) to lsPath1 44876>>>>>>> move (trim(lsPath2)) to lsPath2 44877>>>>>>> if (right(lsPath1,1)=lsSep and left(lsPath2,1)=lsSep) move (replace(lsSep,lsPath2,"")) to lsPath2 44880>>>>>>> if (lsPath1<>"" and lsPath2<>"" and right(lsPath1,1)<>lsSep and left(lsPath2,1)<>lsSep) move (lsSep+lsPath2) to lsPath2 44883>>>>>>> function_return (append(lsPath1,lsPath2)) 44884>>>>>>>end_function 44885>>>>>>> 44885>>>>>>>function SEQ_ConvertToAbsoluteFileName global string sFileName returns string 44887>>>>>>> string sDir 44887>>>>>>>// showln "SEQ_ConvertToAbsoluteFileName " sFileName 44887>>>>>>> if (SEQ_FileExists(sFileName)) ne SEQIT_NONE begin 44889>>>>>>>// showln "Does exists" 44889>>>>>>> get SEQ_ExtractPathFromFileName sFileName to sDir 44890>>>>>>> if sDir eq "" begin 44892>>>>>>> get SEQ_FindFileAlongDFPath sFileName to sDir 44893>>>>>>> get SEQ_ComposeAbsoluteFileName sDir sFileName to sFileName 44894>>>>>>> end 44894>>>>>>>> 44894>>>>>>> get SEQ_TranslatePathToAbsolute sFileName to sFileName 44895>>>>>>> end 44895>>>>>>>> 44895>>>>>>> else move "" to sFileName 44897>>>>>>> function_return sFileName 44898>>>>>>>end_function 44899>>>>>>> 44899>>>>>>>//> This function really makes an effert to return the full path 44899>>>>>>>//> if the data file. If it cannot be determined, the empty string 44899>>>>>>>//> is returned. 44899>>>>>>>function SEQ_FindDataFileFromRootName global string lsRoot returns string 44901>>>>>>> string lsExt lsPath 44901>>>>>>> // This procedure 44901>>>>>>> move (lowercase(right(lsRoot,4))) to lsExt 44902>>>>>>> ifnot (lsExt=".dat" or lsExt=".int") move (lsRoot+".DAT") to lsRoot 44905>>>>>>> 44905>>>>>>> if (SEQ_ExtractPathFromFileName(lsRoot)) eq "" begin 44907>>>>>>> move (SEQ_FindFileAlongDFPath(lsRoot)) to lsPath 44908>>>>>>> move (SEQ_ComposeAbsoluteFileName(lsPath,lsRoot)) to lsRoot 44909>>>>>>> end 44909>>>>>>>> 44909>>>>>>> 44909>>>>>>> get SEQ_ConvertToAbsoluteFileName lsRoot to lsRoot 44910>>>>>>> function_return lsRoot 44911>>>>>>>end_function 44912>>>>>>> 44912>>>>>>>[found ~found] begin // Sneaky way of skipping code 44914>>>>>>>> 44914>>>>>>> files.no$err: // This serves as an empty low-level error handler routine 44914>>>>>>> return 44915>>>>>>>end 44915>>>>>>>> 44915>>>>>>> 44915>>>>>>>//> Function SEQ_FileModTime returns the last modified stamp of a file 44915>>>>>>>//> in TS format (see DATES.NUI). NOTE! File specification MUST include 44915>>>>>>>//> full path. 44915>>>>>>>function SEQ_FileModTime global string fn# returns number 44917>>>>>>> integer h# m# s# err_label# 44917>>>>>>> date date# 44917>>>>>>> number rval# 44917>>>>>>> move (StringOemToAnsi(fn#)) to fn# 44918>>>>>>> ifnot (SEQ_FileExists(fn#)) function_return 0 44921>>>>>>> move |VI31 to err_label# //copy ON ERROR label 44922>>>>>>> on error gosub files.no$err // If file is open get_file_mod_time 44923>>>>>>> indicate err false // command will fail. 44924>>>>>>> get_file_mod_time fn# to date# h# m# s# // VDF6: 4358 DFRUNCON(31e): 4630 44928>>>>>>>// showln "get_file_mod_time " date# " " h# " " m# " " s# 44928>>>>>>> indicate err false 44929>>>>>>> move err_label# to |VI31 //restore original ON ERROR label 44930>>>>>>> indicate err false 44931>>>>>>> move (Date2to4(date#)) to date# 44932>>>>>>> move (TS_Compose2(date#,h#,m#,s#)) to rval# 44933>>>>>>> function_return rval# 44934>>>>>>>end_function // SEQ_FileModTime 44935>>>>>>> 44935>>>>>>>procedure set SEQ_FileModTime global string lsFile number lnTime 44937>>>>>>> integer h# m# s# err_label# liDateFormat 44937>>>>>>> date date# 44937>>>>>>> number rval# 44937>>>>>>> string lsTime 44937>>>>>>> ifnot (SEQ_FileExists(lsFile)) procedure_return 44940>>>>>>> move |VI31 to err_label# //copy ON ERROR label 44941>>>>>>> on error gosub files.no$err 44942>>>>>>> indicate err false 44943>>>>>>> get TS_ExtractDate lnTime to date# 44944>>>>>>> get TS_ExtractTime lnTime to lsTime 44945>>>>>>> move (mid(lsTime,2,1)) to h# 44946>>>>>>> move (mid(lsTime,2,4)) to m# 44947>>>>>>> move (mid(lsTime,2,7)) to s# 44948>>>>>>>// showln "set_file_mod_time " date# " " h# " " m# " " s# 44948>>>>>>> get_attribute DF_DATE_FORMAT to liDateFormat // set_file_mod_time only works when dateformat is DF_DATE_USA 44951>>>>>>> set_attribute DF_DATE_FORMAT to DF_DATE_USA 44954>>>>>>> move (StringOemToAnsi(lsFile)) to lsFile 44955>>>>>>> set_file_mod_time lsFile to date# h# m# s# // Faulty Faulty Faulty 44960>>>>>>> set_attribute DF_DATE_FORMAT to liDateFormat 44963>>>>>>> indicate err false 44964>>>>>>> move err_label# to |VI31 //restore original ON ERROR label 44965>>>>>>> indicate err false 44966>>>>>>>end_procedure // set SEQ_FileModTime 44967>>>>>>> 44967>>>>>>>procedure SEQ_CallBack_DirsInPath global string path# integer msg# integer obj# 44969>>>>>>> integer pos# len# 44969>>>>>>> string sep# dir# char# 44969>>>>>>> move (sysconf(SYSCONF_PATH_SEPARATOR)) to sep# 44970>>>>>>> move (length(path#)) to len# 44971>>>>>>> move "" to dir# 44972>>>>>>> for pos# from 1 to len# 44978>>>>>>>> 44978>>>>>>> move (mid(path#,1,pos#)) to char# 44979>>>>>>> if char# eq sep# begin 44981>>>>>>> if dir# ne "" send msg# to obj# dir# 44984>>>>>>> move "" to dir# 44985>>>>>>> end 44985>>>>>>>> 44985>>>>>>> else move (dir#+char#) to dir# 44987>>>>>>> loop 44988>>>>>>>> 44988>>>>>>> if dir# ne "" send msg# to obj# dir# 44991>>>>>>>end_procedure 44992>>>>>>> 44992>>>>>>>function SEQ_RemoveRedundantDirs global string path# returns string 44994>>>>>>> integer pos# len# 44994>>>>>>> string sep# dir# char# rval# 44994>>>>>>> move (sysconf(SYSCONF_PATH_SEPARATOR)) to sep# 44995>>>>>>> move (length(path#)) to len# 44996>>>>>>> move "" to dir# 44997>>>>>>> move "|" to rval# 44998>>>>>>> for pos# from 1 to len# 45004>>>>>>>> 45004>>>>>>> move (mid(path#,1,pos#)) to char# 45005>>>>>>> if char# eq sep# begin 45007>>>>>>> if dir# ne "" begin 45009>>>>>>> move (SEQ_TranslatePathToAbsolute(dir#)) to dir# 45010>>>>>>> ifnot ("|"+lowercase(dir#)+"|") in (lowercase(rval#)) move (rval#+dir#+"|") to rval# 45013>>>>>>> move "" to dir# 45014>>>>>>> end 45014>>>>>>>> 45014>>>>>>> end 45014>>>>>>>> 45014>>>>>>> else move (dir#+char#) to dir# 45016>>>>>>> loop 45017>>>>>>>> 45017>>>>>>> if dir# ne "" begin 45019>>>>>>> move (SEQ_TranslatePathToAbsolute(dir#)) to dir# 45020>>>>>>> ifnot ("|"+lowercase(dir#)+"|") in (lowercase(rval#)) move (rval#+dir#+"|") to rval# 45023>>>>>>> end 45023>>>>>>>> 45023>>>>>>> replace "|" in rval# with "" 45025>>>>>>> move (replaces("|",rval#,sep#)) to rval# 45026>>>>>>> function_return rval# 45027>>>>>>>end_function 45028>>>>>>> 45028>>>>>>>enumeration_list 45028>>>>>>> define SEQCB_FILES_ONLY 45028>>>>>>> define SEQCB_DIRS_ONLY 45028>>>>>>> define SEQCB_FILESANDDIRS 45028>>>>>>>end_enumeration_list 45028>>>>>>> 45028>>>>>>>desktop_section 45033>>>>>>> object oSEQ_CallBack_ItemsInDir is an cArray NO_IMAGE 45035>>>>>>> property string psPath public "" 45037>>>>>>> procedure add_item string str# 45040>>>>>>> set value item (item_count(self)) to str# 45041>>>>>>> end_procedure 45042>>>>>>> function iNumberOfItems integer lhMode returns integer 45045>>>>>>> integer liMax liItm liCount 45045>>>>>>> get item_count to liMax 45046>>>>>>> decrement liMax 45047>>>>>>> move 0 to liCount 45048>>>>>>> if (lhMode=SEQCB_FILES_ONLY) begin 45050>>>>>>> for liItm from 0 to liMax 45056>>>>>>>> 45056>>>>>>> ifnot (left(value(self,liItm),1)="[") increment liCount 45059>>>>>>> loop 45060>>>>>>>> 45060>>>>>>> function_return liCount 45061>>>>>>> end 45061>>>>>>>> 45061>>>>>>> if (lhMode=SEQCB_DIRS_ONLY) begin 45063>>>>>>> for liItm from 0 to liMax 45069>>>>>>>> 45069>>>>>>> if (left(value(self,liItm),1)="[") increment liCount 45072>>>>>>> loop 45073>>>>>>>> 45073>>>>>>> function_return liCount 45074>>>>>>> end 45074>>>>>>>> 45074>>>>>>> if (lhMode=SEQCB_FILESANDDIRS) function_return (item_count(self)) 45077>>>>>>> end_function 45078>>>>>>> end_object 45079>>>>>>>end_desktop_section 45084>>>>>>> 45084>>>>>>>procedure SEQ_Load_ItemsInDir global string path# 45086>>>>>>> send WinFolder_ReadFolder path# 45087>>>>>>>end_procedure 45088>>>>>>>function SEQ_NumberFiles global integer liMode returns integer 45090>>>>>>> integer lhObj 45090>>>>>>> move (oWinFolderEntries(self)) to lhObj 45091>>>>>>> if (liMode=SEQCB_FILES_ONLY ) function_return (piFileCount(lhObj)) 45094>>>>>>> if (liMode=SEQCB_DIRS_ONLY ) function_return (piFolderCount(lhObj)) 45097>>>>>>> if (liMode=SEQCB_FILESANDDIRS) function_return (piFileCount(lhObj)+piFolderCount(lhObj)) 45100>>>>>>>end_function 45101>>>>>>>procedure SEQ_CallBack_ItemsInDir global integer liMode integer lhMsg integer lhObj 45103>>>>>>> integer lhFolder liMax liRow lbFolder 45103>>>>>>> string lsName lsPath 45103>>>>>>> move (oWinFolderEntries(self)) to lhFolder 45104>>>>>>> get psFolder of lhFolder to lsPath 45105>>>>>>> get row_count of lhFolder to liMax 45106>>>>>>> decrement liMax 45107>>>>>>> for liRow from 0 to liMax 45113>>>>>>>> 45113>>>>>>> get pbFolder.i of lhFolder liRow to lbFolder 45114>>>>>>> get psFileName.i of lhFolder liRow to lsName 45115>>>>>>> 45115>>>>>>> if lbFolder begin 45117>>>>>>> if (liMode<>SEQCB_FILES_ONLY) send lhMsg to lhObj ("["+lsName+"]") lsPath (pnFileSz.i(lhFolder,liRow)) (pnLastWrite.i(lhFolder,liRow)) 45120>>>>>>> end 45120>>>>>>>> 45120>>>>>>> else begin 45121>>>>>>> if (liMode<>SEQCB_DIRS_ONLY) send lhMsg to lhObj lsName lsPath (pnFileSz.i(lhFolder,liRow)) (pnLastWrite.i(lhFolder,liRow)) 45124>>>>>>> end 45124>>>>>>>> 45124>>>>>>> loop 45125>>>>>>>> 45125>>>>>>>end_procedure 45126>>>>>>> 45126>>>>>>>desktop_section 45131>>>>>>> object oFileInPath is an cArray NO_IMAGE 45133>>>>>>> property string psFileToCheck public "" 45135>>>>>>> property integer piMessage public 0 45137>>>>>>> property integer piObject public 0 45139>>>>>>> procedure CallBack_FileInPath_Help string dir# 45142>>>>>>> integer msg# obj# 45142>>>>>>> string fn# 45142>>>>>>> get piMessage to msg# 45143>>>>>>> get piObject to obj# 45144>>>>>>> move (SEQ_ComposeAbsoluteFileName(dir#,psFileToCheck(self))) to fn# 45145>>>>>>> if (SEQ_FileExists(fn#)) send msg# to obj# fn# 45148>>>>>>> end_procedure 45149>>>>>>> procedure CallBack_FileInPath string file# string path# integer msg# integer obj# 45152>>>>>>> send delete_data 45153>>>>>>> set psFileToCheck to file# 45154>>>>>>> set piMessage to msg# 45155>>>>>>> set piObject to obj# 45156>>>>>>> send SEQ_CallBack_DirsInPath path# msg_CallBack_FileInPath_help self 45157>>>>>>> send delete_data 45158>>>>>>> end_procedure 45159>>>>>>> end_object 45160>>>>>>>end_desktop_section 45165>>>>>>> 45165>>>>>>>procedure SEQ_CallBack_FileInPath global string file# string path# integer msg# integer obj# 45167>>>>>>> send CallBack_FileInPath to (oFileInPath(self)) file# path# msg# obj# 45168>>>>>>>end_procedure 45169>>>>>>> 45169>>>>>>>// Procedure SEQ_WriteArrayItems writes the contents of an array (obj#) to 45169>>>>>>>// sequential channel ch#. The procedure will only produce a meaningful 45169>>>>>>>// result if the items of the array does not contain strings with binary data 45169>>>>>>>// or CR/FL characters. 45169>>>>>>>procedure SEQ_WriteArrayItems global integer ch# integer obj# 45171>>>>>>> integer itm# max# 45171>>>>>>> get item_count of obj# to max# 45172>>>>>>> writeln channel ch# max# 45175>>>>>>> for itm# from 0 to (max#-1) 45181>>>>>>>> 45181>>>>>>> writeln (value(obj#,itm#)) 45183>>>>>>> loop 45184>>>>>>>> 45184>>>>>>>end_procedure 45185>>>>>>> 45185>>>>>>>// Procedure SEQ_ReadArrayItems will fill the array (obj#) with data 45185>>>>>>>// read from sequential channel ch#. These data must have been written 45185>>>>>>>// using the SEQ_WriteArrayItems procedure. 45185>>>>>>>procedure SEQ_ReadArrayItems global integer ch# integer obj# 45187>>>>>>> integer itm# max# 45187>>>>>>> string str# 45187>>>>>>> send delete_data to obj# 45188>>>>>>> get item_count of obj# to max# 45189>>>>>>> readln channel ch# max# 45191>>>>>>> for itm# from 0 to (max#-1) 45197>>>>>>>> 45197>>>>>>> readln str# 45198>>>>>>> set value of obj# item itm# to str# 45199>>>>>>> loop 45200>>>>>>>> 45200>>>>>>>end_procedure 45201>>>>>>> 45201>>>>>>>// Calling procedure SEQ_WriteRecordBuffer_LD will write the current 45201>>>>>>>// contents of the record buffer of file file# through channel ch#. 45201>>>>>>>// The post-fix "LD" means line delimited. 45201>>>>>>>procedure SEQ_WriteRecordBuffer_LD global integer ch# integer file# 45203>>>>>>> integer max# field# fieldindex# filenumber# len# type# 45203>>>>>>> move fieldindex to fieldindex# 45204>>>>>>> move filenumber to filenumber# 45205>>>>>>> get_attribute DF_FILE_NUMBER_FIELDS of file# to max# 45208>>>>>>> move file# to filenumber 45209>>>>>>> write channel ch# // Set channel 45210>>>>>>> for fieldindex from 1 to max# 45216>>>>>>>> 45216>>>>>>> get_attribute DF_FIELD_TYPE of file# fieldindex to type# 45219>>>>>>> if type# ne DF_OVERLAP begin // Do not write overlap fields 45221>>>>>>> if (type#=DF_BINARY or type#=DF_TEXT) begin // If TEXT or BINARY we 45223>>>>>>> move (length(indirect_file.recnum)) to len# // write(ln) the length 45224>>>>>>> writeln len# // of the field before 45226>>>>>>> write indirect_file.recnum // its contents. 45227>>>>>>> end 45227>>>>>>>> 45227>>>>>>> else writeln indirect_file.recnum 45230>>>>>>> end 45230>>>>>>>> 45230>>>>>>> loop 45231>>>>>>>> 45231>>>>>>> move fieldindex# to fieldindex 45232>>>>>>> move filenumber# to filenumber 45233>>>>>>>end_procedure 45234>>>>>>> 45234>>>>>>>// Read a record from channel ch# as written by the SEQ_WriteRecordBuffer_LD 45234>>>>>>>// procedure. 45234>>>>>>>procedure SEQ_ReadRecordBuffer_LD global integer ch# integer file# 45236>>>>>>> integer max# fieldindex# filenumber# len# type# 45236>>>>>>> move fieldindex to fieldindex# 45237>>>>>>> move filenumber to filenumber# 45238>>>>>>> get_attribute DF_FILE_NUMBER_FIELDS of file# to max# 45241>>>>>>> move file# to filenumber 45242>>>>>>> read channel ch# // Set channel 45243>>>>>>> for fieldindex from 1 to max# 45249>>>>>>>> 45249>>>>>>> get_attribute DF_FIELD_TYPE of file# fieldindex to type# 45252>>>>>>> if type# ne DF_OVERLAP begin 45254>>>>>>> if (type#=DF_BINARY or type#=DF_TEXT) begin 45256>>>>>>> readln len# 45257>>>>>>> read_block indirect_file.recnum len# 45258>>>>>>> end 45258>>>>>>>> 45258>>>>>>> else readln indirect_file.recnum 45260>>>>>>> end 45260>>>>>>>> 45260>>>>>>> loop 45261>>>>>>>> 45261>>>>>>> move fieldindex# to fieldindex 45262>>>>>>> move filenumber# to filenumber 45263>>>>>>>end_procedure 45264>>>>>>> 45264>>>>>>>// Reads a record like the SEQ_ReadRecordBuffer_LD procedure but places the 45264>>>>>>>// result in the array passed in the lhArray instead of directly in the 45264>>>>>>>// record buffer. 45264>>>>>>>procedure SEQ_ReadRecordBufferToArray_LD global integer liChannel integer liFile integer lhArray 45266>>>>>>> integer liMax liField liLen liType 45266>>>>>>> string lsValue 45266>>>>>>> send delete_data to lhArray 45267>>>>>>> get_attribute DF_FILE_NUMBER_FIELDS of liFile to liMax 45270>>>>>>> read channel liChannel // Set channel 45271>>>>>>> for liField from 1 to liMax 45277>>>>>>>> 45277>>>>>>> get_attribute DF_FIELD_TYPE of liFile liField to liType 45280>>>>>>> if liType ne DF_OVERLAP begin 45282>>>>>>> if (liType=DF_BINARY or liType=DF_TEXT) begin 45284>>>>>>> readln liLen 45285>>>>>>> read_block lsValue liLen 45286>>>>>>> end 45286>>>>>>>> 45286>>>>>>> else readln lsValue 45288>>>>>>> end 45288>>>>>>>> 45288>>>>>>> set value of lhArray item liField to lsValue 45289>>>>>>> loop 45290>>>>>>>> 45290>>>>>>>end_procedure 45291>>>>>>> 45291>>>>>>>// Returns true if delete was successful 45291>>>>>>>function SEQ_EraseFile global string lsFile returns integer 45293>>>>>>> if (SEQ_FileExists(lsFile)) eq SEQIT_DIRECTORY function_return 0 45296>>>>>>> erasefile (StringOemToAnsi(lsFile)) 45297>>>>>>>> 45297>>>>>>> if (SEQ_FileExists(lsFile)) eq SEQIT_NONE function_return 1 45300>>>>>>> // function_return 0 45300>>>>>>>end_function 45301>>>>>>> 45301>>>>>>>Use wvaW32fh.pkg // Package by Wil van Antwerpen from www.vdf-guidance.com Including file: wvaw32fh.pkg (C:\projects\BRS\VDFQuery\AppSrc\wvaw32fh.pkg) 45301>>>>>>>>>// this package serves as a buffer between VDFQuery packages and 45301>>>>>>>>>// the Win32 file handling of Wil v. Antwherpen. 45301>>>>>>>>> 45301>>>>>>>>>use wvasymb.pkg Including file: wvasymb.pkg (C:\projects\BRS\VDFQuery\AppSrc\wvasymb.pkg) 45301>>>>>>>>>>> 45301>>>>>>>>>>>enumeration_list 45301>>>>>>>>>>> define WVA$FILE_HANDLING_1999 45301>>>>>>>>>>> define WVA$FILE_HANDLING_2002 45301>>>>>>>>>>>end_enumeration_list 45301>>>>>>>>> 45301>>>>>>>>> // define wva_default for WVA$FILE_HANDLING_1999 45301>>>>>>>>> define wva_default for WVA$FILE_HANDLING_2002 45301>>>>>>>>> 45301>>>>>>>>>//#IF wva_default=WVA$FILE_HANDLING_1999 45301>>>>>>>>> //use vsWin32fh.pkg 45301>>>>>>>>> //Function wvaSelect_File Global String sSupportedFileTypes String sCaptionText String sInitial_Folder Returns String 45301>>>>>>>>> //function_return (vsSelect_File(sSupportedFileTypes,sCaptionText,sInitial_Folder)) 45301>>>>>>>>> //End_Function 45301>>>>>>>>> //Function wvaFolderExists Global String sFolderName returns Integer 45301>>>>>>>>> //function_return (vsFolderExists(sFolderName)) 45301>>>>>>>>> //End_Function 45301>>>>>>>>> //Function wvaWin32_SHBrowseForFolder Global String sDialogTitle returns String 45301>>>>>>>>> //function_return (vsWin32_SHBrowseForFolder(sDialogTitle)) 45301>>>>>>>>> //End_Function 45301>>>>>>>>> //Function wvaWin32_CreateDirectory Global String sNewFolder Returns Integer 45301>>>>>>>>> //function_return (vsWin32_CreateDirectory(sNewFolder)) 45301>>>>>>>>> //End_Function 45301>>>>>>>>> //Function wvaVerifyNewFolder Global String sFolderName Returns Integer 45301>>>>>>>>> //function_return (vsVerifyNewFolder(sFolderName)) 45301>>>>>>>>> //End_Function 45301>>>>>>>>> //Function wvaWin32_ShDeleteFile Global String sFileName Returns Integer 45301>>>>>>>>> //function_return (vsWin32_ShDeleteFile(sFileName)) 45301>>>>>>>>> //End_Function 45301>>>>>>>>> //Function wvaWin32_ShCopyFile Global String sSource String sDestination returns Integer 45301>>>>>>>>> //function_return (vsWin32_ShCopyFile(sSource,sDestination)) 45301>>>>>>>>> //End_Function 45301>>>>>>>>> //Function wvaWin32_ShMoveFile Global String sSource String sDestination returns Integer 45301>>>>>>>>> //function_return (vsWin32_ShMoveFile(sSource,sDestination)) 45301>>>>>>>>> //End_Function 45301>>>>>>>>> //Function wvaWin32_ShRenameFile Global String sSource String sDestination returns Integer 45301>>>>>>>>> //function_return (vsWin32_ShRenameFile(sSource,sDestination)) 45301>>>>>>>>> //End_Function 45301>>>>>>>>> //Procedure wvaWin32_ShellExecute global String sOperation String sDocument String sParameters String sPath 45301>>>>>>>>> //send vsWin32_ShellExecute sOperation sDocument sParameters sPath 45301>>>>>>>>> //end_procedure 45301>>>>>>>>>//#ENDIF 45301>>>>>>>>> use vWin32fh.pkg 45301>>>>>>>>> Function wvaSelect_File Global String sSupportedFileTypes String sCaptionText String sInitial_Folder Returns String 45303>>>>>>>>> function_return (vSelect_File(sSupportedFileTypes,sCaptionText,sInitial_Folder)) 45304>>>>>>>>> End_Function 45305>>>>>>>>> Function wvaFolderExists Global String sFolderName returns Integer 45307>>>>>>>>> function_return (vFolderExists(sFolderName)) 45308>>>>>>>>> End_Function 45309>>>>>>>>> Function wvaWin32_SHBrowseForFolder Global String sDialogTitle returns String 45311>>>>>>>>> function_return (vSHBrowseForFolder(sDialogTitle)) 45312>>>>>>>>> End_Function 45313>>>>>>>>> Function wvaWin32_CreateDirectory Global String sNewFolder Returns Integer 45315>>>>>>>>> function_return (vCreateDirectory(sNewFolder)) 45316>>>>>>>>> End_Function 45317>>>>>>>>> Function wvaVerifyNewFolder Global String sFolderName Returns Integer 45319>>>>>>>>> function_return (vVerifyNewFolder(sFolderName)) 45320>>>>>>>>> End_Function 45321>>>>>>>>> Function wvaWin32_ShDeleteFile Global String sFileName Returns Integer 45323>>>>>>>>> function_return (vDeleteFile(sFileName)) 45324>>>>>>>>> End_Function 45325>>>>>>>>> Function wvaWin32_ShCopyFile Global String sSource String sDestination returns Integer 45327>>>>>>>>> function_return (vCopyFile(sSource,sDestination)) 45328>>>>>>>>> End_Function 45329>>>>>>>>> Function wvaWin32_ShMoveFile Global String sSource String sDestination returns Integer 45331>>>>>>>>> function_return (vMoveFile(sSource,sDestination)) 45332>>>>>>>>> End_Function 45333>>>>>>>>> Function wvaWin32_ShRenameFile Global String sSource String sDestination returns Integer 45335>>>>>>>>> function_return (vRenameFile(sSource,sDestination)) 45336>>>>>>>>> End_Function 45337>>>>>>>>> Procedure wvaWin32_ShellExecute global String sOperation String sDocument String sParameters String sPath 45339>>>>>>>>> send vShellExecute sOperation sDocument sParameters sPath 45340>>>>>>>>> end_procedure 45341>>>>>>>function SEQ_CopyFile global string lsSourceFile string lsTargetFile returns integer 45343>>>>>>> integer liRval 45343>>>>>>> move (StringOemToAnsi(lsSourceFile)) to lsSourceFile 45344>>>>>>> move (StringOemToAnsi(lsTargetFile)) to lsTargetFile 45345>>>>>>> get wvaWin32_ShCopyFile lsSourceFile lsTargetFile to liRval 45346>>>>>>> move (not(liRval)) to liRval 45347>>>>>>> function_return liRval 45348>>>>>>>end_function 45349>>>>>>>// Returns true if delete was successful 45349>>>>>>>function SEQ_MoveFile global string lsSourceFile string lsTargetFile returns integer 45351>>>>>>> integer liRval 45351>>>>>>> get SEQ_CopyFile lsSourceFile lsTargetFile to liRval 45352>>>>>>> if liRval get SEQ_EraseFile lsSourceFile to liRval 45355>>>>>>> function_return liRval 45356>>>>>>>end_function 45357>>>>>>> 45357>>>>>>>function SEQ_ValidDrives global returns string 45359>>>>>>> integer liLen liPos lbError 45359>>>>>>> string lsDrives lsDrive lsRval 45359>>>>>>> send delete_data 45360>>>>>>> move "ABCDEFGHIJKLMNOPQRSTUVWXYZ" to lsDrives 45361>>>>>>> move (length(lsDrives)) to liLen 45362>>>>>>> move "" to lsRval 45363>>>>>>> for liPos from 1 to liLen 45369>>>>>>>> 45369>>>>>>> move (mid(lsDrives,1,liPos)) to lsDrive 45370>>>>>>> valid_drive lsDrive lbError 45371>>>>>>> ifnot lbError move (lsRval+lsDrive) to lsRval 45374>>>>>>> loop 45375>>>>>>>> 45375>>>>>>> function_return lsRval 45376>>>>>>>end_function 45377>>>>>>> 45377>>>>>>>function SEQ_AppendFiles global string lsFile1 string lsFile2 returns integer 45379>>>>>>> integer liRval liChannelOut liChannelIn liSize liIterations liRest liCount 45379>>>>>>> move (lowercase(lsFile1)) to lsFile1 45380>>>>>>> move (lowercase(lsFile2)) to lsFile2 45381>>>>>>> move 0 to liRval // Failure 45382>>>>>>> if lsFile1 ne lsFile2 begin 45384>>>>>>> // Both files exists? 45384>>>>>>> get SEQ_AppendOutput lsFile1 to liChannelOut 45385>>>>>>> if liChannelOut ge 0 begin 45387>>>>>>> send SEQ_WriteFile liChannelOut lsFile2 45388>>>>>>> move 1 to liRval // Let's just hope it's ok 45389>>>>>>> //get SEQ_FileSize lsFile2 to liSize 45389>>>>>>> //if liSize begin 45389>>>>>>> // get SEQ_DirectInput ("binary:"+lsFile2) to liChannelIn 45389>>>>>>> // if liChannelIn ge 0 begin 45389>>>>>>> // move (liSize/250) to liIterations 45389>>>>>>> // move (liSize-(liIterations*250)) to liRest 45389>>>>>>> // for liCount from 1 to liIterations 45389>>>>>>> // read_block channel liChannelIn giSeq$Temp 250 45389>>>>>>> // write channel liChannelOut giSeq$Temp 45389>>>>>>> // loop 45389>>>>>>> // read_block channel liChannelIn giSeq$Temp liRest 45389>>>>>>> // write channel liChannelOut giSeq$Temp 45389>>>>>>> // move 1 to liRval 45389>>>>>>> // send SEQ_CloseInput liChannelIn 45389>>>>>>> // end 45389>>>>>>> //end 45389>>>>>>> send SEQ_CloseOutput liChannelOut 45390>>>>>>> end 45390>>>>>>>> 45390>>>>>>> end 45390>>>>>>>> 45390>>>>>>> function_return liRval 45391>>>>>>>end_function 45392>>>>>>> 45392>>>>>>>// procedure SEQ_WriteHexByteStream global integer liChannel string lsHexBytes 45392>>>>>>>// integer liBytes liPos liByte liByteValue 45392>>>>>>>// string lsHexByte 45392>>>>>>>// move (length(lsHexBytes)/2) to liBytes 45392>>>>>>>// showln "Start SEQ_WriteHexByteStream" 45392>>>>>>>// decrement liBytes 45392>>>>>>>// for liByte from 0 to liBytes 45392>>>>>>>// move (liByte*2+1) to liPos 45392>>>>>>>// move (mid(lsHexBytes,2,liPos)) to lsHexByte 45392>>>>>>>// move (pos(left(lsHexByte,1),"0123456789ABCDEF")-1*16+pos(right(lsHexByte,1),"0123456789ABCDEF")-1) to liByteValue 45392>>>>>>>// character liByteValue to giSeq$Temp 45392>>>>>>>// write channel liChannel giSeq$Temp 45392>>>>>>>// loop 45392>>>>>>>// showln "End SEQ_WriteHexByteStream" 45392>>>>>>>// end_procedure 45392>>>>>>> 45392>>>>>>>procedure SEQ_WriteHexByteStream global integer liChannel string lsHexBytes 45394>>>>>>> integer liBytes liPos liByte liByteValue liByteCount 45394>>>>>>> string lsHexByte 45394>>>>>>> move (length(lsHexBytes)/2) to liBytes 45395>>>>>>> decrement liBytes 45396>>>>>>> move 0 to liByteCount 45397>>>>>>> move "" to giSeq$Temp 45398>>>>>>> for liByte from 0 to liBytes 45404>>>>>>>> 45404>>>>>>> move (liByte*2+1) to liPos 45405>>>>>>> move (mid(lsHexBytes,2,liPos)) to lsHexByte 45406>>>>>>> move (pos(left(lsHexByte,1),"0123456789ABCDEF")-1*16+pos(right(lsHexByte,1),"0123456789ABCDEF")-1) to liByteValue 45407>>>>>>> append giSeq$Temp (character(liByteValue)) 45408>>>>>>> increment liByteCount 45409>>>>>>> if liByteCount eq 250 begin 45411>>>>>>> write channel liChannel giSeq$Temp 45413>>>>>>> move 0 to liByteCount 45414>>>>>>> move "" to giSeq$Temp 45415>>>>>>> end 45415>>>>>>>> 45415>>>>>>> loop 45416>>>>>>>> 45416>>>>>>> if liByteCount write channel liChannel giSeq$Temp 45420>>>>>>>end_procedure 45421>>>>>>> 45421>>>>>>>function SEQ_FileListDirectory global returns string 45423>>>>>>> 45423>>>>>>>end_function 45424>>>>>>> 45424>>>>>>>//> The cChannelAdmin class was deviced to help administrate one sequential 45424>>>>>>>//> channel when it is used for more than one task at the same time. 45424>>>>>>>//> It may be used to temporarily suspend its current connection, do 45424>>>>>>>//> something else and then resume where it left off. 45424>>>>>>>class cChannelAdmin is an cArray // in/out device ch_pos 45425>>>>>>> procedure construct_object integer liImg 45427>>>>>>> forward send construct_object liImg 45429>>>>>>> property integer pChannel public 0 // channel number to administrate 45430>>>>>>> property integer pPointer public 0 // stack pointer 45431>>>>>>> end_procedure 45432>>>>>>> 45432>>>>>>> procedure reset 45434>>>>>>> send delete_data 45435>>>>>>> set pPointer to 0 45436>>>>>>> end_procedure 45437>>>>>>> 45437>>>>>>> procedure close_help 45439>>>>>>> integer liPointer liCh liPosition lbInput 45439>>>>>>> string lsDev 45439>>>>>>> get pPointer to liPointer 45440>>>>>>> decrement liPointer 45441>>>>>>> get pChannel to liCh 45442>>>>>>> get_channel_position liCh to liPosition 45443>>>>>>>> 45443>>>>>>> get integer_value item (liPointer*3) to lbInput 45444>>>>>>> if lbInput close_input channel liCh 45448>>>>>>> else close_output channel liCh 45451>>>>>>> set value item (liPointer*3+2) to liPosition 45452>>>>>>> get value item (liPointer*3+1) to lsDev 45453>>>>>>> //send obs ("closing current activity ("+if(lbInput,"input","output")+") "+lsDev+" at position "+string(liPosition)) 45453>>>>>>> end_procedure 45454>>>>>>> 45454>>>>>>> procedure close_current_activity 45456>>>>>>> send close_help 45457>>>>>>> end_procedure 45458>>>>>>> 45458>>>>>>> procedure restore_activity 45460>>>>>>> integer liPointer lbInput liPosition liCh 45460>>>>>>> string lsDev lsValue 45460>>>>>>> get pPointer to liPointer 45461>>>>>>> decrement liPointer 45462>>>>>>> get pChannel to liCh 45463>>>>>>> get value item (liPointer*3) to lbInput 45464>>>>>>> get value item (liPointer*3+1) to lsDev 45465>>>>>>> get value item (liPointer*3+2) to liPosition 45466>>>>>>> if lbInput begin 45468>>>>>>> direct_input channel liCh lsDev 45470>>>>>>> if liPosition gt 0 decrement liPosition 45473>>>>>>> set_channel_position liCh to liPosition 45474>>>>>>>> 45474>>>>>>> if liPosition gt 0 read_block channel liCh lsValue 1 45478>>>>>>> end 45478>>>>>>>> 45478>>>>>>> else append_output channel liCh (StringOemToAnsi(lsDev)) 45481>>>>>>> //send obs ("restoring current activity ("+if(lbInput,"input","output")+") "+lsDev+" at position "+string(liPosition)) 45481>>>>>>> end_procedure 45482>>>>>>> 45482>>>>>>> function sReadln returns string 45484>>>>>>> string lsRval 45484>>>>>>> readln channel (pChannel(self)) lsRval 45486>>>>>>> function_return lsRval 45487>>>>>>> end_function 45488>>>>>>> 45488>>>>>>> //> Use this procedure to initiate a new sequential file operation. 45488>>>>>>> procedure direct_xput integer lbInput string lsDev 45490>>>>>>> integer liPointer liChannel 45490>>>>>>> //send obs ("direct_xput ("+if(lbInput,"input","output")+") "+lsDev) 45490>>>>>>> get pPointer to liPointer 45491>>>>>>> get pChannel to liChannel 45492>>>>>>> if liPointer send close_current_activity 45495>>>>>>> 45495>>>>>>> if lbInput direct_input channel liChannel (StringOemToAnsi(lsDev)) 45499>>>>>>> else direct_output channel liChannel (StringOemToAnsi(lsDev)) 45502>>>>>>> set array_value item (liPointer*3) to lbInput 45503>>>>>>> set array_value item (liPointer*3+1) to lsDev 45504>>>>>>> set pPointer to (liPointer+1) 45505>>>>>>> end_procedure 45506>>>>>>> 45506>>>>>>> //> Use procedure Close_Xput to terminate the current sequential file 45506>>>>>>> //> operation and restore the previous, if any. 45506>>>>>>> procedure close_xput 45508>>>>>>> integer liPointer 45508>>>>>>> get pPointer to liPointer 45509>>>>>>> send close_help 45510>>>>>>> decrement liPointer 45511>>>>>>> set pPointer to liPointer 45512>>>>>>> if liPointer send restore_activity 45515>>>>>>> end_procedure 45516>>>>>>>end_class // cChannelAdmin 45517>>>>>>> 45517>>>>>>>// Returns something like 
2003-08-23_175515.
45517>>>>>>>function SEQ_SysTimeFileName global string lsPre string lsExt returns string
45519>>>>>>>  string lsRval
45519>>>>>>>  move (lsPre+DateToString(dSysDate(),DF_DATE_MILITARY,1,"-")+"_"+replaces(":",sSysTime(),"")) to lsRval
45520>>>>>>>  if (lsExt<>"") move (lsRval+"."+lsExt) to lsRval
45523>>>>>>>  function_return lsRval
45524>>>>>>>end_function
45525>>>>>>>
45525>>>>>>>
45525>>>>>>>function SEQ_InputChannelLineCount global integer liChannel returns integer
45527>>>>>>>  string lsThrowAway
45527>>>>>>>  get SEQ_ReadLnProbe liChannel to lsThrowAway
45528>>>>>>>  function_return LineCount
45529>>>>>>>end_function
45530>>>>>>>
45530>>>>>>>function SEQ_ChannelPosToLineCount global integer liChannel integer liPos returns integer
45532>>>>>>>  integer liPushPos lbSeqEof lbSneakMode liTestPos liCount
45532>>>>>>>  string lsRval lsValue liLineCount
45532>>>>>>>  get_channel_position liChannel to liPushPos
45533>>>>>>>>
45533>>>>>>>
45533>>>>>>>  move 0 to liCount
45534>>>>>>>  set_channel_position liChannel to 0
45535>>>>>>>>
45535>>>>>>>  repeat
45535>>>>>>>>
45535>>>>>>>    readln channel liChannel lsValue
45537>>>>>>>    increment liCount
45538>>>>>>>    move (seqeof) to lbSeqEof
45539>>>>>>>    get_channel_position liChannel to liTestPos
45540>>>>>>>>
45540>>>>>>>  until (liTestPos>=liPos or lbSeqEof<>0)
45542>>>>>>>  if (liPos>liTestPos) move -1 to liCount // Signal that the position doesn't exist at all
45545>>>>>>>
45545>>>>>>>  // Restore the state of the channel:
45545>>>>>>>  move (liPushPos>0) to lbSneakMode
45546>>>>>>>  if lbSneakMode decrement liPushPos
45549>>>>>>>  set_channel_position liChannel to liPushPos
45550>>>>>>>>
45550>>>>>>>  if lbSneakMode read_block channel liChannel lsValue 1
45554>>>>>>>  indicate seqeof as lbSeqEof ne 0
45555>>>>>>>  function_return liCount
45556>>>>>>>end_function
45557>>>>>>>
45557>>>>>>>function SEQ_CurrentFolder global returns string
45559>>>>>>>  string lsValue
45559>>>>>>>  GET_CURRENT_DIRECTORY to lsValue
45560>>>>>>>  function_return lsValue
45561>>>>>>>end_function
45562>>>>>>>
45562>>>>>>>function SEQ_TextFromSeqInput global string sDevice returns string
45564>>>>>>>  integer liChannel lbSeqEof
45564>>>>>>>  string sRval sLine sChar10
45564>>>>>>>  move "" to sRval
45565>>>>>>>  move (character(10)) to sChar10
45566>>>>>>>  get SEQ_DirectInput sDevice to liChannel
45567>>>>>>>  if liChannel ge 0 begin
45569>>>>>>>    repeat
45569>>>>>>>>
45569>>>>>>>      readln sLine
45570>>>>>>>      move (seqeof) to lbSeqEof
45571>>>>>>>      ifnot lbSeqEof move (sRval+sLine+sChar10) to sRval
45574>>>>>>>    until lbSeqEof
45576>>>>>>>  end
45576>>>>>>>>
45576>>>>>>>  send SEQ_CloseInput liChannel
45577>>>>>>>  function_return sRval
45578>>>>>>>end_function
45579>>>>>>>
45579>>>>>>>function SEQ_TextFromDfImage global integer iImg returns string
45581>>>>>>>  function_return (SEQ_TextFromSeqInput("image:"+string(iImg)))
45582>>>>>>>end_function
45583>>>>>>>function SEQ_TextFromFile global string sFile returns string
45585>>>>>>>  function_return (SEQ_TextFromSeqInput(sFile))
45586>>>>>>>end_function
45587>>>>>>>function SEQ_TextFromDfField global integer iFile integer iField returns string
45589>>>>>>>  // I have no idea whether this will work
45589>>>>>>>  function_return (SEQ_TextFromSeqInput("dbms:"+string(iFile)+" "+string(iField)))
45590>>>>>>>end_function
45591>>>>>>>
45591>>>>>
45591>>>>>function sTextFromDfImage global integer iImg returns string
45593>>>>>  function_return (SEQ_TextFromSeqInput("image:"+string(iImg)))
45594>>>>>end_function
45595>>>>>function sTextFromFile global string sFile returns string
45597>>>>>  function_return (SEQ_TextFromSeqInput(sFile))
45598>>>>>end_function
45599>>>>>function sTextFromDfField global integer iFile integer iField returns string
45601>>>>>  // I have no idea whether this will work
45601>>>>>  function_return (SEQ_TextFromSeqInput("dbms:"+string(iFile)+" "+string(iField)))
45602>>>>>end_function
45603>>>>>
45603>>>
45603>>>procedure DoDisplayLog global
45605>>>  integer liLogImage
45605>>>  string lsLog
45605>>>  get AppInfo AI_LOG_IMAGE to liLogImage
45606>>>  get sTextFromDfImage liLogImage to lsLog
45607>>>  send DoDisplayText "Program log" lsLog
45608>>>end_procedure
45609>>>procedure DoDisplayKnownIssues global
45611>>>  integer liLogImage
45611>>>  string lsLog
45611>>>  get AppInfo AI_KNOWN_ISSUES to liLogImage
45612>>>  get sTextFromDfImage liLogImage to lsLog
45613>>>  send DoDisplayText "Known Issues" lsLog
45614>>>end_procedure
45615>>>
45615>>>object oAboutPanel is a aps.ModalPanel label ("About "+AppInfo(AI_TITLE))
45618>>>  set locate_mode to CENTER_ON_SCREEN
45619>>>  on_key kcancel send close_panel
45620>>>  object oGraph is a GraphicArea
45622>>>    set size to 200 300
45623>>>    send aps_auto_locate_control self
45624>>>  end_object
45625>>>  object oBtn1 is a aps.multi_button
45627>>>    on_item "Log" send DoDisplayLog
45628>>>  end_object
45629>>>  object oBtn2 is a aps.multi_button
45631>>>    on_item "Known issues" send DoDisplayKnownIssues
45632>>>  end_object
45633>>>  object oBtn3 is a aps.multi_button
45635>>>    on_item t.btn.close send close_panel
45636>>>  end_object
45637>>>  procedure popup
45640>>>    integer liLogImage
45640>>>    get AppInfo AI_LOG_IMAGE to liLogImage
45641>>>    set object_shadow_state of (oBtn1(self)) to (not(liLogImage))
45642>>>    get AppInfo AI_KNOWN_ISSUES to liLogImage
45643>>>    set object_shadow_state of (oBtn2(self)) to (not(liLogImage))
45644>>>    set piProgram_RAM of (oGraph(self)) to (AppInfo(TMP_GA_OBJECTID))
45645>>>    forward send popup
45647>>>  end_procedure
45648>>>  send aps_locate_multi_buttons
45649>>>end_object
45650>>>
45650>>>procedure DoAbout global
45652>>>  send popup to (oAboutPanel(self))
45653>>>end_procedure
45654>
45654>set AppInfo AI_TITLE       to "DBQuery"
45655>set AppInfo AI_SUBTITLE    to "for Windows"
45656>set AppInfo AI_VERSION     to "2.1"
45657>set AppInfo AI_REVISION    to ""
45658>set AppInfo AI_AUTHOR      to "Sture ApS"
45659>set AppInfo AI_WATERMARK   to ""
45660>set AppInfo AI_RELEASEDATE to ""
45661>
45661>object oSplash is a cGraphicSplash
45663>end_object
45664>send activate to (oSplash(self))
45665>
45665>Use MdiExt.utl
Including file: mdiext.utl    (C:\projects\BRS\VDFQuery\AppSrc\mdiext.utl)
45665>>>// **********************************************************************
45665>>>// Use MdiExt.utl   // MDI Extensions
45665>>>//
45665>>>// By Sture Andersen
45665>>>//
45665>>>// Create: Mon  15-12-1997
45665>>>//
45665>>>//
45665>>>// Usage:
45665>>>//
45665>>>//   Substitute:
45665>>>//
45665>>>//     Use dfStdBtn
45665>>>//
45665>>>//   for:
45665>>>//
45665>>>//     Object Tool_Bar is a cSturesToolBar
45665>>>//       send Add_Standard_Toolbar_Buttons         // Adds the standard buttons
45665>>>//     //send Add_Space
45665>>>//     //send Add_Calendar_tbButton self // Add calendar button
45665>>>//     //send Add_LinkView_tbButton self // Add link view button
45665>>>//     End_Object
45665>>>//
45665>>>//   and:
45665>>>//
45665>>>//     Use DfStdSbr
45665>>>//
45665>>>//   for:
45665>>>//
45665>>>//     Object Status_Bar is a cStatusBar
45665>>>//     End_Object
45665>>>//
45665>>>// ***********************************************************************
45665>>>
45665>>>Use DFMainBt  // Standard dfMain_ButtonBar (DAC)
Including file: Dfmainbt.pkg    (C:\Programmer\Visual DataFlex 12.0\Pkg\Dfmainbt.pkg)
45665>>>>>//-------------------------------------------------------------------------
45665>>>>>// DFMainBt.pkg - DfMain_ButtonBar class
45665>>>>>//
45665>>>>>//
45665>>>>>// 07/23/96 JJT - New Class names
45665>>>>>//-------------------------------------------------------------------------
45665>>>>>
45665>>>>>Use Dfabtbar.pkg
45665>>>>>
45665>>>>>Class ToolBar is a AppToolBar
45666>>>>>
45666>>>>>    Function Is_Function Integer MsgId Integer ObjId Integer DelegateFg Returns Integer
45668>>>>>      integer rval MainObj#
45668>>>>>      Get Main_Panel_id to MainObj#
45669>>>>>      If (ObjId>Desktop AND MainObj#) ;         Get Is_Function of MainObj# MsgId ObjId DelegateFg to rVal
45672>>>>>      Function_Return rVal
45673>>>>>    End_Function
45674>>>>>
45674>>>>>    Procedure Redirect_Button_Message integer Itm
45676>>>>>         integer Msg# Aux# rval Understood
45676>>>>>         If (Shadow_State(self,itm)) Procedure_Return
45679>>>>>         Get Message   item itm  to Msg#
45680>>>>>         Get Aux_Value item itm  to Aux#
45681>>>>>         If Msg# Begin
45683>>>>>           If Aux# eq 0 Begin
45685>>>>>              Get Focus of desktop to Aux#
45686>>>>>              Get Is_Function Get_DEO_Object Aux# TRUE to Understood
45687>>>>>              If Not Understood Move 0 to Aux#
45690>>>>>           End
45690>>>>>>
45690>>>>>           If Aux# Get Msg# of Aux# to rval
45693>>>>>           Procedure_return rval
45694>>>>>         end
45694>>>>>>
45694>>>>>    End_Procedure // Redirect_Message
45695>>>>>
45695>>>>>End_Class
45696>>>>>
45696>>>>>
45696>>>Use DFMainSt  // Standard Status bar class (DAC)
Including file: Dfmainst.pkg    (C:\Programmer\Visual DataFlex 12.0\Pkg\Dfmainst.pkg)
45696>>>>>// 07/23/96 JJT - New Class names
45696>>>>>// 12/13/2001 JJT - Updated Syntax Add_item to AddPane (suggested syntax)
45696>>>>>Use LanguageText.pkg
45696>>>>>Use dfAstbar.pkg
45696>>>>>
45696>>>>>Class StatusBar is a AppStatusBar
45697>>>>>
45697>>>>>    Procedure Construct_Object
45699>>>>>       Forward Send Construct_Object
45701>>>>>       //
45701>>>>>       Send AddPane 350  '' sbLOWERED    // micro-help
45702>>>>>       Send AddPane  40  C_$View sbNORMAL
45703>>>>>       Send AddPane 200  '' sbLOWERED    // view name
45704>>>>>       Send AddPane   0  '' sbNORMAL     // spring 'normal' to end
45705>>>>>
45705>>>>>    End_Procedure // Construct_Object
45706>>>>>
45706>>>>>    Procedure Show_View_Name String sName
45708>>>>>        Set Value item 2 to sName
45709>>>>>    End_Procedure
45710>>>>>
45710>>>>>End_Class
45711>>>Use FieldInf  // Global field info objects
45711>>>Use MsgBox    // DAC class
45711>>>Use Language  // Set default languange if not set by compiler command line
45711>>>Use API_Attr.utl // Functions for querying API attributes
Including file: api_attr.utl    (C:\projects\BRS\VDFQuery\AppSrc\api_attr.utl)
45711>>>>>Use API_Attr.nui // Functions for querying API attributes (No User Interface)
Including file: api_attr.nui    (C:\projects\BRS\VDFQuery\AppSrc\api_attr.nui)
45711>>>>>>>// Use API_Attr.nui // Functions for querying API attributes (No User Interface)
45711>>>>>>>// Part of VDFQuery by Sture ApS
45711>>>>>>>//
45711>>>>>>>// Create: Mon  25-10-1999
45711>>>>>>>// Update: Fri  10-11-1999 - Changed
45711>>>>>>>//         Sat  15-01-2000 - Sysconf atributes added
45711>>>>>>>//         Tue  16-02-2000 - OA_DFPATH taken out. Made superfluous by DF_OPEN_PATH
45711>>>>>>>//         Wed  22-03-2000 - Internal workings simplified
45711>>>>>>>//         Wed  27-06-2001 - OA_COLLATE_PATH, OA_COLLATE_SIZE and
45711>>>>>>>//                           OA_COLLATE_TIME changed
45711>>>>>>>//         Tue  07-08-2001 - OA_CURRENT_USER_COUNT added
45711>>>>>>>//         Mon  13-08-2001 - DF_FILE_REVISION changed from DF_BCD to DF_ASCII
45711>>>>>>>//         Sat  11-09-2004 - OA_LOCK_COUNT added
45711>>>>>>>
45711>>>>>>>//> pkgdoc.begin
45711>>>>>>>//> This package defines a number of functions designed to replace
45711>>>>>>>//> the GET_ATTRIBUTE command. Now, the GET_ATTRIBUTE is very very (very)
45711>>>>>>>//> flexible in that it allows you to query any attribute whether it is
45711>>>>>>>//> file-, field- or index related.
45711>>>>>>>//>
45711>>>>>>>//> However, the attributes are so different in nature that it is useful
45711>>>>>>>//> to group them into categories. Actually, the attribute names that are
45711>>>>>>>//> used as first parameter to the GET_ATTRIBUTE command in any case,
45711>>>>>>>//> indicates a grouping of the attributes:
45711>>>>>>>//>
45711>>>>>>>//> Example of file related attributes:
45711>>>>>>>//> 
45711>>>>>>>//> DF_FILE_MAX_RECORDS
45711>>>>>>>//> DF_FILE_LOCK_TYPE
45711>>>>>>>//> 
45711>>>>>>>//>
45711>>>>>>>//> and field related dittos:
45711>>>>>>>//> 
45711>>>>>>>//> DF_FIELD_NAME
45711>>>>>>>//> DF_FIELD_TYPE
45711>>>>>>>//> 
45711>>>>>>>//>
45711>>>>>>>//> and global attributes (for the entire application):
45711>>>>>>>//> 
45711>>>>>>>//> DF_DECIMAL_SEPARATOR
45711>>>>>>>//> DF_OPEN_PATH
45711>>>>>>>//> 
45711>>>>>>>//>
45711>>>>>>>//> As you can see, the first part of the name indicates which group Data
45711>>>>>>>//> Access considers it belongs to.
45711>>>>>>>//>
45711>>>>>>>//> But, their grouping is not strong enough (for my purpose anyway). Consider
45711>>>>>>>//> these attributes:
45711>>>>>>>//>
45711>>>>>>>//> 
45711>>>>>>>//> 1: DF_FILE_RECORD_LENGTH
45711>>>>>>>//> 2: DF_FILE_DISPLAY_NAME
45711>>>>>>>//> 3: DF_FILE_NEXT_EMPTY
45711>>>>>>>//> 
45711>>>>>>>//>
45711>>>>>>>//> According to their names they all belong in the group of file related
45711>>>>>>>//> attributes. But in reality only the DF_FILE_RECORD_LENGTH returns
45711>>>>>>>//> an attribute of the file definition itself. The DF_FILE_DISPLAY_NAME
45711>>>>>>>//> attribute (together with DF_FILE_LOGICAL_NAME and DF_FILE_ROOT_NAME)
45711>>>>>>>//> returns an attribute of FILELIST.CFG. The same could be said about
45711>>>>>>>//> DF_FILE_NEXT_EMPTY but again it differs from the two others in that
45711>>>>>>>//> it returns the next entry (relative to its parameter) in FILELIST.CFG
45711>>>>>>>//> that is currently not used (empty root name).
45711>>>>>>>//>
45711>>>>>>>//> Therefore this package divides the attributes into the following groups:
45711>>>>>>>//>
45711>>>>>>>//> 
45711>>>>>>>//> ATTRTYPE_GLOBAL    Attributes not related to tables or drivers
45711>>>>>>>//> ATTRTYPE_FILELIST  Filelist attributes (root name, display name and
45711>>>>>>>//>                    logical name)
45711>>>>>>>//> ATTRTYPE_FILE      Table attributes
45711>>>>>>>//> ATTRTYPE_FIELD     Field attributes
45711>>>>>>>//> ATTRTYPE_INDEX     Index attributes
45711>>>>>>>//> ATTRTYPE_IDXSEG    Index segment attributes
45711>>>>>>>//> ATTRTYPE_DRIVER    Driver attributes
45711>>>>>>>//> ATTRTYPE_DRVSRV    Server attributes
45711>>>>>>>//> ATTRTYPE_SPECIAL1  Used to figure out whether 2 fields overlap each
45711>>>>>>>//>                    other
45711>>>>>>>//> ATTRTYPE_FLSTNAV   Filelist.cfg navigation (next empty, next used,
45711>>>>>>>//>                    next open)
45711>>>>>>>//> 
45711>>>>>>>//>
45711>>>>>>>//> If you want to retrieve an attribute value using one of the functions in
45711>>>>>>>//> this package, you have to know which type of attribute you are querying
45711>>>>>>>//> in order to use the correct function:
45711>>>>>>>//>
45711>>>>>>>//> 
45711>>>>>>>//> Type               Function
45711>>>>>>>//> ------------------ -----------------------
45711>>>>>>>//> ATTRTYPE_GLOBAL    API_AttrValue_GLOBAL
45711>>>>>>>//> ATTRTYPE_FILELIST  API_AttrValue_FILELIST
45711>>>>>>>//> ATTRTYPE_FILE      API_AttrValue_FILE
45711>>>>>>>//> ATTRTYPE_FIELD     API_AttrValue_FIELD
45711>>>>>>>//> ATTRTYPE_INDEX     API_AttrValue_INDEX
45711>>>>>>>//> ATTRTYPE_IDXSEG    API_AttrValue_IDXSEG
45711>>>>>>>//> ATTRTYPE_DRIVER    API_AttrValue_DRIVER
45711>>>>>>>//> ATTRTYPE_DRVSRV    API_AttrValue_DRVSRV
45711>>>>>>>//> ATTRTYPE_SPECIAL1  API_AttrValue_SPECIAL1
45711>>>>>>>//> ATTRTYPE_FLSTNAV   API_AttrValue_FLSTNAV
45711>>>>>>>//> 
45711>>>>>>>//>
45711>>>>>>>//> These functions are defined like this:
45711>>>>>>>//>
45711>>>>>>>//> 
45711>>>>>>>//> FUNCTION API_AttrValue_GLOBAL global INTEGER attr# RETURNS string
45711>>>>>>>//>
45711>>>>>>>//> FUNCTION API_AttrValue_FILELIST global INTEGER attr# integer file# ;
45711>>>>>>>//>                                                            RETURNS string
45711>>>>>>>//>
45711>>>>>>>//> FUNCTION API_AttrValue_FILE global INTEGER attr# INTEGER file# ;
45711>>>>>>>//>                                                            RETURNS string
45711>>>>>>>//>
45711>>>>>>>//> FUNCTION API_AttrValue_FIELD global INTEGER attr# INTEGER file# ;
45711>>>>>>>//>                                           INTEGER field# RETURNS string
45711>>>>>>>//>
45711>>>>>>>//> FUNCTION API_AttrValue_INDEX global INTEGER attr# INTEGER file# ;
45711>>>>>>>//>                                            INTEGER index# RETURNS string
45711>>>>>>>//>
45711>>>>>>>//> FUNCTION API_AttrValue_IDXSEG global INTEGER attr# INTEGER file# ;
45711>>>>>>>//>                             INTEGER index# INTEGER segment# RETURNS string
45711>>>>>>>//>
45711>>>>>>>//> FUNCTION API_AttrValue_DRIVER global INTEGER attr# INTEGER driver# ;
45711>>>>>>>//>                                                             RETURNS string
45711>>>>>>>//>
45711>>>>>>>//> FUNCTION API_AttrValue_DRVSRV global INTEGER attr# INTEGER driver# ;
45711>>>>>>>//>                                             INTEGER server# RETURNS string
45711>>>>>>>//>
45711>>>>>>>//> FUNCTION API_AttrValue_SPECIAL1 global INTEGER attr# INTEGER file# ;
45711>>>>>>>//>                              INTEGER field1# INTEGER field2# RETURNS string
45711>>>>>>>//>
45711>>>>>>>//> FUNCTION API_AttrValue_FLSTNAV global INTEGER attr# INTEGER file# ;
45711>>>>>>>//>                                                           RETURNS string
45711>>>>>>>//> 
45711>>>>>>>//>
45711>>>>>>>//> Take a moment to convince yourself that each function takes a reasonable
45711>>>>>>>//> number of parameters. Note that even if these functions most often will
45711>>>>>>>//> return an integer (some indeed always return integers) their return type
45711>>>>>>>//> is string. This was done for reasons of simplicity.
45711>>>>>>>//> pkgdoc.end
45711>>>>>>>
45711>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
45711>>>>>>>Use Files.nui    // Utilities for handling file related stuff
45711>>>>>>>Use DBMS.nui     // Basic DBMS functions
Including file: dbms.nui    (C:\projects\BRS\VDFQuery\AppSrc\dbms.nui)
45711>>>>>>>>>//**********************************************************************
45711>>>>>>>>>// Use DBMS.nui     // Basic DBMS functions (No User Interface)
45711>>>>>>>>>//
45711>>>>>>>>>// By Sture Andersen
45711>>>>>>>>>//
45711>>>>>>>>>// Create: Mon  10-11-1997
45711>>>>>>>>>// Update: Wed  10-12-1997 - Added DBMS_OpenFileAs, DBMS_OpenFileBrowse
45711>>>>>>>>>//                           and DBMS_IsOpen functions
45711>>>>>>>>>//         Thu  18-12-1997 - Function DBMS_IsOpenedAsFile added
45711>>>>>>>>>//         Wed  03-02-1999 - Functions DBMS_Driver_UserName and
45711>>>>>>>>>//                           DBMS_DriverNameToType added
45711>>>>>>>>>//         Sat  29-05-1999 - DBMS_Callback_FilelistEntries added
45711>>>>>>>>>//         Thu  16-09-1999 - ON ERROR error fixed
45711>>>>>>>>>//         Thu  04-11-1999 - Procedure DBMS_CallBack_FileFields added
45711>>>>>>>>>//         Tue  04-01-2000 - Function DBMS_NextNotOpen added
45711>>>>>>>>>//         Wed  19-04-2000 - Function DBMS_StripPathAndDriver added
45711>>>>>>>>>//         Wed  02-04-2003 - Function DBMS_TablePath added
45711>>>>>>>>>//         Sun  21-12-2003 - DBMS_Callback_FilelistEntries enhanced.
45711>>>>>>>>>//                         - Function DBMS_EraseDfFile added
45711>>>>>>>>>//         Mon  17-01-2005 - Procedures DBMS_SetFieldValueMax and
45711>>>>>>>>>//                           DBMS_SetFieldValueMin added
45711>>>>>>>>>//         Fri  21-01-2005 - Procedure DBMS_FindByRecnum added
45711>>>>>>>>>//**********************************************************************
45711>>>>>>>>>// Useful pastry:
45711>>>>>>>>>//
45711>>>>>>>>>// Set_Attribute DF_FILE_ALIAS Customer2.File_number to DF_FILE_IS_ALIAS
45711>>>>>>>>>// Set_Attribute DF_FILE_ALIAS Customer.File_number  to DF_FILE_IS_MASTER
45711>>>>>>>>>Use Strings.nui  // String manipulation for VDF
45711>>>>>>>>>Use Files.nui    // Utilities for handling file related stuff (No User Interface)
45711>>>>>>>>>Use Dates.nui    // Date routines (No User Interface)
45711>>>>>>>>>
45711>>>>>>>>>define DBMS_MaxFileListEntry for 4095 // 255
45711>>>>>>>>>
45711>>>>>>>>>enumeration_list // Driver ID's
45711>>>>>>>>>  define DBMS_DRIVER_ERROR
45711>>>>>>>>>  define DBMS_DRIVER_UNKNOWN
45711>>>>>>>>>  define DBMS_DRIVER_DATAFLEX
45711>>>>>>>>>  define DBMS_DRIVER_PERVASIVE
45711>>>>>>>>>  define DBMS_DRIVER_ORACLE
45711>>>>>>>>>  define DBMS_DRIVER_MS_SQL
45711>>>>>>>>>  define DBMS_DRIVER_DB2
45711>>>>>>>>>  define DBMS_DRIVER_ODBC
45711>>>>>>>>>  define DBMS_DRIVER_PERVASIVE_MODRT
45711>>>>>>>>>  define DBMS_DRIVER_MS_SQL_DAW
45711>>>>>>>>>  define DBMS_DRIVER_MAX             // Points to the highest known driver ID
45711>>>>>>>>>end_enumeration_list
45711>>>>>>>>>
45711>>>>>>>>>function DBMS_Driver_UserName global integer liType returns string
45713>>>>>>>>>  if liType eq DBMS_DRIVER_ERROR      function_return "Unknown (Error)"
45716>>>>>>>>>  if liType eq DBMS_DRIVER_UNKNOWN    function_return "Unknown"
45719>>>>>>>>>  if liType eq DBMS_DRIVER_DATAFLEX   function_return "DataFlex"
45722>>>>>>>>>  if liType eq DBMS_DRIVER_PERVASIVE  function_return "Pervasive"
45725>>>>>>>>>  if liType eq DBMS_DRIVER_ORACLE     function_return "Oracle"
45728>>>>>>>>>  if liType eq DBMS_DRIVER_MS_SQL     function_return "MS SQL (MT)"
45731>>>>>>>>>  if liType eq DBMS_DRIVER_DB2        function_return "DB/2"
45734>>>>>>>>>  if liType eq DBMS_DRIVER_MS_SQL_DAW function_return "MS SQL (DAW)"
45737>>>>>>>>>  if liType eq DBMS_DRIVER_ODBC       function_return "ODBC Connectivity"
45740>>>>>>>>>  if liType eq DBMS_DRIVER_PERVASIVE_MODRT function_return "Pervasive (mod/rt)"
45743>>>>>>>>>end_function
45744>>>>>>>>>
45744>>>>>>>>>function DBMS_DriverNameToType global string lsDriver returns integer
45746>>>>>>>>>  uppercase lsDriver
45747>>>>>>>>>>
45747>>>>>>>>>  if lsDriver eq "DATAFLEX" function_return DBMS_DRIVER_DATAFLEX
45750>>>>>>>>>  if lsDriver eq "ORA_DRV"  function_return DBMS_DRIVER_ORACLE
45753>>>>>>>>>  if lsDriver eq "SQL_DRV"  function_return DBMS_DRIVER_MS_SQL
45756>>>>>>>>>  if lsDriver eq "DFBTRDRV" function_return DBMS_DRIVER_PERVASIVE
45759>>>>>>>>>  if lsDriver eq "MSSQLDRV" function_return DBMS_DRIVER_MS_SQL_DAW
45762>>>>>>>>>  if lsDriver eq "ODBC_DRV" function_return DBMS_DRIVER_ODBC
45765>>>>>>>>>  function_return DBMS_DRIVER_UNKNOWN // is not zero!
45766>>>>>>>>>end_function
45767>>>>>>>>>
45767>>>>>>>>>function DBMS_TypeToDriverName global integer liType returns string
45769>>>>>>>>>  if liType eq DBMS_DRIVER_DATAFLEX   function_return "DATAFLEX"
45772>>>>>>>>>  if liType eq DBMS_DRIVER_ORACLE     function_return "ORA_DRV"
45775>>>>>>>>>  if liType eq DBMS_DRIVER_MS_SQL     function_return "SQL_DRV"
45778>>>>>>>>>  if liType eq DBMS_DRIVER_MS_SQL_DAW function_return "MSSQLDRV"
45781>>>>>>>>>  if liType eq DBMS_DRIVER_PERVASIVE  function_return "DFBTRDRV"
45784>>>>>>>>>  if liType eq DBMS_DRIVER_ODBC       function_return "ODBC_DRV"
45787>>>>>>>>>  function_return "Unknown" // Must return this value!
45788>>>>>>>>>end_function
45789>>>>>>>>>
45789>>>>>>>>>function DBMS_FileDriverType global integer liFile returns integer
45791>>>>>>>>>  string lsDriver
45791>>>>>>>>>  get_attribute DF_FILE_DRIVER of liFile to lsDriver
45794>>>>>>>>>  function_return (DBMS_DriverNameToType(lsDriver))
45795>>>>>>>>>end_function
45796>>>>>>>>>
45796>>>>>>>>>if dfFalse begin
45798>>>>>>>>>  DBMS_OpenError: move DBMS_DRIVER_ERROR to windowindex // DBMS_DRIVER_ERROR is 0
45799>>>>>>>>>  return
45800>>>>>>>>>end
45800>>>>>>>>>>
45800>>>>>>>>>
45800>>>>>>>>>//> This function is used to find out if a file is currently open. If not
45800>>>>>>>>>//> it will return 0 (false)  and if it is opened a driver ID like
45800>>>>>>>>>//> DBMS_DRIVER_DATAFLEX or DBMS_DRIVER_ORACLE will be returned.
45800>>>>>>>>>function DBMS_IsOpenFile global integer liFile returns integer
45802>>>>>>>>>  integer liRval liHandleType
45802>>>>>>>>>  string lsDriver
45802>>>>>>>>>  get_attribute DF_FILE_HANDLE_TYPE of liFile to liHandleType
45805>>>>>>>>>  if (liHandleType=DF_FILE_HANDLE_EXISTING_RESTRUCTURE or liHandleType=DF_FILE_HANDLE_NEW_RESTRUCTURE) function_return 1
45808>>>>>>>>>  get_attribute DF_FILE_OPENED of liFile to liRval
45811>>>>>>>>>  if liRval begin
45813>>>>>>>>>    get_attribute DF_FILE_DRIVER of liFile to lsDriver
45816>>>>>>>>>    get DBMS_DriverNameToType lsDriver to liRval
45817>>>>>>>>>  end
45817>>>>>>>>>>
45817>>>>>>>>>  function_return liRval
45818>>>>>>>>>end_function
45819>>>>>>>>>
45819>>>>>>>>>function DBMS_IsOpenedAsFile global integer liFile returns integer
45821>>>>>>>>>  integer lbOpen
45821>>>>>>>>>  string lsPhysName lsRootName
45821>>>>>>>>>  get_attribute DF_FILE_OPENED of liFile to lbOpen
45824>>>>>>>>>  if lbOpen begin
45826>>>>>>>>>    get_attribute DF_FILE_PHYSICAL_NAME of liFile to lsPhysName
45829>>>>>>>>>    get_attribute DF_FILE_ROOT_NAME of liFile to lsRootName
45832>>>>>>>>>    if (uppercase(lsPhysName)) ne (uppercase(lsRootName)) function_return 1
45835>>>>>>>>>  end
45835>>>>>>>>>>
45835>>>>>>>>>  function_return 0
45836>>>>>>>>>end_function
45837>>>>>>>>>
45837>>>>>>>>>function DBMS_RootNameWhichDriver global string lsRootName returns integer
45839>>>>>>>>>  // This function analyses the rootname and determines which driver should
45839>>>>>>>>>  // be used to open it.
45839>>>>>>>>>  integer liRval
45839>>>>>>>>>  string lsDriver
45839>>>>>>>>>  if ".INT" in (uppercase(lsRootName)) move DBMS_DRIVER_UNKNOWN to liRval
45842>>>>>>>>>  else if ":" in lsRootName begin
45845>>>>>>>>>    move (uppercase(ExtractWord(lsRootName,":",1))) to lsDriver
45846>>>>>>>>>    if (length(trim(lsDriver))) eq 1 move DBMS_DRIVER_DATAFLEX to liRval
45849>>>>>>>>>    else get DBMS_DriverNameToType lsDriver to liRval
45851>>>>>>>>>  end
45851>>>>>>>>>>
45851>>>>>>>>>  else move DBMS_DRIVER_DATAFLEX to liRval
45853>>>>>>>>>  function_return liRval
45854>>>>>>>>>end_function
45855>>>>>>>>>
45855>>>>>>>>>function DBMS_AutoLoadDriver global string lsRootName returns integer
45857>>>>>>>>>  // This function returns the ID for the driver loaded, if successful.
45857>>>>>>>>>  integer liDriver liRval
45857>>>>>>>>>  get DBMS_RootNameWhichDriver lsRootName to liDriver
45858>>>>>>>>>  if (liDriver<>DBMS_DRIVER_DATAFLEX and ;      liDriver<>DBMS_DRIVER_ERROR and ;      liDriver<>DBMS_DRIVER_UNKNOWN) begin
45860>>>>>>>>>
45860>>>>>>>>>  end
45860>>>>>>>>>>
45860>>>>>>>>>  else move 0 to liRval
45862>>>>>>>>>//  send obs (DBMS_Driver_UserName(lsDriver))
45862>>>>>>>>>end_function
45863>>>>>>>>>
45863>>>>>>>>>// The function returns the driver ID for that DB if the table could be
45863>>>>>>>>>// opened. If the table could not be opened 0 is returned.
45863>>>>>>>>>function DBMS_OpenFile global integer liFile integer liMode integer liBufIndex returns integer
45865>>>>>>>>>  integer liRval liWindowIndex
45865>>>>>>>>>  string lsDriver lsRoot
45865>>>>>>>>>//  send obs "OpenFile" (string(liFile)) (string(liMode)) (string(liBufIndex))
45865>>>>>>>>>  move windowindex to liWindowIndex
45866>>>>>>>>>  move |VI31 to |VI32 //copy ON ERROR label
45867>>>>>>>>>  on error gosub DBMS_OpenError
45868>>>>>>>>>  indicate err false
45869>>>>>>>>>  move DBMS_DRIVER_UNKNOWN to windowindex
45870>>>>>>>>>  if liBufIndex open liFile mode liMode liBufIndex
45874>>>>>>>>>  else          open liFile mode liMode
45877>>>>>>>>>  move |VI32 to |VI31 //restore original ON ERROR label
45878>>>>>>>>>  move windowindex to liRval // If an error was triggered the
45879>>>>>>>>>  indicate err false        // subroutine will have changed windowindex
45880>>>>>>>>>  move liWindowIndex to windowindex
45881>>>>>>>>>  if liRval begin
45883>>>>>>>>>    get_attribute DF_FILE_DRIVER of liFile to lsDriver
45886>>>>>>>>>    get DBMS_DriverNameToType lsDriver to liRval
45887>>>>>>>>>  end
45887>>>>>>>>>>
45887>>>>>>>>>//  if DBMS_DRIVER_UNKNOWN eq liRval send obs ("UNKNOWN DRIVER: "+string(liRval)+" "+string(liFile))
45887>>>>>>>>>  ifnot liRval begin
45889>>>>>>>>>    if liFile begin
45891>>>>>>>>>      get_attribute DF_FILE_ROOT_NAME of liFile to lsRoot
45894>>>>>>>>>      //get DBMS_AutoLoadDriver lsRoot to liRval
45894>>>>>>>>>    end
45894>>>>>>>>>>
45894>>>>>>>>>  end
45894>>>>>>>>>>
45894>>>>>>>>>  function_return liRval
45895>>>>>>>>>end_function
45896>>>>>>>>>
45896>>>>>>>>>function DBMS_OpenFileAs global string lsFileName integer liFile integer liMode integer liBufIndex returns integer
45898>>>>>>>>>  integer liRval liWindowIndex
45898>>>>>>>>>  string lsDriver
45898>>>>>>>>>  if (DBMS_IsOpenFile(liFile)) close liFile
45901>>>>>>>>>  move (ToAnsi(lsFileName)) to lsFileName
45902>>>>>>>>>  if lsFileName eq "" function_return DBMS_DRIVER_ERROR
45905>>>>>>>>>  move windowindex to liWindowIndex
45906>>>>>>>>>  move |VI31 to |VI32 //copy ON ERROR label
45907>>>>>>>>>  on error gosub DBMS_OpenError
45908>>>>>>>>>  indicate err false
45909>>>>>>>>>  move DBMS_DRIVER_UNKNOWN to windowindex
45910>>>>>>>>>  if liBufIndex open lsFileName as liFile mode liMode liBufIndex
45914>>>>>>>>>  else          open lsFileName as liFile mode liMode
45917>>>>>>>>>  move |VI32 to |VI31 //restore original ON ERROR label
45918>>>>>>>>>  move windowindex to liRval // If an error was triggered the
45919>>>>>>>>>  indicate err false        // subroutine will have changed windowindex
45920>>>>>>>>>  move liWindowIndex to windowindex
45921>>>>>>>>>  if liRval begin
45923>>>>>>>>>    get_attribute DF_FILE_DRIVER of liFile to lsDriver
45926>>>>>>>>>    get DBMS_DriverNameToType lsDriver to liRval
45927>>>>>>>>>  end
45927>>>>>>>>>>
45927>>>>>>>>>  function_return liRval
45928>>>>>>>>>end_function
45929>>>>>>>>>
45929>>>>>>>>>procedure DBMS_CloseFile global integer liFile
45931>>>>>>>>>  integer lbOpen
45931>>>>>>>>>  if liFile begin
45933>>>>>>>>>    get_attribute DF_FILE_OPENED of liFile to lbOpen
45936>>>>>>>>>    if lbOpen close liFile
45939>>>>>>>>>  end
45939>>>>>>>>>>
45939>>>>>>>>>end_procedure
45940>>>>>>>>>
45940>>>>>>>>>function DBMS_StripPathAndDriver global string lsRoot returns string
45942>>>>>>>>>  integer liPos
45942>>>>>>>>>  string lsChar
45942>>>>>>>>>  move (sysconf(SYSCONF_DIR_SEPARATOR)) to lsChar
45943>>>>>>>>>  if lsChar in lsRoot begin
45945>>>>>>>>>    move (pos(lsChar,lsRoot)) to liPos
45946>>>>>>>>>    move (StringRightBut(lsRoot,liPos)) to lsRoot
45947>>>>>>>>>  end
45947>>>>>>>>>>
45947>>>>>>>>>  move ":" to lsChar
45948>>>>>>>>>  if lsChar in lsRoot begin
45950>>>>>>>>>    move (pos(lsChar,lsRoot)) to liPos
45951>>>>>>>>>    move (StringRightBut(lsRoot,liPos)) to lsRoot
45952>>>>>>>>>  end
45952>>>>>>>>>>
45952>>>>>>>>>  if "." in lsRoot get StripFromLastOccurance lsRoot "." to lsRoot
45955>>>>>>>>>  function_return lsRoot
45956>>>>>>>>>end_function
45957>>>>>>>>>
45957>>>>>>>>>function DBMS_TablePath global integer liFile returns string
45959>>>>>>>>>  integer lbIsOpenedAs liType
45959>>>>>>>>>  string lsDriver lsRval lsCurrentDir lsDirSep lsPath
45959>>>>>>>>>
45959>>>>>>>>>  move (sysconf(SYSCONF_DIR_SEPARATOR)) to lsDirSep // "/" or "\"
45960>>>>>>>>>
45960>>>>>>>>>  get_attribute DF_FILE_DRIVER of liFile to lsDriver
45963>>>>>>>>>  get DBMS_DriverNameToType lsDriver to liType
45964>>>>>>>>>
45964>>>>>>>>>  get DBMS_IsOpenedAsFile liFile to lbIsOpenedAs
45965>>>>>>>>>
45965>>>>>>>>>  if lbIsOpenedAs get_attribute DF_FILE_PHYSICAL_NAME of liFile to lsRval
45970>>>>>>>>>  else get_attribute DF_FILE_ROOT_NAME of liFile to lsRval
45974>>>>>>>>>
45974>>>>>>>>>  if liType eq DBMS_DRIVER_DATAFLEX move (lsRval+".dat") to lsRval
45977>>>>>>>>>  else begin
45978>>>>>>>>>    replace (lsDriver+":") in lsRval with ""
45980>>>>>>>>>    ifnot ".INT" in (uppercase(lsRval)) move (lsRval+".int") to lsRval
45983>>>>>>>>>  end
45983>>>>>>>>>>
45983>>>>>>>>>  ifnot (lsRval contains lsDirSep) get_file_path lsRval to lsRval
45986>>>>>>>>>  if (left(lsRval,2)=("."+lsDirSep)) begin
45988>>>>>>>>>    get_current_directory to lsCurrentDir
45989>>>>>>>>>    replace "." in lsRval with lsCurrentDir
45991>>>>>>>>>  end
45991>>>>>>>>>>
45991>>>>>>>>>  function_return lsRval
45992>>>>>>>>>end_function
45993>>>>>>>>>
45993>>>>>>>>>Use WinBase
45993>>>>>>>>>// This one probably requires the file to open?
45993>>>>>>>>>function DBMS_Rootname_Path global integer liFile returns string
45995>>>>>>>>>  integer liType
45995>>>>>>>>>  string lsStr lsCurDir lsDriver
45995>>>>>>>>>  get_current_directory to lsCurDir
45996>>>>>>>>>  get_attribute DF_FILE_DRIVER of liFile to lsDriver
45999>>>>>>>>>  get DBMS_DriverNameToType lsDriver to liType
46000>>>>>>>>>
46000>>>>>>>>>  get_attribute DF_FILE_ROOT_NAME of liFile to lsStr
46003>>>>>>>>>  if liType eq DBMS_DRIVER_DATAFLEX move (lsStr+".dat") to lsStr
46006>>>>>>>>>  else begin
46007>>>>>>>>>    replace (lsDriver+":") in lsStr with ""
46009>>>>>>>>>    ifnot ".INT" in (uppercase(lsStr)) move (lsStr+".int") to lsStr
46012>>>>>>>>>  end
46012>>>>>>>>>>
46012>>>>>>>>>  ifnot "\" in lsStr get_file_path lsStr to lsStr
46015>>>>>>>>>  if (left(lsStr,2)) eq ".\" replace "." in lsStr with lsCurDir
46019>>>>>>>>>  function_return (uppercase(lsStr))
46020>>>>>>>>>end_function
46021>>>>>>>>>
46021>>>>>>>>>function DBMS_Rootname global integer liFile returns string
46023>>>>>>>>>  string lsRval
46023>>>>>>>>>  get_attribute DF_FILE_ROOT_NAME of liFile to lsRval
46026>>>>>>>>>  function_return lsRval
46027>>>>>>>>>end_function
46028>>>>>>>>>function DBMS_DFName global integer liFile returns string
46030>>>>>>>>>  string lsRval
46030>>>>>>>>>  get_attribute DF_FILE_LOGICAL_NAME of liFile to lsRval
46033>>>>>>>>>  function_return lsRval
46034>>>>>>>>>end_function
46035>>>>>>>>>function DBMS_DisplayName global integer liFile returns string
46037>>>>>>>>>  string lsRval
46037>>>>>>>>>  get_attribute DF_FILE_DISPLAY_NAME of liFile to lsRval
46040>>>>>>>>>  function_return (rtrim(lsRval))
46041>>>>>>>>>end_function
46042>>>>>>>>>function DBMS_FieldValue global integer liFile integer liField returns string
46044>>>>>>>>>  string lsRval
46044>>>>>>>>>  get_field_value liFile liField to lsRval
46047>>>>>>>>>  function_return lsRval
46048>>>>>>>>>end_function
46049>>>>>>>>>function DBMS_FieldName global integer liFile integer liField returns string
46051>>>>>>>>>  integer lbOpen lbWasOpen
46051>>>>>>>>>  string lsRval
46051>>>>>>>>>  move (DBMS_IsOpenFile(liFile)) to lbWasOpen
46052>>>>>>>>>  ifnot lbWasOpen move (DBMS_OpenFile(liFile,DF_SHARE,0)) to lbOpen
46055>>>>>>>>>  if (lbWasOpen or lbOpen) get_attribute DF_FIELD_NAME of liFile liField to lsRval
46060>>>>>>>>>  else move ("FILE"+string(liFile)+"."+string(liField)+" N/A") to lsRval
46062>>>>>>>>>  if (lbOpen and not(lbWasOpen)) close liFile
46065>>>>>>>>>  function_return lsRval
46066>>>>>>>>>end_function
46067>>>>>>>>>
46067>>>>>>>>>// OBS! Functions DBMS_FieldInfo and DBMS_FileInfo will go away some day
46067>>>>>>>>>
46067>>>>>>>>>                                              // 0=field type Ŀ
46067>>>>>>>>>                                              // 1=field length Ĵ
46067>>>>>>>>>                                              // 2=#dec points Ĵ
46067>>>>>>>>>                                              // 3=relating file Ĵ
46067>>>>>>>>>                                              // 4=relating fieldĴ
46067>>>>>>>>>                                              // 5=main index
46067>>>>>>>>>function DBMS_FieldInfo global integer liFile integer liField integer liItem returns integer
46069>>>>>>>>>  integer liRval
46069>>>>>>>>>  if liItem eq 0 get_attribute DF_FIELD_TYPE          of liFile liField to liRval // DF_ASCII DF_BCD DF_DATE DF_OVERLAP DF_TEXT DF_BINARY
46074>>>>>>>>>  if liItem eq 1 get_attribute DF_FIELD_LENGTH        of liFile liField to liRval
46079>>>>>>>>>  if liItem eq 2 get_attribute DF_FIELD_PRECISION     of liFile liField to liRval
46084>>>>>>>>>  if liItem eq 3 get_attribute DF_FIELD_RELATED_FILE  of liFile liField to liRval
46089>>>>>>>>>  if liItem eq 4 get_attribute DF_FIELD_RELATED_FIELD of liFile liField to liRval
46094>>>>>>>>>  if liItem eq 5 get_attribute DF_FIELD_INDEX         of liFile liField to liRval
46099>>>>>>>>>  function_return liRval
46100>>>>>>>>>end_function                    // 0=max records Ŀ
46101>>>>>>>>>                                // 1=current recs Ĵ
46101>>>>>>>>>                                // 2=rec length Ĵ
46101>>>>>>>>>                                // 3=rec length used
46101>>>>>>>>>                                // 4=number of flds
46101>>>>>>>>>function DBMS_FileInfo global integer liFile integer liItem returns integer
46103>>>>>>>>>  integer liRval
46103>>>>>>>>>  if liItem eq 0 get_attribute DF_FILE_MAX_RECORDS        of liFile to liRval
46108>>>>>>>>>  if liItem eq 1 get_attribute DF_FILE_RECORDS_USED       of liFile to liRval
46113>>>>>>>>>  if liItem eq 2 get_attribute DF_FILE_RECORD_LENGTH      of liFile to liRval
46118>>>>>>>>>  if liItem eq 3 get_attribute DF_FILE_RECORD_LENGTH_USED of liFile to liRval
46123>>>>>>>>>  if liItem eq 4 get_attribute DF_FILE_NUMBER_FIELDS      of liFile to liRval
46128>>>>>>>>>  function_return liRval
46129>>>>>>>>>end_function
46130>>>>>>>>>
46130>>>>>>>>>// Function DBMS_Relating_Field returns the number of the field in liFile
46130>>>>>>>>>// that relates to liRelFile. The search for the field is started at field
46130>>>>>>>>>// number liStartField plus one. If no such field is found 0 is returned.
46130>>>>>>>>>function DBMS_Relating_Field global integer liFile integer liRelFile integer liStartField returns integer
46132>>>>>>>>>  integer liRval liField liMax lbFin lbTmp
46132>>>>>>>>>  move liStartField to liField
46133>>>>>>>>>  move 0 to lbFin
46134>>>>>>>>>  move 0 to liRval
46135>>>>>>>>>  get_attribute DF_FILE_NUMBER_FIELDS of liFile to liMax
46138>>>>>>>>>  repeat
46138>>>>>>>>>>
46138>>>>>>>>>    increment liField
46139>>>>>>>>>    if liField gt liMax move 1 to lbFin
46142>>>>>>>>>    ifnot lbFin begin
46144>>>>>>>>>      get_attribute DF_FIELD_RELATED_FILE of liFile liField to lbTmp
46147>>>>>>>>>      if lbTmp eq liRelFile begin
46149>>>>>>>>>        move liField to liRval
46150>>>>>>>>>        move 1 to lbFin
46151>>>>>>>>>      end
46151>>>>>>>>>>
46151>>>>>>>>>    end
46151>>>>>>>>>>
46151>>>>>>>>>  until lbFin
46153>>>>>>>>>  function_return liRval
46154>>>>>>>>>end_function
46155>>>>>>>>>
46155>>>>>>>>>function DBMS_CanOpenFile global integer liFile returns integer
46157>>>>>>>>>  integer lbOpen liRval
46157>>>>>>>>>  string lsDriver
46157>>>>>>>>>  move 0 to liRval
46158>>>>>>>>>  get_attribute DF_FILE_OPENED of liFile to lbOpen
46161>>>>>>>>>  if lbOpen begin
46163>>>>>>>>>    ifnot (DBMS_IsOpenedAsFile(liFile)) begin // Return false if file is opened AS
46165>>>>>>>>>      get_attribute DF_FILE_DRIVER of liFile to lsDriver
46168>>>>>>>>>      get DBMS_DriverNameToType lsDriver to liRval
46169>>>>>>>>>      //send obs "DBMS_CanOpenFile" liFile lsDriver liRval
46169>>>>>>>>>    end
46169>>>>>>>>>>
46169>>>>>>>>>  end
46169>>>>>>>>>>
46169>>>>>>>>>  else move (DBMS_OpenFile(liFile,DF_SHARE,0)) to liRval
46171>>>>>>>>>  if (liRval and not(lbOpen)) close liFile
46174>>>>>>>>>  function_return liRval
46175>>>>>>>>>end_function
46176>>>>>>>>>
46176>>>>>>>>>function DBMS_CanOpenFileAs global string lsFileName integer liFile returns integer
46178>>>>>>>>>  integer lbOpen liRval
46178>>>>>>>>>  string lsDriver
46178>>>>>>>>>  move 0 to liRval
46179>>>>>>>>>  get_attribute DF_FILE_OPENED of liFile to lbOpen
46182>>>>>>>>>  if lbOpen begin
46184>>>>>>>>>    get_attribute DF_FILE_DRIVER of liFile to lsDriver
46187>>>>>>>>>    get DBMS_DriverNameToType lsDriver to liRval
46188>>>>>>>>>  end
46188>>>>>>>>>>
46188>>>>>>>>>  else move (DBMS_OpenFileAs(lsFileName,liFile,DF_SHARE,0)) to liRval
46190>>>>>>>>>  if (liRval and not(lbOpen)) close liFile
46193>>>>>>>>>  function_return liRval
46194>>>>>>>>>end_function
46195>>>>>>>>>
46195>>>>>>>>>function DBMS_NextNotOpen global integer liFile returns integer
46197>>>>>>>>>  integer liRval
46197>>>>>>>>>  move 0 to liRval
46198>>>>>>>>>  increment liFile
46199>>>>>>>>>  while (liFile<=DBMS_MaxFileListEntry and liRval=0)
46203>>>>>>>>>    ifnot (DBMS_IsOpenFile(liFile)) move liFile to liRval
46206>>>>>>>>>    increment liFile
46207>>>>>>>>>  end
46208>>>>>>>>>>
46208>>>>>>>>>  function_return liRval
46209>>>>>>>>>end_function
46210>>>>>>>>>
46210>>>>>>>>>// Filelist Entry Classes
46210>>>>>>>>>define FLEC_ALL            for 1
46210>>>>>>>>>define FLEC_NOT_BAD        for 2
46210>>>>>>>>>define FLEC_BAD            for 4
46210>>>>>>>>>define FLEC_NO_ALIAS       for 8
46210>>>>>>>>>define FLEC_EMPTY          for 10
46210>>>>>>>>>define FLEC_EMPTY_NOT_OPEN for 11
46210>>>>>>>>>
46210>>>>>>>>>procedure DBMS_Callback_FilelistEntries global integer liFlec integer liMsg integer lhObj
46212>>>>>>>>>  integer liFile lbOk
46212>>>>>>>>>  string lsRoot lsRootNames
46212>>>>>>>>>  if (liFlec=FLEC_EMPTY or liFlec=FLEC_EMPTY_NOT_OPEN) begin
46214>>>>>>>>>    repeat
46214>>>>>>>>>>
46214>>>>>>>>>      get_attribute DF_FILE_NEXT_EMPTY of liFile to liFile
46217>>>>>>>>>      if liFile begin
46219>>>>>>>>>        if (liFlec=FLEC_EMPTY_NOT_OPEN) begin
46221>>>>>>>>>          get_attribute DF_FILE_OPENED of liFile to lbOK
46224>>>>>>>>>          move (not(lbOK)) to lbOK
46225>>>>>>>>>        end
46225>>>>>>>>>>
46225>>>>>>>>>        else move 1 to lbOK
46227>>>>>>>>>        if lbOk send liMsg to lhObj liFile
46230>>>>>>>>>      end
46230>>>>>>>>>>
46230>>>>>>>>>    until liFile eq 0
46232>>>>>>>>>  end
46232>>>>>>>>>>
46232>>>>>>>>>  else begin
46233>>>>>>>>>    move " " to lsRootNames
46234>>>>>>>>>    move 0 to liFile
46235>>>>>>>>>    repeat
46235>>>>>>>>>>
46235>>>>>>>>>      get_attribute DF_FILE_NEXT_USED of liFile to liFile
46238>>>>>>>>>      if liFile begin
46240>>>>>>>>>        move 1 to lbOk
46241>>>>>>>>>        ifnot (liFlec iand FLEC_ALL) begin
46243>>>>>>>>>          ifnot (liFlec iand FLEC_BAD    ) move (DBMS_CanOpenFile(liFile)) to lbOk
46246>>>>>>>>>          ifnot (liFlec iand FLEC_NOT_BAD) move (not(DBMS_CanOpenFile(liFile))) to lbOk
46249>>>>>>>>>        end
46249>>>>>>>>>>
46249>>>>>>>>>        if lbOk begin
46251>>>>>>>>>          if (liFlec iand FLEC_NO_ALIAS) begin
46253>>>>>>>>>            get_attribute DF_FILE_ROOT_NAME of liFile to lsRoot
46256>>>>>>>>>            move (lowercase(lsRoot)) to lsRoot
46257>>>>>>>>>            if (" "+lsRoot+" ") in lsRootNames move 0 to lbOk
46260>>>>>>>>>            else move (lsRootNames+lsRoot+" ") to lsRootNames
46262>>>>>>>>>          end
46262>>>>>>>>>>
46262>>>>>>>>>          if lbOk send liMsg to lhObj liFile
46265>>>>>>>>>        end
46265>>>>>>>>>>
46265>>>>>>>>>      end
46265>>>>>>>>>>
46265>>>>>>>>>    until liFile eq 0
46267>>>>>>>>>  end
46267>>>>>>>>>>
46267>>>>>>>>>end_procedure
46268>>>>>>>>>
46268>>>>>>>>>procedure DBMS_CallBack_FileFields global integer liFile integer liMsg integer lhObj
46270>>>>>>>>>  integer liType liLen liDec liRelFile liRelField liOffset liField liMax liIdx
46270>>>>>>>>>  string lsName
46270>>>>>>>>>  get_attribute DF_FILE_NUMBER_FIELDS of liFile to liMax
46273>>>>>>>>>  for liField from 1 to liMax
46279>>>>>>>>>>
46279>>>>>>>>>    get_attribute DF_FIELD_NAME          of liFile liField to lsName
46282>>>>>>>>>    get_attribute DF_FIELD_TYPE          of liFile liField to liType
46285>>>>>>>>>    get_attribute DF_FIELD_LENGTH        of liFile liField to liLen
46288>>>>>>>>>    get_attribute DF_FIELD_PRECISION     of liFile liField to liDec
46291>>>>>>>>>    get_attribute DF_FIELD_INDEX         of liFile liField to liIdx
46294>>>>>>>>>    get_attribute DF_FIELD_RELATED_FILE  of liFile liField to liRelFile
46297>>>>>>>>>    get_attribute DF_FIELD_RELATED_FIELD of liFile liField to liRelField
46300>>>>>>>>>    get_attribute DF_FIELD_OFFSET        of liFile liField to liOffset
46303>>>>>>>>>    send liMsg to lhObj liFile liField lsName liType liLen liDec liIdx liRelFile liRelField liOffset
46304>>>>>>>>>  loop
46305>>>>>>>>>>
46305>>>>>>>>>end_procedure
46306>>>>>>>>>
46306>>>>>>>>>function DBMS_GetFieldNumber global integer liFile integer liField returns integer
46308>>>>>>>>>  function_return liField
46309>>>>>>>>>end_function
46310>>>>>>>>>
46310>>>>>>>>>function DBMS_EraseDfFile global integer liFile string lsRoot returns integer
46312>>>>>>>>>  integer liRval
46312>>>>>>>>>  string lsDatFile lsPath
46312>>>>>>>>>  if liFile get_attribute DF_FILE_ROOT_NAME of liFile to lsRoot
46317>>>>>>>>>  move (lowercase(lsRoot)) to lsRoot
46318>>>>>>>>>  move (lsRoot+".dat") to lsDatFile
46319>>>>>>>>>  move (SEQ_FindFileAlongDFPath(lsDatFile)) to lsPath
46320>>>>>>>>>  get Files_AppendPath lsPath lsRoot to lsRoot
46321>>>>>>>>>
46321>>>>>>>>>  get SEQ_EraseFile (lsRoot+".dat") to liRval
46322>>>>>>>>>  get SEQ_EraseFile (lsRoot+".tag") to liRval
46323>>>>>>>>>  get SEQ_EraseFile (lsRoot+".vld") to liRval
46324>>>>>>>>>  get SEQ_EraseFile (lsRoot+".hdr") to liRval
46325>>>>>>>>>  get SEQ_EraseFile (lsRoot+".k1")  to liRval
46326>>>>>>>>>  get SEQ_EraseFile (lsRoot+".k2")  to liRval
46327>>>>>>>>>  get SEQ_EraseFile (lsRoot+".k3")  to liRval
46328>>>>>>>>>  get SEQ_EraseFile (lsRoot+".k4")  to liRval
46329>>>>>>>>>  get SEQ_EraseFile (lsRoot+".k5")  to liRval
46330>>>>>>>>>  get SEQ_EraseFile (lsRoot+".k6")  to liRval
46331>>>>>>>>>  get SEQ_EraseFile (lsRoot+".k7")  to liRval
46332>>>>>>>>>  get SEQ_EraseFile (lsRoot+".k8")  to liRval
46333>>>>>>>>>  get SEQ_EraseFile (lsRoot+".k9")  to liRval
46334>>>>>>>>>  get SEQ_EraseFile (lsRoot+".k10") to liRval
46335>>>>>>>>>  get SEQ_EraseFile (lsRoot+".k11") to liRval
46336>>>>>>>>>  get SEQ_EraseFile (lsRoot+".k12") to liRval
46337>>>>>>>>>  get SEQ_EraseFile (lsRoot+".k13") to liRval
46338>>>>>>>>>  get SEQ_EraseFile (lsRoot+".k14") to liRval
46339>>>>>>>>>  get SEQ_EraseFile (lsRoot+".k15") to liRval
46340>>>>>>>>>  get SEQ_EraseFile (lsRoot+".def") to liRval
46341>>>>>>>>>  get SEQ_EraseFile (lsRoot+".fd")  to liRval
46342>>>>>>>>>  function_return 1
46343>>>>>>>>>end_function
46344>>>>>>>>>
46344>>>>>>>>>//> Sets a field to its highest possible value
46344>>>>>>>>>procedure DBMS_SetFieldValueMax global integer liFile integer liField
46346>>>>>>>>>  integer liType liLen liDecs
46346>>>>>>>>>  number lnValue
46346>>>>>>>>>  string lsChar lsValue
46346>>>>>>>>>  get_attribute DF_FIELD_TYPE of liFile liField to liType
46349>>>>>>>>>  if (liType=DF_DATE) set_field_value liFile liField to LargestPossibleDate
46354>>>>>>>>>  else begin
46355>>>>>>>>>    get_attribute DF_FIELD_LENGTH of liFile liField to liLen
46358>>>>>>>>>    if (liType=DF_ASCII) begin
46360>>>>>>>>>      move (left(trim(gs$CollateString),1)) to lsChar // Highest possible collating value
46361>>>>>>>>>      set_field_value liFile liField to (repeat(lsChar,liLen))
46364>>>>>>>>>    end
46364>>>>>>>>>>
46364>>>>>>>>>    if (liType=DF_BCD) begin
46366>>>>>>>>>      get_attribute DF_FIELD_PRECISION of liFile liField to liDecs
46369>>>>>>>>>      move (liLen-liDecs) to liLen
46370>>>>>>>>>      if liDecs move (repeat("9",liLen)+CurrentDecimalSeparator()+repeat("9",liDecs)) to lsValue
46373>>>>>>>>>      else      move (repeat("9",liLen)) to lsValue
46375>>>>>>>>>      move lsValue to lnValue
46376>>>>>>>>>      set_field_value liFile liField to lnValue
46379>>>>>>>>>    end
46379>>>>>>>>>>
46379>>>>>>>>>  end
46379>>>>>>>>>>
46379>>>>>>>>>end_procedure
46380>>>>>>>>>
46380>>>>>>>>>//> Sets a field to its lowest possible value
46380>>>>>>>>>procedure DBMS_SetFieldValueMin global integer liFile integer liField
46382>>>>>>>>>  integer liType liLen liDecs
46382>>>>>>>>>  number lnValue
46382>>>>>>>>>  string lsChar lsValue
46382>>>>>>>>>  get_attribute DF_FIELD_TYPE of liFile liField to liType
46385>>>>>>>>>  if (liType=DF_DATE) set_field_value liFile liField to 0
46390>>>>>>>>>  else begin
46391>>>>>>>>>    get_attribute DF_FIELD_LENGTH of liFile liField to liLen
46394>>>>>>>>>    if (liType=DF_ASCII) begin
46396>>>>>>>>>      set_field_value liFile liField to (repeat(" ",liLen))
46399>>>>>>>>>    end
46399>>>>>>>>>>
46399>>>>>>>>>    if (liType=DF_BCD) begin
46401>>>>>>>>>      if liField begin // Not RECNUM
46403>>>>>>>>>        get_attribute DF_FIELD_PRECISION of liFile liField to liDecs
46406>>>>>>>>>        move (liLen-liDecs) to liLen
46407>>>>>>>>>        decrement liLen
46408>>>>>>>>>        if liDecs move ("-"+repeat("9",liLen)+CurrentDecimalSeparator()+repeat("9",liDecs)) to lsValue
46411>>>>>>>>>        else      move ("-"+repeat("9",liLen)) to lsValue
46413>>>>>>>>>        move lsValue to lnValue
46414>>>>>>>>>        set_field_value liFile liField to lnValue
46417>>>>>>>>>      end
46417>>>>>>>>>>
46417>>>>>>>>>      else set_field_value liFile liField to 0 // If RECNUM field
46421>>>>>>>>>    end
46421>>>>>>>>>>
46421>>>>>>>>>  end
46421>>>>>>>>>>
46421>>>>>>>>>end_procedure
46422>>>>>>>>>
46422>>>>>>>>>procedure DBMS_FindByRecnum global integer liFile integer liRecnum
46424>>>>>>>>>  clear liFile
46425>>>>>>>>>  if liRecnum begin
46427>>>>>>>>>    set_field_value liFile 0 to liRecnum
46430>>>>>>>>>    vfind liFile 0 EQ
46432>>>>>>>>>  end
46432>>>>>>>>>>
46432>>>>>>>>>end_procedure
46433>>>>>>>>>
46433>>>>>>>>>
46433>>>>>>>Use AppFolders.nui // Function AppFolder returns the absolute folder name of strategic folders
Including file: AppFolders.nui    (C:\projects\BRS\VDFQuery\AppSrc\AppFolders.nui)
46433>>>>>>>>>// Use AppFolders.nui // Function AppFolder returns the absolute folder name of strategic folders
46433>>>>>>>>>//
46433>>>>>>>>>// Not very sophisticated! Everything is based on the location of filelist.cfg. Should really
46433>>>>>>>>>// examine the -ws file. Well, let's see how VDF 12 works before exhausting ourselves.
46433>>>>>>>>>
46433>>>>>>>>>use files.nui
46433>>>>>>>>>
46433>>>>>>>>>enumeration_list
46433>>>>>>>>>  define APPFOLDER_HTML
46433>>>>>>>>>  define APPFOLDER_FILELIST
46433>>>>>>>>>  define APPFOLDER_PROGRAM
46433>>>>>>>>>  define APPFOLDER_VDF_ROOT
46433>>>>>>>>>  define APPFOLDER_MAX
46433>>>>>>>>>end_enumeration_list
46433>>>>>>>>>
46433>>>>>>>>>
46433>>>>>>>>>function AppFolder global integer liWhich returns string
46435>>>>>>>>>  string lsValue
46435>>>>>>>>>  if (liWhich=APPFOLDER_VDF_ROOT) begin // VDF Root dir
46437>>>>>>>>>    get_profile_string "Defaults" "VdfRootDir" To lsValue
46440>>>>>>>>>  end
46440>>>>>>>>>>
46440>>>>>>>>>  if (liWhich=APPFOLDER_FILELIST) begin // Filelist.cfg
46442>>>>>>>>>    get SEQ_FindFileAlongDFPath "filelist.cfg" to lsValue
46443>>>>>>>>>  end
46443>>>>>>>>>>
46443>>>>>>>>>  if (liWhich=APPFOLDER_PROGRAM) begin // Filelist.cfg
46445>>>>>>>>>    get appfolder APPFOLDER_FILELIST to lsValue
46446>>>>>>>>>    get SEQ_ExtractPathFromFileName lsValue to lsValue
46447>>>>>>>>>    get Files_AppendPath lsValue "Programs" to lsValue
46448>>>>>>>>>  end
46448>>>>>>>>>>
46448>>>>>>>>>  if (liWhich=APPFOLDER_HTML) begin // Filelist.cfg
46450>>>>>>>>>    get appfolder APPFOLDER_FILELIST to lsValue
46451>>>>>>>>>    get SEQ_ExtractPathFromFileName lsValue to lsValue
46452>>>>>>>>>    get Files_AppendPath lsValue "AppHtml" to lsValue
46453>>>>>>>>>  end
46453>>>>>>>>>>
46453>>>>>>>>>  function_return lsValue
46454>>>>>>>>>end_function
46455>>>>>>>>>
46455>>>>>>>>>function AppSubFolder global integer liWhich string lsSubFolder returns string
46457>>>>>>>>>  string lsValue
46457>>>>>>>>>  get AppFolder liWhich to lsValue
46458>>>>>>>>>  get Files_AppendPath lsValue lsSubFolder to lsValue
46459>>>>>>>>>  function_return lsValue
46460>>>>>>>>>end_function
46461>>>>>>>>>
46461>>>>>>>>>// Translate absolute disk folder (or file) into relative HTML folder (or file).
46461>>>>>>>>>function AppFolder_DiskToHtml global string lsDiskFolder returns string
46463>>>>>>>>>  string lsHtmlRootFolder lsRelativeFolder
46463>>>>>>>>>  get AppFolder APPFOLDER_HTML to lsHtmlRootFolder
46464>>>>>>>>>  move (lowercase(lsDiskFolder)) to lsDiskFolder
46465>>>>>>>>>  move (lowercase(lsHtmlRootFolder)) to lsHtmlRootFolder
46466>>>>>>>>>  move (replace(lsHtmlRootFolder,lsDiskFolder,"")) to lsRelativeFolder
46467>>>>>>>>>
46467>>>>>>>>>  if (left(lsRelativeFolder,1)="\") move (replace("\",lsRelativeFolder,"")) to lsRelativeFolder
46470>>>>>>>>>  move (replaces("\",lsRelativeFolder,"/")) to lsRelativeFolder
46471>>>>>>>>>  function_return lsRelativeFolder
46472>>>>>>>>>end_function
46473>>>>>>>enumeration_list // Global read only attributes from sysconf and other (OA = Other Attributes)
46473>>>>>>>  define OA_REG_NAME
46473>>>>>>>  define OA_SERIAL_NUMBER
46473>>>>>>>  define OA_MAX_USERS
46473>>>>>>>  define OA_DATAFLEX_REV
46473>>>>>>>  define OA_OS_SHORT_NAME
46473>>>>>>>  define OA_OS_MAJOR_REV
46473>>>>>>>  define OA_OS_MINOR_REV
46473>>>>>>>  define OA_OS_NAME
46473>>>>>>>  define OA_MACHINE_NAME
46473>>>>>>>  define OA_WORKDIR
46473>>>>>>>  define OA_PATH
46473>>>>>>>  define OA_DIR_SEPARATOR // "/" or "\"
46473>>>>>>>  define OA_FILE_MASK
46473>>>>>>>  define OA_SYSTEM_NAME
46473>>>>>>>  define OA_PATH_SEPARATOR // ":" or ";"
46473>>>>>>>  define OA_DATE4_STATE
46473>>>>>>>  define OA_SYSDATE4_STATE
46473>>>>>>>  define OA_EPOCH_VALUE
46473>>>>>>>  define OA_TIMER_RESOLUTION
46473>>>>>>>  define OA_COLLATE_PATH     // Path to COLLATE.CFG (excluding the file name itself)
46473>>>>>>>  define OA_COLLATE_SIZE     // Size of COLLATE.CFG in bytes
46473>>>>>>>  define OA_COLLATE_TIME     // Time stamp of COLLATE.CFG in TS-number format (see DATES.UTL)
46473>>>>>>>  define OA_RUNTIME_NAME     // SYSCONF_RUNTIME_NAME
46473>>>>>>>  define OA_UTC_TIME_OFFSET  // SYSCONF_UTC_TIME_OFFSET
46473>>>>>>>  define OA_MAX_ARGUMENT_SIZE
46473>>>>>>>  define OA_CURRENT_USER_COUNT
46473>>>>>>>  define OA_DFPRINTER
46473>>>>>>>  define OA_LOCK_COUNT
46473>>>>>>>
46473>>>>>>>  define OA_FOLDER_VDF_ROOT
46473>>>>>>>  define OA_FOLDER_FILELIST
46473>>>>>>>  define OA_FOLDER_HTML
46473>>>>>>>  define OA_FOLDER_PROGRAM
46473>>>>>>>
46473>>>>>>>  define OA_MAX // Pointer to highest OA index+1 (formerly OA_PATH_MAX)
46473>>>>>>>end_enumeration_list
46473>>>>>>>
46473>>>>>>>enumeration_list // Enumerate attribute types
46473>>>>>>>  define ATTRTYPE_NONE      // Not an attribute type
46473>>>>>>>  define ATTRTYPE_GLOBAL    // No parameters
46473>>>>>>>  define ATTRTYPE_DRIVER    // 1: Driver number
46473>>>>>>>  define ATTRTYPE_DRVSRV    // 1: Driver number  2: Server number
46473>>>>>>>  define ATTRTYPE_FILELIST  // 1: File  (No changes to structure, filelist only)
46473>>>>>>>  define ATTRTYPE_FILE      // 1: File
46473>>>>>>>  define ATTRTYPE_FIELD     // 1: File   2: Field
46473>>>>>>>  define ATTRTYPE_INDEX     // 1: File   2: Index
46473>>>>>>>  define ATTRTYPE_IDXSEG    // 1: File   2: Index   3: Segment
46473>>>>>>>  define ATTRTYPE_SPECIAL1  // 1: File 2/3: Field/Field  (overlap check)
46473>>>>>>>  define ATTRTYPE_FLSTNAV   // 1: File (for navigating filelist)
46473>>>>>>>end_enumeration_list
46473>>>>>>>
46473>>>>>>>desktop_section // Compile as if on desktop
46478>>>>>>>  object oAPI_AttributeTypes is a cArray no_image
46480>>>>>>>    item_property_list
46480>>>>>>>      item_property string  psName.i
46480>>>>>>>      item_property integer piParams.i // Number of parameters (DFScript feature)
46480>>>>>>>    end_item_property_list
#REM 46517 DEFINE FUNCTION PIPARAMS.I INTEGER LIROW RETURNS INTEGER
#REM 46522 DEFINE PROCEDURE SET PIPARAMS.I INTEGER LIROW INTEGER VALUE
#REM 46527 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 46532 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
46538>>>>>>>    procedure DefAttrType integer type# string name# integer params#
46541>>>>>>>      set psName.i type# to name#
46542>>>>>>>      set piParams.i type# to params#
46543>>>>>>>    end_procedure                   // Number of parameters
46544>>>>>>>    send DefAttrType ATTRTYPE_GLOBAL   "Global"              0
46545>>>>>>>    send DefAttrType ATTRTYPE_DRIVER   "Driver"              1
46546>>>>>>>    send DefAttrType ATTRTYPE_DRVSRV   "Server"              2
46547>>>>>>>    send DefAttrType ATTRTYPE_FILELIST "Filelist"            1
46548>>>>>>>    send DefAttrType ATTRTYPE_FILE     "File"                1
46549>>>>>>>    send DefAttrType ATTRTYPE_FIELD    "Field"               2
46550>>>>>>>    send DefAttrType ATTRTYPE_INDEX    "Index"               2
46551>>>>>>>    send DefAttrType ATTRTYPE_IDXSEG   "Index segment"       3
46552>>>>>>>    send DefAttrType ATTRTYPE_SPECIAL1 "Special1"            3
46553>>>>>>>    send DefAttrType ATTRTYPE_FLSTNAV  "Filelist navigation" 1
46554>>>>>>>  end_object
46555>>>>>>>  class cAPI_AttrValueArray is a cArray
46556>>>>>>>    item_property_list
46556>>>>>>>      item_property integer piValue.i        // Actual value
46556>>>>>>>      item_property string  psCodeName.i     // Value as written in code
46556>>>>>>>      item_property string  psDisplayName.i  // Value as presented to an unknowing user
46556>>>>>>>    end_item_property_list cAPI_AttrValueArray
#REM 46591 DEFINE FUNCTION PSDISPLAYNAME.I INTEGER LIROW RETURNS STRING
#REM 46595 DEFINE PROCEDURE SET PSDISPLAYNAME.I INTEGER LIROW STRING VALUE
#REM 46599 DEFINE FUNCTION PSCODENAME.I INTEGER LIROW RETURNS STRING
#REM 46603 DEFINE PROCEDURE SET PSCODENAME.I INTEGER LIROW STRING VALUE
#REM 46607 DEFINE FUNCTION PIVALUE.I INTEGER LIROW RETURNS INTEGER
#REM 46611 DEFINE PROCEDURE SET PIVALUE.I INTEGER LIROW INTEGER VALUE
46616>>>>>>>    procedure add_value integer value# string codename# string displayname#
46618>>>>>>>      integer row#
46618>>>>>>>      get row_count to row#
46619>>>>>>>      set piValue.i       row# to value#
46620>>>>>>>      set psCodeName.i    row# to codename#
46621>>>>>>>      set psDisplayName.i row# to displayname#
46622>>>>>>>    end_procedure
46623>>>>>>>    function iValue2Row.i integer value# returns integer
46625>>>>>>>      integer row# max#
46625>>>>>>>      get row_count to max#
46626>>>>>>>      for row# from 0 to (max#-1)
46632>>>>>>>>
46632>>>>>>>        if (piValue.i(self,row#)) eq value# function_return row#
46635>>>>>>>      loop
46636>>>>>>>>
46636>>>>>>>      function_return -1
46637>>>>>>>    end_function
46638>>>>>>>  end_class // cAPI_AttrValueArray
46639>>>>>>>  object oAPI_Attributes is a cArray no_image
46641>>>>>>>    item_property_list
46641>>>>>>>      item_property string  psName.i
46641>>>>>>>      item_property integer piAttrType.i     // Attribute type
46641>>>>>>>      item_property string  psDisplayName.i  // Attribute display name
46641>>>>>>>      item_property integer piWrite.i        // Write access?
46641>>>>>>>      item_property integer piOnlyDAC.i      // Internal DAC use
46641>>>>>>>      item_property integer piValueType.i    // DF_BCD or DF_ASCII
46641>>>>>>>      item_property integer piValueArray.i   // Legal values
46641>>>>>>>      item_property integer piRuntimeOnly.i  // Runtime only attribute (FILE attr)
46641>>>>>>>    end_item_property_list
#REM 46696 DEFINE FUNCTION PIRUNTIMEONLY.I INTEGER LIROW RETURNS INTEGER
#REM 46701 DEFINE PROCEDURE SET PIRUNTIMEONLY.I INTEGER LIROW INTEGER VALUE
#REM 46706 DEFINE FUNCTION PIVALUEARRAY.I INTEGER LIROW RETURNS INTEGER
#REM 46711 DEFINE PROCEDURE SET PIVALUEARRAY.I INTEGER LIROW INTEGER VALUE
#REM 46716 DEFINE FUNCTION PIVALUETYPE.I INTEGER LIROW RETURNS INTEGER
#REM 46721 DEFINE PROCEDURE SET PIVALUETYPE.I INTEGER LIROW INTEGER VALUE
#REM 46726 DEFINE FUNCTION PIONLYDAC.I INTEGER LIROW RETURNS INTEGER
#REM 46731 DEFINE PROCEDURE SET PIONLYDAC.I INTEGER LIROW INTEGER VALUE
#REM 46736 DEFINE FUNCTION PIWRITE.I INTEGER LIROW RETURNS INTEGER
#REM 46741 DEFINE PROCEDURE SET PIWRITE.I INTEGER LIROW INTEGER VALUE
#REM 46746 DEFINE FUNCTION PSDISPLAYNAME.I INTEGER LIROW RETURNS STRING
#REM 46751 DEFINE PROCEDURE SET PSDISPLAYNAME.I INTEGER LIROW STRING VALUE
#REM 46756 DEFINE FUNCTION PIATTRTYPE.I INTEGER LIROW RETURNS INTEGER
#REM 46761 DEFINE PROCEDURE SET PIATTRTYPE.I INTEGER LIROW INTEGER VALUE
#REM 46766 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 46771 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
46777>>>>>>>
46777>>>>>>>    procedure callback_attrtype.iii integer attrtype# integer msg# integer lhObj
46780>>>>>>>      integer max# attr#
46780>>>>>>>      get row_count to max#
46781>>>>>>>      for attr# from 0 to (max#-1)
46787>>>>>>>>
46787>>>>>>>        if (piAttrType.i(self,attr#)=attrtype#) send msg# to lhObj attr#
46790>>>>>>>      loop
46791>>>>>>>>
46791>>>>>>>    end_procedure
46792>>>>>>>
46792>>>>>>>    procedure callback_attrvalue.iii integer attr# integer msg# integer lhObj
46795>>>>>>>      integer arr# max# row#
46795>>>>>>>      get piValueArray.i attr# to arr#
46796>>>>>>>      if arr# begin
46798>>>>>>>        get row_count of arr# to max#
46799>>>>>>>        for row# from 0 to (max#-1)
46805>>>>>>>>
46805>>>>>>>          send msg# to lhObj (piValue.i(arr#,row#)) (psCodeName.i(arr#,row#)) (psDisplayName.i(arr#,row#))
46806>>>>>>>        loop
46807>>>>>>>>
46807>>>>>>>      end
46807>>>>>>>>
46807>>>>>>>    end_procedure
46808>>>>>>>
46808>>>>>>>    function iAttrValueArrayObj integer attr# returns integer
46811>>>>>>>      integer rval#
46811>>>>>>>      get piValueArray.i attr# to rval#
46812>>>>>>>      ifnot rval# begin
46814>>>>>>>        object oAPI_AttrValueArray is a cAPI_AttrValueArray no_image
46816>>>>>>>          move self to rval#
46817>>>>>>>        end_object
46818>>>>>>>        set piValueArray.i attr# to rval#
46819>>>>>>>      end
46819>>>>>>>>
46819>>>>>>>      function_return rval#
46820>>>>>>>    end_function
46821>>>>>>>
46821>>>>>>>    procedure AddAttrValue integer attr# integer value# string codename# string displayname#
46824>>>>>>>      integer lhObj
46824>>>>>>>      get iAttrValueArrayObj attr# to lhObj
46825>>>>>>>      send add_value to lhObj value# codename# displayname#
46826>>>>>>>    end_procedure
46827>>>>>>>
46827>>>>>>>    send AddAttrValue DF_FIELD_TYPE DF_ASCII   "DF_ASCII"   "Ascii"
46828>>>>>>>    send AddAttrValue DF_FIELD_TYPE DF_BCD     "DF_BCD"     "Bcd"
46829>>>>>>>    send AddAttrValue DF_FIELD_TYPE DF_DATE    "DF_DATE"    "Date"
46830>>>>>>>    send AddAttrValue DF_FIELD_TYPE DF_OVERLAP "DF_OVERLAP" "Overlap"
46831>>>>>>>    send AddAttrValue DF_FIELD_TYPE DF_TEXT    "DF_TEXT"    "Text"
46832>>>>>>>    send AddAttrValue DF_FIELD_TYPE DF_BINARY  "DF_BINARY"  "Binary"
46833>>>>>>>
46833>>>>>>>    send AddAttrValue DF_FILE_HANDLE_TYPE DF_FILE_HANDLE_BAD                   "DF_FILE_HANDLE_BAD"                  "Bad"
46834>>>>>>>    send AddAttrValue DF_FILE_HANDLE_TYPE DF_FILE_HANDLE_CLOSED                "DF_FILE_HANDLE_CLOSED"               "Closed"
46835>>>>>>>    send AddAttrValue DF_FILE_HANDLE_TYPE DF_FILE_HANDLE_OPENED                "DF_FILE_HANDLE_OPENED"               "Opened"
46836>>>>>>>    send AddAttrValue DF_FILE_HANDLE_TYPE DF_FILE_HANDLE_EXISTING_RESTRUCTURE  "DF_FILE_HANDLE_EXISTING_RESTRUCTURE" "Existing restructure"
46837>>>>>>>    send AddAttrValue DF_FILE_HANDLE_TYPE DF_FILE_HANDLE_NEW_RESTRUCTURE       "DF_FILE_HANDLE_NEW_RESTRUCTURE"      "New restructure"
46838>>>>>>>
46838>>>>>>>    send AddAttrValue DF_DATE_FORMAT DF_DATE_USA      "DF_DATE_USA"      "USA (mm/dd/yyyy)"
46839>>>>>>>    send AddAttrValue DF_DATE_FORMAT DF_DATE_EUROPEAN "DF_DATE_EUROPEAN" "European (dd/mm/yyyy)"
46840>>>>>>>    send AddAttrValue DF_DATE_FORMAT DF_DATE_MILITARY "DF_DATE_MILITARY" "Military (yyyy/mm/dd)"
46841>>>>>>>
46841>>>>>>>    send AddAttrValue DF_FILE_LOCK_TYPE DF_LOCK_TYPE_NONE   "DF_LOCK_TYPE_NONE"   "None"
46842>>>>>>>    send AddAttrValue DF_FILE_LOCK_TYPE DF_LOCK_TYPE_FILE   "DF_LOCK_TYPE_FILE"   "File"
46843>>>>>>>    send AddAttrValue DF_FILE_LOCK_TYPE DF_LOCK_TYPE_RECORD "DF_LOCK_TYPE_RECORD" "Record"
46844>>>>>>>
46844>>>>>>>    send AddAttrValue DF_FILE_OPEN_MODE DF_SHARE     "DF_SHARE"     "Share"
46845>>>>>>>    send AddAttrValue DF_FILE_OPEN_MODE DF_EXCLUSIVE "DF_EXCLUSIVE" "Exclusive"
46846>>>>>>>
46846>>>>>>>    send AddAttrValue DF_FILE_COMPRESSION DF_FILE_COMPRESS_NONE     "DF_FILE_COMPRESS_NONE"     "None"
46847>>>>>>>    send AddAttrValue DF_FILE_COMPRESSION DF_FILE_COMPRESS_FAST     "DF_FILE_COMPRESS_FAST"     "Fast"
46848>>>>>>>    send AddAttrValue DF_FILE_COMPRESSION DF_FILE_COMPRESS_STANDARD "DF_FILE_COMPRESS_STANDARD" "Standard"
46849>>>>>>>    send AddAttrValue DF_FILE_COMPRESSION DF_FILE_COMPRESS_CUSTOM   "DF_FILE_COMPRESS_CUSTOM"   "Custom"
46850>>>>>>>
46850>>>>>>>    send AddAttrValue DF_FILE_TRANSACTION DF_FILE_TRANSACTION_NONE          "DF_FILE_TRANSACTION_NONE"          "None"
46851>>>>>>>    send AddAttrValue DF_FILE_TRANSACTION DF_FILE_TRANSACTION_CLIENT_ATOMIC "DF_FILE_TRANSACTION_CLIENT_ATOMIC" "Client atomic"
46852>>>>>>>    send AddAttrValue DF_FILE_TRANSACTION DF_FILE_TRANSACTION_SERVER_ATOMIC "DF_FILE_TRANSACTION_SERVER_ATOMIC" "Server atomic"
46853>>>>>>>    send AddAttrValue DF_FILE_TRANSACTION DF_FILE_TRANSACTION_SERVER_LOGGED "DF_FILE_TRANSACTION_SERVER_LOGGED" "Server logged"
46854>>>>>>>
46854>>>>>>>    send AddAttrValue DF_FILE_STATUS DF_FILE_INACTIVE       "DF_FILE_INACTIVE"       "Inactive"
46855>>>>>>>    send AddAttrValue DF_FILE_STATUS DF_FILE_ACTIVE         "DF_FILE_ACTIVE"         "Active"
46856>>>>>>>    send AddAttrValue DF_FILE_STATUS DF_FILE_ACTIVE_CHANGED "DF_FILE_ACTIVE_CHANGED" "Changed"
46857>>>>>>>
46857>>>>>>>    send AddAttrValue DF_FILE_COMMITTED DFTRUE  "DFTRUE"  "True"
46858>>>>>>>    send AddAttrValue DF_FILE_COMMITTED DFFALSE "DFFALSE" "False"
46859>>>>>>>
46859>>>>>>>    send AddAttrValue DF_FILE_RESTRUCTURE DF_NO_RESTRUCTURE    "DF_NO_RESTRUCTURE"    "None"
46860>>>>>>>    send AddAttrValue DF_FILE_RESTRUCTURE DF_RESTRUCTURE_FILE  "DF_RESTRUCTURE_FILE"  "File"
46861>>>>>>>    send AddAttrValue DF_FILE_RESTRUCTURE DF_RESTRUCTURE_INDEX "DF_RESTRUCTURE_INDEX" "Index"
46862>>>>>>>    send AddAttrValue DF_FILE_RESTRUCTURE DF_RESTRUCTURE_BOTH  "DF_RESTRUCTURE_BOTH"  "File/Index"
46863>>>>>>>
46863>>>>>>>    send AddAttrValue DF_FILE_MULTIUSER DF_FILE_USER_SINGLE "DF_FILE_USER_SINGLE" "Single user"
46864>>>>>>>    send AddAttrValue DF_FILE_MULTIUSER DF_FILE_USER_MULTI  "DF_FILE_USER_MULTI"  "Multi user"
46865>>>>>>>
46865>>>>>>>    send AddAttrValue DF_FILE_MODE DF_FILE_ALIAS_DEFAULT "DF_FILE_ALIAS_DEFAULT" "Default"
46866>>>>>>>    send AddAttrValue DF_FILE_MODE DF_FILE_IS_MASTER     "DF_FILE_IS_MASTER"     "Master"
46867>>>>>>>    send AddAttrValue DF_FILE_MODE DF_FILE_IS_ALIAS      "DF_FILE_IS_ALIAS"      "Alias"
46868>>>>>>>
46868>>>>>>>    send AddAttrValue DF_FILE_REUSE_DELETED DF_FILE_DELETED_NOREUSE "DF_FILE_DELETED_NOREUSE" "No reuse"
46869>>>>>>>    send AddAttrValue DF_FILE_REUSE_DELETED DF_FILE_DELETED_REUSE   "DF_FILE_DELETED_REUSE"   "Reuse"
46870>>>>>>>
46870>>>>>>>    send AddAttrValue DF_FILE_INTEGRITY_CHECK DFTRUE  "DFTRUE"  "True"
46871>>>>>>>    send AddAttrValue DF_FILE_INTEGRITY_CHECK DFFALSE "DFFALSE" "False"
46872>>>>>>>
46872>>>>>>>    send AddAttrValue DF_INDEX_TYPE DF_INDEX_TYPE_ONLINE "DF_INDEX_TYPE_ONLINE" "Online"
46873>>>>>>>    send AddAttrValue DF_INDEX_TYPE DF_INDEX_TYPE_BATCH  "DF_INDEX_TYPE_BATCH"  "Batch"
46874>>>>>>>
46874>>>>>>>    send AddAttrValue DF_INDEX_SEGMENT_DIRECTION DF_ASCENDING  "DF_ASCENDING"  "Ascending"
46875>>>>>>>    send AddAttrValue DF_INDEX_SEGMENT_DIRECTION DF_DESCENDING "DF_DESCENDING" "Descending"
46876>>>>>>>
46876>>>>>>>    send AddAttrValue DF_INDEX_SEGMENT_CASE DF_CASE_USED    "DF_CASE_USED"    "Case used"
46877>>>>>>>    send AddAttrValue DF_INDEX_SEGMENT_CASE DF_CASE_IGNORED "DF_CASE_IGNORED" "Case ignored"
46878>>>>>>>
46878>>>>>>>    function sValueRead_separator.i integer value# returns string
46881>>>>>>>      function_return (character(value#)+" ("+string(value#)+")")
46882>>>>>>>    end_function
46883>>>>>>>
46883>>>>>>>    procedure DefAttr integer attr# string name# integer attrtype# string dname# integer write# integer onlyDAC# integer valuetype# integer rt_only#
46886>>>>>>>      set psName.i        attr# to name#
46887>>>>>>>      set piAttrType.i    attr# to attrtype#
46888>>>>>>>      set psDisplayName.i attr# to dname#
46889>>>>>>>      set piWrite.i       attr# to write#
46890>>>>>>>      set piOnlyDAC.i     attr# to onlyDAC#
46891>>>>>>>       set piValueType.i   attr# to valuetype#
46892>>>>>>>      set piRuntimeOnly.i attr# to rt_only#
46893>>>>>>>    end_procedure
46894>>>>>>>    //                                     Runtime onlyRuntime onlyĿ
46894>>>>>>>    //                                     Value typeValue typeĿ        
46894>>>>>>>    //                                     Internal DAC?Internal DAC?Ŀ         
46894>>>>>>>    //                                     Write access?Write access?          
46894>>>>>>>    send DefAttr DF_LOCK_DELAY              "DF_LOCK_DELAY"              ATTRTYPE_GLOBAL   "Lock delay"            1 0 DF_BCD   0
46895>>>>>>>    send DefAttr DF_LOCK_TIMEOUT            "DF_LOCK_TIMEOUT"            ATTRTYPE_GLOBAL   "Lock timeout"          1 0 DF_BCD   0
46896>>>>>>>    send DefAttr DF_OPEN_PATH               "DF_OPEN_PATH"               ATTRTYPE_GLOBAL   "Open path"             1 0 DF_ASCII 0
46897>>>>>>>    send DefAttr DF_DATE_FORMAT             "DF_DATE_FORMAT"             ATTRTYPE_GLOBAL   "Date format"           1 0 DF_BCD   0
46898>>>>>>>    send DefAttr DF_DATE_SEPARATOR          "DF_DATE_SEPARATOR"          ATTRTYPE_GLOBAL   "Date separator"        1 0 DF_BCD   0
46899>>>>>>>    send DefAttr DF_DECIMAL_SEPARATOR       "DF_DECIMAL_SEPARATOR"       ATTRTYPE_GLOBAL   "Decimal separator"     1 0 DF_BCD   0
46900>>>>>>>    send DefAttr DF_THOUSANDS_SEPARATOR     "DF_THOUSANDS_SEPARATOR"     ATTRTYPE_GLOBAL   "Thousands separator"   1 0 DF_BCD   0
46901>>>>>>>    send DefAttr DF_ALL_FILES_TOUCHED       "DF_ALL_FILES_TOUCHED"       ATTRTYPE_GLOBAL   "All files touched"     0 0 DF_BCD   0
46902>>>>>>>    send DefAttr DF_HIGH_DATA_INTEGRITY     "DF_HIGH_DATA_INTEGRITY"     ATTRTYPE_GLOBAL   "High data integrity"   1 0 DF_BCD   0
46903>>>>>>>    send DefAttr DF_TRAN_COUNT              "DF_TRAN_COUNT"              ATTRTYPE_GLOBAL   "Transact. nest. level" 0 0 DF_BCD   0
46904>>>>>>>    send DefAttr DF_TRANSACTION_ABORT       "DF_TRANSACTION_ABORT"       ATTRTYPE_GLOBAL   "Transaction abort"     0 0 DF_BCD   0
46905>>>>>>>    send DefAttr DF_REREAD_REQUIRED         "DF_REREAD_REQUIRED"         ATTRTYPE_GLOBAL   "Reread required"       0 0 DF_BCD   0
46906>>>>>>>    send DefAttr DF_FILELIST_NAME           "DF_FILELIST_NAME"           ATTRTYPE_GLOBAL   "Filelist name"         1 0 DF_ASCII 0
46907>>>>>>>    send DefAttr DF_REPORT_UNSUPPORTED_ATTRIBUTES ;                                        "DF_REPORT_UNSUPPORTED_ATTRIBUTES" ;                                                                         ATTRTYPE_GLOBAL   "Report unsup. attr."   1 0 DF_BCD   0
46908>>>>>>>    send DefAttr DF_STRICT_ATTRIBUTES       "DF_STRICT_ATTRIBUTES"       ATTRTYPE_GLOBAL   "Strict attributes"     1 0 DF_BCD   0
46909>>>>>>>    send DefAttr DF_NUMBER_DRIVERS          "DF_NUMBER_DRIVERS"          ATTRTYPE_GLOBAL   "Number drivers"        0 0 DF_BCD   0
46910>>>>>>>    send DefAttr DF_DRIVER_NAME             "DF_DRIVER_NAME"             ATTRTYPE_DRIVER   "Driver name"           0 0 DF_ASCII 0
46911>>>>>>>    send DefAttr DF_DRIVER_NUMBER_SERVERS   "DF_DRIVER_NUMBER_SERVERS"   ATTRTYPE_DRIVER   "Driver number servers" 0 0 DF_BCD   0
46912>>>>>>>    send DefAttr DF_DRIVER_SERVER_NAME      "DF_DRIVER_SERVER_NAME"      ATTRTYPE_DRVSRV   "Driver server name"    0 0 DF_ASCII 0
46913>>>>>>>    send DefAttr DF_API_DISABLED            "DF_API_DISABLED"            ATTRTYPE_GLOBAL   "API disabled"          0 1 DF_BCD   0
46914>>>>>>>    send DefAttr DF_API_DISABLED_ERROR      "DF_API_DISABLED_ERROR"      ATTRTYPE_GLOBAL   "API disabled error"    0 1 DF_BCD   0
46915>>>>>>>
46915>>>>>>>    send DefAttr DF_FILE_STATUS             "DF_FILE_STATUS"             ATTRTYPE_FILE     "Status"                0 0 DF_BCD   1
46916>>>>>>>    send DefAttr DF_FILE_MODE               "DF_FILE_MODE"               ATTRTYPE_FILE     "Mode"                  1 0 DF_BCD   1
46917>>>>>>>    send DefAttr DF_FILE_MAX_RECORDS        "DF_FILE_MAX_RECORDS"        ATTRTYPE_FILE     "Max records"           1 0 DF_BCD   0
46918>>>>>>>    send DefAttr DF_FILE_RECORDS_USED       "DF_FILE_RECORDS_USED"       ATTRTYPE_FILE     "Records used"          0 0 DF_BCD   0
46919>>>>>>>    send DefAttr DF_FILE_TYPE               "DF_FILE_TYPE"               ATTRTYPE_FILE     "Type"                  0 0 DF_BCD   0
46920>>>>>>>    send DefAttr DF_FILE_MULTIUSER          "DF_FILE_MULTIUSER"          ATTRTYPE_FILE     "Multiuser"             1 0 DF_BCD   0
46921>>>>>>>    send DefAttr DF_FILE_REUSE_DELETED      "DF_FILE_REUSE_DELETED"      ATTRTYPE_FILE     "Reuse deleted"         1 0 DF_BCD   0
46922>>>>>>>    send DefAttr DF_FILE_NUMBER             "DF_FILE_NUMBER"             ATTRTYPE_FILE     "Number"                0 0 DF_BCD   1
46923>>>>>>>    send DefAttr DF_FILE_COMPRESSION        "DF_FILE_COMPRESSION"        ATTRTYPE_FILE     "Compression"           1 0 DF_BCD   0
46924>>>>>>>    send DefAttr DF_FILE_LAST_INDEX_NUMBER  "DF_FILE_LAST_INDEX_NUMBER"  ATTRTYPE_FILE     "Last index number"     0 0 DF_BCD   0
46925>>>>>>>    send DefAttr DF_FILE_NUMBER_FIELDS      "DF_FILE_NUMBER_FIELDS"      ATTRTYPE_FILE     "Number fields"         0 0 DF_BCD   0
46926>>>>>>>    // Max 8 characters:
46926>>>>>>>    send DefAttr DF_FILE_LOGICAL_NAME       "DF_FILE_LOGICAL_NAME"       ATTRTYPE_FILELIST "Logical name"          1 0 DF_ASCII 0
46927>>>>>>>    // Max 40 characters:
46927>>>>>>>    send DefAttr DF_FILE_ROOT_NAME          "DF_FILE_ROOT_NAME"          ATTRTYPE_FILELIST "Root name"             1 0 DF_ASCII 0
46928>>>>>>>    send DefAttr DF_FILE_CHANGED            "DF_FILE_CHANGED"            ATTRTYPE_FILE     "Changed"               0 0 DF_BCD   1
46929>>>>>>>    send DefAttr DF_FILE_ALIAS              "DF_FILE_ALIAS"              ATTRTYPE_FILE     "Alias"                 1 0 DF_BCD   1
46930>>>>>>>    send DefAttr DF_FILE_TOUCHED            "DF_FILE_TOUCHED"            ATTRTYPE_FILE     "Touched"               0 0 DF_BCD   1
46931>>>>>>>    send DefAttr DF_FILE_TRANSACTION        "DF_FILE_TRANSACTION"        ATTRTYPE_FILE     "Transaction"           1 0 DF_BCD   0
46932>>>>>>>    send DefAttr DF_FILE_OPENED             "DF_FILE_OPENED"             ATTRTYPE_FILE     "Opened"                0 0 DF_BCD   1
46933>>>>>>>    // Max 32 characters:
46933>>>>>>>    send DefAttr DF_FILE_DISPLAY_NAME       "DF_FILE_DISPLAY_NAME"       ATTRTYPE_FILELIST "Display name"          1 0 DF_ASCII 0
46934>>>>>>>    send DefAttr DF_FILE_PHYSICAL_NAME      "DF_FILE_PHYSICAL_NAME"      ATTRTYPE_FILE     "Physical name"         0 0 DF_ASCII 0
46935>>>>>>>    send DefAttr DF_FILE_NEXT_OPENED        "DF_FILE_NEXT_OPENED"        ATTRTYPE_FLSTNAV  "Next opened"           0 0 DF_BCD   0
46936>>>>>>>    send DefAttr DF_FILE_NEXT_USED          "DF_FILE_NEXT_USED"          ATTRTYPE_FLSTNAV  "Next used"             0 0 DF_BCD   0
46937>>>>>>>    send DefAttr DF_FILE_NEXT_EMPTY         "DF_FILE_NEXT_EMPTY"         ATTRTYPE_FLSTNAV  "Next empty"            0 0 DF_BCD   0
46938>>>>>>>    send DefAttr DF_FILE_RECORD_LENGTH      "DF_FILE_RECORD_LENGTH"      ATTRTYPE_FILE     "Record length"         1 0 DF_BCD   0
46939>>>>>>>    send DefAttr DF_FILE_RESTRUCTURE        "DF_FILE_RESTRUCTURE"        ATTRTYPE_FILE     "Restructure"           0 0 DF_BCD   1
46940>>>>>>>    send DefAttr DF_FILE_OPEN_MODE          "DF_FILE_OPEN_MODE"          ATTRTYPE_FILE     "Open mode"             0 0 DF_BCD   1
46941>>>>>>>    send DefAttr DF_FILE_INTEGRITY_CHECK    "DF_FILE_INTEGRITY_CHECK"    ATTRTYPE_FILE     "Integrity check"       1 0 DF_BCD   0
46942>>>>>>>    send DefAttr DF_FILE_OWNER              "DF_FILE_OWNER"              ATTRTYPE_FILE     "Owner"                 0 0 DF_ASCII 1
46943>>>>>>>    send DefAttr DF_FILE_IS_SYSTEM_FILE     "DF_FILE_IS_SYSTEM_FILE"     ATTRTYPE_FILE     "Is system file"        0 0 DF_BCD   0
46944>>>>>>>    send DefAttr DF_FILE_LOCK_TYPE          "DF_FILE_LOCK_TYPE"          ATTRTYPE_FILE     "Lock type"             0 0 DF_BCD   0
46945>>>>>>>    send DefAttr DF_FILE_COMMITTED          "DF_FILE_COMMITTED"          ATTRTYPE_FILE     "Committed"             0 0 DF_BCD   1
46946>>>>>>>    send DefAttr DF_FILE_DRIVER             "DF_FILE_DRIVER"             ATTRTYPE_FILE     "Driver"                0 0 DF_ASCII 0
46947>>>>>>>    send DefAttr DF_FILE_RECORD_LENGTH_USED "DF_FILE_RECORD_LENGTH_USED" ATTRTYPE_FILE     "Record length used"    0 0 DF_BCD   0
46948>>>>>>>    send DefAttr DF_FILE_HANDLE_TYPE        "DF_FILE_HANDLE_TYPE"        ATTRTYPE_FILE     "Handle type"           0 1 DF_BCD   1
46949>>>>>>>    send DefAttr DF_FILE_RECORD_IDENTITY    "DF_FILE_RECORD_IDENTITY"    ATTRTYPE_FILE     "Record identity"       1 0 DF_BCD   0
46950>>>>>>>    send DefAttr DF_FILE_LOGIN              "DF_FILE_LOGIN"              ATTRTYPE_FILE     "Login"                 1 0 DF_ASCII 1
46951>>>>>>>    send DefAttr DF_FILE_RECORD_PRIVILEGE   "DF_FILE_RECORD_PRIVILEGE"   ATTRTYPE_FILE     "Record privilege"      0 1 DF_BCD   1
46952>>>>>>>    send DefAttr DF_FILE_PRIVILEGE          "DF_FILE_PRIVILEGE"          ATTRTYPE_FILE     "Privilege"             0 1 DF_BCD   1
46953>>>>>>>    send DefAttr DF_FILE_CREATION_SERIAL    "DF_FILE_CREATION_SERIAL"    ATTRTYPE_FILE     "Creation serial"       0 1 DF_BCD   1
46954>>>>>>>    send DefAttr DF_FILE_REVISION           "DF_FILE_REVISION"           ATTRTYPE_FILE     "Revision"              0 0 DF_ASCII 0
46955>>>>>>>    send DefAttr DF_FILE_RELATED_COUNT      "DF_FILE_RELATED_COUNT"      ATTRTYPE_FILE     "Related count"         0 1 DF_BCD   1
46956>>>>>>>    send DefAttr DF_FILE_RELATED_FIELDS     "DF_FILE_RELATED_FIELDS"     ATTRTYPE_FILE     "Related fields"        0 1 DF_BCD   1
46957>>>>>>>    send DefAttr DF_FILE_SYSTEM_FILE        "DF_FILE_SYSTEM_FILE"        ATTRTYPE_FILE     "System file"           0 1 DF_BCD   1
46958>>>>>>>    send DefAttr DF_FILE_SYSTEM_FIELD       "DF_FILE_SYSTEM_FIELD"       ATTRTYPE_FILE     "System field"          0 1 DF_BCD   1
46959>>>>>>>    send DefAttr DF_FILE_RECORD_REREAD      "DF_FILE_RECORD_REREAD"      ATTRTYPE_FILE     "Record reread"         0 1 DF_BCD   1
46960>>>>>>>    send DefAttr DF_FIELD_NUMBER            "DF_FIELD_NUMBER"            ATTRTYPE_FIELD    "Number"                0 1 DF_BCD   0
46961>>>>>>>    send DefAttr DF_FIELD_TYPE              "DF_FIELD_TYPE"              ATTRTYPE_FIELD    "Type"                  1 0 DF_BCD   0
46962>>>>>>>    send DefAttr DF_FIELD_LENGTH            "DF_FIELD_LENGTH"            ATTRTYPE_FIELD    "Length"                1 0 DF_BCD   0
46963>>>>>>>    send DefAttr DF_FIELD_PRECISION         "DF_FIELD_PRECISION"         ATTRTYPE_FIELD    "Precision"             1 0 DF_BCD   0
46964>>>>>>>    send DefAttr DF_FIELD_RELATED_FILE      "DF_FIELD_RELATED_FILE"      ATTRTYPE_FIELD    "Related file"          1 0 DF_BCD   0
46965>>>>>>>    send DefAttr DF_FIELD_RELATED_FIELD     "DF_FIELD_RELATED_FIELD"     ATTRTYPE_FIELD    "Related field"         1 0 DF_BCD   0
46966>>>>>>>    send DefAttr DF_FIELD_NAME              "DF_FIELD_NAME"              ATTRTYPE_FIELD    "Name"                  1 0 DF_ASCII 0
46967>>>>>>>    send DefAttr DF_FIELD_INDEX             "DF_FIELD_INDEX"             ATTRTYPE_FIELD    "Index"                 1 0 DF_BCD   0
46968>>>>>>>    send DefAttr DF_FIELD_OFFSET            "DF_FIELD_OFFSET"            ATTRTYPE_FIELD    "Offset"                1 0 DF_BCD   0
46969>>>>>>>    send DefAttr DF_FIELD_OLD_NUMBER        "DF_FIELD_OLD_NUMBER"        ATTRTYPE_FIELD    "Old number"            0 0 DF_BCD   0
46970>>>>>>>    send DefAttr DF_FIELD_OVERLAP           "DF_FIELD_OVERLAP"           ATTRTYPE_SPECIAL1 "Overlap"               0 0 DF_BCD   0
46971>>>>>>>    send DefAttr DF_FIELD_NATIVE_LENGTH     "DF_FIELD_NATIVE_LENGTH"     ATTRTYPE_FIELD    "Native length"         0 0 DF_BCD   0
46972>>>>>>>
46972>>>>>>>    send DefAttr DF_INDEX_NUMBER_SEGMENTS   "DF_INDEX_NUMBER_SEGMENTS"   ATTRTYPE_INDEX    "Number segments"       1 0 DF_BCD   0
46973>>>>>>>    send DefAttr DF_INDEX_NUMBER_BUFFERS    "DF_INDEX_NUMBER_BUFFERS"    ATTRTYPE_INDEX    "Number buffers"        0 0 DF_BCD   0
46974>>>>>>>    send DefAttr DF_INDEX_TYPE              "DF_INDEX_TYPE"              ATTRTYPE_INDEX    "Type"                  1 0 DF_BCD   0
46975>>>>>>>    send DefAttr DF_INDEX_LEVELS            "DF_INDEX_LEVELS"            ATTRTYPE_INDEX    "Levels"                0 0 DF_BCD   0
46976>>>>>>>    send DefAttr DF_INDEX_KEY_LENGTH        "DF_INDEX_KEY_LENGTH"        ATTRTYPE_INDEX    "Key length"            0 0 DF_BCD   0
46977>>>>>>>
46977>>>>>>>    send DefAttr DF_INDEX_SEGMENT_DIRECTION "DF_INDEX_SEGMENT_DIRECTION" ATTRTYPE_IDXSEG   "Segment direction"     1 0 DF_BCD   0
46978>>>>>>>    send DefAttr DF_INDEX_SEGMENT_CASE      "DF_INDEX_SEGMENT_CASE"      ATTRTYPE_IDXSEG   "Segment case"          1 0 DF_BCD   0
46979>>>>>>>    send DefAttr DF_INDEX_SEGMENT_FIELD     "DF_INDEX_SEGMENT_FIELD"     ATTRTYPE_IDXSEG   "Segment field"         1 0 DF_BCD   0
46980>>>>>>>    function sAttrCodeValueText.is integer attr# string value# returns string
46983>>>>>>>      integer arr# row#
46983>>>>>>>      get piValueArray.i attr# to arr#
46984>>>>>>>      if arr# begin
46986>>>>>>>        get iValue2Row.i of arr# value# to row#
46987>>>>>>>        if row# eq -1 move "Unknown" to value#
46990>>>>>>>        else move (psCodeName.i(arr#,row#)) to value#
46992>>>>>>>      end
46992>>>>>>>>
46992>>>>>>>      function_return value#
46993>>>>>>>    end_function
46994>>>>>>>    function sAttrReadValueText.is integer attr# string value# returns string
46997>>>>>>>      integer arr# row#
46997>>>>>>>      get piValueArray.i attr# to arr#
46998>>>>>>>      if arr# begin
47000>>>>>>>        get iValue2Row.i of arr# value# to row#
47001>>>>>>>        if row# eq -1 move "Unknown" to value#
47004>>>>>>>        else move (psDisplayName.i(arr#,row#)) to value#
47006>>>>>>>      end
47006>>>>>>>>
47006>>>>>>>      function_return value#
47007>>>>>>>    end_function
47008>>>>>>>  end_object // oAPI_Attributes
47009>>>>>>>end_desktop_section
47014>>>>>>>
47014>>>>>>>function API_AttrType_Count global returns integer
47016>>>>>>>  function_return (row_count(oAPI_AttributeTypes(self)))
47017>>>>>>>end_function
47018>>>>>>>function API_AttrType_Name global integer type# returns string
47020>>>>>>>  function_return (psName.i(oAPI_AttributeTypes(self),type#))
47021>>>>>>>end_function
47022>>>>>>>function API_AttrType_Params global integer type# returns integer
47024>>>>>>>  function_return (piParams.i(oAPI_AttributeTypes(self),type#))
47025>>>>>>>end_function
47026>>>>>>>
47026>>>>>>>function API_Attr_Count global returns integer
47028>>>>>>>  function_return (row_count(oAPI_Attributes(self)))
47029>>>>>>>end_function
47030>>>>>>>function API_Attr_WriteAccess global integer attr# returns integer
47032>>>>>>>  function_return (piWrite.i(oAPI_Attributes(self),attr#))
47033>>>>>>>end_function
47034>>>>>>>function API_Attr_Name global integer attr# returns string
47036>>>>>>>  function_return (psName.i(oAPI_Attributes(self),attr#))
47037>>>>>>>end_function
47038>>>>>>>function API_Attr_DisplayName global integer attr# returns string
47040>>>>>>>  function_return (psDisplayName.i(oAPI_Attributes(self),attr#))
47041>>>>>>>end_function
47042>>>>>>>function API_Attr_ValueName global integer attr# string value# returns string
47044>>>>>>>  function_return (sAttrCodeValueText.is(oAPI_Attributes(self),attr#,value#))
47045>>>>>>>end_function
47046>>>>>>>function API_Attr_DisplayValueName global integer attr# string value# returns string
47048>>>>>>>  function_return (sAttrReadValueText.is(oAPI_Attributes(self),attr#,value#))
47049>>>>>>>end_function
47050>>>>>>>function API_Attr_NumberOfParams global integer attr# returns integer
47052>>>>>>>  function_return (API_AttrType_Params(piAttrType.i(oAPI_Attributes(self),attr#)))
47053>>>>>>>end_function
47054>>>>>>>function API_AttrType global integer attr# returns integer
47056>>>>>>>  function_return (piAttrType.i(oAPI_Attributes(self),attr#))
47057>>>>>>>end_function
47058>>>>>>>function API_AttrValueType global integer attr# returns integer
47060>>>>>>>  function_return (piValueType.i(oAPI_Attributes(self),attr#))
47061>>>>>>>end_function
47062>>>>>>>function API_AttrRuntimeOnly global integer attr# returns integer
47064>>>>>>>  function_return (piRuntimeOnly.i(oAPI_Attributes(self),attr#))
47065>>>>>>>end_function
47066>>>>>>>//> Is the attribute represented by a set of (symbolic) discrete values?
47066>>>>>>>function API_AttrDiscreteValues global integer attr# returns integer
47068>>>>>>>  function_return (piValueArray.i(oAPI_Attributes(self),attr#))
47069>>>>>>>end_function
47070>>>>>>>procedure API_AttrType_Callback global integer attrtype# integer msg# integer lhObj
47072>>>>>>>  send callback_attrtype.iii to (oAPI_Attributes(self)) attrtype# msg# lhObj
47073>>>>>>>end_procedure
47074>>>>>>>procedure API_AttrValue_Callback global integer attr# integer msg# integer lhObj
47076>>>>>>>  send callback_attrvalue.iii to (oAPI_Attributes(self)) attr# msg# lhObj
47077>>>>>>>end_procedure
47078>>>>>>>
47078>>>>>>>//> Returns true if Attribute queried is relevant to restructure
47078>>>>>>>//> oprations.
47078>>>>>>>function API_AttrWorksOnStructure global integer attr# returns integer
47080>>>>>>>  integer type#
47080>>>>>>>  get API_AttrType attr# to type#
47081>>>>>>>  if type# eq ATTRTYPE_FILE function_return 1
47084>>>>>>>  if type# eq ATTRTYPE_FIELD function_return 1
47087>>>>>>>  if type# eq ATTRTYPE_INDEX function_return 1
47090>>>>>>>  if type# eq ATTRTYPE_IDXSEG function_return 1
47093>>>>>>>  if type# eq ATTRTYPE_SPECIAL1 function_return 1
47096>>>>>>>  // function_return 0
47096>>>>>>>end_function
47097>>>>>>>
47097>>>>>>>function API_ShortFieldTypeName global integer type# returns string
47099>>>>>>>  if type# eq DF_ASCII   function_return "Asc"
47102>>>>>>>  if type# eq DF_BCD     function_return "Num"
47105>>>>>>>  if type# eq DF_DATE    function_return "Dat"
47108>>>>>>>  if type# eq DF_OVERLAP function_return "Ove"
47111>>>>>>>  if type# eq DF_TEXT    function_return "Tex"
47114>>>>>>>  if type# eq DF_BINARY  function_return "Bin"
47117>>>>>>>end_function
47118>>>>>>>
47118>>>>>>>function API_AttrValue_GLOBAL global integer attr# returns string
47120>>>>>>>  string rval#
47120>>>>>>>  if (API_AttrType(attr#)=ATTRTYPE_GLOBAL) get_attribute attr# to rval#
47125>>>>>>>  else begin
47126>>>>>>>    error 666 "Attribute queried is not of GLOBAL type"
47127>>>>>>>>
47127>>>>>>>    move "" to rval#
47128>>>>>>>  end
47128>>>>>>>>
47128>>>>>>>  function_return rval#
47129>>>>>>>end_function
47130>>>>>>>function API_AttrValue_FILELIST global integer attr# integer file# returns string
47132>>>>>>>  string rval#
47132>>>>>>>  if (API_AttrType(attr#)=ATTRTYPE_FILELIST) get_attribute attr# of file# to rval#
47137>>>>>>>  else begin
47138>>>>>>>    //send obs (API_Attr_Name(attr#)+" on file "+string(file#))
47138>>>>>>>    error 666 "Attribute queried is not of FILELIST type"
47139>>>>>>>>
47139>>>>>>>    move "" to rval#
47140>>>>>>>  end
47140>>>>>>>>
47140>>>>>>>  function_return rval#
47141>>>>>>>end_function
47142>>>>>>>function API_AttrValue_FILE global integer attr# integer file# returns string
47144>>>>>>>  string rval#
47144>>>>>>>  if (API_AttrType(attr#)=ATTRTYPE_FILE) get_attribute attr# of file# to rval#
47149>>>>>>>  else begin
47150>>>>>>>    //send obs (API_Attr_Name(attr#)+" on file "+string(file#))
47150>>>>>>>    error 666 ("Attribute queried is not of FILE type")
47151>>>>>>>>
47151>>>>>>>    move "" to rval#
47152>>>>>>>  end
47152>>>>>>>>
47152>>>>>>>  function_return rval#
47153>>>>>>>end_function
47154>>>>>>>function API_AttrValue_FIELD global integer attr# integer file# integer field# returns string
47156>>>>>>>  string rval#
47156>>>>>>>  if (API_AttrType(attr#)=ATTRTYPE_FIELD) get_attribute attr# of file# field# to rval#
47161>>>>>>>  else begin
47162>>>>>>>    error 666 "Attribute queried is not of FIELD type"
47163>>>>>>>>
47163>>>>>>>    move "" to rval#
47164>>>>>>>  end
47164>>>>>>>>
47164>>>>>>>  function_return rval#
47165>>>>>>>end_function
47166>>>>>>>function API_AttrValue_INDEX global integer attr# integer file# integer index# returns string
47168>>>>>>>  string rval# lsDriver
47168>>>>>>>  if (API_AttrType(attr#)=ATTRTYPE_INDEX) begin
47170>>>>>>>    get_attribute DF_FILE_DRIVER of file# to lsDriver
47173>>>>>>>    if lsDriver eq "ODBC_DRV" function_return ""
47176>>>>>>>    get_attribute attr# of file# index# to rval#
47179>>>>>>>  end
47179>>>>>>>>
47179>>>>>>>  else begin
47180>>>>>>>    error 666 "Attribute queried is not of INDEX type"
47181>>>>>>>>
47181>>>>>>>    move "" to rval#
47182>>>>>>>  end
47182>>>>>>>>
47182>>>>>>>  function_return rval#
47183>>>>>>>end_function
47184>>>>>>>function API_AttrValue_IDXSEG global integer attr# integer file# integer index# integer segment# returns string
47186>>>>>>>  string rval#
47186>>>>>>>  if (API_AttrType(attr#)=ATTRTYPE_IDXSEG) get_attribute attr# of file# index# segment# to rval#
47191>>>>>>>  else begin
47192>>>>>>>    error 666 "Attribute queried is not of IDXSEG type"
47193>>>>>>>>
47193>>>>>>>    move "" to rval#
47194>>>>>>>  end
47194>>>>>>>>
47194>>>>>>>  function_return rval#
47195>>>>>>>end_function
47196>>>>>>>function API_AttrValue_SPECIAL1 global integer attr# integer file# integer field1# integer field2# returns string
47198>>>>>>>  string rval#
47198>>>>>>>  if (API_AttrType(attr#)=ATTRTYPE_SPECIAL1) get_attribute attr# of file# field1# field2# to rval#
47203>>>>>>>  else begin
47204>>>>>>>    error 666 "Attribute queried is not of SPECIAL1 type"
47205>>>>>>>>
47205>>>>>>>    move "" to rval#
47206>>>>>>>  end
47206>>>>>>>>
47206>>>>>>>  function_return rval#
47207>>>>>>>end_function
47208>>>>>>>function API_AttrValue_FLSTNAV global integer attr# integer file# returns string
47210>>>>>>>  string rval#
47210>>>>>>>  if (API_AttrType(attr#)=ATTRTYPE_FLSTNAV) get_attribute attr# of file# to rval#
47215>>>>>>>  else begin
47216>>>>>>>    error 666 "Attribute queried is not of FLSTNAV type"
47217>>>>>>>>
47217>>>>>>>    move "" to rval#
47218>>>>>>>  end
47218>>>>>>>>
47218>>>>>>>  function_return rval#
47219>>>>>>>end_function
47220>>>>>>>function API_AttrValue_DRIVER global integer attr# integer driver# returns string
47222>>>>>>>  string rval#
47222>>>>>>>  if (API_AttrType(attr#)=ATTRTYPE_DRIVER) get_attribute attr# of driver# to rval#
47227>>>>>>>  else begin
47228>>>>>>>    error 666 "Attribute queried is not of DRIVER type"
47229>>>>>>>>
47229>>>>>>>    move "" to rval#
47230>>>>>>>  end
47230>>>>>>>>
47230>>>>>>>  function_return rval#
47231>>>>>>>end_function
47232>>>>>>>function API_AttrValue_DRVSRV global integer attr# integer driver# integer server# returns string
47234>>>>>>>  string rval#
47234>>>>>>>  if (API_AttrType(attr#)=ATTRTYPE_DRVSRV) get_attribute attr# of driver# server# to rval#
47239>>>>>>>  else begin
47240>>>>>>>    error 666 "Attribute queried is not of DRVSRV type"
47241>>>>>>>>
47241>>>>>>>    move "" to rval#
47242>>>>>>>  end
47242>>>>>>>>
47242>>>>>>>  function_return rval#
47243>>>>>>>end_function
47244>>>>>>>
47244>>>>>>>function API_FieldNameToNumber global integer file# string name# returns integer
47246>>>>>>>  integer max# field#
47246>>>>>>>  move (API_AttrValue_FILE(DF_FILE_NUMBER_FIELDS,file#)) to max#
47247>>>>>>>  for field# from 1 to max#
47253>>>>>>>>
47253>>>>>>>    if name# eq (API_AttrValue_FIELD(DF_FIELD_NAME,file#,field#)) function_return field#
47256>>>>>>>  loop
47257>>>>>>>>
47257>>>>>>>  //function_return 0
47257>>>>>>>end_function
47258>>>>>>>
47258>>>>>>>desktop_section // Compile as if on desktop
47263>>>>>>>  object oFilesThatCanBeOpened is a cArray NO_IMAGE
47265>>>>>>>    property integer piValidContents public 0
47267>>>>>>>    procedure reset
47270>>>>>>>      set piValidContents to false
47271>>>>>>>      send delete_data
47272>>>>>>>    end_procedure
47273>>>>>>>    procedure RegisterValidEntries
47276>>>>>>>      integer file#
47276>>>>>>>      send reset
47277>>>>>>>      move 0 to file#
47278>>>>>>>      repeat
47278>>>>>>>>
47278>>>>>>>        move (API_AttrValue_FLSTNAV(DF_FILE_NEXT_USED,file#)) to file#
47279>>>>>>>        if file# set value item file# to (DBMS_CanOpenFile(file#))
47282>>>>>>>      until (not(file#))
47284>>>>>>>      set piValidContents to true
47285>>>>>>>    end_procedure
47286>>>>>>>    function iNextFileThatCanOpen integer file# returns integer
47289>>>>>>>      integer itm# max#
47289>>>>>>>      ifnot (piValidContents(self)) send RegisterValidEntries
47292>>>>>>>      get item_count to max#
47293>>>>>>>      move (file#+1) to itm#
47294>>>>>>>      while itm# lt max#
47298>>>>>>>        if (value(self,itm#)) ne 0 function_return itm#
47301>>>>>>>        increment itm#
47302>>>>>>>      end
47303>>>>>>>>
47303>>>>>>>      //function_return 0
47303>>>>>>>    end_function
47304>>>>>>>  end_object // oFilesThatCanBeOpened
47305>>>>>>>end_desktop_section
47310>>>>>>>
47310>>>>>>>function API_NextFileThatCanOpen global integer liFile returns integer
47312>>>>>>>  function_return (iNextFileThatCanOpen(oFilesThatCanBeOpened(self),liFile))
47313>>>>>>>end_function
47314>>>>>>>procedure API_ResetListOfFilesThatCanOpen global
47316>>>>>>>  send reset to (oFilesThatCanBeOpened(self))
47317>>>>>>>end_procedure
47318>>>>>>>
47318>>>>>>>function API_OtherAttr_Value global integer liScAttr returns string
47320>>>>>>>  string lsRval lsValue
47320>>>>>>>  if liScAttr eq OA_DIR_SEPARATOR    function_return (SysConf(SYSCONF_DIR_SEPARATOR))
47323>>>>>>>  if liScAttr eq OA_TIMER_RESOLUTION function_return (SysConf(SYSCONF_TIMER_RESOLUTION))
47326>>>>>>>  if liScAttr eq OA_OS_SHORT_NAME    function_return (SysConf(SYSCONF_OS_SHORT_NAME))
47329>>>>>>>  if liScAttr eq OA_OS_MAJOR_REV     function_return (SysConf(SYSCONF_OS_MAJOR_REV))
47332>>>>>>>  if liScAttr eq OA_OS_MINOR_REV     function_return (SysConf(SYSCONF_OS_MINOR_REV))
47335>>>>>>>  if liScAttr eq OA_OS_NAME          function_return (SysConf(SYSCONF_OS_NAME))
47338>>>>>>>  if liScAttr eq OA_MACHINE_NAME     function_return (SysConf(SYSCONF_MACHINE_NAME))
47341>>>>>>>  if liScAttr eq OA_FILE_MASK        function_return (SysConf(SYSCONF_FILE_MASK))
47344>>>>>>>  if liScAttr eq OA_DATAFLEX_REV     function_return (SysConf(SYSCONF_DATAFLEX_REV))
47347>>>>>>>  if liScAttr eq OA_SYSTEM_NAME      function_return (SysConf(SYSCONF_SYSTEM_NAME))
47350>>>>>>>  if liScAttr eq OA_PATH_SEPARATOR   function_return (SysConf(SYSCONF_PATH_SEPARATOR))
47353>>>>>>>  if liScAttr eq OA_SERIAL_NUMBER    registration lsValue lsRval
47356>>>>>>>  if liScAttr eq OA_REG_NAME         registration lsRval lsValue
47359>>>>>>>  if liScAttr eq OA_WORKDIR          begin
47361>>>>>>>    get_current_directory to lsRval
47362>>>>>>>    move (ToOem(lsRval)) to lsRval
47363>>>>>>>  end
47363>>>>>>>>
47363>>>>>>>  if liScAttr eq OA_PATH             begin
47365>>>>>>>    get_environment "PATH" to lsRval
47366>>>>>>>>
47366>>>>>>>    move (ToOem(lsRval)) to lsRval
47367>>>>>>>  end
47367>>>>>>>>
47367>>>>>>>  if liScAttr eq OA_MAX_USERS        get_licensed_max_users to lsRval
47370>>>>>>>  if liScAttr eq OA_DATE4_STATE      get_date_attribute DATE4_STATE to lsRval
47373>>>>>>>  if liScAttr eq OA_SYSDATE4_STATE   get_date_attribute SYSDATE4_STATE to lsRval
47376>>>>>>>  if liScAttr eq OA_EPOCH_VALUE      get_date_attribute EPOCH_VALUE to lsRval
47379>>>>>>>  //if liScAttr eq OA_COLLATE_PATH move (SEQ_FindFileAlongDFPath("collate.cfg")) to lsRval
47379>>>>>>>  if liScAttr eq OA_COLLATE_PATH begin
47381>>>>>>>    get_profile_string "defaults" "VDFRootDir" to lsRval
47384>>>>>>>    get SEQ_ComposeAbsoluteFileName lsRval "\bin\" to lsRval
47385>>>>>>>    if (SEQ_FileExists(lsRval+"\collate.cfg")=SEQIT_FILE) function_return lsRval
47388>>>>>>>    move (SEQ_FindFileAlongPath(API_OtherAttr_Value(OA_PATH),"collate.cfg")) to lsRval
47389>>>>>>>  end
47389>>>>>>>>
47389>>>>>>>  if liScAttr eq OA_COLLATE_SIZE move (SEQ_FileSize(SEQ_ComposeAbsoluteFileName(API_OtherAttr_Value(OA_COLLATE_PATH),"collate.cfg"))) to lsRval
47392>>>>>>>  if liScAttr eq OA_COLLATE_TIME move (SEQ_FileModTime(SEQ_ComposeAbsoluteFileName(API_OtherAttr_Value(OA_COLLATE_PATH),"collate.cfg"))) to lsRval
47395>>>>>>>    if liScAttr eq OA_RUNTIME_NAME    function_return (ToOem(SysConf(SYSCONF_RUNTIME_NAME)))
47398>>>>>>>    if liScAttr eq OA_UTC_TIME_OFFSET function_return (SysConf(SYSCONF_UTC_TIME_OFFSET))
47401>>>>>>>  if liScAttr eq OA_MAX_ARGUMENT_SIZE get_argument_size to lsRval
47404>>>>>>>  if liScAttr eq OA_CURRENT_USER_COUNT move -1 to lsRval //get_current_user_count to lsRval
47407>>>>>>>  if liScAttr eq OA_DFPRINTER get_environment "DFPRINTER" to lsRval
47410>>>>>>>  if liScAttr eq OA_LOCK_COUNT get_current_lockcount to lsRval
47413>>>>>>>
47413>>>>>>>
47413>>>>>>>  if liScAttr eq OA_FOLDER_FILELIST  get AppFolder APPFOLDER_FILELIST to lsRval
47416>>>>>>>  if liScAttr eq OA_FOLDER_PROGRAM   get AppFolder APPFOLDER_PROGRAM  to lsRval
47419>>>>>>>  if liScAttr eq OA_FOLDER_HTML      get AppFolder APPFOLDER_HTML     to lsRval
47422>>>>>>>  if liScAttr eq OA_FOLDER_VDF_ROOT  get AppFolder APPFOLDER_VDF_ROOT to lsRval
47425>>>>>>>  function_return lsRval
47426>>>>>>>end_function // API_OtherAttr_Value
47427>>>>>>>function OtherAttr_ValueDisplayName global integer liScAttr string lsValue returns string
47429>>>>>>>  if liScAttr eq OA_DIR_SEPARATOR     function_return lsValue
47432>>>>>>>  if liScAttr eq OA_TIMER_RESOLUTION  function_return lsValue
47435>>>>>>>  if liScAttr eq OA_OS_SHORT_NAME     function_return lsValue
47438>>>>>>>  if liScAttr eq OA_OS_MAJOR_REV      function_return lsValue
47441>>>>>>>  if liScAttr eq OA_OS_MINOR_REV      function_return lsValue
47444>>>>>>>  if liScAttr eq OA_OS_NAME           function_return lsValue
47447>>>>>>>  if liScAttr eq OA_MACHINE_NAME      function_return lsValue
47450>>>>>>>  if liScAttr eq OA_FILE_MASK         function_return lsValue
47453>>>>>>>  if liScAttr eq OA_DATAFLEX_REV      function_return lsValue
47456>>>>>>>  if liScAttr eq OA_SYSTEM_NAME       function_return lsValue
47459>>>>>>>  if liScAttr eq OA_PATH_SEPARATOR    function_return lsValue
47462>>>>>>>  if liScAttr eq OA_SERIAL_NUMBER     function_return lsValue
47465>>>>>>>  if liScAttr eq OA_REG_NAME          function_return lsValue
47468>>>>>>>  if liScAttr eq OA_WORKDIR           function_return lsValue
47471>>>>>>>  if liScAttr eq OA_PATH              function_return lsValue
47474>>>>>>>  if liScAttr eq OA_MAX_USERS         function_return lsValue
47477>>>>>>>  if liScAttr eq OA_DATE4_STATE       function_return (if(integer(lsValue),"True","False"))
47480>>>>>>>  if liScAttr eq OA_SYSDATE4_STATE    function_return (if(integer(lsValue),"True","False"))
47483>>>>>>>  if liScAttr eq OA_EPOCH_VALUE       function_return lsValue
47486>>>>>>>  if liScAttr eq OA_COLLATE_PATH      function_return lsValue
47489>>>>>>>  if liScAttr eq OA_COLLATE_SIZE      function_return (lsValue+" bytes")
47492>>>>>>>  if liScAttr eq OA_COLLATE_TIME      function_return (TS_ConvertToString(lsValue))
47495>>>>>>>  if liScAttr eq OA_RUNTIME_NAME      function_return lsValue
47498>>>>>>>  if liScAttr eq OA_UTC_TIME_OFFSET   function_return (TS_ExtractTime(lsValue))
47501>>>>>>>  if liScAttr eq OA_MAX_ARGUMENT_SIZE  function_return lsValue
47504>>>>>>>  if liScAttr eq OA_CURRENT_USER_COUNT function_return lsValue
47507>>>>>>>  if liScAttr eq OA_DFPRINTER         function_return lsValue
47510>>>>>>>  if liScAttr eq OA_LOCK_COUNT        function_return lsValue
47513>>>>>>>  if liScAttr eq OA_FOLDER_HTML       function_return lsValue
47516>>>>>>>  if liScAttr eq OA_FOLDER_FILELIST   function_return lsValue
47519>>>>>>>  if liScAttr eq OA_FOLDER_PROGRAM    function_return lsValue
47522>>>>>>>  if liScAttr eq OA_FOLDER_VDF_ROOT   function_return lsValue
47525>>>>>>>end_function
47526>>>>>>>function OtherAttr_DisplayName global integer liScAttr returns string
47528>>>>>>>  if liScAttr eq OA_DIR_SEPARATOR     function_return "Dir separator"
47531>>>>>>>  if liScAttr eq OA_TIMER_RESOLUTION  function_return "Timer resolution"
47534>>>>>>>  if liScAttr eq OA_OS_SHORT_NAME     function_return "OS short name"
47537>>>>>>>  if liScAttr eq OA_OS_MAJOR_REV      function_return "OS major rev."
47540>>>>>>>  if liScAttr eq OA_OS_MINOR_REV      function_return "OS minor rev."
47543>>>>>>>  if liScAttr eq OA_OS_NAME           function_return "OS name"
47546>>>>>>>  if liScAttr eq OA_MACHINE_NAME      function_return "Machine name"
47549>>>>>>>  if liScAttr eq OA_FILE_MASK         function_return "File mask"
47552>>>>>>>  if liScAttr eq OA_DATAFLEX_REV      function_return "DF revision"
47555>>>>>>>  if liScAttr eq OA_SYSTEM_NAME       function_return "System name"
47558>>>>>>>  if liScAttr eq OA_PATH_SEPARATOR    function_return "Path separator"
47561>>>>>>>  if liScAttr eq OA_SERIAL_NUMBER     function_return "Serial number"
47564>>>>>>>  if liScAttr eq OA_REG_NAME          function_return "Registration name"
47567>>>>>>>  if liScAttr eq OA_WORKDIR           function_return "Working dir."
47570>>>>>>>  if liScAttr eq OA_PATH              function_return "Search path"
47573>>>>>>>  if liScAttr eq OA_MAX_USERS         function_return "Max. users"
47576>>>>>>>  if liScAttr eq OA_DATE4_STATE       function_return "Date4 state"
47579>>>>>>>  if liScAttr eq OA_SYSDATE4_STATE    function_return "Sysdate4 state"
47582>>>>>>>  if liScAttr eq OA_EPOCH_VALUE       function_return "Epoch value"
47585>>>>>>>  if liScAttr eq OA_COLLATE_PATH      function_return "Collate file"
47588>>>>>>>  if liScAttr eq OA_COLLATE_SIZE      function_return "Collate size"
47591>>>>>>>  if liScAttr eq OA_COLLATE_TIME      function_return "Collate timestamp"
47594>>>>>>>  if liScAttr eq OA_RUNTIME_NAME      function_return "Module path & name"
47597>>>>>>>  if liScAttr eq OA_UTC_TIME_OFFSET   function_return "Seconds from Meridian"
47600>>>>>>>  if liScAttr eq OA_MAX_ARGUMENT_SIZE function_return "Max string size"
47603>>>>>>>  if liScAttr eq OA_CURRENT_USER_COUNT function_return "Current user count"
47606>>>>>>>  if liScAttr eq OA_DFPRINTER         function_return "Default printer (DF3.2)"
47609>>>>>>>  if liScAttr eq OA_LOCK_COUNT        function_return "Current lock count"
47612>>>>>>>  if liScAttr eq OA_FOLDER_HTML       function_return "HTML folder"
47615>>>>>>>  if liScAttr eq OA_FOLDER_FILELIST   function_return "Filelist folder"
47618>>>>>>>  if liScAttr eq OA_FOLDER_PROGRAM    function_return "Programs folder"
47621>>>>>>>  if liScAttr eq OA_FOLDER_VDF_ROOT   function_return "VDF root folder"
47624>>>>>>>end_function
47625>>>>>>>
47625>>>>>>>procedure API_OtherAttributes_CallBack global integer lhMsg integer lhObj
47627>>>>>>>  integer liAttr
47627>>>>>>>  for liAttr from 0 to (OA_MAX-1)
47633>>>>>>>>
47633>>>>>>>    send lhMsg to lhObj (OtherAttr_DisplayName(liAttr)) (OtherAttr_ValueDisplayName(liAttr,API_OtherAttr_Value(liAttr)))
47634>>>>>>>  loop
47635>>>>>>>>
47635>>>>>>>end_procedure
47636>>>
47636>>>   define t.TbBtn.Bgn.Tip      for "Beginning of file"
47636>>>   define t.TbBtn.Bgn.StHlp    for "Find the First record (Ctrl+Home)"
47636>>>   define t.TbBtn.Prev.Tip     for "Find Previous"
47636>>>   define t.TbBtn.Prev.StHlp   for "Find the Previous record (F7)"
47636>>>   define t.TbBtn.Next.Tip     for "Find Next"
47636>>>   define t.TbBtn.Next.StHlp   for "Find the Next record (F8)"
47636>>>   define t.TbBtn.End.Tip      for "End of File"
47636>>>   define t.TbBtn.End.StHlp    for "Find the Last record (Ctrl+End)"
47636>>>   define t.TbBtn.Prompt.Tip   for "Prompt"
47636>>>   define t.TbBtn.Prompt.StHlp for "Show available selections (F4)"
47636>>>   define t.TbBtn.Print.Tip    for "Print"
47636>>>   define t.TbBtn.Print.StHlp  for "Print report (Shift+F4)"
47636>>>   define t.TbBtn.Clear.Tip    for "Clear"
47636>>>   define t.TbBtn.Clear.StHlp  for "Clear current record / Add a new record (F5)"
47636>>>   define t.TbBtn.ClearA.Tip   for "Clear All"
47636>>>   define t.TbBtn.ClearA.StHlp for "Clear all data from view (Ctrl+F5)"
47636>>>   define t.TbBtn.Save.Tip     for "Save"
47636>>>   define t.TbBtn.Save.StHlp   for "Save the current record (F2)"
47636>>>   define t.TbBtn.Del.Tip      for "Delete"
47636>>>   define t.TbBtn.Del.StHlp    for "Delete the current record (Shift+F2)"
47636>>>   define t.TbBtn.Cut.Tip      for "Cut"
47636>>>   define t.TbBtn.Cut.StHlp    for "Cuts the selection and puts it on the Clipboard"
47636>>>   define t.TbBtn.Copy.Tip     for "Copy"
47636>>>   define t.TbBtn.Copy.StHlp   for "Copies the selection and puts it on the Clipboard"
47636>>>   define t.TbBtn.Paste.Tip    for "Paste"
47636>>>   define t.TbBtn.Paste.StHlp  for "Inserts Clipboard contents"
47636>>>   define t.LnkVw.NotDefined   for "Linked view not defined for '#'"
47636>>>   define t.LnkVw.ToolTip      for "Jump to linked view"
47636>>>   define t.LnkVw.StatusHelp   for "Jumps to linked view (Ctrl+O)"
47636>>>   define t.LnkVw.DoesNotExist for "Linked view does not exist (#)"
47636>>>
47636>>>// Return the object ID of the prompt list attached to obj#, if any:
47636>>>function iDDPrompt_Object global integer obj# returns integer
47638>>>  integer dm# svr# file# fld# rval#
47638>>>  get delegation_mode of obj# to dm#
47639>>>  set delegation_mode of obj# to no_delegate_or_error
47640>>>  get data_file  of obj# item CURRENT to file#
47641>>>  get data_field of obj# item CURRENT to fld#
47642>>>  set delegation_mode of obj# to dm#
47643>>>  if (file#*fld#) begin
47645>>>    get server of obj# to svr#
47646>>>    if svr# begin
47648>>>      if (main_file(svr#)<>file#) get which_data_set of svr# file# to svr#
47651>>>      if svr# begin // This way we will not error if we are dealing a data_set
47653>>>        get delegation_mode of svr# to dm#
47654>>>        set delegation_mode of svr# to no_delegate_or_error
47655>>>        get field_prompt_object of svr# fld# to rval#
47656>>>        set delegation_mode of svr# to dm#
47657>>>      end
47657>>>>
47657>>>    end
47657>>>>
47657>>>  end
47657>>>>
47657>>>  function_return rval#
47658>>>end_function
47659>>>
47659>>>class cAvailableFileObjects is an array
47660>>>  // An object of this class is meant to hold an object and a corresponding
47660>>>  // access method per file in filelist.cfg. These objects are added to the
47660>>>  // list via the add_data_file_object message.
47660>>>
47660>>>  procedure construct_object
47662>>>    forward send construct_object
47664>>>    property string pErrMsgNotAvail public ""
47665>>>  end_procedure
47666>>>
47666>>>  procedure add_data_file_object integer file# integer msg# integer tmp_obj#
47668>>>    integer obj#
47668>>>    if num_arguments gt 1 move tmp_obj# to obj#
47671>>>    else move 0 to obj#
47673>>>    set value item (file#*2)   to obj#
47674>>>    set value item (file#*2+1) to msg#
47675>>>  end_procedure
47676>>>
47676>>>  procedure exec_data_file_object integer file#
47678>>>    integer obj# msg#
47678>>>    string str# err#
47678>>>    get value item (file#*2)   to obj#
47679>>>    get value item (file#*2+1) to msg#
47680>>>    if msg# begin
47682>>>      if obj# send msg# to obj#
47685>>>      else send msg#
47687>>>    end
47687>>>>
47687>>>    else begin
47688>>>      get File_Display_Name file# to str#
47689>>>      get pErrMsgNotAvail to err#
47690>>>      send Info_Box (replace("#",err#,str#))
47691>>>    end
47691>>>>
47691>>>  end_procedure
47692>>>
47692>>>  function exists_data_file_object integer file# returns integer
47694>>>    function_return (integer(value(self,file#*2+1)))
47695>>>  end_function
47696>>>end_class // cAvailableFileObjects
47697>>>
47697>>>object oAvailableFileViews is a cAvailableFileObjects
47699>>>  set pErrMsgNotAvail to t.LnkVw.NotDefined
47700>>>end_object
47701>>>
47701>>>procedure Add_LinkView_File for BaseClass integer file# integer msg# integer tmp_obj#
47703>>>  integer obj#
47703>>>  if num_arguments gt 2 move tmp_obj# to obj#
47706>>>  else move self to obj#
47708>>>  send add_data_file_object to (oAvailableFileViews(self)) file# msg# obj#
47709>>>end_procedure
47710>>>
47710>>>register_function iLinkViewFile integer itm# returns integer
47710>>>procedure Activate_LinkView for BaseClass
47712>>>  integer file# dm# obj# itm#
47712>>>  move (focus(desktop)) to obj# // Which object has the focus?
47713>>>  if obj# gt desktop begin
47715>>>    get delegation_mode of obj# to dm# // Make sure that the object does not make
47716>>>    set delegation_mode of obj# to no_delegate_or_error // noise when asked below.
47717>>>    get current_item of obj# to itm#
47718>>>    get iLinkViewFile of obj# itm# to file#
47719>>>    ifnot file# get data_file of obj# item itm# to file# // Get 'filenumber'
47722>>>    set delegation_mode of obj# to dm# // Restore delegation mode.
47723>>>    send exec_data_file_object to (oAvailableFileViews(self)) file#
47724>>>  end
47724>>>>
47724>>>end_procedure
47725>>>
47725>>>procedure Activate_LinkView_File integer file#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
47727>>>  send exec_data_file_object to (oAvailableFileViews(self)) file#
47728>>>end_procedure
47729>>>
47729>>>function Exists_LinkView returns integer
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
47731>>>  integer rval# file# dm# obj# itm#
47731>>>  move (focus(desktop)) to obj# // Which object has the focus?
47732>>>  if obj# gt desktop begin
47734>>>    get delegation_mode of obj# to dm# // Make sure that the object does not make
47735>>>    set delegation_mode of obj# to no_delegate_or_error // noise when asked below.
47736>>>    get current_item of obj# to itm#
47737>>>    get iLinkViewFile of obj# itm# to file#
47738>>>    ifnot file# get data_file of obj# item current to file# // Get 'filenumber'
47741>>>    set delegation_mode of obj# to dm# // Restore delegation mode.
47742>>>    get exists_data_file_object of (oAvailableFileViews(self)) file# to rval#
47743>>>  end
47743>>>>
47743>>>  function_return rval#
47744>>>end_function
47745>>>
47745>>>function Exists_LinkView_File integer file# returns integer
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
47747>>>  integer rval#
47747>>>  get exists_data_file_object of (oAvailableFileViews(self)) file# to rval#
47748>>>  function_return rval#
47749>>>end_function
47750>>>
47750>>>procedure Add_LinkView_tbButton integer oTb#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
47752>>>  send Add_Toolbar_Button_Bitmap to oTb# "tbvwlnsm.bmp" t.LnkVw.ToolTip t.LnkVw.StatusHelp msg_Activate_LinkView
47753>>>end_procedure
47754>>>
47754>>>// For backwards compatibility:
47754>>>
47754>>>// If automatic promptlists (AutoPrmpt.utl) has been used prior to this package
47754>>>// we hook up on to it:
47754>>>
47754>>>integer oToolBar#
47754>>>move 0 to oToolBar#
47755>>>
47755>>> Class cSturesToolBar is a ToolBar
47756>>>  Procedure construct_object
47758>>>    forward send construct_object
47760>>>    ifnot oToolBar# move self to oToolBar#
47763>>>    property integer pImageList_Item_Count public 0
47764>>>    property integer pAutoShadow_State public 1
47765>>>//    Set default_icons to (IDB_STANDARD IOR IDB_VIEW IOR IDB_LARGE)
47765>>>    Send ImageList_Add 'bgn.bmp'   // 0
47766>>>    Send ImageList_Add 'end.bmp'   // 1
47767>>>    Send ImageList_Add 'next.bmp'  // 2
47768>>>    Send ImageList_Add 'prev.bmp'  // 3
47769>>>    Send ImageList_Add 'clr.bmp'   // 4
47770>>>    Send ImageList_Add 'clra.bmp'  // 5
47771>>>  End_Procedure
47772>>>
47772>>>  Procedure end_construct_object
47774>>>    forward send end_construct_object
47776>>>    ifnot (item_count(self)) send Add_Standard_Toolbar_Buttons
47779>>>    send Update_Toolbar_Shadow_States
47780>>>  End_Procedure
47781>>>
47781>>>  Procedure ImageList_Add string bmp_fn#
47783>>>    forward send ImageList_Add bmp_fn#
47785>>>    set pImageList_Item_Count to (pImageList_Item_Count(self)+1)
47786>>>  End_Procedure
47787>>>
47787>>>  Procedure Add_Toolbar_Button integer ico# string Tip# string StHlp# integer msg# integer obj#
47789>>>    if num_arguments gt 4 send Add_button ico# msg# obj#
47792>>>    else                  send Add_button ico# msg#
47794>>>    send Add_ToolTip Tip#
47795>>>    set  Status_Help To StHlp#
47796>>>  End_Procedure
47797>>>
47797>>>  // If a "normal" prompt list object we send message prompt to the object.
47797>>>  // Otherwise we attempt to popup the default selection list.
47797>>>  register_procedure Request_Popup_DefaultPromptList
47797>>>  procedure Extended_Prompt
47799>>>    integer NormalPrompt# foc# obj#
47799>>>    move (focus(desktop)) to foc#
47800>>>    get iDDPrompt_Object foc# to NormalPrompt#
47801>>>    if NormalPrompt# send prompt to foc#
47804>>>    else send Request_Popup_DefaultPromptList
47806>>>  end_procedure
47807>>>
47807>>>  Procedure Print_Report
47809>>>    send Print_Report to (focus(desktop))
47810>>>  End_Procedure
47811>>>
47811>>>  Procedure Add_Toolbar_Button_Bitmap string bmp# string Tip# string StHlp# integer msg# integer obj#
47813>>>    integer ico#
47813>>>    send ImageList_Add bmp#
47814>>>    move (ICO_USER+pImageList_Item_Count(self)-1) to ico#
47815>>>    if num_arguments gt 4 send Add_Toolbar_Button ico# Tip# StHlp# msg# obj#
47818>>>    else                  send Add_Toolbar_Button ico# Tip# StHlp# msg#
47820>>>  End_Procedure
47821>>>
47821>>>  Procedure Add_Print_Button
47823>>>    send Add_Toolbar_Button ICO_STD_PRINT t.TbBtn.Print.Tip t.TbBtn.Print.StHlp  msg_Print_Report self
47824>>>  End_Procedure
47825>>>
47825>>>  // This procedure adds the standard tool bar buttons.
47825>>>  Procedure Add_Standard_Toolbar_Buttons
47827>>>    send Add_Space
47828>>>    send Add_Toolbar_Button (ICO_USER+0)     t.TbBtn.Bgn.Tip    t.TbBtn.Bgn.StHlp     msg_Beginning_Of_Data
47829>>>    send Add_Toolbar_Button (ICO_USER+3)     t.TbBtn.Prev.Tip   t.TbBtn.Prev.StHlp    msg_Find_Previous
47830>>>    send Add_Toolbar_Button (ICO_USER+2)     t.TbBtn.Next.Tip   t.TbBtn.Next.StHlp    msg_Find_Next
47831>>>    send Add_Toolbar_Button (ICO_USER+1)     t.TbBtn.End.Tip    t.TbBtn.End.StHlp     msg_End_Of_Data
47832>>>    send Add_Space
47833>>>    send Add_Toolbar_Button ICO_STD_FIND     t.TbBtn.Prompt.Tip t.TbBtn.Prompt.StHlp  msg_Extended_Prompt self
47834>>>    send Add_Toolbar_Button (ICO_USER+4)     t.TbBtn.Clear.Tip  t.TbBtn.Clear.StHlp   msg_Request_Clear
47835>>>    send Add_Toolbar_Button (ICO_USER+5)     t.TbBtn.ClearA.Tip t.TbBtn.ClearA.StHlp  msg_Request_Clear_All
47836>>>    send Add_Space
47837>>>    send Add_Toolbar_Button ICO_STD_FILESAVE t.TbBtn.Save.Tip   t.TbBtn.Save.StHlp    msg_Request_Save
47838>>>    send Add_Toolbar_Button ICO_STD_DELETE   t.TbBtn.Del.Tip    t.TbBtn.Del.StHlp     msg_Request_Delete
47839>>>    send Add_Space
47840>>>    send Add_Toolbar_Button ICO_STD_CUT      t.TbBtn.Cut.Tip    t.TbBtn.Cut.StHlp     msg_Cut
47841>>>    send Add_Toolbar_Button ICO_STD_COPY     t.TbBtn.Copy.Tip   t.TbBtn.Copy.StHlp    msg_Copy
47842>>>    send Add_Toolbar_Button ICO_STD_PASTE    t.TbBtn.Paste.Tip  t.TbBtn.Paste.StHlp   msg_Paste
47843>>>  End_Procedure
47844>>>End_Class
47845>>>
47845>>>
47845>>>register_function iAllowRequestFind returns integer
47845>>>register_function iDisAllowRequestFind returns integer
47845>>>function iFieldOptions.i integer obj# returns integer
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
47847>>>  integer rval# dm# file# fld# tmp# svr# findok# not_findok#
47847>>>  integer link_to_file#
47847>>>  get delegation_mode of obj# to dm#
47848>>>  set delegation_mode of obj# to no_delegate_or_error
47849>>>  get data_file of obj# item CURRENT to file#
47850>>>  get iLinkViewFile of obj# item CURRENT to link_to_file#
47851>>>  get data_field of obj# item CURRENT to fld#
47852>>>  get iAllowRequestFind of obj# to findok#
47853>>>  get iDisAllowRequestFind of obj# to not_findok#
47854>>>  move 0 to rval#
47855>>>  get form_datatype of obj# item CURRENT to tmp#
47856>>>  move (tmp#=DATE_WINDOW) to tmp#
47857>>>  if tmp# move (rval#+FLDOPT_DATE) to rval#
47860>>>  if (file#*fld#) begin
47862>>>    if (integer(API_AttrValue_FILE(DF_FILE_OPENED,file#))) begin
47864>>>      ifnot not_findok# ifnot findok# get_attribute DF_FIELD_INDEX of file# fld# to findok#
47871>>>      if (should_save(obj#)) move (rval#+FLDOPT_SAVE) to rval#
47874>>>      get server of obj# to svr#
47875>>>      if svr# move (current_record(svr#)) to tmp#
47878>>>      if tmp# move (rval#+FLDOPT_DELETE) to rval#
47881>>>      if link_to_file# get Exists_LinkView_File link_to_file# to tmp#
47884>>>      else get Exists_LinkView_File file# to tmp#
47886>>>      if tmp# move (rval#+FLDOPT_LINKVW) to rval#
47889>>>    end
47889>>>>
47889>>>  end
47889>>>>
47889>>>  if findok# move (rval#+FLDOPT_FIND) to rval#
47892>>>  set delegation_mode of obj# to dm#
47893>>>  function_return rval#
47894>>>end_function
47895>>>
47895>>>register_procedure Request_Popup_Calendar
47895>>>
47895>>>Procedure Update_Toolbar_Shadow_States
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
47897>>>  integer foc# itm# max# msg# opt#
47897>>>  if oToolBar# begin
47899>>>    if (pAutoShadow_State(oToolBar#)) begin
47901>>>      move (focus(desktop)) to foc#
47902>>>      if foc# gt desktop get iFieldOptions.i foc# to opt#
47905>>>      get item_count of oToolBar# to max#
47906>>>      for itm# from 0 to (max#-1)
47912>>>>
47912>>>        get message of oToolBar# item itm# to msg#
47913>>>        if (msg#=msg_beginning_of_data or msg#=msg_find_previous or msg#=msg_find_next or msg#=msg_end_of_data) set shadow_state of oToolBar# item itm# to (not(opt# iAND FLDOPT_FIND))
47916>>>      //if (msg#=msg_Request_Save)           set shadow_state of oToolBar# item itm# to (not(opt# iAND FLDOPT_SAVE))
47916>>>      //if (msg#=msg_Request_Clear)          set shadow_state of oToolBar# item itm# to (not((opt# iAND FLDOPT_SAVE) or (opt# iAND FLDOPT_DELETE)))
47916>>>      //if (msg#=msg_Request_Delete)         set shadow_state of oToolBar# item itm# to (not(opt# iAND FLDOPT_DELETE))
47916>>>        if (msg#=msg_Request_Popup_Calendar) set shadow_state of oToolBar# item itm# to (not(opt# iAND FLDOPT_DATE))
47919>>>        if (msg#=msg_Activate_LinkView)      set shadow_state of oToolBar# item itm# to (not(opt# iAND FLDOPT_LINKVW))
47922>>>      loop
47923>>>>
47923>>>    end
47923>>>>
47923>>>  end
47923>>>>
47923>>>End_Procedure
47924>>>
47924>>>Class cSturesStatusBar is a StatusBar
47925>>>  Procedure Show_Status_Help string str#
47927>>>    forward send Show_Status_Help str#
47929>>>    send Update_Toolbar_Shadow_States
47930>>>  End_Procedure
47931>>>End_Class
47932>>>
47932>>>class cViewPopupMenu is a ViewPopupMenu
47933>>>  procedure construct_object
47935>>>    forward send construct_object
47937>>>    property string pTitle       public ""
47938>>>    property string pStatus_Help public ""
47939>>>  end_procedure
47940>>>  procedure end_construct_object
47942>>>    integer itm# self#
47942>>>    string title# status_help#
47942>>>    get pTitle to title#
47943>>>    get pStatus_Help to status_help#
47944>>>    forward send end_construct_object
47946>>>    move self to self#
47947>>>    delegate send add_item 0 title# // 0 betyder aktiver child menu
47949>>>    get item_count of (parent(self)) to itm#
47950>>>    set aux_value of (parent(self)) item (itm#-1) to self#
47951>>>    set status_help of (parent(self)) item (itm#-1) to status_help#
47952>>>  end_procedure
47953>>>  function Message integer itm# returns integer
47955>>>     integer rVal#
47955>>>     Forward Get message item itm# to rVal#
47957>>>     // Apparantly global messages cannot be represented via the add_item
47957>>>     // message. Therefore we have to do this:
47957>>>     if rval# gt 10000 move (rval#-65536) to rval#
47960>>>     function_return rval#
47961>>>  end_function
47962>>>  procedure add_menu_item integer msg# string label# string status_help# integer tmp_aux#
47964>>>    integer aux#
47964>>>    if num_arguments begin
47966>>>      send add_item msg# label#
47967>>>      if num_arguments gt 3 move tmp_aux# to aux#
47970>>>      else move -1 to aux# // -1 will automatically get replaced with client_id
47972>>>      set aux_value item (item_count(self)-1) to aux#
47973>>>      set status_help item (item_count(self)-1) to status_help#
47974>>>    end
47974>>>>
47974>>>    else send add_item msg_none ""
47976>>>  end_procedure
47977>>>  procedure add_standard_menu_items
47979>>>  end_procedure
47980>>>end_class
47981>Use OpenStat.nui // cTablesOpenStatus class (formely cFileAllFiles)
Including file: openstat.nui    (C:\projects\BRS\VDFQuery\AppSrc\openstat.nui)
47981>>>// Use OpenStat.nui // cTablesOpenStatus class (formely cFileAllFiles) (No User Interface)
47981>>>
47981>>>//> Usually when a DataFlex program is running a number of data tables
47981>>>//> have been opened (with the open command). Each open table is assigned
47981>>>//> a number usually identical to the number of the entry in FILELIST.CFG.
47981>>>//>
47981>>>//> An object of the cTablesOpenStatus is capable of taking a snapshot
47981>>>//> of which tables are open. After a 'snapshop' has been taken you may
47981>>>//> open new tables or change the open mode of already open tables.
47981>>>//>
47981>>>//> At this point the object is capable of restoring the status to the
47981>>>//> the time of the snapshot.
47981>>>//>
47981>>>//>
47981>>>//>   object oOpenStat is a cTablesOpenStatus
47981>>>//>   end_object
47981>>>//>
47981>>>//>   send RegisterCurrentOpenFiles to (oOpenStat(self)) // Snap!
47981>>>//>   open this
47981>>>//>   close that
47981>>>//>   send RestoreFiles to (oOpenStat(self)) // Restore
47981>>>
47981>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
47981>>>Use DBMS.nui     // Basic DBMS functions
47981>>>
47981>>>          class cTablesOpenPrepareList is an cArray // This must be embedded in a cTablesOpenStatus object
47982>>>            item_property_list
47982>>>              item_property integer piFile.i
47982>>>              item_property integer piMode.i
47982>>>              item_property integer piIdx.i
47982>>>              item_property string  psRootName.i
47982>>>            end_item_property_list cTablesOpenPrepareList
#REM 48020 DEFINE FUNCTION PSROOTNAME.I INTEGER LIROW RETURNS STRING
#REM 48024 DEFINE PROCEDURE SET PSROOTNAME.I INTEGER LIROW STRING VALUE
#REM 48028 DEFINE FUNCTION PIIDX.I INTEGER LIROW RETURNS INTEGER
#REM 48032 DEFINE PROCEDURE SET PIIDX.I INTEGER LIROW INTEGER VALUE
#REM 48036 DEFINE FUNCTION PIMODE.I INTEGER LIROW RETURNS INTEGER
#REM 48040 DEFINE PROCEDURE SET PIMODE.I INTEGER LIROW INTEGER VALUE
#REM 48044 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 48048 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
48053>>>            procedure prepare_open integer liFile integer liMode integer liIndex string lsRootName
48055>>>              integer liRow
48055>>>              get row_count to liRow
48056>>>              set piFile.i     liRow to liFile
48057>>>              set piMode.i     liRow to liMode
48058>>>              set piIdx.i      liRow to liIndex
48059>>>              set psRootName.i liRow to lsRootName
48060>>>            end_procedure
48061>>>            //> Function iOpen_Prepared will return 0 if all tables in the set
48061>>>            //> was opened as specified. If this cannot be done the function
48061>>>            //> will return the number of the first table, that could not be
48061>>>            //> opened. If the function returns a non zero value, the number of
48061>>>            //> tables actually opened by the function is undefined.
48061>>>            function iOpen_Prepared.i integer lbQuiet returns integer
48063>>>              integer liRval liMax liRow lbStop
48063>>>              integer liFile liMode liIndex lbOpen
48063>>>              string lsRootName
48063>>>              get row_count to liMax
48064>>>              move 0 to liRval
48065>>>              move 0 to liRow
48066>>>              move 0 to lbStop
48067>>>              repeat
48067>>>>
48067>>>                if liRow lt liMax begin
48069>>>                  get piFile.i     liRow to liFile
48070>>>                  get piMode.i     liRow to liMode
48071>>>                  get piIdx.i      liRow to liIndex
48072>>>                  get psRootName.i liRow to lsRootName
48073>>>                  if lsRootName eq "" get iOpen_File.ii liFile liMode to lbOpen
48076>>>                  else                get DBMS_OpenFileAs lsRootName liFile liMode liIndex to lbOpen
48078>>>
48078>>>                  ifnot lbOpen begin
48080>>>                    move 1 to lbStop
48081>>>                    ifnot lbQuiet error 772 ("File: "+string(liFile)+" can't be opened ("+lsRootName+")")
48084>>>                    move liFile to liRval
48085>>>                  end
48085>>>>
48085>>>                  else increment liRow
48087>>>                end
48087>>>>
48087>>>                else move 1 to lbStop
48089>>>              until lbStop
48091>>>              function_return liRval
48092>>>            end_function
48093>>>
48093>>>            function sRootName_Prepared integer liFile returns string
48095>>>              integer liRow liMax lbFin
48095>>>              string lsRval
48095>>>              get row_count to liMax
48096>>>              move 0 to lbFin
48097>>>              move 0 to liRow
48098>>>              move "" to lsRval
48099>>>              if liMax begin
48101>>>                repeat
48101>>>>
48101>>>                  if (piFile.i(self,liRow)=liFile) begin
48103>>>                    move (psRootName.i(self,liRow)) to lsRval
48104>>>                    if lsRval eq "" get_attribute DF_FILE_ROOT_NAME of liFile to lsRval
48109>>>                    move 1 to lbFin
48110>>>                  end
48110>>>>
48110>>>                  ifnot lbFin increment liRow
48113>>>                  if liRow ge liMax move 1 to lbFin
48116>>>                until lbFin
48118>>>              end
48118>>>>
48118>>>              function_return lsRval
48119>>>            end_function
48120>>>          end_class // cTablesOpenPrepareList
48121>>>
48121>>>class cTablesOpenStatus is a cArray
48122>>>  procedure construct_object
48124>>>    forward send construct_object
48126>>>    object oFilesToOpen is a cTablesOpenPrepareList no_image
48128>>>    end_object
48129>>>    property integer pbRestoreOpened private 0
48130>>>    property integer pbQuiet private 0
48131>>>  end_procedure
48132>>>
48132>>>  item_property_list
48132>>>    item_property integer piIsOpen.i         // 1=Yes, 0=No
48132>>>    item_property integer piOpenMode.i       // DF_SHARE, DF_EXCLUSIVE
48132>>>    item_property integer piFilemode.i       // DF_FILE_ALIAS_DEFAULT, DF_FILE_IS_MASTER, DF_FILE_IS_ALIAS
48132>>>    item_property integer piFileAlias.i      // Is it an alias file?
48132>>>    item_property string  psPhysicalName.i   // Runtimes idea of the root name of the file
48132>>>    item_property string  psRootName.i       // Filelist.cfg's idea of the root name
48132>>>    item_property integer piDriver.i         // Comes from the DBMS_FileDriverType function (dbms.nui)
48132>>>    item_property integer psWhereIsIt.i      // Sture's private investigation to figure out where the data file is.
48132>>>  end_item_property_list cTablesOpenStatus
#REM 48182 DEFINE FUNCTION PSWHEREISIT.I INTEGER LIROW RETURNS INTEGER
#REM 48186 DEFINE PROCEDURE SET PSWHEREISIT.I INTEGER LIROW INTEGER VALUE
#REM 48190 DEFINE FUNCTION PIDRIVER.I INTEGER LIROW RETURNS INTEGER
#REM 48194 DEFINE PROCEDURE SET PIDRIVER.I INTEGER LIROW INTEGER VALUE
#REM 48198 DEFINE FUNCTION PSROOTNAME.I INTEGER LIROW RETURNS STRING
#REM 48202 DEFINE PROCEDURE SET PSROOTNAME.I INTEGER LIROW STRING VALUE
#REM 48206 DEFINE FUNCTION PSPHYSICALNAME.I INTEGER LIROW RETURNS STRING
#REM 48210 DEFINE PROCEDURE SET PSPHYSICALNAME.I INTEGER LIROW STRING VALUE
#REM 48214 DEFINE FUNCTION PIFILEALIAS.I INTEGER LIROW RETURNS INTEGER
#REM 48218 DEFINE PROCEDURE SET PIFILEALIAS.I INTEGER LIROW INTEGER VALUE
#REM 48222 DEFINE FUNCTION PIFILEMODE.I INTEGER LIROW RETURNS INTEGER
#REM 48226 DEFINE PROCEDURE SET PIFILEMODE.I INTEGER LIROW INTEGER VALUE
#REM 48230 DEFINE FUNCTION PIOPENMODE.I INTEGER LIROW RETURNS INTEGER
#REM 48234 DEFINE PROCEDURE SET PIOPENMODE.I INTEGER LIROW INTEGER VALUE
#REM 48238 DEFINE FUNCTION PIISOPEN.I INTEGER LIROW RETURNS INTEGER
#REM 48242 DEFINE PROCEDURE SET PIISOPEN.I INTEGER LIROW INTEGER VALUE
48247>>>
48247>>>  //> This procedure resets the set of files to be openend by the
48247>>>  //> iOpen_Prepared function.
48247>>>  procedure reset_prepared
48249>>>    send delete_data to (oFilesToOpen(self))
48250>>>  end_procedure
48251>>>  procedure reset
48253>>>    send reset_prepared
48254>>>    send delete_data
48255>>>  end_procedure
48256>>>  //> When you want a set of files to be openend in exclusive mode or
48256>>>  //> if you want to open a set of files different the ones currently
48256>>>  //> opened you may use the Prepare_Open message to register which
48256>>>  //> files you want opened in what entries (1-4095).
48256>>>  procedure prepare_open integer liFile integer liMode integer liIndex string lsRootName
48258>>>    send prepare_open to (oFilesToOpen(self)) liFile liMode liIndex lsRootName
48259>>>  end_procedure
48260>>>
48260>>>  procedure prepare_open_all_registered_tables_exclusive
48262>>>    integer liMax liTable
48262>>>    get row_count to liMax
48263>>>    decrement liMax
48264>>>    for liTable from 0 to liMax
48270>>>>
48270>>>      if (piIsOpen.i(self,liTable)) begin
48272>>>        if (piFileAlias.i(self,litable)<>DF_FILE_IS_ALIAS) begin
48274>>>          send prepare_open liTable DF_EXCLUSIVE 0 (psPhysicalName.i(self,liTable))
48275>>>        end
48275>>>>
48275>>>      end
48275>>>>
48275>>>    loop
48276>>>>
48276>>>  end_procedure
48277>>>
48277>>>  function iOpen_Prepared returns integer
48279>>>    function_return (iOpen_Prepared.i(oFilesToOpen(self),0))
48280>>>  end_function
48281>>>  function iOpen_Prepared_Quiet returns integer
48283>>>    function_return (iOpen_Prepared.i(oFilesToOpen(self),1))
48284>>>  end_function
48285>>>  function sRootName_Prepared integer liFile returns string
48287>>>    function_return (sRootName_Prepared(oFilesToOpen(self),liFile))
48288>>>  end_function
48289>>>
48289>>>  //> Takes a snap shot of open files.
48289>>>  procedure RegisterCurrentOpenFiles
48291>>>    integer liFile lbOpen liFileOpenMode liFileMode liFileAlias
48291>>>    string lsPhysicalName lsRootName lsWhereIsIt
48291>>>    send delete_data
48292>>>    move 0 to liFile
48293>>>    repeat
48293>>>>
48293>>>      get_attribute DF_FILE_NEXT_OPENED of liFile to liFile
48296>>>      if liFile begin
48298>>>        get_attribute DF_FILE_OPEN_MODE     of liFile to liFileOpenMode // DF_SHARE, DF_EXCLUSIVE
48301>>>        get_attribute DF_FILE_MODE          of liFile to liFileMode     // DF_FILE_ALIAS_DEFAULT, DF_FILE_IS_MASTER, DF_FILE_IS_ALIAS
48304>>>        get_attribute DF_FILE_ALIAS         of liFile to liFileAlias    // I don't know what this is!
48307>>>        get_attribute DF_FILE_PHYSICAL_NAME of liFile to lsPhysicalName // Runtimes idea of the root name of the file
48310>>>        get_attribute DF_FILE_ROOT_NAME     of liFile to lsRootName     // Filelist.cfg's idea of the root name
48313>>>
48313>>>        get DBMS_TablePath liFile to lsWhereIsIt
48314>>>
48314>>>        set piIsOpen.i       liFile to 1 // Open!
48315>>>        set piOpenMode.i     liFile to liFileOpenMode
48316>>>        set piFilemode.i     liFile to liFileMode
48317>>>        set piFileAlias.i    liFile to liFileAlias
48318>>>        set psPhysicalName.i liFile to lsPhysicalName
48319>>>        set psRootName.i     liFile to lsRootName
48320>>>        set piDriver.i       liFile to (DBMS_FileDriverType(liFile))
48321>>>        set psWhereIsIt.i    liFile to lsWhereIsIt
48322>>>      end
48322>>>>
48322>>>    until liFile eq 0
48324>>>  end_procedure
48325>>>  procedure CloseAllFiles
48327>>>    Close DF_ALL
48328>>>  end_procedure
48329>>>  procedure CloseAllFilesOnDriver integer liDriver
48331>>>    integer liFile
48331>>>    move 0 to liFile
48332>>>    repeat
48332>>>>
48332>>>      get_attribute DF_FILE_NEXT_OPENED of liFile to liFile
48335>>>      if liFile if (DBMS_FileDriverType(liFile)) eq liDriver close liFile
48340>>>    until liFile eq 0
48342>>>  end_procedure
48343>>>  //> Close the ones that weren't open at the time of the last snapshot
48343>>>  procedure RestoreClosed
48345>>>    integer liFile
48345>>>    move 0 to liFile
48346>>>    repeat
48346>>>>
48346>>>      get_attribute DF_FILE_NEXT_OPENED of liFile to liFile
48349>>>      if liFile ifnot (piIsOpen.i(self,liFile)) close liFile
48354>>>    until liFile eq 0
48356>>>  end_procedure
48357>>>  //> Open the ones that were open at the time of the last snapshot
48357>>>  procedure RestoreOpened
48359>>>    integer liFile lbOpen liFileOpenMode liFileMode liFileAlias liMax lbQuiet
48359>>>    string lsPhysicalName lsRootName
48359>>>    get cTablesOpenStatus.pbQuiet to lbQuiet
48360>>>    get row_count to liMax
48361>>>    decrement liMax
48362>>>    for liFile from 1 to liMax
48368>>>>
48368>>>      get piIsOpen.i liFile to lbOpen
48369>>>      if lbOpen begin
48371>>>        get piOpenMode.i     liFile to liFileOpenMode
48372>>>        get piFilemode.i     liFile to liFileMode
48373>>>        get piFileAlias.i    liFile to liFileAlias
48374>>>        get psPhysicalName.i liFile to lsPhysicalName
48375>>>        get psRootName.i     liFile to lsRootName
48376>>>        if (uppercase(lsPhysicalName)) ne (uppercase(lsRootName)) begin
48378>>>          move (DBMS_OpenFileAs(lsPhysicalName,liFile,liFileOpenMode,0)) to lbOpen
48379>>>          ifnot lbOpen begin
48381>>>            ifnot lbQuiet begin
48383>>>              error 666 ("Can't restore open files (file: "+string(liFile)+")")
48384>>>>
48384>>>              error 666 ("Name: "+lsPhysicalName+"!")
48385>>>>
48385>>>            end
48385>>>>
48385>>>            set cTablesOpenStatus.pbRestoreOpened to false
48386>>>          end
48386>>>>
48386>>>        end
48386>>>>
48386>>>        else move (DBMS_OpenFile(liFile,liFileOpenMode,0)) to lbOpen
48388>>>        if lbOpen begin
48390>>>          set_attribute DF_FILE_MODE  of liFile to liFileMode
48393>>>          set_attribute DF_FILE_ALIAS of liFile to liFileAlias
48396>>>        //send obs "File Mode:" (string(liFileMode)) "File Alias:" (string(liFileAlias))
48396>>>        end
48396>>>>
48396>>>        else begin
48397>>>          ifnot lbQuiet begin
48399>>>            error 668 "Error: Cannot reconnect to database!" //"(Sounds serious, but it isn't)" "Restart program (not the computer)" (uppercase(lsPhysicalName)) (uppercase(lsRootName)) (string(liFileOpenMode)) (string(liFileMode))
48400>>>>
48400>>>          end
48400>>>>
48400>>>          set cTablesOpenStatus.pbRestoreOpened to false
48401>>>        end
48401>>>>
48401>>>      end
48401>>>>
48401>>>    loop
48402>>>>
48402>>>  end_procedure
48403>>>  function bRestoreOpened integer lbQuiet returns integer
48405>>>    integer lbRval
48405>>>    set cTablesOpenStatus.pbRestoreOpened to true
48406>>>    set cTablesOpenStatus.pbQuiet to lbQuiet
48407>>>    send RestoreOpened
48408>>>    get cTablesOpenStatus.pbRestoreOpened to lbRval
48409>>>    set cTablesOpenStatus.pbQuiet to false
48410>>>    function_return lbRval
48411>>>  end_function
48412>>>
48412>>>  // This may be used to make sure that the file_mode and file_alias attributes
48412>>>  // are identical before and after reindexing a file.
48412>>>  procedure write_file
48414>>>    integer liFile liChannel liFileMode liFileAlias
48414>>>    get Seq_New_Channel to liChannel
48415>>>    direct_output channel liChannel "openstat.txt"
48417>>>    move 0 to liFile
48418>>>    repeat
48418>>>>
48418>>>      get_attribute DF_FILE_NEXT_OPENED of liFile to liFile
48421>>>      if liFile begin
48423>>>        get_attribute DF_FILE_MODE          of liFile to liFileMode
48426>>>        get_attribute DF_FILE_ALIAS         of liFile to liFileAlias
48429>>>        writeln channel liChannel ("File:"+string(liFile))
48432>>>        writeln "File Mode:" (string(liFileMode)) "File Alias:" (string(liFileAlias))
48437>>>      end
48437>>>>
48437>>>    until liFile eq 0
48439>>>    close_output channel liChannel
48441>>>    send Seq_Release_Channel liChannel
48442>>>  end_procedure
48443>>>
48443>>>  procedure RestoreFiles
48445>>>    send RestoreClosed
48446>>>    send RestoreOpened
48447>>>  end_procedure
48448>>>  //> Open a file of the previous snapshot in a new and exciting mode.
48448>>>  function iOpen_File.ii integer liFile integer liMode returns integer
48450>>>    string lsPhysicalName
48450>>>    get psPhysicalName.i liFile to lsPhysicalName
48451>>>    if lsPhysicalName ne "" function_return (DBMS_OpenFileAs(lsPhysicalName,liFile,liMode,0))
48454>>>    function_return (DBMS_OpenFile(liFile,liMode,0))
48455>>>  end_function
48456>>>end_class // cTablesOpenStatus
48457>>>
48457>>>desktop_section
48462>>>  object oTablesOpenStatus_Global is a cTablesOpenStatus
48464>>>  end_object
48465>>>end_desktop_section
48470>>>
48470>>>procedure OpenStat_RegisterFiles global
48472>>>  send RegisterCurrentOpenFiles to (oTablesOpenStatus_Global(self))
48473>>>end_procedure
48474>>>procedure OpenStat_CloseAllFiles global
48476>>>  send CloseAllFiles to (oTablesOpenStatus_Global(self))
48477>>>end_procedure
48478>>>procedure OpenStat_RestoreFiles global
48480>>>  send RestoreFiles to (oTablesOpenStatus_Global(self))
48481>>>end_procedure
48482>>>
48482>>>function OpenStat_RestoreFilesFunction global integer lbQuiet returns integer
48484>>>  integer lbRval
48484>>>  send RestoreClosed to (oTablesOpenStatus_Global(self))
48485>>>  get bRestoreOpened of (oTablesOpenStatus_Global(self)) lbQuiet to lbRval
48486>>>  function_return lbRval
48487>>>end_function
48488>>>
48488>>>//> Calling this procedure will close and re-open all embedded database tables currently open
48488>>>//> by the application. I can't remember why I did it, but here it is.
48488>>>procedure FlushAllDataFlexBuffers global
48490>>>  integer lhObj
48490>>>  move (oTablesOpenStatus_Global(self)) to lhObj
48491>>>  send RegisterCurrentOpenFiles to lhObj
48492>>>  send CloseAllFilesOnDriver to lhObj DBMS_DRIVER_DATAFLEX
48493>>>  send RestoreOpened to lhObj
48494>>>end_procedure
48495>>>
48495>
48495>Use Version.nui
48495>
48495>Use cApplication.pkg
48495>Object oApplication is a cApplication
48497>    Set pbEnterKeyAsTabKey to DFTRUE
48498>    Set psAutoOpenWorkspace to "" // Do not attempt to open "config.ws"  
48499>End_Object // oApplication
48500>
48500>Use WsFunctions.pkg // Workspace functions encapsulated in WsFunctions object (VdfQueryLib)
Including file: WsFunctions.pkg    (C:\projects\BRS\VDFQuery\AppSrc\WsFunctions.pkg)
48500>>>// Use WsFunctions.pkg // Workspace functions encapsulated in WsFunctions object (VdfQuery)
48500>>>
48500>>>Use VdfBase.pkg // DAW package, provides low level support expected of all VDF applications (windows and webapp)
48500>>>Use cRegistry.pkg // DAW package, provides access to the Windows system Registry
48500>>>
48500>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
48500>>>
48500>>>Desktop_Section
48505>>>
48505>>>        Object oWsSelector is a ModalPanel
48507>>>            Set Location to 4 13
48508>>>            Set size to 254 319
48509>>>            Set piMinSize to 254 319
48510>>>            Set label to "Work space selector"
48511>>>            Set Border_Style to Border_Thick
48512>>>            
48512>>>            Property Boolean pbAccept
48514>>>            On_Key kCancel Send close_panel
48515>>>            
48515>>>            Procedure AcceptPanel
48518>>>                Set pbAccept to True
48519>>>                Send close_panel
48520>>>            End_Procedure
48521>>>            
48521>>>            Object oTextBox is a TextBox
48523>>>                Set Size to 50 14
48524>>>                Set Location to 14 27
48525>>>                Set Label to "Currently selected workspace:"
48526>>>            End_Object
48527>>>            Object oForm is a Form
48529>>>                Set Size to 14 267
48530>>>                Set Location to 28 24
48531>>>                Set peAnchors to anTopLeftRight
48532>>>                Set Enabled_State to False
48533>>>            End_Object
48534>>>            Object oList is a List
48536>>>                Set Size to 156 267
48537>>>                Set Location to 46 24
48538>>>                Set peAnchors to anAll
48539>>>                Set Select_Mode to Auto_Select
48540>>>                On_Key kEnter Send AcceptPanel
48541>>>                Procedure DoFillList String[] aValues
48544>>>                    Integer iMax iItm
48544>>>                    Send delete_data
48545>>>                    Move (SizeOfArray(aValues)) to iMax
48546>>>                    Decrement iMax
48547>>>                    For iItm from 0 to iMax
48553>>>>
48553>>>                        Send add_item MSG_None aValues[iItm]
48554>>>                    Loop
48555>>>>
48555>>>                End_Procedure
48556>>>                Procedure Mouse_Click Integer iWindowNumber Integer iPosition // Sent on mouse double click.
48559>>>                    Send AcceptPanel
48560>>>                End_Procedure
48561>>>            End_Object
48562>>>            Object oButton1 is a Button
48564>>>                Set Location to 209 176
48565>>>                Set Label to "Select"
48566>>>                Set peAnchors to anBottomRight
48567>>>                Procedure OnClick
48570>>>                    Send AcceptPanel
48571>>>                End_Procedure
48572>>>            End_Object
48573>>>            Object oButton2 is a Button
48575>>>                Set Location to 209 240
48576>>>                Set Label to "Cancel"
48577>>>                Set peAnchors to anBottomRight
48578>>>                Procedure OnClick
48581>>>                    Send close_panel
48582>>>                End_Procedure
48583>>>            End_Object
48584>>>            
48584>>>            Function SelectSwsFile String[] aValues String sCurrent Returns String
48587>>>                String sRval
48587>>>                Set pbAccept to False
48588>>>                Set value of oForm to sCurrent
48589>>>                Send DoFillList of oList aValues
48590>>>                Send popup
48591>>>                If (pbAccept(Self)) Begin
48593>>>                    Get value of oList (Current_Item(oList)) to sRval
48594>>>                End
48594>>>>
48594>>>                Function_Return sRval
48595>>>            End_Function
48596>>>        End_Object // oWsSelector
48597>>>
48597>>>    Object WsFunctions is a cObject
48599>>>        Object oRecentWs is a cRegistry // Private
48601>>>            Set phRootKey to HKEY_CURRENT_USER
48602>>>        End_Object
48603>>>        
48603>>>        //> The VDF studio stores its "Recent Workspaces" list in the Windows registry. Use the ReadRegistryRecentWorkSpaces 
48603>>>        //> procedure to dig them out.
48603>>>        Procedure ReadRegistryRecentWorkSpaces String[] ByRef aValues
48606>>>            Boolean bOpen
48606>>>            Handle hoArray
48606>>>            Integer iMaxKey iKey
48606>>>            String sKey
48606>>>            Move (ResizeArray(aValues,0)) to aValues
48607>>>            Get OpenKey of oRecentWs "Software\Data Access Worldwide\Visual DataFlex Tools\12.0\Studio\RecentWorkspaces" to bOpen
48608>>>            If (bOpen) Begin
48610>>>                Get Create U_Array to hoArray // Create an array object
48611>>>                Get GetValues of oRecentWs hoArray to iMaxKey
48612>>>                Decrement iMaxKey
48613>>>                For iKey from 0 to iMaxKey
48619>>>>
48619>>>                    Get value of hoArray iKey to sKey
48620>>>                    Get ReadString of oRecentWs sKey to aValues[iKey]
48621>>>                Loop
48622>>>>
48622>>>                Send destroy of hoArray // Remove the array object from memory.
48623>>>            End
48623>>>>
48623>>>        End_Procedure
48624>>>
48624>>>        //> Returns a handle to cWorkSpace object currently in action.
48624>>>        Function WorkSpaceObject Returns Handle
48627>>>            Handle hRval
48627>>>            Move 0 to hRval
48628>>>            If (ghoApplication>=0) Begin
48630>>>                Get phoWorkspace of ghoApplication to hRval
48631>>>            End
48631>>>>
48631>>>            Function_Return hRval
48632>>>        End_Function
48633>>>
48633>>>        //> Returns the name (incl. full path) of the .ws file currently used.
48633>>>        Function WorkSpaceFile Returns String
48636>>>            Handle hoWs
48636>>>            String sFile
48636>>>            Get WorkSpaceObject to hoWs
48637>>>            If (hoWs>0) Begin
48639>>>                Get psWorkspaceWSFile of hoWs to sFile
48640>>>            End
48640>>>>
48640>>>            Else Begin
48641>>>                Move "" to sFile
48642>>>            End
48642>>>>
48642>>>            Function_Return sFile
48643>>>        End_Function
48644>>>
48644>>>        //> Use this function to calculate the absolute path of the .ws file corresponding to the abslute path of a .sws file given as parameter.
48644>>>        Function SwsFileToWsFile String sSwsFile Returns String
48647>>>            Boolean bStop
48647>>>            //Integer iChannel
48647>>>            Handle hoIniFile
48647>>>            String sWsFile sLine
48647>>>
48647>>>            Get Create U_cIniFile To hoIniFile
48648>>>
48648>>>            Set psFilename of hoIniFile To sSwsFile
48649>>>            Get ReadString of hoIniFile "WorkspacePaths" "ConfigFile" "" To sWsFile
48650>>>            Send Destroy of hoIniFile // destroy dynaically created inifile object
48651>>>
48651>>>            If (left(sWsFile,2)=".\") Begin // If that's not the case we assume that the path is absolute. (Maybe someday it is necessary to take "..\" into account also).
48653>>>                Move (Remove(swsFile,1,2)) to sWsFile // Remove the first two characters
48654>>>                
48654>>>                Get SEQ_ExtractPathFromFileName sSwsFile to sSwsFile // "C:\Apps\VdfQueryLib\VDFQueryLib.sws" -> "C:\Apps\VdfQueryLib"
48655>>>                Get Files_AppendPath sSwsFile sWsFile to sWsFile
48656>>>            End
48656>>>>
48656>>>            Function_Return sWsFile
48657>>>        End_Function
48658>>>
48658>>>        //> Function OpenWorkspace takes a .sws or .ws file and calls the "OpenWorkSpaceFile" method of the current cWorkSpace object. The return
48658>>>        //> value is one of the following:
48658>>>        //>     -1                      : cWorkSpace object not found
48658>>>        //>     wsWorkspaceOpened       : WS opened ok
48658>>>        //>     wsWorkspaceNotFound     : the named WS was not found in the global list
48658>>>        //>     wsWorkspaceFileNotFound : the WS file was not found
48658>>>        //>     wsDataPathEmpty         : the DataPath entry was empty
48658>>>        //>     wsFileListEmpty         : The FileList entry was empty
48658>>>        //>     wsFileListNotExist      : The FileList.cfg file could not be found
48658>>>        Function OpenWorkspace String sFile Returns Integer
48661>>>            Handle hoWs
48661>>>            Integer iRval
48661>>>            Get WorkSpaceObject to hoWs
48662>>>            If (hoWs>=0) Begin
48664>>>                If (lowercase(right(sFile,4))=".sws") Get SwsFileToWsFile sFile to sFile
48667>>>                Get OpenWorkspaceFile of hoWs sFile to iRval
48668>>>            End
48668>>>>
48668>>>            Function_Return iRval
48669>>>        End_Function
48670>>>
48670>>>        Function OpenWorkspaceErrorText integer iReturnValue returns string
48673>>>            if (iReturnValue=-1)                      function_return "cWorkSpace object not found"
48676>>>            if (iReturnValue=wsWorkspaceOpened)       function_return "WS opened ok"
48679>>>            if (iReturnValue=wsWorkspaceNotFound)     function_return "The named WS was not found in the global list"
48682>>>            if (iReturnValue=wsWorkspaceFileNotFound) function_return "The WS file was not found"
48685>>>            if (iReturnValue=wsDataPathEmpty)         function_return "The DataPath entry was empty"
48688>>>            if (iReturnValue=wsFileListEmpty)         function_return "The FileList entry was empty"
48691>>>            if (iReturnValue=wsFileListNotExist)      function_return "'FileList.cfg' file could not be found"
48694>>>            function_return ""
48695>>>        End_Function
48696>>>
48696>>>            Function SelectRecentWorkspaceFile Returns String
48699>>>                String sSwsFile sWsFile
48699>>>                String[] aValues
48700>>>                Send ReadRegistryRecentWorkSpaces (&aValues)
48701>>>                Get SelectSwsFile of oWsSelector aValues (WorkSpaceFile(Self)) to sSwsFile
48702>>>                Function_Return sSwsFile
48703>>>            End_Function
48704>>>    End_Object
48705>>>End_Desktop_Section
48710>
48710>// If you use WinPrint:
48710>//Use VDFQuery.utl // DFQUERY for Visual DataFlex (WinPrint version)
48710>
48710>// If you use VPE:
48710>define VPE_USE_EMBEDDED_PREVIEW for 1
48710>Use VpeQuery.utl // DFQUERY for Visual DataFlex (VPE version)
Including file: vpequery.utl    (C:\projects\BRS\VDFQuery\AppSrc\vpequery.utl)
48710>>>DEFINE USE$VPE for 1 // Define the symbol, never mind the value. This will make
48710>>>                     // VdfQuery.utl interface VPE instead of WinPrint
48710>>>use VdfQuery.utl // DFQUERY for Visual DataFlex
Including file: vdfquery.utl    (C:\projects\BRS\VDFQuery\AppSrc\vdfquery.utl)
48710>>>>>//**********************************************************************
48710>>>>>// Use VdfQuery.utl // DFQUERY for Visual DataFlex
48710>>>>>//
48710>>>>>// Version: 2.4
48710>>>>>//
48710>>>>>// This package is a 'Public Domain' contribution to the DataFlex community.
48710>>>>>//
48710>>>>>//
48710>>>>>// Recommendations:
48710>>>>>//
48710>>>>>//  * This package and all other files in the download should be placed in a
48710>>>>>//    directory by itself separate from all other source code making up your
48710>>>>>//    applications.
48710>>>>>//
48710>>>>>//  * You should not make ANY modifications to the source code without
48710>>>>>//    very clearly marking your changes both in the header of the package
48710>>>>>//    file in question and next to the lines that you alter. In fact, the
48710>>>>>//    marking made in the header of the file should be in capital letters
48710>>>>>//    at the very first line of the file so that one glance at the file
48710>>>>>//    in an editor will reveal that it has been modified. Furthermore, you
48710>>>>>//    should maintain a separate log-file (changes.log) mentioning all
48710>>>>>//    changes done to the packages. This will help you when upgrading to
48710>>>>>//    newer versions of the software and other programmers that in the
48710>>>>>//    future will have to maintain your system.
48710>>>>>//
48710>>>>>//  * If you have suggestions or questions about the functions in here you
48710>>>>>//    should pose them at the Data Access newgroups at news.dataaccess.com:
48710>>>>>//
48710>>>>>//                   news://dataaccess.com/visual-dataflex
48710>>>>>//
48710>>>>>//    You should put the name of the package file in the the subject line
48710>>>>>//    of your question.
48710>>>>>//
48710>>>>>//                                                    Sture Andersen
48710>>>>>//                                                      Sture ApS
48710>>>>>//
48710>>>>>//
48710>>>>>//    To get rid of user specific folders: set VdfQuery_OldFolders_State to TRUE
48710>>>>>//
48710>>>>>//**********************************************************************
48710>>>>>
48710>>>>>Use Version.nui
48710>>>>>
48710>>>>>Use APS          // Auto Positioning and Sizing classes for VDF
48710>>>>>Use ObjGroup.utl // Defining groups of objects
Including file: objgroup.utl    (C:\projects\BRS\VDFQuery\AppSrc\objgroup.utl)
48710>>>>>>>//**********************************************************************
48710>>>>>>>// Use ObjGroup.utl // Defining groups of objects
48710>>>>>>>//
48710>>>>>>>// Author:  Sture B. Andersen
48710>>>>>>>//
48710>>>>>>>// Create:  Fri  18-07-1997
48710>>>>>>>// Update:  Mon  17-11-1997 - Deferred_Request_Destroy_Object added
48710>>>>>>>//          Wed  28-01-1998 - Procedure Deferred_Message added
48710>>>>>>>//          Tue  11-08-1998 - Deferred_Message now implemented for use
48710>>>>>>>//                            with character mode as well. Beware though,
48710>>>>>>>//                            a lot of things will make it fail (inkey$
48710>>>>>>>//                            commands etc...)
48710>>>>>>>//                          - Non-use of K$ removed.
48710>>>>>>>//          Mon  18-01-1999 - Global integer NotExitingApplication
48710>>>>>>>//                            introduced.
48710>>>>>>>//                          - A lot of comments added.
48710>>>>>>>//          Sun  25-04-1999 - Fixed NotExitingApplication
48710>>>>>>>//          Tue  31-07-2001 - Added Exit_Application_Check (Fixed
48710>>>>>>>//                            NotExitingApplication for CM)
48710>>>>>>>//          Thu  08-08-2002 - Changed timer create/destroy strategy for
48710>>>>>>>//                            character mode DataFlex
48710>>>>>>>//
48710>>>>>>>// Purpose: 1: To provide a global mechanism for defining groups of objects
48710>>>>>>>//             that may be instatiated in different parts of the application
48710>>>>>>>//             object tree (determined at runtime).
48710>>>>>>>//
48710>>>>>>>//          2: To provide a method for adding a message to the back of the
48710>>>>>>>//             DataFlex message queue.
48710>>>>>>>//
48710>>>>>>>//          It's an odd couple of features to present in one and the same
48710>>>>>>>//          package but they really are depending upon its other services.
48710>>>>>>>//          Nice and tight...
48710>>>>>>>//
48710>>>>>>>// Blabla:  It may also be used as an easy method for creating multiple views
48710>>>>>>>//          at runtime from the same object definition. That would be done
48710>>>>>>>//          like this:
48710>>>>>>>//
48710>>>>>>>//           use objgroup.utl
48710>>>>>>>//          
48710>>>>>>>//           DEFINE_OBJECT_GROUP OG_Modules
48710>>>>>>>//             object Modules_vw is a aps.dbview label (og_param(0))
48710>>>>>>>//               object dd is a Modules_dd
48710>>>>>>>//               end_object
48710>>>>>>>//               set main_dd to (dd(self))
48710>>>>>>>//               set server to (dd(self))
48710>>>>>>>//               object cont is a aps.dbcontainer3d
48710>>>>>>>//                 set p_auto_column to false
48710>>>>>>>//                 object grd is a aps.dbGrid
48710>>>>>>>//                   begin_row
48710>>>>>>>//                     entry_item Modules.Code
48710>>>>>>>//                     entry_item Modules.Name
48710>>>>>>>//                   end_row
48710>>>>>>>//                 end_object
48710>>>>>>>//               end_object
48710>>>>>>>//               Procedure Close_Panel // Release when closed!
48710>>>>>>>//                 Forward Send Close_Panel
48710>>>>>>>//                 send Deferred_Request_Destroy_Object
48710>>>>>>>//               End_Procedure
48710>>>>>>>//               move self to OG_Current_Object# // global integer
48710>>>>>>>//               // The previous line makes sure we know the object-ID of
48710>>>>>>>//               // the view we just created.
48710>>>>>>>//             end_object
48710>>>>>>>//           END_DEFINE_OBJECT_GROUP
48710>>>>>>>//          
48710>>>>>>>//           procedure OpenNewModuleVw // Access method
48710>>>>>>>//             CREATE_OBJECT_GROUP OG_Modules "Yet another view"
48710>>>>>>>//             send popup to OG_Current_Object#
48710>>>>>>>//           end_procedure
48710>>>>>>>//
48710>>>>>>>//          This method does not require that the view is coded with
48710>>>>>>>//          APS objects.
48710>>>>>>>//
48710>>>>>>>//
48710>>>>>>>//          The Deferred_Message procedure
48710>>>>>>>//          ------------------------------
48710>>>>>>>//
48710>>>>>>>//          The package provides a third feature which is the Deferred_Message
48710>>>>>>>//          method. This is a way to tell DataFlex that you want a procedure
48710>>>>>>>//          to execute - not now - but when everything else is finished. In
48710>>>>>>>//          effect you can now send a message by adding it to the very end of
48710>>>>>>>//          the message queue.
48710>>>>>>>//
48710>>>>>>>//          Why would one want to do that? Well, I invented it to get around
48710>>>>>>>//          the problem of destroying panels, when they are closed. You may
48710>>>>>>>//          create a procedure like this:
48710>>>>>>>//
48710>>>>>>>//                      Procedure Close_Panel
48710>>>>>>>//                        forward send Close_Panel
48710>>>>>>>//                        send Request_Destroy_Object // Destroy when closed
48710>>>>>>>//                      End_Procedure
48710>>>>>>>//
48710>>>>>>>//          Because the runtime is still executing a procedure in the object
48710>>>>>>>//          you are destroying, you will get problems. Since this goes for
48710>>>>>>>//          all procedures within an object you simply cannot make an
48710>>>>>>>//          object destroy itself, when it is closed.
48710>>>>>>>//
48710>>>>>>>//          UNLESS you can find a way to put a message in the far back of
48710>>>>>>>//          the message queue. That would make sure that everything in
48710>>>>>>>//          connection with closing the panel had already happened before
48710>>>>>>>//          object destruction. And that is what the Deferred_Message
48710>>>>>>>//          procedure can do. Therefore you may instead write:
48710>>>>>>>//
48710>>>>>>>//                      Procedure Close_Panel
48710>>>>>>>//                        forward send Close_Panel
48710>>>>>>>//                        send Deferred_Message msg_Request_Destroy_Object
48710>>>>>>>//                      End_Procedure
48710>>>>>>>//
48710>>>>>>>//          Somewhere along the VDF versions (6 or 7) DAW fixed this
48710>>>>>>>//          particular problem so that now it is OK to destroy an object
48710>>>>>>>//          while executing one of its methods.
48710>>>>>>>//
48710>>>>>>>//
48710>>>>>>>//          This technique is also viable if you want to make more
48710>>>>>>>//          independant DDO structures perform something in one go. It
48710>>>>>>>//          is a fact that when a DDO object is doing something (saving
48710>>>>>>>//          or finding or the like) you cannot make another (un-connected)
48710>>>>>>>//          DDO structure do anything. It appears to be dead. The reason is
48710>>>>>>>//          that while a DDO is performing one of those DDO things it sets
48710>>>>>>>//          global integers OPERATION_MODE and OPERATION_ORIGIN to whatever
48710>>>>>>>//          thereby blocking other DDO's from doing anything. If you
48710>>>>>>>//          keep your tongue straight, you may use the Deferred_Message
48710>>>>>>>//          procedure to get around this limitation.
48710>>>>>>>//
48710>>>>>>>//          However, when using this technique, there is a couple of
48710>>>>>>>//          (hundred) pitfalls.
48710>>>>>>>//
48710>>>>>>>//          The technique I use to do this involves a timer object. The
48710>>>>>>>//          first time you send a deferred message this timer object
48710>>>>>>>//          will be created (and not before).
48710>>>>>>>//
48710>>>>>>>//          As I understand it, a timer in Windows simply must have a
48710>>>>>>>//          window handle (a Windows administrative thing that relates
48710>>>>>>>//          to a window you can see on screen) in order to function. A
48710>>>>>>>//          DataFlex application can have a lot of windows and it is
48710>>>>>>>//          important that this window is the ClientArea object of your
48710>>>>>>>//          application. Placing it anywhere else will give you problems.
48710>>>>>>>//
48710>>>>>>>//          If you get an error 'DFTimerManager doesn't have Window_Handle!'
48710>>>>>>>//          when you close your application, the timer object has been
48710>>>>>>>//          created in the wrong place. You can get around this by inserting
48710>>>>>>>//          this line in the beginning of the ClientArea object:
48710>>>>>>>//
48710>>>>>>>//                  Object Main_Client is a ClientArea
48710>>>>>>>//                    send Deferred_Message msg_none
48710>>>>>>>//                    ...
48710>>>>>>>//
48710>>>>>>>//          Another error situation arises if there is any deferred
48710>>>>>>>//          messages waiting to be executed when you close your
48710>>>>>>>//          application. This may happen for example if you hook up
48710>>>>>>>//          to the New_Current_Record method in a DD object.
48710>>>>>>>//
48710>>>>>>>//            Procedure New_Current_Record integer old_rec# integer new_rec#
48710>>>>>>>//              forward send New_Current_Record old_rec# new_rec#
48710>>>>>>>//              send Deferred_Message msg_Update_Other_DD_Structures
48710>>>>>>>//            End_Procedure
48710>>>>>>>//
48710>>>>>>>//          For reasons un-known to man kind, a DD object fires a
48710>>>>>>>//          New_Current_Record message when the object is destroyed (most
48710>>>>>>>//          likely at the time of exiting the application). Do you see the
48710>>>>>>>//          problem? A message is put in the message queue, when in fact
48710>>>>>>>//          control never returns to the program. Timers don't like
48710>>>>>>>//          that sort of thing. You will receive an "Can't kill timer!
48710>>>>>>>//          Windows error #" error.
48710>>>>>>>//
48710>>>>>>>//          If you get into this sort of trouble you may need to check
48710>>>>>>>//          the value of global integer NotExitingApplication (defined
48710>>>>>>>//          in this package) before you send a deferred message. The
48710>>>>>>>//          procedure above would now look like this:
48710>>>>>>>//
48710>>>>>>>//            Procedure New_Current_Record integer old_rec# integer new_rec#
48710>>>>>>>//              forward send New_Current_Record old_rec# new_rec#
48710>>>>>>>//              if NotExitingApplication ;
48710>>>>>>>//                 send Deferred_Message msg_Update_Other_DD_Structures
48710>>>>>>>//            End_Procedure
48710>>>>>>>//
48710>>>>>>>//
48710>>>>>>>//**********************************************************************
48710>>>>>>>
48710>>>>>>>Use UI
48710>>>>>>>Use Macros.utl   // Various macros (DESKTOP_SECTION)
48710>>>>>>>Use Set.utl      // cArray, cSet and cStack classes
48710>>>>>>>Use Base.nui
48710>>>>>>>                         // when deferred_request_destroy_object is called
48710>>>>>>>desktop_section
48715>>>>>>>  integer NotExitingApplication
48715>>>>>>>  move 1 to NotExitingApplication
48716>>>>>>>  object OG_Current_Object_stack is an cStack
48718>>>>>>>    procedure Notify_Exit_Application
48721>>>>>>>      move 0 to NotExitingApplication
48722>>>>>>>    end_procedure
48723>>>>>>>    procedure Broadcast_Notify_Exit_Application
48726>>>>>>>      move 0 to NotExitingApplication
48727>>>>>>>    end_procedure
48728>>>>>>>    function Exit_Application_Check returns integer // CM check
48731>>>>>>>      move 0 to NotExitingApplication
48732>>>>>>>      function_return 0 // No changes
48733>>>>>>>    end_function
48734>>>>>>>  end_object
48735>>>>>>>
48735>>>>>>>  // This object holds all parameters for Object Group instantiations. The
48735>>>>>>>  // object is a stack and the last item holds the number of items for the
48735>>>>>>>  // current object group instantiation.
48735>>>>>>>  //   The global integer ObjectGroupCurrentOffset# points to the first
48735>>>>>>>  // parameter in the current object group instantiation.
48735>>>>>>>
48735>>>>>>>  integer OG_ParameterArray# // Object ID for OG_ParameterArray
48735>>>>>>>  object OG_ParameterArray is an array
48737>>>>>>>    move self to OG_ParameterArray#
48738>>>>>>>  end_object
48739>>>>>>>end_desktop_section
48744>>>>>>>
48744>>>>>>>integer OG_CurrentOffset#  //
48744>>>>>>>move 0 to OG_CurrentOffset#
48745>>>>>>>
48745>>>>>>>integer OG_Current_Object# //
48745>>>>>>>integer OG_Tmp# //
48745>>>>>>>
48745>>>>>>>// The prefix "og" stands for object group.
48745>>>>>>>procedure og_set_param global integer itm# string value#
48747>>>>>>>  set value of OG_ParameterArray# item (OG_CurrentOffset#+itm#) to value#
48748>>>>>>>end_procedure
48749>>>>>>>function og_param global integer itm# returns string
48751>>>>>>>  function_return (value(OG_ParameterArray#,OG_CurrentOffset#+itm#))
48752>>>>>>>end_function
48753>>>>>>>procedure og_allocate_param_space global integer itm#
48755>>>>>>>  integer item_count#
48755>>>>>>>  get item_count of OG_ParameterArray# to item_count#
48756>>>>>>>  set value of OG_ParameterArray# item (item_count#+itm#) to itm#
48757>>>>>>>  move item_count# to OG_CurrentOffset#
48758>>>>>>>end_procedure
48759>>>>>>>procedure og_add_param global string value#
48761>>>>>>>  integer item_count# max#
48761>>>>>>>  get item_count of OG_ParameterArray# to item_count#
48762>>>>>>>  get integer_value of OG_ParameterArray# item (item_count#-1) to max#
48763>>>>>>>  send delete_item to OG_ParameterArray# (item_count#-1)
48764>>>>>>>  set value of OG_ParameterArray# item (item_count#-1) to value#
48765>>>>>>>  set value of OG_ParameterArray# item item_count# to (max#+1)
48766>>>>>>>end_procedure
48767>>>>>>>procedure og_drop_params global // Delete all parameters from last OG instantiation
48769>>>>>>>  integer max# itm# item_count#
48769>>>>>>>  get item_count of OG_ParameterArray# to item_count#
48770>>>>>>>  get value of OG_ParameterArray# item (item_count#-1) to max#
48771>>>>>>>  for itm# from 0 to max#
48777>>>>>>>>
48777>>>>>>>    send delete_item to OG_ParameterArray# (item_count#-1-itm#)
48778>>>>>>>  loop
48779>>>>>>>>
48779>>>>>>>  get item_count of OG_ParameterArray# to item_count#
48780>>>>>>>  if item_count# ; // Only if not empty    move (item_count#-integer_value(OG_ParameterArray#,item_count#-1)-1) to OG_CurrentOffset#
48783>>>>>>>  else move 0 to OG_CurrentOffset#
48785>>>>>>>end_procedure
48786>>>>>>>
48786>>>>>>>// The above set of messages enables two different strategies for setting
48786>>>>>>>// up parameters for an OG instantiation:
48786>>>>>>>//
48786>>>>>>>//      1) sending og_allocate_param_space to allocate the necessary number
48786>>>>>>>//         of array items at one time. Afterwards the values are set using
48786>>>>>>>//         the og_set_param message
48786>>>>>>>//
48786>>>>>>>//      2) sending og_allocate_param_space with parameter 0 simply to
48786>>>>>>>//         indicate that a new parameter set is about to be specified.
48786>>>>>>>//         Parameter values are hereafter set by using the og_add_param
48786>>>>>>>//         message.
48786>>>>>>>//
48786>>>>>>>// Strategy 2 is somewhat slower than 1 but may be more convenient in
48786>>>>>>>// most instances.
48786>>>>>>>//
48786>>>>>>>// In any case message og_drop_params will drop the current parameters
48786>>>>>>>// by deleting them from the stack.
48786>>>>>>>
48786>>>>>>>
48786>>>>>>>
48786>>>>>>>
48786>>>>>>>// The rest of this file is dedicated to supplying a method to be used when
48786>>>>>>>// destroying objects. The method Deferred_Request_Destroy_Object is understood
48786>>>>>>>// by all objects but should only be sent to panels (View's and ModalPanel's)
48786>>>>>>>//
48786>>>>>>>// The next couple of hundred lines is a duplicate of the standard VDF timer
48786>>>>>>>// package except that class names has been changed ("0" has been added). This
48786>>>>>>>// is needed because I do not want to rely on the DfTimer.pkg package. Why not?
48786>>>>>>>// Because that has to be USE'd from within the (App)ClientArea to avoid focus
48786>>>>>>>// loss at application start up. This package (ObjGroup.utl) may be used
48786>>>>>>>// anywhere and still work (as far as I know).
48786>>>>>>>
48786>>>>>>>Use Windows // Standard DAC packages
48786>>>>>>>Use WinUser //
48786>>>>>>>
48786>>>>>>>External_Function SetTimer0 "SetTimer" User32.DLL Integer hWnd Integer idTimer Integer idTimeout Pointer tmprc Returns Integer
48787>>>>>>>External_Function KillTimer0 "KillTimer" User32.DLL Integer hWnd Integer idTimer Returns Integer
48788>>>>>>>External_Function GetLastError0 "GetLastError" Kernel32.DLL Returns DWORD
48789>>>>>>>
48789>>>>>>>Integer giTimerManager#
48789>>>>>>>
48789>>>>>>>Class TimersArray0 is an Array
48790>>>>>>>    Function Find_Object Integer iObj Returns Integer
48792>>>>>>>        integer iMax
48792>>>>>>>        integer iItem
48792>>>>>>>        integer iValue
48792>>>>>>>        Get Item_count to iMax
48793>>>>>>>        Decrement iMax
48794>>>>>>>        For iItem from 1 to iMax
48800>>>>>>>>
48800>>>>>>>            Get Integer_Value item iItem to iValue
48801>>>>>>>            If iValue EQ iObj Function_Return iItem
48804>>>>>>>        Loop
48805>>>>>>>>
48805>>>>>>>        Function_Return -1
48806>>>>>>>    End_Function
48807>>>>>>>
48807>>>>>>>    Procedure Add_Object Integer iObj Returns Integer
48809>>>>>>>        integer iItem
48809>>>>>>>        Get Find_Object iObj to iItem
48810>>>>>>>        If iItem LT 0 Begin
48812>>>>>>>            Get Find_Object 0 to iItem
48813>>>>>>>            If iItem LT 0 Get Item_Count to iItem
48816>>>>>>>        End
48816>>>>>>>>
48816>>>>>>>        Set Array_Value item iItem to iObj
48817>>>>>>>        Procedure_Return iItem
48818>>>>>>>    End_Procedure
48819>>>>>>>
48819>>>>>>>    Procedure Remove_Object Integer iObj
48821>>>>>>>        integer iItem
48821>>>>>>>        Get Find_Object iObj to iItem
48822>>>>>>>        If iItem GT 0 Set Array_Value item iItem to 0
48825>>>>>>>    End_Procedure
48826>>>>>>>    Procedure Destroy_Object
48828>>>>>>>        Delegate Send Kill_All_Timers
48830>>>>>>>        Forward Send Destroy_Object
48832>>>>>>>    End_Procedure
48833>>>>>>>End_Class // TimersArray0
48834>>>>>>>
48834>>>>>>>Class DFTimerManager0 is a DFControl
48835>>>>>>>    Procedure Construct_Object
48837>>>>>>>        Forward Send Construct_Object
48839>>>>>>>        Set Visible_State to FALSE
48840>>>>>>>        Set External_Class_Name "DFTimer" to "static"
48841>>>>>>>        Set External_Message WM_TIMER to OnTimer
48842>>>>>>>        Object TimersArray0 is a TimersArray0
48844>>>>>>>            Set Array_Value item 0 to -9999 // So we don't use item 0
48845>>>>>>>        End_Object
48846>>>>>>>        Move self to giTimerManager#
48847>>>>>>>    End_Procedure
48848>>>>>>>
48848>>>>>>>    Procedure Set Timer_Active_State Integer iObj Integer iState
48850>>>>>>>        integer iTimerID iTimeout iResult iSet
48850>>>>>>>        Dword   nResult
48850>>>>>>>        Handle  hWnd
48850>>>>>>>        Get Window_Handle to hWnd
48851>>>>>>>        If Not hWnd Begin
48853>>>>>>>            Error 999 "DFTimerManager doesn't have Window_Handle!"
48854>>>>>>>>
48854>>>>>>>            Procedure_Return
48855>>>>>>>        End
48855>>>>>>>>
48855>>>>>>>
48855>>>>>>>        Move (TimersArray0(self)) to iSet
48856>>>>>>>        If iState Begin
48858>>>>>>>            Get MSG_Add_Object of iSet iObj to iTimerID
48859>>>>>>>            Get Timeout of iObj to iTimeout
48860>>>>>>>            Move (SetTimer0(hWnd, iTimerID, iTimeout, 0)) to iResult
48861>>>>>>>            If Not iResult Begin
48863>>>>>>>                Error 999 "Can't create timer. Too many?"
48864>>>>>>>>
48864>>>>>>>                Procedure_Return
48865>>>>>>>            End
48865>>>>>>>>
48865>>>>>>>        End
48865>>>>>>>>
48865>>>>>>>        Else Begin
48866>>>>>>>            Get Find_Object of iSet iObj to iTimerID
48867>>>>>>>            If iTimerID EQ -1 Procedure_Return
48870>>>>>>>            Move (KillTimer0(hWnd, iTimerID)) to iResult
48871>>>>>>>            If Not iResult Begin
48873>>>>>>>                Move (GetLastError0()) to nResult
48874>>>>>>>                Error 999 ("Can't kill timer! Windows error" * string(nResult) - "!")
48875>>>>>>>>
48875>>>>>>>                Procedure_Return
48876>>>>>>>            End
48876>>>>>>>>
48876>>>>>>>            Send Remove_Object to iSet iObj
48877>>>>>>>        End
48877>>>>>>>>
48877>>>>>>>    End_Procedure
48878>>>>>>>
48878>>>>>>>    Function Timer_Active_State Integer iObj Returns Integer
48880>>>>>>>        integer iResult
48880>>>>>>>        Get Find_Object of (TimersArray0(self)) iObj to iResult
48881>>>>>>>        Function_Return (iResult NE 0)
48882>>>>>>>    End_Function
48883>>>>>>>
48883>>>>>>>    Procedure Kill_All_Timers
48885>>>>>>>        integer iMax iSet iItem iObj iResult
48885>>>>>>>        Handle  hWnd
48885>>>>>>>
48885>>>>>>>        Get Window_Handle to hWnd
48886>>>>>>>        If Not hWnd Begin
48888>>>>>>>            Error 999 "DFTimerManager doesn't have Window_Handle!"
48889>>>>>>>>
48889>>>>>>>            Procedure_Return
48890>>>>>>>        End
48890>>>>>>>>
48890>>>>>>>
48890>>>>>>>        Move (TimersArray0(self)) to iSet
48891>>>>>>>        Get Item_Count of iSet to iMax
48892>>>>>>>        Decrement iMax
48893>>>>>>>        For iItem From 1 to iMax
48899>>>>>>>>
48899>>>>>>>            Get Integer_Value of iSet item iItem to iObj
48900>>>>>>>            If iObj Begin
48902>>>>>>>                Move (KillTimer0(hWnd, iItem)) to iResult
48903>>>>>>>                Set Array_Value of iSet item iItem to 0
48904>>>>>>>            End
48904>>>>>>>>
48904>>>>>>>        Loop
48905>>>>>>>>
48905>>>>>>>    End_Procedure
48906>>>>>>>
48906>>>>>>>    Procedure OnTimer Integer wParam Integer lParam
48908>>>>>>>        integer iObj
48908>>>>>>>        Get Integer_Value of (TimersArray0(self)) item wParam to iObj
48909>>>>>>>        If Not iObj Begin
48911>>>>>>>            Error 999 "OnTimer: Timer event without object!"
48912>>>>>>>>
48912>>>>>>>            Procedure_Return
48913>>>>>>>        End
48913>>>>>>>>
48913>>>>>>>        Send OnTimer to iObj wParam lParam
48914>>>>>>>    End_Procedure
48915>>>>>>>
48915>>>>>>>    Procedure Destroy_Object
48917>>>>>>>        Forward Send Destroy_Object
48919>>>>>>>        Move 0 to giTimerManager#
48920>>>>>>>    End_Procedure
48921>>>>>>>End_Class // DFTimerManger
48922>>>>>>>
48922>>>>>>>Class DFTimerManagerPanel0 is a DFPanel
48923>>>>>>>
48923>>>>>>>    Procedure Construct_Object
48925>>>>>>>        Forward Send Construct_Object
48927>>>>>>>        Set Visible_State to FALSE
48928>>>>>>>        Object DFTimerManager is a DFTimerManager0
48930>>>>>>>        End_Object
48931>>>>>>>    End_Procedure
48932>>>>>>>
48932>>>>>>>    Procedure End_Construct_Object
48934>>>>>>>        Forward Send End_Construct_Object
48936>>>>>>>        Send Page_Object TRUE
48937>>>>>>>        Broadcast Send Page_Object TRUE
48939>>>>>>>    End_Procedure
48940>>>>>>>End_Class
48941>>>>>>>
48941>>>>>>>Class DFTimer0 is a Textbox
48942>>>>>>>    Procedure Construct_Object
48944>>>>>>>        Forward Send Construct_Object
48946>>>>>>>        Set Visible_State to FALSE
48947>>>>>>>        Property Integer Timeout            Private 1000
48948>>>>>>>        Property Integer Timer_Message      Public  0
48949>>>>>>>        Property Integer Timer_Object       Public  0
48950>>>>>>>        Property Integer Auto_Start_State   Public  TRUE
48951>>>>>>>        Property Integer Auto_Stop_State    Public  TRUE
48952>>>>>>>    End_Procedure
48953>>>>>>>
48953>>>>>>>    Procedure Set Timer_Active_State Integer iState
48955>>>>>>>        integer iObj
48955>>>>>>>        Move self to iObj
48956>>>>>>>        If giTimerManager# Set Timer_Active_State of giTimerManager# iObj to iState
48959>>>>>>>    End_Procedure
48960>>>>>>>
48960>>>>>>>    Function Timer_Active_State returns integer
48962>>>>>>>        integer iState
48962>>>>>>>        integer iObj
48962>>>>>>>        Move self to iObj
48963>>>>>>>        If giTimerManager# Get Timer_Active_State of giTimerManager# iObj to iState
48966>>>>>>>        Function_Return iState
48967>>>>>>>    End_Function
48968>>>>>>>
48968>>>>>>>    Procedure Set Timeout Integer iTimeout
48970>>>>>>>        integer iActive
48970>>>>>>>        Set !$.Timeout to iTimeout
48971>>>>>>>        Get Timer_Active_State to iActive
48972>>>>>>>        If iActive Set Timer_Active_State to TRUE
48975>>>>>>>    End_Procedure
48976>>>>>>>
48976>>>>>>>    Function Timeout Returns Integer
48978>>>>>>>        integer iTimeout
48978>>>>>>>        Get !$.Timeout to iTimeout
48979>>>>>>>        Function_Return iTimeout
48980>>>>>>>    End_Function
48981>>>>>>>
48981>>>>>>>    Procedure OnTimer Integer iwParam Integer ilParam
48983>>>>>>>        integer iMsg
48983>>>>>>>        integer iObj
48983>>>>>>>        Get Timer_Message to iMsg
48984>>>>>>>        Get Timer_Object  to iObj
48985>>>>>>>        If (iMsg) Begin
48987>>>>>>>            Get Timer_Object  to iObj
48988>>>>>>>            If iObj Send iMsg to iObj iwParam ilParam
48991>>>>>>>            Else Send iMsg iwParam ilParam
48993>>>>>>>        End
48993>>>>>>>>
48993>>>>>>>    End_Procedure
48994>>>>>>>
48994>>>>>>>    Procedure Page_Object Integer iState
48996>>>>>>>        Forward Send Page_Object iState
48998>>>>>>>        If (iState AND Auto_Start_State(self)) Set Timer_Active_State to TRUE
49001>>>>>>>    End_Procedure
49002>>>>>>>
49002>>>>>>>    Procedure Page_Delete
49004>>>>>>>        If (Auto_Stop_State(self)) Set Timer_Active_State to FALSE
49007>>>>>>>        Forward Send Page_Delete
49009>>>>>>>    End_Procedure
49010>>>>>>>
49010>>>>>>>    Procedure Destroy_Object
49012>>>>>>>        Set Timer_Active_State to FALSE
49013>>>>>>>        Forward Send Destroy_Object
49015>>>>>>>    End_Procedure
49016>>>>>>>End_Class // DFTimer0
49017>>>>>>>
49017>>>>>>>// This is where this package differs from the DAC package. Object
49017>>>>>>>// DFTimerManagerPanel0 is NOT instantiated at program start up
49017>>>>>>>// thus leaving focus un-disturbed. Instead they are created the first
49017>>>>>>>// time Deferred_Request_Destroy_Object is sent.
49017>>>>>>>
49017>>>>>>>DEFINE_OBJECT_GROUP OG_DeferredTimer
49018>>>>>>>  Object DFTimerManagerPanel0 is a DFTimerManagerPanel0
49020>>>>>>>    // This object will make the program lose its focus if instantiated
49020>>>>>>>    // before Main.Client_Area has been created.
49020>>>>>>>  End_Object
49021>>>>>>>
49021>>>>>>>  object oMessages is an Array no_image
49023>>>>>>>  end_object
49024>>>>>>>
49024>>>>>>>  object oDestructionTimer is a DfTimer0
49026>>>>>>>    // And this object would have made the program crash
49026>>>>>>>    set auto_start_state to false
49027>>>>>>>    set auto_stop_state to false
49028>>>>>>>    property integer pDestroyObject public 0
49030>>>>>>>    procedure OnTimer
49033>>>>>>>      integer obj# msg# oMessages#
49033>>>>>>>      get pDestroyObject to obj#
49034>>>>>>>      if obj# begin
49036>>>>>>>        send request_destroy_object to obj#
49037>>>>>>>        set pDestroyObject to 0
49038>>>>>>>        set Timer_Active_State to false // Stop timer
49039>>>>>>>        if (item_count(oMessages(self))) begin
49041>>>>>>>          set TimeOut to 0 // This means "as soon as possible"
49042>>>>>>>          set Timer_Active_State to true // Start timer
49043>>>>>>>        end
49043>>>>>>>>
49043>>>>>>>      end
49043>>>>>>>>
49043>>>>>>>      else begin
49044>>>>>>>        move (oMessages(self)) to oMessages#
49045>>>>>>>        if (item_count(oMessages#)) begin
49047>>>>>>>          get value of oMessages# item 0 to msg#
49048>>>>>>>          get value of oMessages# item 1 to obj#
49049>>>>>>>          send delete_item to oMessages# 0
49050>>>>>>>          send delete_item to oMessages# 0
49051>>>>>>>          set Timer_Active_State to false // Stop timer
49052>>>>>>>          if obj# send msg# to obj#
49055>>>>>>>          else send msg#
49057>>>>>>>          if (item_count(oMessages#)) begin
49059>>>>>>>            set TimeOut to 0 // This means "as soon as possible"
49060>>>>>>>            set Timer_Active_State to true // Start timer
49061>>>>>>>          end
49061>>>>>>>>
49061>>>>>>>        end
49061>>>>>>>>
49061>>>>>>>      end
49061>>>>>>>>
49061>>>>>>>    end_procedure
49062>>>>>>>    procedure Deferred_Destroy integer obj#
49065>>>>>>>      set pDestroyObject to obj#
49066>>>>>>>      set TimeOut to 0 // This means "as soon as possible"
49067>>>>>>>      set Timer_Active_State to true // Start timer
49068>>>>>>>    end_procedure
49069>>>>>>>
49069>>>>>>>    procedure Send_Message integer msg# integer obj#
49072>>>>>>>      integer oMessages#
49072>>>>>>>      move (oMessages(self)) to oMessages#
49073>>>>>>>      set value of oMessages# item (item_count(oMessages#)) to msg#
49074>>>>>>>      set value of oMessages# item (item_count(oMessages#)) to obj#
49075>>>>>>>      set TimeOut to 0 // This means "as soon as possible"
49076>>>>>>>      set Timer_Active_State to true // Start timer
49077>>>>>>>    end_procedure
49078>>>>>>>  end_object
49079>>>>>>>END_DEFINE_OBJECT_GROUP
49080>>>>>>>
49080>>>>>>>Procedure Deferred_Request_Destroy_Object for BaseClass
49082>>>>>>>  integer self# Client_ID#
49082>>>>>>>  move self to self#
49083>>>>>>>  ifnot giTimerManager# begin //
49085>>>>>>>    move (Client_ID(self#)) to Client_ID#
49086>>>>>>>    if Client_ID# begin
49088>>>>>>>      CREATE_OBJECT_GROUP OG_DeferredTimer PARENT Client_ID#
49097>>>>>>>    end
49097>>>>>>>>
49097>>>>>>>    else error 666 "ClientArea not found!"
49099>>>>>>>  end
49099>>>>>>>>
49099>>>>>>>  send Deferred_Destroy to (oDestructionTimer(giTimerManager#)) self#
49100>>>>>>>End_Procedure
49101>>>>>>>
49101>>>>>>>Procedure Deferred_Message for BaseClass integer msg# integer obj#
49103>>>>>>>  integer self# Client_ID#
49103>>>>>>>  move self to self#
49104>>>>>>>  ifnot giTimerManager# begin //
49106>>>>>>>    move (Client_ID(self#)) to Client_ID#
49107>>>>>>>    if Client_ID# begin
49109>>>>>>>      CREATE_OBJECT_GROUP OG_DeferredTimer PARENT Client_ID#
49118>>>>>>>    end
49118>>>>>>>>
49118>>>>>>>    else error 666 "ClientArea not found!"
49120>>>>>>>  end
49120>>>>>>>>
49120>>>>>>>  if num_arguments gt 1 send send_message to (oDestructionTimer(giTimerManager#)) msg# obj#
49123>>>>>>>  else send send_message to (oDestructionTimer(giTimerManager#)) msg# self#
49125>>>>>>>End_Procedure
49126>>>>>>>
49126>>>>>Use FdxField.utl // FDX Field things
Including file: fdxfield.utl    (C:\projects\BRS\VDFQuery\AppSrc\fdxfield.utl)
49126>>>>>>>Use FdxField.nui // FDX Field things
Including file: fdxfield.nui    (C:\projects\BRS\VDFQuery\AppSrc\fdxfield.nui)
49126>>>>>>>>>// Use FdxField.nui // FDX Field things
49126>>>>>>>>>//
49126>>>>>>>>>// Wed 10-09-2003 - Added FDX_ReadRecordBufferToArray_LD
49126>>>>>>>>>
49126>>>>>>>>>Use Fdx_Attr.nui // FDX compatible attribute functions
Including file: fdx_attr.nui    (C:\projects\BRS\VDFQuery\AppSrc\fdx_attr.nui)
49126>>>>>>>>>>>// Use FDX_Attr.nui // FDX compatible attribute functions
49126>>>>>>>>>>>//
49126>>>>>>>>>>>//> The functions defined in this class allows you to query the setting
49126>>>>>>>>>>>//> of all the API attrbutes whether from the current runtime or from
49126>>>>>>>>>>>//> an FDX object, using the same calling syntax.
49126>>>>>>>>>>>
49126>>>>>>>>>>>
49126>>>>>>>>>>>Use API_Attr.nui // Database API attributes characteristics
49126>>>>>>>>>>>Use DBMS.nui     // Basic DBMS functions
49126>>>>>>>>>>>
49126>>>>>>>>>>>// The functions below are only declared if FDX.nui is used.
49126>>>>>>>>>>>register_function AttrValue_GLOBAL integer attr# returns string
49126>>>>>>>>>>>register_function AttrValue_FILELIST integer attr# integer file# returns string
49126>>>>>>>>>>>register_function AttrValue_FILE integer attr# integer file# returns string
49126>>>>>>>>>>>register_function AttrValue_FIELD integer attr# integer file# integer field# returns string
49126>>>>>>>>>>>register_function AttrValue_INDEX integer attr# integer file# integer index# returns string
49126>>>>>>>>>>>register_function AttrValue_IDXSEG integer attr# integer file# integer index# integer segment# returns string
49126>>>>>>>>>>>register_function AttrValue_SPECIAL1 integer attr# integer file# integer field1# integer field2# returns string
49126>>>>>>>>>>>register_function AttrValue_FLSTNAV integer attr# integer file# returns string
49126>>>>>>>>>>>register_function AttrValue_DRIVER integer attr# integer driver# returns string
49126>>>>>>>>>>>register_function AttrValue_DRVSRV integer attr# integer driver# integer server# returns string
49126>>>>>>>>>>>register_function OtherAttr_Value integer attr# returns string
49126>>>>>>>>>>>register_function piFileDefObject.i integer file# returns integer
49126>>>>>>>>>>>register_function psFileName returns string
49126>>>>>>>>>>>register_function iNextFileThatCanOpen integer file# returns integer
49126>>>>>>>>>>>
49126>>>>>>>>>>>function FDX_AttrValue_GLOBAL global integer oFDX# integer attr# returns string
49128>>>>>>>>>>>  if oFDX# function_return (AttrValue_GLOBAL(oFDX#,attr#))
49131>>>>>>>>>>>  else function_return (API_AttrValue_GLOBAL(attr#))
49133>>>>>>>>>>>end_function
49134>>>>>>>>>>>function FDX_AttrValue_FILELIST global integer oFDX# integer attr# integer file# returns string
49136>>>>>>>>>>>  if oFDX# function_return (AttrValue_FILELIST(oFDX#,attr#,file#))
49139>>>>>>>>>>>  else function_return (API_AttrValue_FILELIST(attr#,file#))
49141>>>>>>>>>>>end_function
49142>>>>>>>>>>>function FDX_AttrValue_FILE global integer oFDX# integer attr# integer file# returns string
49144>>>>>>>>>>>  if oFDX# function_return (AttrValue_FILE(oFDX#,attr#,file#))
49147>>>>>>>>>>>  else function_return (API_AttrValue_FILE(attr#,file#))
49149>>>>>>>>>>>end_function
49150>>>>>>>>>>>function FDX_AttrValue_FIELD global integer oFDX# integer attr# integer file# integer field# returns string
49152>>>>>>>>>>>  if oFDX# function_return (AttrValue_FIELD(oFDX#,attr#,file#,field#))
49155>>>>>>>>>>>  else function_return (API_AttrValue_FIELD(attr#,file#,field#))
49157>>>>>>>>>>>end_function
49158>>>>>>>>>>>function FDX_AttrValue_INDEX global integer oFDX# integer attr# integer file# integer index# returns string
49160>>>>>>>>>>>  if oFDX# function_return (AttrValue_INDEX(oFDX#,attr#,file#,index#))
49163>>>>>>>>>>>  else function_return (API_AttrValue_INDEX(attr#,file#,index#))
49165>>>>>>>>>>>end_function
49166>>>>>>>>>>>function FDX_AttrValue_IDXSEG global integer oFDX# integer attr# integer file# integer index# integer segment# returns string
49168>>>>>>>>>>>  if oFDX# function_return (AttrValue_IDXSEG(oFDX#,attr#,file#,index#,segment#))
49171>>>>>>>>>>>  else function_return (API_AttrValue_IDXSEG(attr#,file#,index#,segment#))
49173>>>>>>>>>>>end_function
49174>>>>>>>>>>>function FDX_AttrValue_SPECIAL1 global integer oFDX# integer attr# integer file# integer field1# integer field2# returns string
49176>>>>>>>>>>>  if oFDX# function_return (AttrValue_SPECIAL1(oFDX#,attr#,file#,field1#,field2#))
49179>>>>>>>>>>>  else function_return (API_AttrValue_SPECIAL1(attr#,file#,field1#,field2#))
49181>>>>>>>>>>>end_function
49182>>>>>>>>>>>function FDX_AttrValue_FLSTNAV global integer oFDX# integer attr# integer file# returns string
49184>>>>>>>>>>>  if oFDX# function_return (AttrValue_FLSTNAV(oFDX#,attr#,file#))
49187>>>>>>>>>>>  else function_return (API_AttrValue_FLSTNAV(attr#,file#))
49189>>>>>>>>>>>end_function
49190>>>>>>>>>>>function FDX_AttrValue_DRIVER global integer oFDX# integer attr# integer driver# returns string
49192>>>>>>>>>>>  if oFDX# function_return (AttrValue_DRIVER(oFDX#,attr#,driver#))
49195>>>>>>>>>>>  else function_return (API_AttrValue_DRIVER(attr#,driver#))
49197>>>>>>>>>>>end_function
49198>>>>>>>>>>>function FDX_AttrValue_DRVSRV global integer oFDX# integer attr# integer driver# integer server# returns string
49200>>>>>>>>>>>  if oFDX# function_return (AttrValue_DRVSRV(oFDX#,attr#,driver#,server#))
49203>>>>>>>>>>>  else function_return (API_AttrValue_DRVSRV(attr#,driver#,server#))
49205>>>>>>>>>>>end_function
49206>>>>>>>>>>>function FDX_OtherAttr_Value global integer oFDX# integer attr# returns string
49208>>>>>>>>>>>  if oFDX# function_return (OtherAttr_Value(oFDX#,attr#))
49211>>>>>>>>>>>  else function_return (API_OtherAttr_Value(attr#))
49213>>>>>>>>>>>end_function
49214>>>>>>>>>>>function FDX_CanOpenFile global integer oFDX# integer file# returns integer
49216>>>>>>>>>>>  if oFDX# function_return (piFileDefObject.i(oFdx#,file#))
49219>>>>>>>>>>>  else function_return (DBMS_CanOpenFile(file#))
49221>>>>>>>>>>>end_function
49222>>>>>>>>>>>function FDX_NextFileThatCanOpen global integer oFDX# integer file# returns integer
49224>>>>>>>>>>>  if oFDX# function_return (iNextFileThatCanOpen(oFdx#,file#))
49227>>>>>>>>>>>  else function_return (API_NextFileThatCanOpen(file#))
49229>>>>>>>>>>>end_function
49230>>>>>>>>>>>function FDX_FindRootName global integer lhFDX string lsFindRootName integer liFile returns integer
49232>>>>>>>>>>>  string lsRootStripped
49232>>>>>>>>>>>  get DBMS_StripPathAndDriver lsFindRootName to lsFindRootName
49233>>>>>>>>>>>  repeat
49233>>>>>>>>>>>>
49233>>>>>>>>>>>    move (FDX_AttrValue_FLSTNAV(lhFDX,DF_FILE_NEXT_USED,liFile)) to liFile
49234>>>>>>>>>>>    if liFile begin
49236>>>>>>>>>>>      get FDX_AttrValue_FILELIST lhFDX DF_FILE_ROOT_NAME liFile to lsRootStripped
49237>>>>>>>>>>>      get DBMS_StripPathAndDriver lsRootStripped to lsRootStripped
49238>>>>>>>>>>>      if (lowercase(lsFindRootName)=lowercase(lsRootStripped)) function_return liFile
49241>>>>>>>>>>>    end
49241>>>>>>>>>>>>
49241>>>>>>>>>>>  until liFile eq 0
49243>>>>>>>>>>>  function_return 0
49244>>>>>>>>>>>end_function
49245>>>>>>>>>>>function FDX_FindLogicalName global integer lhFDX string lsFindLogName integer liFile returns integer
49247>>>>>>>>>>>  string lsLogName
49247>>>>>>>>>>>  repeat
49247>>>>>>>>>>>>
49247>>>>>>>>>>>    move (FDX_AttrValue_FLSTNAV(lhFDX,DF_FILE_NEXT_USED,liFile)) to liFile
49248>>>>>>>>>>>    if liFile begin
49250>>>>>>>>>>>      get FDX_AttrValue_FILELIST lhFDX DF_FILE_LOGICAL_NAME liFile to lsLogName
49251>>>>>>>>>>>      if (lowercase(lsFindLogName)=lowercase(lsLogName)) function_return liFile
49254>>>>>>>>>>>    end
49254>>>>>>>>>>>>
49254>>>>>>>>>>>  until liFile eq 0
49256>>>>>>>>>>>  function_return 0
49257>>>>>>>>>>>end_function
49258>>>>>>>>>>>
49258>>>>>>>>>>>// ******** Samples ********************************************
49258>>>>>>>>>>>//
49258>>>>>>>>>>>// A loop through all files/all fields:
49258>>>>>>>>>>>//
49258>>>>>>>>>>>//   procedure GoThoughAllFields
49258>>>>>>>>>>>//     integer oFDX# file# field# max#
49258>>>>>>>>>>>//     get piFDX_Server to oFDX#
49258>>>>>>>>>>>//     move 0 to file#
49258>>>>>>>>>>>//     repeat
49258>>>>>>>>>>>//       move (FDX_AttrValue_FLSTNAV(oFDX#,DF_FILE_NEXT_USED,file#)) to file#
49258>>>>>>>>>>>//       if file# begin
49258>>>>>>>>>>>//         move (FDX_AttrValue_FILE(oFDX#,DF_FILE_NUMBER_FIELDS,file#)) to max#
49258>>>>>>>>>>>//         for field# from 1 to max#
49258>>>>>>>>>>>//           (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_NAME,file#,field#))
49258>>>>>>>>>>>//         loop
49258>>>>>>>>>>>//       end
49258>>>>>>>>>>>//     until file# eq 0
49258>>>>>>>>>>>//   end_procedure
49258>>>>>>>>>>>//
49258>>>>>>>>>>>// A loop through all indices/segments of a file:
49258>>>>>>>>>>>//
49258>>>>>>>>>>>//   procedure GoThoughAllIndices integer file#
49258>>>>>>>>>>>//     integer oFDX# index# seg_max# segment# field#
49258>>>>>>>>>>>//     get piFDX_Server to oFDX#
49258>>>>>>>>>>>//
49258>>>>>>>>>>>//     for index# from 1 to 16
49258>>>>>>>>>>>//       get FDX_AttrValue_INDEX oFDX# DF_INDEX_NUMBER_SEGMENTS file# index# to seg_max#
49258>>>>>>>>>>>//       if max_seg# begin // If there's an index at all
49258>>>>>>>>>>>//         for segment# from 1 to seg_max#
49258>>>>>>>>>>>//           get FDX_AttrValue_IDXSEG oFDX# DF_INDEX_SEGMENT_FIELD file# index# segment# to field#
49258>>>>>>>>>>>//         loop
49258>>>>>>>>>>>//       end
49258>>>>>>>>>>>//     loop
49258>>>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
49258>>>>>>>>>Use Strings.nui  // String manipulation for VDF
49258>>>>>>>>>Use Dates.nui    // Date manipulation for VDF
49258>>>>>>>>>
49258>>>>>>>>>//> Translates an overlap field into the sequence of fields that makes up
49258>>>>>>>>>//> the overlap field. The field sequence is returned in a string where each
49258>>>>>>>>>//> field in the sequence takes up four characters. The sequence of fields
49258>>>>>>>>>//> 2, 3 and 4 would return as "2   3   4   ".
49258>>>>>>>>>function FDX_FieldsInOverlap global integer lhFDX integer liFile integer lbOverlap returns string
49260>>>>>>>>>  integer liField liMax
49260>>>>>>>>>  string lsValue
49260>>>>>>>>>  move "" to lsValue
49261>>>>>>>>>  // Only go through this if lbOverlap is indeed an overlap field:
49261>>>>>>>>>  if (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile,lbOverlap))) eq DF_OVERLAP begin
49263>>>>>>>>>    move (FDX_AttrValue_FILE(lhFDX,DF_FILE_NUMBER_FIELDS,liFile)) to liMax
49264>>>>>>>>>    for liField from 1 to liMax
49270>>>>>>>>>>
49270>>>>>>>>>      // Only check to see if field is part of the overlap if it is not itself an overlap field:
49270>>>>>>>>>      if (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile,liField))) ne DF_OVERLAP begin
49272>>>>>>>>>        if (integer(FDX_AttrValue_SPECIAL1(lhFDX,DF_FIELD_OVERLAP,liFile,lbOverlap,liField))) move (lsValue+pad(liField,4)) to lsValue
49275>>>>>>>>>      end
49275>>>>>>>>>>
49275>>>>>>>>>    loop
49276>>>>>>>>>>
49276>>>>>>>>>  end
49276>>>>>>>>>>
49276>>>>>>>>>  else move (pad(lbOverlap,4)) to lsValue
49278>>>>>>>>>  function_return lsValue
49279>>>>>>>>>end_function // FDX_FieldsInOverlap
49280>>>>>>>>>
49280>>>>>>>>>//> The function returns a set of (overlap-) fields all overlapping
49280>>>>>>>>>//> the field passed as an arguments
49280>>>>>>>>>function FDX_FieldsOverlappingField global integer lhFDX integer liFile integer liField returns string
49282>>>>>>>>>  integer liMaxField liTestField
49282>>>>>>>>>  string lsRval
49282>>>>>>>>>  move "" to lsRval
49283>>>>>>>>>  move (FDX_AttrValue_FILE(lhFDX,DF_FILE_NUMBER_FIELDS,liFile)) to liMaxField
49284>>>>>>>>>  for liTestField from 1 to liMaxField
49290>>>>>>>>>>
49290>>>>>>>>>    if (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile,liTestField))) eq DF_OVERLAP begin
49292>>>>>>>>>      if (integer(FDX_AttrValue_SPECIAL1(lhFDX,DF_FIELD_OVERLAP,liFile,liTestField,liField))) move (lsRval+pad(liTestField,4)) to lsRval
49295>>>>>>>>>    end
49295>>>>>>>>>>
49295>>>>>>>>>  loop
49296>>>>>>>>>>
49296>>>>>>>>>  function_return lsRval
49297>>>>>>>>>end_function // FDX_FieldsInOverlap
49298>>>>>>>>>
49298>>>>>>>>>//> Remove dublettes from a sequence of fields
49298>>>>>>>>>function FDX_FieldsRemoveDublettes global string lsFields returns string
49300>>>>>>>>>  integer liMaxPos liSegment
49300>>>>>>>>>  string lsValue liField
49300>>>>>>>>>  move "" to lsValue
49301>>>>>>>>>  move (length(lsFields)+3/4) to liMaxPos
49302>>>>>>>>>  for liSegment from 1 to liMaxPos
49308>>>>>>>>>>
49308>>>>>>>>>    move (mid(lsFields,4,liSegment-1*4+1)) to liField
49309>>>>>>>>>    ifnot liField in lsValue move (lsValue+liField) to lsValue
49312>>>>>>>>>  loop
49313>>>>>>>>>>
49313>>>>>>>>>  function_return lsValue
49314>>>>>>>>>end_function
49315>>>>>>>>>
49315>>>>>>>>>//> This function takes a sequence of fields translating each overlap field
49315>>>>>>>>>//> in the sequence to its underlying real fields and returns the translated
49315>>>>>>>>>//> sequence.
49315>>>>>>>>>function FDX_FieldsTranslateOverlaps global integer lhFDX integer liFile string lsFields returns string
49317>>>>>>>>>  integer liMaxPos liField liPos
49317>>>>>>>>>  string lsValue
49317>>>>>>>>>  move "" to lsValue
49318>>>>>>>>>  move (length(lsFields)+3/4) to liMaxPos
49319>>>>>>>>>  for liPos from 0 to (liMaxPos-1)
49325>>>>>>>>>>
49325>>>>>>>>>    move (mid(lsFields,4,liPos*4+1)) to liField
49326>>>>>>>>>    if (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile,liField))) eq DF_OVERLAP move (lsValue+FDX_FieldsInOverlap(lhFDX,liFile,liField)) to lsValue
49329>>>>>>>>>    else move (lsValue+pad(liField,4)) to lsValue
49331>>>>>>>>>  loop
49332>>>>>>>>>>
49332>>>>>>>>>  function_return lsValue
49333>>>>>>>>>end_function // FDX_FieldsTranslateOverlaps
49334>>>>>>>>>
49334>>>>>>>>>//> Use to check if two fields are identically defined
49334>>>>>>>>>function FDX_FieldIdenticalFieldDefinition global integer lhFDX integer liFile1 integer liField1 integer liFile2 integer liField2 returns integer
49336>>>>>>>>>  if (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile1,liField1))<>integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile2,liField2))) function_return 0
49339>>>>>>>>>  if (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_LENGTH,liFile1,liField1))<>integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_LENGTH,liFile2,liField2))) function_return 0
49342>>>>>>>>>  if (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_PRECISION,liFile1,liField1))<>integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_PRECISION,liFile2,liField2))) function_return 0
49345>>>>>>>>>  function_return 1 // Yes, they are identical
49346>>>>>>>>>end_function
49347>>>>>>>>>
49347>>>>>>>>>//> Use to check if two sequences of fields are identically defined. Returns TRUE if identical
49347>>>>>>>>>function FDX_FieldIdenticalFieldSequenceDefinition global integer lhFDX integer liFile1 string lsFields1 integer liFile2 string lsFields2 returns integer
49349>>>>>>>>>  integer liMaxPos liField liPos liField1 liField2
49349>>>>>>>>>  if (length(lsFields1)<>length(lsFields2)) function_return 0
49352>>>>>>>>>  move (length(lsFields1)+3/4) to liMaxPos
49353>>>>>>>>>  for liPos from 0 to (liMaxPos-1)
49359>>>>>>>>>>
49359>>>>>>>>>    move (mid(lsFields1,4,liPos*4+1)) to liField1
49360>>>>>>>>>    move (mid(lsFields2,4,liPos*4+1)) to liField2
49361>>>>>>>>>    ifnot (FDX_FieldIdenticalFieldDefinition(lhFDX,liFile1,liField1,liFile2,liField2)) function_return 0
49364>>>>>>>>>  loop
49365>>>>>>>>>>
49365>>>>>>>>>  function_return 1 // Yes, they are identical
49366>>>>>>>>>end_function
49367>>>>>>>>>
49367>>>>>>>>>//> Use this to compare two overlap fields. Returns TRUE if identical.
49367>>>>>>>>>function FDX_FieldIdenticalOverlapStructures global integer lhFDX integer liFile1 integer liField1 integer liFile2 integer liField2 returns integer
49369>>>>>>>>>  string lsFields1 lsFields2
49369>>>>>>>>>  get FDX_FieldsInOverlap lhFDX liFile1 liField1 to lsFields1
49370>>>>>>>>>  get FDX_FieldsInOverlap lhFDX liFile2 liField2 to lsFields2
49371>>>>>>>>>  function_return (FDX_FieldIdenticalFieldSequenceDefinition(lhFDX,liFile1,lsFields1,liFile2,lsFields2))
49372>>>>>>>>>end_function
49373>>>>>>>>>
49373>>>>>>>>>function FDX_FieldName global integer lhFDX integer liFile integer liField integer lbIncludeTable returns string
49375>>>>>>>>>  string lsLogName lsFieldName
49375>>>>>>>>>  ifnot liFile function_return ""
49378>>>>>>>>>  move (FDX_AttrValue_FILELIST(lhFDX,DF_FILE_LOGICAL_NAME,liFile)) to lsLogName
49379>>>>>>>>>  if liField move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_NAME,liFile,liField)) to lsFieldName
49382>>>>>>>>>  else move "RECNUM" to lsFieldName
49384>>>>>>>>>  if lbIncludeTable function_return (lsLogName+"."+lsFieldName)
49387>>>>>>>>>  function_return lsFieldName
49388>>>>>>>>>end_function
49389>>>>>>>>>
49389>>>>>>>>>function FDX_FieldNames global integer lhFDX integer liFile string lsFields returns string
49391>>>>>>>>>  integer liMaxPos liSegment
49391>>>>>>>>>  string lsRval lsField
49391>>>>>>>>>  move "" to lsRval
49392>>>>>>>>>  move (length(lsFields)+3/4) to liMaxPos
49393>>>>>>>>>  for liSegment from 1 to liMaxPos
49399>>>>>>>>>>
49399>>>>>>>>>    move (mid(lsFields,4,liSegment-1*4+1)) to lsField
49400>>>>>>>>>    move (lsRval+FDX_FieldName(lhFDX,liFile,lsField,0)) to lsRval
49401>>>>>>>>>    if liSegment ne liMaxPos move (lsRval+",") to lsRval
49404>>>>>>>>>  loop
49405>>>>>>>>>>
49405>>>>>>>>>  function_return lsRval
49406>>>>>>>>>end_function
49407>>>>>>>>>
49407>>>>>>>>>function FDX_FieldTypeName global integer lhFDX integer liFile integer liField returns string
49409>>>>>>>>>  integer liType
49409>>>>>>>>>  move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile,liField)) to liType
49410>>>>>>>>>  function_return (StringFieldType(liType))
49411>>>>>>>>>end_function
49412>>>>>>>>>
49412>>>>>>>>>function FDX_FieldLength global integer lhFDX integer liFile integer liField returns string
49414>>>>>>>>>  integer liType liLen liDec lhObj
49414>>>>>>>>>  string lsRval
49414>>>>>>>>>  move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile,liField)) to liType
49415>>>>>>>>>  move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_LENGTH,liFile,liField)) to liLen
49416>>>>>>>>>  move liLen to lsRval
49417>>>>>>>>>  if liType eq DF_BCD begin
49419>>>>>>>>>    move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_PRECISION,liFile,liField)) to liDec
49420>>>>>>>>>    move "#.#" to lsRval
49421>>>>>>>>>    replace "#" in lsRval with (string(liLen-liDec))
49423>>>>>>>>>    replace "#" in lsRval with (string(liDec))
49425>>>>>>>>>  end
49425>>>>>>>>>>
49425>>>>>>>>>  function_return lsRval
49426>>>>>>>>>end_function
49427>>>>>>>>>
49427>>>>>>>>>function FDX_FieldTypeAndLengthName global integer lhFDX integer liFile integer liField returns string
49429>>>>>>>>>  string lsRval
49429>>>>>>>>>  get FDX_FieldTypeName lhFDX liFile liField to lsRval
49430>>>>>>>>>  move (uppercase(left(lsRval,3))) to lsRval
49431>>>>>>>>>  function_return (lsRval+" "+FDX_FieldLength(lhFDX,liFile,liField))
49432>>>>>>>>>end_function
49433>>>>>>>>>
49433>>>>>>>>>function FDX_FieldTypeAndLengthName2 global integer lhFDX integer liFile integer liField returns string
49435>>>>>>>>>  string lsRval
49435>>>>>>>>>  get FDX_FieldTypeName lhFDX liFile liField to lsRval
49436>>>>>>>>>  function_return (lsRval+" "+FDX_FieldLength(lhFDX,liFile,liField))
49437>>>>>>>>>end_function
49438>>>>>>>>>
49438>>>>>>>>>//> Returns "Field Name (NUM 2.2)"
49438>>>>>>>>>function FDX_FieldNameAndType global integer lhFDX integer liFile integer liField returns string
49440>>>>>>>>>  string lsRval
49440>>>>>>>>>  get FDX_AttrValue_FIELD lhFDX DF_FIELD_NAME liFile liField to lsRval
49441>>>>>>>>>  move (StringUppercaseFirstLetters(replaces("_",lsRval," "))) to lsRval
49442>>>>>>>>>  function_return (lsRval+" ("+FDX_FieldTypeAndLengthName(lhFDX,liFile,liField)+")")
49443>>>>>>>>>end_function
49444>>>>>>>>>
49444>>>>>>>>>//> Returns the concatenated values of the fields in sFields parameter
49444>>>>>>>>>//> separated by space characters. Overlap fields are ignored. (and so
49444>>>>>>>>>//> are Text and Binary fields)
49444>>>>>>>>>function FDX_FieldValues global integer lhFDX integer iFile string sFields returns string
49446>>>>>>>>>  integer iMaxPos iField iPos iType iLen iDec
49446>>>>>>>>>  string sRval sFieldVal
49446>>>>>>>>>  move "" to sRval
49447>>>>>>>>>  ifnot lhFDX begin
49449>>>>>>>>>    move (length(sFields)+3/4) to iMaxPos
49450>>>>>>>>>    for iPos from 1 to iMaxPos
49456>>>>>>>>>>
49456>>>>>>>>>      move (mid(sFields,4,iPos-1*4+1)) to iField
49457>>>>>>>>>      move (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,iFile,iField))) to iType
49458>>>>>>>>>      get_field_value iFile iField to sFieldVal
49461>>>>>>>>>      if iType eq DF_ASCII move (sRval+rtrim(sFieldVal)) to sRval
49464>>>>>>>>>      if iType eq DF_BCD begin
49466>>>>>>>>>        get_attribute DF_FIELD_LENGTH of iFile iField to iLen
49469>>>>>>>>>        get_attribute DF_FIELD_PRECISION of iFile iField to iDec
49472>>>>>>>>>        if iDec increment iLen // Make room for comma
49475>>>>>>>>>        move (sRval+NumToStrR(sFieldVal,iDec,iLen)) to sRval
49476>>>>>>>>>      end
49476>>>>>>>>>>
49476>>>>>>>>>      if iType eq DF_DATE move (sRval+string(DateToInteger(sFieldVal))) to sRval
49479>>>>>>>>>      if iPos ne iMaxPos move (sRval+" ") to sRval
49482>>>>>>>>>    loop
49483>>>>>>>>>>
49483>>>>>>>>>  end
49483>>>>>>>>>>
49483>>>>>>>>>  else function_return "Function FDX_FieldValues may only be called with lhFDX=0"
49485>>>>>>>>>  function_return sRval
49486>>>>>>>>>end_function
49487>>>>>>>>>
49487>>>>>>>>>//> Returns the concatenated values of the fields in sFields parameter
49487>>>>>>>>>//> separated by "-" characters. Overlap fields are ignored. (and so
49487>>>>>>>>>//> are Text and Binary fields). The returns value of this function is
49487>>>>>>>>>//> meant to be used as the a file name.
49487>>>>>>>>>function FDX_FieldValuesFileName_Help global string lsSource returns string
49489>>>>>>>>>  integer liPos liLen liByte
49489>>>>>>>>>  string lsChar lsRval
49489>>>>>>>>>  move "" to lsRval
49490>>>>>>>>>  move (length(lsSource)) to liLen
49491>>>>>>>>>  for liPos from 1 to liLen
49497>>>>>>>>>>
49497>>>>>>>>>    move (mid(lsSource,1,liPos)) to lsChar
49498>>>>>>>>>    move (lsRval+ByteToHex(ascii(lsChar))) to lsRval
49499>>>>>>>>>  loop
49500>>>>>>>>>>
49500>>>>>>>>>  function_return lsRval
49501>>>>>>>>>end_function
49502>>>>>>>>>function FDX_FieldValuesFileName global integer lhFDX integer liFile string lsFields returns string
49504>>>>>>>>>  integer liMaxPos liField liPos liType liLen liDec
49504>>>>>>>>>  string lsRval lsFieldValue
49504>>>>>>>>>  move "" to lsRval
49505>>>>>>>>>  ifnot lhFDX begin
49507>>>>>>>>>    move (length(lsFields)+3/4) to liMaxPos
49508>>>>>>>>>    for liPos from 1 to liMaxPos
49514>>>>>>>>>>
49514>>>>>>>>>      move (mid(lsFields,4,liPos-1*4+1)) to liField
49515>>>>>>>>>      move (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile,liField))) to liType
49516>>>>>>>>>      get_field_value liFile liField to lsFieldValue
49519>>>>>>>>>      if liType eq DF_ASCII move (lsRval+FDX_FieldValuesFileName_Help(lsFieldValue)) to lsRval
49522>>>>>>>>>      if liType eq DF_BCD begin
49524>>>>>>>>>        get_attribute DF_FIELD_LENGTH of liFile liField to liLen
49527>>>>>>>>>        get_attribute DF_FIELD_PRECISION of liFile liField to liDec
49530>>>>>>>>>        if liDec increment liLen // Make room for comma
49533>>>>>>>>>        move (lsRval+NumToStrRzf(lsFieldValue,liDec,liLen)) to lsRval
49534>>>>>>>>>      end
49534>>>>>>>>>>
49534>>>>>>>>>      if liType eq DF_DATE move (lsRval+string(DateToInteger(lsFieldValue))) to lsRval
49537>>>>>>>>>      if liPos ne liMaxPos move (lsRval+"-") to lsRval
49540>>>>>>>>>    loop
49541>>>>>>>>>>
49541>>>>>>>>>  end
49541>>>>>>>>>>
49541>>>>>>>>>  else function_return "Function FDX_FieldValues may only be called with lhFDX=0"
49543>>>>>>>>>  move (replaces(".",lsRval,"")) to lsRval
49544>>>>>>>>>  move (replaces(",",lsRval,"")) to lsRval
49545>>>>>>>>>  move (replaces(" ",lsRval,"")) to lsRval
49546>>>>>>>>>  function_return lsRval
49547>>>>>>>>>end_function
49548>>>>>>>>>
49548>>>>>>>>>//
49548>>>>>>>>>// Recieving procedure should be defined like this:
49548>>>>>>>>>//
49548>>>>>>>>>// Procedure HandleField integer liFile integer liField string lsName integer liType integer liLen integer liPrec integer liRelFile integer liRelField integer liIndex integer liOffSet
49548>>>>>>>>>//
49548>>>>>>>>>//
49548>>>>>>>>>procedure FDX_FieldCallBack global integer lhFDX integer liFile integer liMsg integer lhObj
49550>>>>>>>>>  integer liMaxField liField
49550>>>>>>>>>  integer liType liLen liPrec liRelFile liRelField liIndex liOffSet
49550>>>>>>>>>  string lsName
49550>>>>>>>>>  move (FDX_AttrValue_FILE(lhFDX,DF_FILE_NUMBER_FIELDS,liFile)) to liMaxField
49551>>>>>>>>>  for liField from 1 to liMaxField
49557>>>>>>>>>>
49557>>>>>>>>>
49557>>>>>>>>>    get FDX_AttrValue_FIELD lhFDX DF_FIELD_NAME          liFile liField to lsName
49558>>>>>>>>>    get FDX_AttrValue_FIELD lhFDX DF_FIELD_TYPE          liFile liField to liType
49559>>>>>>>>>    get FDX_AttrValue_FIELD lhFDX DF_FIELD_LENGTH        liFile liField to liLen
49560>>>>>>>>>    get FDX_AttrValue_FIELD lhFDX DF_FIELD_PRECISION     liFile liField to liPrec
49561>>>>>>>>>    get FDX_AttrValue_FIELD lhFDX DF_FIELD_RELATED_FILE  liFile liField to liRelFile
49562>>>>>>>>>    get FDX_AttrValue_FIELD lhFDX DF_FIELD_RELATED_FIELD liFile liField to liRelField
49563>>>>>>>>>    get FDX_AttrValue_FIELD lhFDX DF_FIELD_INDEX         liFile liField to liIndex
49564>>>>>>>>>    get FDX_AttrValue_FIELD lhFDX DF_FIELD_OFFSET        liFile liField to liOffSet
49565>>>>>>>>>    // procedure handle_field integer liFile integer liField string lsName integer liType integer liLen integer liPrec integer liRelFile integer liRelField integer liIndex integer liOffSet
49565>>>>>>>>>    send liMsg to lhObj liFile liField lsName liType liLen liPrec liRelFile liRelField liIndex liOffSet
49566>>>>>>>>>  loop
49567>>>>>>>>>>
49567>>>>>>>>>end_procedure
49568>>>>>>>>>
49568>>>>>>>>>function FDX_FindField global integer lhFDX integer liFile string lsFieldName returns integer
49570>>>>>>>>>  integer liMax liField
49570>>>>>>>>>  string lsValue
49570>>>>>>>>>  move (uppercase(lsFieldName)) to lsFieldName
49571>>>>>>>>>  if (lsFieldName="RECNUM") function_return 0
49574>>>>>>>>>  move (FDX_AttrValue_FILE(lhFDX,DF_FILE_NUMBER_FIELDS,liFile)) to liMax
49575>>>>>>>>>  for liField from 1 to liMax
49581>>>>>>>>>>
49581>>>>>>>>>    get FDX_AttrValue_FIELD lhFDX DF_FIELD_NAME liFile liField to lsValue
49582>>>>>>>>>    if (uppercase(lsValue)=lsFieldName) function_return liField
49585>>>>>>>>>  loop
49586>>>>>>>>>>
49586>>>>>>>>>  function_return -1
49587>>>>>>>>>end_function
49588>>>>>>>>>
49588>>>>>>>>>//> Reads a record like the SEQ_ReadRecordBuffer_LD procedure but places the
49588>>>>>>>>>//> result in the array passed in the lhArray instead of directly in the
49588>>>>>>>>>//> record buffer.
49588>>>>>>>>>procedure FDX_ReadRecordBufferToArray_LD global integer lhFDX integer liChannel integer liFile integer lhArray
49590>>>>>>>>>  integer liMax liField liLen liType
49590>>>>>>>>>  string lsValue
49590>>>>>>>>>  send delete_data to lhArray
49591>>>>>>>>>  get FDX_AttrValue_FILE lhFDX DF_FILE_NUMBER_FIELDS liFile to liMax
49592>>>>>>>>>  read channel liChannel // Set channel
49593>>>>>>>>>  for liField from 1 to liMax
49599>>>>>>>>>>
49599>>>>>>>>>    get FDX_AttrValue_FIELD lhFDX DF_FIELD_TYPE liFile liField to liType
49600>>>>>>>>>    if liType ne DF_OVERLAP begin
49602>>>>>>>>>      if (liType=DF_BINARY or liType=DF_TEXT) begin
49604>>>>>>>>>        readln liLen
49605>>>>>>>>>        read_block lsValue liLen
49606>>>>>>>>>      end
49606>>>>>>>>>>
49606>>>>>>>>>      else readln lsValue
49608>>>>>>>>>    end
49608>>>>>>>>>>
49608>>>>>>>>>    set value of lhArray item liField to lsValue
49609>>>>>>>>>  loop
49610>>>>>>>>>>
49610>>>>>>>>>end_procedure
49611>>>>>>>>>
49611>>>>>>>>>//> Returns set of (child table) fields that relates to parent table.
49611>>>>>>>>>function FDX_FieldsRelatingToParent global integer lhFDX integer liChild integer liParent returns string
49613>>>>>>>>>  integer liMax liField liTest
49613>>>>>>>>>  string lsValue
49613>>>>>>>>>  get FDX_AttrValue_FILE lhFDX DF_FILE_NUMBER_FIELDS liChild to liMax
49614>>>>>>>>>  move "" to lsValue
49615>>>>>>>>>
49615>>>>>>>>>  for liField from 1 to liMax
49621>>>>>>>>>>
49621>>>>>>>>>    get FDX_AttrValue_FIELD lhFDX DF_FIELD_RELATED_FILE liChild liField to liTest
49622>>>>>>>>>    if (liTest=liParent) move (lsValue+pad(liField,4)) to lsValue
49625>>>>>>>>>  loop
49626>>>>>>>>>>
49626>>>>>>>>>
49626>>>>>>>>>  function_return lsValue
49627>>>>>>>>>end_function
49628>>>>>Use FdxIndex.utl // Index analysing functions
Including file: fdxindex.utl    (C:\projects\BRS\VDFQuery\AppSrc\fdxindex.utl)
49628>>>>>>>Use FdxIndex.nui // Index analysing functions
Including file: fdxindex.nui    (C:\projects\BRS\VDFQuery\AppSrc\fdxindex.nui)
49628>>>>>>>>>// Use FdxIndex.nui // Index analysing functions
49628>>>>>>>>>
49628>>>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
49628>>>>>>>>>Use Fdx_Attr.nui // FDX compatible attribute functions
49628>>>>>>>>>Use FdxField.nui // FDX Field things
49628>>>>>>>>>
49628>>>>>>>>>//> This function returns an index as a sequence of fields. The field
49628>>>>>>>>>//> sequence is returned in a string where each field in the sequence
49628>>>>>>>>>//> takes up four characters. The sequence of fields 2, 3 and 4 would
49628>>>>>>>>>//> return as "2   3   4   ".
49628>>>>>>>>>function FDX_IndexAsFields global integer oFDX# integer file# integer index# returns string
49630>>>>>>>>>  integer segment# max_seg# field#
49630>>>>>>>>>  string rval#
49630>>>>>>>>>  move "" to rval#
49631>>>>>>>>>  get FDX_AttrValue_INDEX oFDX# DF_INDEX_NUMBER_SEGMENTS file# index# to max_seg#
49632>>>>>>>>>  if max_seg# begin // If there's an index at all
49634>>>>>>>>>    for segment# from 1 to max_seg#
49640>>>>>>>>>>
49640>>>>>>>>>      get FDX_AttrValue_IDXSEG oFDX# DF_INDEX_SEGMENT_FIELD file# index# segment# to field#
49641>>>>>>>>>      move (rval#+pad(field#,4)) to rval#
49642>>>>>>>>>    loop
49643>>>>>>>>>>
49643>>>>>>>>>  end
49643>>>>>>>>>>
49643>>>>>>>>>  function_return rval#
49644>>>>>>>>>end_function // FDX_IndexAsFields
49645>>>>>>>>>
49645>>>>>>>>>//> Returns DFTRUE if index# if last segment of index# is not RECNUM. If the
49645>>>>>>>>>//> index does not exist DFFALSE is returned.
49645>>>>>>>>>function FDX_IndexUnique global integer oFDX# integer file# integer index# returns integer
49647>>>>>>>>>  string str#
49647>>>>>>>>>  if index# eq 0 function_return 1
49650>>>>>>>>>  get FDX_IndexAsFields oFDX# file# index# to str#
49651>>>>>>>>>  function_return (integer(right(str#,4)))
49652>>>>>>>>>end_function
49653>>>>>>>>>
49653>>>>>>>>>//> Function FDX_IndexAsFieldNames returns the specified index as field names
49653>>>>>>>>>//> separated by commas. A descending segment will be marked by a minus
49653>>>>>>>>>//> sign while uppercased segments will appear with an uppercased field
49653>>>>>>>>>//> name. The width# parameter will (if not 0) break up the return value
49653>>>>>>>>>//> in strings none of which is longer than indicated by its value. In this
49653>>>>>>>>>//> case the sub-strings will be separated by a character 10.
49653>>>>>>>>>function FDX_IndexAsFieldNames global integer oFDX# integer file# integer index# integer width# returns string
49655>>>>>>>>>  integer max_seg# segment# field# dir# case# liType
49655>>>>>>>>>  string rval# lf# fname# substring# test#
49655>>>>>>>>>
49655>>>>>>>>>  get FDX_AttrValue_INDEX oFDX# DF_INDEX_TYPE file# index# to liType
49656>>>>>>>>>  ifnot width# move 1000 to width#
49659>>>>>>>>>  move (character(10)) to lf#
49660>>>>>>>>>  get FDX_AttrValue_INDEX oFDX# DF_INDEX_NUMBER_SEGMENTS file# index# to max_seg#
49661>>>>>>>>>
49661>>>>>>>>>  if (liType=DF_INDEX_TYPE_ONLINE) move "" to substring#
49664>>>>>>>>>  else move "(Batch) " to substring#
49666>>>>>>>>>
49666>>>>>>>>>  for segment# from 1 to max_seg#
49672>>>>>>>>>>
49672>>>>>>>>>    get FDX_AttrValue_IDXSEG oFDX# DF_INDEX_SEGMENT_FIELD     file# index# segment# to field#
49673>>>>>>>>>    if field# get FDX_AttrValue_FIELD  oFDX# DF_FIELD_NAME    file# field# to fname#
49676>>>>>>>>>    else move "recnum" to fname#
49678>>>>>>>>>    get FDX_AttrValue_IDXSEG oFDX# DF_INDEX_SEGMENT_DIRECTION file# index# segment# to dir#
49679>>>>>>>>>    get FDX_AttrValue_IDXSEG oFDX# DF_INDEX_SEGMENT_CASE      file# index# segment# to case#
49680>>>>>>>>>
49680>>>>>>>>>    if dir# eq DF_DESCENDING move ("-"+fname#) to fname#
49683>>>>>>>>>    if case# eq DF_CASE_IGNORED move (uppercase(fname#)) to fname#
49686>>>>>>>>>    else move (lowercase(fname#)) to fname#
49688>>>>>>>>>
49688>>>>>>>>>    if segment# ne max_seg# move (fname#+",") to fname# // If not the last segment append a comma to the name
49691>>>>>>>>>    move (substring#+fname#) to test#
49692>>>>>>>>>
49692>>>>>>>>>    if (length(test#)>width# and substring#<>"") begin
49694>>>>>>>>>      // If we go in here the length of the substring is too long and
49694>>>>>>>>>      // we will have to insert a lf character.
49694>>>>>>>>>      if rval# eq "" move substring# to rval#
49697>>>>>>>>>      else move (rval#+lf#+substring#) to rval#
49699>>>>>>>>>      move fname# to substring#
49700>>>>>>>>>    end
49700>>>>>>>>>>
49700>>>>>>>>>    else begin // It's not too wide
49701>>>>>>>>>      if substring# eq "" move fname# to substring#
49704>>>>>>>>>      else move (substring#+fname#) to substring#
49706>>>>>>>>>    end
49706>>>>>>>>>>
49706>>>>>>>>>  loop
49707>>>>>>>>>>
49707>>>>>>>>>
49707>>>>>>>>>  if rval# eq "" move substring# to rval#
49710>>>>>>>>>  else move (rval#+lf#+substring#) to rval#
49712>>>>>>>>>  function_return rval#
49713>>>>>>>>>end_function // FDX_IndexAsFieldNames
49714>>>>>>>>>
49714>>>>>>>>>//> This function will return the number of the first unique index
49714>>>>>>>>>//> defined for the file passed. If no such index is found, 0 will
49714>>>>>>>>>//> be returned.
49714>>>>>>>>>function FDX_IndexFindPrimary global integer oFDX# integer file# returns integer
49716>>>>>>>>>  integer index# fin# rval# max_seg# segment# field#
49716>>>>>>>>>  move 1 to index#
49717>>>>>>>>>  move 0 to fin#
49718>>>>>>>>>  move 0 to rval#
49719>>>>>>>>>  repeat
49719>>>>>>>>>>
49719>>>>>>>>>    if index# gt 15 move 1 to fin#
49722>>>>>>>>>    ifnot fin# begin
49724>>>>>>>>>      get FDX_AttrValue_INDEX oFDX# DF_INDEX_NUMBER_SEGMENTS file# index# to max_seg#
49725>>>>>>>>>      for segment# from 1 to max_seg#
49731>>>>>>>>>>
49731>>>>>>>>>        get FDX_AttrValue_IDXSEG oFDX# DF_INDEX_SEGMENT_FIELD file# index# segment# to field#
49732>>>>>>>>>        if (segment#=max_seg# and field#<>0) begin
49734>>>>>>>>>          move 1 to fin#
49735>>>>>>>>>          move index# to rval#
49736>>>>>>>>>        end
49736>>>>>>>>>>
49736>>>>>>>>>      loop
49737>>>>>>>>>>
49737>>>>>>>>>      increment index#
49738>>>>>>>>>    end
49738>>>>>>>>>>
49738>>>>>>>>>  until fin#
49740>>>>>>>>>  function_return rval#
49741>>>>>>>>>end_function // FDX_IndexFindPrimary
49742>>>>>>>>>
49742>>>>>>>>>function FDX_IndexFindAny global integer lhFDX integer liFile integer liIndex integer lbMustBeUnique integer lbMustBeOnLine returns integer
49744>>>>>>>>>  integer lbFin liRval liSegments lbOk liType
49744>>>>>>>>>  move 0 to lbFin
49745>>>>>>>>>  move 0 to liRval
49746>>>>>>>>>  increment liIndex
49747>>>>>>>>>  repeat
49747>>>>>>>>>>
49747>>>>>>>>>    if liIndex gt 15 move 1 to lbFin
49750>>>>>>>>>    ifnot lbFin begin
49752>>>>>>>>>      get FDX_AttrValue_INDEX lhFDX DF_INDEX_NUMBER_SEGMENTS liFile liIndex to liSegments
49753>>>>>>>>>
49753>>>>>>>>>      if liSegments begin // If index exists
49755>>>>>>>>>        move DFTRUE to lbOk
49756>>>>>>>>>        if lbMustBeUnique get FDX_IndexUnique lhFDX liFile liIndex to lbOk
49759>>>>>>>>>        if lbMustBeOnLine begin
49761>>>>>>>>>          get FDX_AttrValue_INDEX lhFDX DF_INDEX_TYPE liFile liIndex to liType
49762>>>>>>>>>          move (liType=DF_INDEX_TYPE_ONLINE) to lbOk
49763>>>>>>>>>        end
49763>>>>>>>>>>
49763>>>>>>>>>        if lbOk begin
49765>>>>>>>>>          move 1 to lbFin
49766>>>>>>>>>          move liIndex to liRval
49767>>>>>>>>>        end
49767>>>>>>>>>>
49767>>>>>>>>>      end
49767>>>>>>>>>>
49767>>>>>>>>>      increment liIndex
49768>>>>>>>>>    end
49768>>>>>>>>>>
49768>>>>>>>>>  until lbFin
49770>>>>>>>>>  function_return liRval
49771>>>>>>>>>end_function
49772>>>>>>>>>
49772>>>>>>>>>//> This tries to find an index uniquely composed of the fields passed in
49772>>>>>>>>>//> fields parameter. If such an index can be found its number will be
49772>>>>>>>>>//> returned (otherwise 0 is returned). The search will begin at index
49772>>>>>>>>>//> start_idx#+1.
49772>>>>>>>>>function FDX_IndexFindUnique global integer oFDX# integer file# string fields# integer start_idx# returns integer
49774>>>>>>>>>  integer index# pos# segment# max#
49774>>>>>>>>>  string idx_fields# check_fields# field#
49774>>>>>>>>>  get FDX_FieldsTranslateOverlaps oFDX# file# fields# to fields#
49775>>>>>>>>>  get FDX_FieldsRemoveDublettes fields# to fields#
49776>>>>>>>>>  for index# from (start_idx#+1) to 15
49782>>>>>>>>>>
49782>>>>>>>>>    get FDX_IndexAsFields oFDX# file# index# to idx_fields#
49783>>>>>>>>>    if idx_fields# ne "" begin
49785>>>>>>>>>      move fields# to check_fields#
49786>>>>>>>>>      get FDX_FieldsTranslateOverlaps oFDX# file# idx_fields# to idx_fields#
49787>>>>>>>>>      get FDX_FieldsRemoveDublettes idx_fields# to idx_fields#
49788>>>>>>>>>      move (length(idx_fields#)/4) to max#
49789>>>>>>>>>      for segment# from 1 to max#
49795>>>>>>>>>>
49795>>>>>>>>>        move (mid(fields#,4,segment#-1*4+1)) to field#
49796>>>>>>>>>        move (replace(field#,check_fields#,"")) to check_fields#
49797>>>>>>>>>      loop
49798>>>>>>>>>>
49798>>>>>>>>>      if check_fields# eq "" function_return index#
49801>>>>>>>>>    end
49801>>>>>>>>>>
49801>>>>>>>>>  loop
49802>>>>>>>>>>
49802>>>>>>>>>  function_return 0
49803>>>>>>>>>end_function // FDX_IndexFindUnique
49804>>>>>>>>>
49804>>>>>>>>>//> Find an index that has fields as its most significant segments (in that
49804>>>>>>>>>//> order)
49804>>>>>>>>>function FDX_IndexFindMatching global integer oFDX# integer file# string fields# integer start_idx# returns integer
49806>>>>>>>>>  integer index# pos# segment# max# field1# field2# good#
49806>>>>>>>>>  string idx_fields# field#
49806>>>>>>>>>  get FDX_FieldsTranslateOverlaps oFDX# file# fields# to fields#
49807>>>>>>>>>  move (length(fields#)/4) to max#
49808>>>>>>>>>  for index# from (start_idx#+1) to 15
49814>>>>>>>>>>
49814>>>>>>>>>    get FDX_IndexAsFields oFDX# file# index# to idx_fields#
49815>>>>>>>>>    if idx_fields# ne "" begin
49817>>>>>>>>>      get FDX_FieldsTranslateOverlaps oFDX# file# idx_fields# to idx_fields#
49818>>>>>>>>>      move 1 to good#
49819>>>>>>>>>      for segment# from 1 to max#
49825>>>>>>>>>>
49825>>>>>>>>>        if good# begin
49827>>>>>>>>>          move (mid(fields#,4,segment#-1*4+1)) to field1#
49828>>>>>>>>>          move (mid(idx_fields#,4,segment#-1*4+1)) to field2#
49829>>>>>>>>>          if field1# ne field2# move 0 to good#
49832>>>>>>>>>        end
49832>>>>>>>>>>
49832>>>>>>>>>      loop
49833>>>>>>>>>>
49833>>>>>>>>>      if good# function_return index#
49836>>>>>>>>>    end
49836>>>>>>>>>>
49836>>>>>>>>>  loop
49837>>>>>>>>>>
49837>>>>>>>>>  function_return 0
49838>>>>>>>>>end_function // FDX_IndexFindMatching
49839>>>>>>>>>
49839>>>>>>>>>//> Find a field that is not part of liIndex. The field returned will not be a
49839>>>>>>>>>//> overlap field. If no such field can be found, 0 is returned.
49839>>>>>>>>>function FDX_FieldNotInIndex global integer oFDX# integer liFile integer liIndex returns integer
49841>>>>>>>>>  integer liField liMax
49841>>>>>>>>>  string lsFields
49841>>>>>>>>>  if liIndex begin // If not recnum
49843>>>>>>>>>    get FDX_IndexAsFields oFDX# liFile liIndex to lsFields
49844>>>>>>>>>    get FDX_FieldsTranslateOverlaps oFDX# liFile lsFields to lsFields
49845>>>>>>>>>  end
49845>>>>>>>>>>
49845>>>>>>>>>  else move "" to lsFields
49847>>>>>>>>>  move (FDX_AttrValue_FILE(oFDX#,DF_FILE_NUMBER_FIELDS,liFile)) to liMax
49848>>>>>>>>>  for liField from 1 to liMax
49854>>>>>>>>>>
49854>>>>>>>>>    // Only check to see if field is part of the overlap if it is not itself an overlap field:
49854>>>>>>>>>    if (integer(FDX_AttrValue_FIELD(oFDX#,DF_FIELD_TYPE,liFile,liField))) ne DF_OVERLAP begin
49856>>>>>>>>>      ifnot (IsIntegerPresent(lsFields,liField)) function_return liField
49859>>>>>>>>>    end
49859>>>>>>>>>>
49859>>>>>>>>>  loop
49860>>>>>>>>>>
49860>>>>>>>>>  function_return 0
49861>>>>>>>>>end_function
49862>>>>>>>>>
49862>>>>>>>>>//> This function returns all
49862>>>>>>>>>function FDX_MostSignificantFieldsInIndexNotRelating global integer oFDX# integer liFile integer liIndex returns string
49864>>>>>>>>>  integer liPos liMaxPos liField liStillRelating liOverlapField
49864>>>>>>>>>  integer liMaxOverlap liOverlapPos liAnyRelatingOverlaps
49864>>>>>>>>>  string lsFields lsRval lsOverlaps
49864>>>>>>>>>  get FDX_IndexAsFields oFDX# liFile liIndex to lsFields
49865>>>>>>>>>  get FDX_FieldsTranslateOverlaps oFDX# liFile lsFields to lsFields
49866>>>>>>>>>  move "" to lsRval
49867>>>>>>>>>  move 1 to liStillRelating
49868>>>>>>>>>  move (length(lsFields)+3/4) to liMaxPos
49869>>>>>>>>>  for liPos from 0 to (liMaxPos-1)
49875>>>>>>>>>>
49875>>>>>>>>>    move (mid(lsFields,4,liPos*4+1)) to liField
49876>>>>>>>>>
49876>>>>>>>>>    if liStillRelating begin
49878>>>>>>>>>      ifnot (integer(FDX_AttrValue_FIELD(oFDX#,DF_FIELD_RELATED_FILE,liFile,liField))) begin
49880>>>>>>>>>        get FDX_FieldsOverlappingField oFDX# liFile liField to lsOverlaps
49881>>>>>>>>>        move (length(lsFields)+3/4) to liMaxOverlap
49882>>>>>>>>>        move 0 to liAnyRelatingOverlaps
49883>>>>>>>>>        for liOverlapPos from 0 to (liMaxOverlap-1)
49889>>>>>>>>>>
49889>>>>>>>>>          move (mid(lsOverlaps,4,liOverlapPos*4+1)) to liOverlapField
49890>>>>>>>>>          if (integer(FDX_AttrValue_FIELD(oFDX#,DF_FIELD_RELATED_FILE,liFile,liOverlapField))) move 1 to liAnyRelatingOverlaps
49893>>>>>>>>>        loop
49894>>>>>>>>>>
49894>>>>>>>>>        ifnot liAnyRelatingOverlaps move 0 to liStillRelating
49897>>>>>>>>>      end
49897>>>>>>>>>>
49897>>>>>>>>>    end
49897>>>>>>>>>>
49897>>>>>>>>>    ifnot liStillRelating move (lsRval+pad(liField,4)) to lsRval
49900>>>>>>>>>  loop
49901>>>>>>>>>>
49901>>>>>>>>>  function_return lsRval
49902>>>>>>>>>end_function
49903>>>>>>>>>
49903>>>>>>>>>// Parameter liIndexType must be DF_INDEX_TYPE_ONLINE or DF_INDEX_TYPE_BATCH
49903>>>>>>>>>//    Define call back like this:
49903>>>>>>>>>//    procedure HandleIndex integer liFile integer liIndex string lsFields integer liType
49903>>>>>>>>>procedure FDX_IndexCallback global integer lhFDX integer liFile integer liIndexType integer liMsg integer lhObj
49905>>>>>>>>>  integer liIndex liType
49905>>>>>>>>>  string lsIndexDef
49905>>>>>>>>>  for liIndex from 1 to 15
49911>>>>>>>>>>
49911>>>>>>>>>    get FDX_IndexAsFields lhFDX liFile liIndex to lsIndexDef
49912>>>>>>>>>    if (lsIndexDef<>"") begin
49914>>>>>>>>>      get FDX_AttrValue_INDEX lhFDX DF_INDEX_TYPE liFile liIndex to liType
49915>>>>>>>>>      if (liType=liIndexType) send liMsg to lhObj liFile liIndex lsIndexDef liType
49918>>>>>>>>>    end
49918>>>>>>>>>>
49918>>>>>>>>>  loop
49919>>>>>>>>>>
49919>>>>>>>>>end_procedure
49920>>>>>>>>>
49920>>>>>>>>>desktop_section
49925>>>>>>>>>  object oFdxIndexTempArray is a cArray
49927>>>>>>>>>    property string psRval public ""
49929>>>>>>>>>    procedure AddToRval integer liFile integer liIndex string lsIndexDef integer liIndexType
49932>>>>>>>>>      string lsRval
49932>>>>>>>>>      get psRval to lsRval
49933>>>>>>>>>      if (lsRval="") set psRval to (string(liIndex))
49936>>>>>>>>>      set psRval to (lsRval+" "+string(liIndex))
49937>>>>>>>>>    end_procedure
49938>>>>>>>>>    function sSetOfIndices integer lhFDX integer liFile integer liIndexType returns string
49941>>>>>>>>>      set psRval to ""
49942>>>>>>>>>      send FDX_IndexCallback lhFDX liFile liIndexType msg_AddToRval self
49943>>>>>>>>>      function_return (psRval(self))
49944>>>>>>>>>    end_function
49945>>>>>>>>>  end_object
49946>>>>>>>>>end_desktop_section
49951>>>>>>>>>
49951>>>>>>>>>//> Returns all indices of type liIndexType (DF_INDEX_TYPE_ONLINE or DF_INDEX_TYPE_BATCH)
49951>>>>>>>>>function FDX_SetOfIndices global integer lhFDX integer liFile integer liIndexType returns string
49953>>>>>>>>>  string lsRval
49953>>>>>>>>>  get sSetOfIndices of (oFdxIndexTempArray(self)) lhFDX liFile liIndexType to lsRval
49954>>>>>>>>>  function_return lsRval
49955>>>>>>>>>end_function
49956>>>>>>>>>
49956>>>>>>>>>//> Returns all indices that may be used efficiently for finding records in liFile by specifying
49956>>>>>>>>>//> fields in lsFields
49956>>>>>>>>>function FDX_SetOfIndicesFieldConstrained global integer lhFDX integer liFile string lsFields returns string
49958>>>>>>>>>  integer liIndex liField liMaxPos liPos
49958>>>>>>>>>  string lsTakeThemOut lsValue lsIndex lsField
49958>>>>>>>>>  move "" to lsValue
49959>>>>>>>>>  get FDX_FieldsRemoveDublettes lsFields to lsFields
49960>>>>>>>>>  for liIndex from 1 to 15
49966>>>>>>>>>>
49966>>>>>>>>>    move lsFields to lsTakeThemOut
49967>>>>>>>>>
49967>>>>>>>>>    get FDX_IndexAsFields lhFDX liFile liIndex to lsIndex
49968>>>>>>>>>    get FDX_FieldsTranslateOverlaps lhFDX liFile lsIndex to lsIndex
49969>>>>>>>>>    get FDX_FieldsRemoveDublettes lsIndex to lsIndex
49970>>>>>>>>>
49970>>>>>>>>>    // Note that we calculate liMaxPos based on lsFields and NOT lsIndex. The
49970>>>>>>>>>    // reason is that we want lsFields (=lsTakeThemOut) to appear as the most
49970>>>>>>>>>    // significant segments of the index (in no particular order) and not
49970>>>>>>>>>    // scattered all over the index.
49970>>>>>>>>>    move (length(lsFields)+3/4) to liMaxPos
49971>>>>>>>>>    for liPos from 1 to liMaxPos
49977>>>>>>>>>>
49977>>>>>>>>>      move (mid(lsIndex,4,liPos-1*4+1)) to liField
49978>>>>>>>>>      move (pad(liField,4)) to lsField
49979>>>>>>>>>      move (replace(lsField,lsTakeThemOut,"")) to lsTakeThemOut
49980>>>>>>>>>    loop
49981>>>>>>>>>>
49981>>>>>>>>>
49981>>>>>>>>>    if (lsTakeThemOut="") move (lsValue+pad(liIndex,4)) to lsValue
49984>>>>>>>>>  loop
49985>>>>>>>>>>
49985>>>>>>>>>
49985>>>>>>>>>  function_return lsValue
49986>>>>>>>>>end_function
49987>>>>>>>>>
49987>>>>>>>>>//> Returns all indices that may be used efficiently for finding records in liChildTable
49987>>>>>>>>>function FDX_SetOfIndicesTableConstrained global integer lhFDX integer liChildTable integer liParentTable returns string
49989>>>>>>>>>  string lsRelatingFields lsValue
49989>>>>>>>>>  get FDX_FieldsRelatingToParent lhFDX liChildTable liParentTable to lsRelatingFields
49990>>>>>>>>>  get FDX_FieldsTranslateOverlaps lhFDX liChildTable lsRelatingFields to lsRelatingFields
49991>>>>>>>>>  get FDX_SetOfIndicesFieldConstrained lhFDX liChildTable to lsRelatingFields
49992>>>>>>>>>  function_return lsValue
49993>>>>>>>>>end_function
49994>>>>>>>>>
49994>>>>>>>>>
49994>>>>>>>>>
49994>>>>>Use DataScan.utl // Data scan classes
Including file: datascan.utl    (C:\projects\BRS\VDFQuery\AppSrc\datascan.utl)
49994>>>>>>>// **********************************************************************
49994>>>>>>>// Use DataScan.utl // Data scan classes
49994>>>>>>>//
49994>>>>>>>// By Sture Andersen
49994>>>>>>>//
49994>>>>>>>// Create: Sun  28-12-1997 -
49994>>>>>>>// Update: Fri  02-04-1998 - Descending segments are not seeded anymore.
49994>>>>>>>//         Sat  20-06-1998 - cReport_info class moved to here from VDFQUERY.UTL.
49994>>>>>>>//         Sat  29-08-1998 - Breaking ability added to cReport_info class.
49994>>>>>>>//         Sat  13-02-1999 - cReportTotals class added
49994>>>>>>>//         Wed  27-04-1999 - Fixed jump out error on numeric segments
49994>>>>>>>//                         - Fix for descending segments
49994>>>>>>>//                         - Objects oJumpInValues and oJumpOutValues needs
49994>>>>>>>//                           recoding. Currently it is next to un-readable
49994>>>>>>>//         Mon  10-05-1999 - Fixes for VDF 6 (Vincent Oorsprong)
49994>>>>>>>//         Tue  31-07-2001 - Made good for file numbers up to 4095
49994>>>>>>>//         Wed  08-08-2001 - Fixed jump out error
49994>>>>>>>//         Wed  07-05-2003 - Fixed SC_COMP_CBETWEEN criteria
49994>>>>>>>//
49994>>>>>>>//
49994>>>>>>>//  "Or" criteria in conventional selection criteria
49994>>>>>>>//
49994>>>>>>>//     1. No index optimization:   20 hours
49994>>>>>>>//     2. Total rewrite:          120 hours
49994>>>>>>>//
49994>>>>>>>//
49994>>>>>>>//
49994>>>>>>>// ***********************************************************************
49994>>>>>>>
49994>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
49994>>>>>>>Use DataView.utl // Classes for analyzing db structures
Including file: dataview.utl    (C:\projects\BRS\VDFQuery\AppSrc\dataview.utl)
49994>>>>>>>>>// NOTE!! THIS PACKAGE IS - ALTHOUGH WELL FUNCTIONING - OUT OF FASHION!
49994>>>>>>>>>//
49994>>>>>>>>>//    THE INTENTIONS OF IT HAS NOW BEEN SUPER IMPLEMENTED IN FDX.NUI
49994>>>>>>>>>//
49994>>>>>>>>>//
49994>>>>>>>>>// **********************************************************************
49994>>>>>>>>>// Use DataView.utl // Classes for analyzing index definitions
49994>>>>>>>>>//
49994>>>>>>>>>// by Sture Andersen
49994>>>>>>>>>//
49994>>>>>>>>>// Create: Sat  10-05-1997 - Extracted from AutoPrmt.pkg and re-organized.
49994>>>>>>>>>// Update: Sun  18-05-1997 - Function idx_next_index_ms_segments added
49994>>>>>>>>>//         Sat  20-12-1997 - Functions idx_is_field_present_index,
49994>>>>>>>>>//                           idx_segment and idx_max_segment added.
49994>>>>>>>>>//         Thu  05-02-1998 - Object oMoreInfo added to cIndexAnalyzer class.
49994>>>>>>>>>//         Wed  10-11-1999 - Error fixed in idx_Segment_Directions and
49994>>>>>>>>>//                           idx_Segment_Cases
49994>>>>>>>>>//
49994>>>>>>>>>//  The purpose of this package is to loosen the connection between the tools
49994>>>>>>>>>//  and the "physical" table definition. Instead of using the get_attribute
49994>>>>>>>>>//  command for retrieving structure information, you query this class, in
49994>>>>>>>>>//  order to be able to change the view of the database.
49994>>>>>>>>>//
49994>>>>>>>>>// ***********************************************************************
49994>>>>>>>>>//
49994>>>>>>>>>// Contents:   (1)  db_structure_layer_mixin class.
49994>>>>>>>>>//             (2)  cIndexAnalyzer class.
49994>>>>>>>>>
49994>>>>>>>>>// (1)
49994>>>>>>>>>// The class db_structure_layer_mixin is a mixin that supports changing
49994>>>>>>>>>// the way that the get_attribute command sees the world.
49994>>>>>>>>>//
49994>>>>>>>>>// The idea is that every time the target class would normally use the
49994>>>>>>>>>// get_attribute command, it instead uses the functions in this class,
49994>>>>>>>>>// which will allow for delegation of the question.
49994>>>>>>>>>//
49994>>>>>>>>>// If property delegate_object is 0 the get_attribute command is used.
49994>>>>>>>>>
49994>>>>>>>>>
49994>>>>>>>>>// The format of the commands below is the following:
49994>>>>>>>>>//   command   
49994>>>>>>>>>
49994>>>>>>>>>class db_structure_layer_mixin is a message
49995>>>>>>>>>  procedure define_db_structure_layer_mixin
49997>>>>>>>>>    property integer DBMS_Server public 0 // If false get_attribute will be used
49998>>>>>>>>>  end_procedure
49999>>>>>>>>>
49999>>>>>>>>>  DBSTRUCT.INDEX_ATTR  attr_index_number_segments   DF_INDEX_NUMBER_SEGMENTS   integer
50010>>>>>>>>>  DBSTRUCT.IDXSEG_ATTR attr_index_segment_field     DF_INDEX_SEGMENT_FIELD     integer
50021>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_number_fields      DF_FILE_NUMBER_FIELDS      integer
50032>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_max_records        DF_FILE_MAX_RECORDS        integer
50043>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_records_used       DF_FILE_RECORDS_USED       integer
50054>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_type               DF_FILE_TYPE               integer
50065>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_multiuser          DF_FILE_MULTIUSER          integer
50076>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_reuse_deleted      DF_FILE_REUSE_DELETED      integer
50087>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_compression        DF_FILE_COMPRESSION        integer
50098>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_number_fields      DF_FILE_NUMBER_FIELDS      integer
50109>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_transaction        DF_FILE_TRANSACTION        integer
50120>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_record_length      DF_FILE_RECORD_LENGTH      integer
50131>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_integrity_check    DF_FILE_INTEGRITY_CHECK    integer
50142>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_is_system_file     DF_FILE_IS_SYSTEM_FILE     integer
50153>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_lock_type          DF_FILE_LOCK_TYPE          integer
50164>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_record_length_used DF_FILE_RECORD_LENGTH_USED integer
50175>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_record_identity    DF_FILE_RECORD_IDENTITY    integer
50186>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_revision           DF_FILE_REVISION           string
50197>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_logical_name       DF_FILE_LOGICAL_NAME       string
50208>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_root_name          DF_FILE_ROOT_NAME          string
50219>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_display_name       DF_FILE_DISPLAY_NAME       string
50230>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_physical_name      DF_FILE_PHYSICAL_NAME      string
50241>>>>>>>>>  DBSTRUCT.FILE_ATTR   attr_file_next_used          DF_FILE_NEXT_USED          integer
50252>>>>>>>>>  DBSTRUCT.FIELD_ATTR  attr_field_type              DF_FIELD_TYPE              integer
50263>>>>>>>>>  DBSTRUCT.FIELD_ATTR  attr_field_length            DF_FIELD_LENGTH            integer
50274>>>>>>>>>  DBSTRUCT.FIELD_ATTR  attr_field_native_length     DF_FIELD_NATIVE_LENGTH     integer
50285>>>>>>>>>  function attr_field_overlap integer file# integer fld1# integer fld2# returns integer
50287>>>>>>>>>    integer rval#
50287>>>>>>>>>    if (DBMS_Server(self)) get attr_field_overlap of (DBMS_Server(self)) file# fld1# fld2# to rval#
50290>>>>>>>>>    else get_attribute DF_FIELD_OVERLAP of file# fld1# fld2# to rval#
50294>>>>>>>>>    function_return rval#
50295>>>>>>>>>  end_function
50296>>>>>>>>>
50296>>>>>>>>>  DBSTRUCT.FIELD_ATTR  attr_field_index             DF_FIELD_INDEX             integer
50307>>>>>>>>>  DBSTRUCT.FIELD_ATTR  attr_field_name              DF_FIELD_NAME              string
50318>>>>>>>>>  function attr_field_name integer file# integer field# returns string
50320>>>>>>>>>    string rval#
50320>>>>>>>>>//   send obs (string(file#)+","+string(field#)+","+string(!a))
50320>>>>>>>>>    if (DBMS_Server(self)) get attr_field_name of (DBMS_Server(self)) file# field# to rval#
50323>>>>>>>>>    else get_attribute DF_FIELD_NAME of file# field# to rval#
50327>>>>>>>>>    if (rval#="" and field#=0) move "RECNUM" to rval#
50330>>>>>>>>>    function_return rval#
50331>>>>>>>>>  end_function
50332>>>>>>>>>  DBSTRUCT.FIELD_ATTR  attr_field_precision         DF_FIELD_PRECISION         integer
50343>>>>>>>>>  DBSTRUCT.FIELD_ATTR  attr_field_related_file      DF_FIELD_RELATED_FILE      integer
50354>>>>>>>>>  DBSTRUCT.FIELD_ATTR  attr_field_related_field     DF_FIELD_RELATED_FIELD     integer
50365>>>>>>>>>  DBSTRUCT.FIELD_ATTR  attr_field_offset            DF_FIELD_OFFSET            integer
50376>>>>>>>>>end_class
50377>>>>>>>>>
50377>>>>>>>>>class cIndexAnalyzerMoreInfo is an array
50378>>>>>>>>>  // pIndex_Key_Length
50378>>>>>>>>>  // pIndex_Levels
50378>>>>>>>>>  // pIndex_Segment_Case
50378>>>>>>>>>  // pIndex_Segment_Direction
50378>>>>>>>>>  procedure set pIndex_Key_Length integer index# integer value#
50380>>>>>>>>>    set value item (index#*40+37) to value#
50381>>>>>>>>>  end_procedure
50382>>>>>>>>>  function pIndex_Key_Length integer index# returns integer
50384>>>>>>>>>    function_return (value(self,index#*40+37))
50385>>>>>>>>>  end_function
50386>>>>>>>>>  procedure set pIndex_Levels integer index# integer value#
50388>>>>>>>>>    set value item (index#*40+38) to value#
50389>>>>>>>>>  end_procedure
50390>>>>>>>>>  function pIndex_Levels integer index# returns integer
50392>>>>>>>>>    function_return (value(self,index#*40+38))
50393>>>>>>>>>  end_function
50394>>>>>>>>>  procedure set pIndex_Type integer index# integer value#
50396>>>>>>>>>    set value item (index#*40+39) to value#
50397>>>>>>>>>  end_procedure
50398>>>>>>>>>  function pIndex_Type integer index# returns integer
50400>>>>>>>>>    function_return (value(self,index#*40+39))
50401>>>>>>>>>  end_function
50402>>>>>>>>>  procedure set pIndex_Segment_Case integer index# integer seg# integer value#
50404>>>>>>>>>    set value item (index#*40+seg#) to value#
50405>>>>>>>>>  end_procedure
50406>>>>>>>>>  function pIndex_Segment_Case integer index# integer segment# returns integer
50408>>>>>>>>>    function_return (value(self,index#*40+segment#))
50409>>>>>>>>>  end_function
50410>>>>>>>>>  procedure set pIndex_Segment_Direction integer index# integer seg# integer value#
50412>>>>>>>>>    set value item (index#*40+20+seg#) to value#
50413>>>>>>>>>  end_procedure
50414>>>>>>>>>  function pIndex_Segment_Direction integer index# integer segment# returns integer
50416>>>>>>>>>    function_return (value(self,index#*40+20+segment#))
50417>>>>>>>>>  end_function
50418>>>>>>>>>end_class
50419>>>>>>>>>
50419>>>>>>>>>// (2)
50419>>>>>>>>>// The index_analyzer class was made to put all stuff, that specifically
50419>>>>>>>>>// analyses indices in one place:
50419>>>>>>>>>class cIndexAnalyzer is an array
50420>>>>>>>>>  procedure construct_object
50422>>>>>>>>>    forward send construct_object
50424>>>>>>>>>    property integer pMainFile             public 0
50425>>>>>>>>>    property integer p_min_len_descr_field public 15
50426>>>>>>>>>    send define_db_structure_layer_mixin
50427>>>>>>>>>    object oMoreInfo is an cIndexAnalyzerMoreInfo
50429>>>>>>>>>    end_object
50430>>>>>>>>>  end_procedure
50431>>>>>>>>>  import_class_protocol db_structure_layer_mixin
50432>>>>>>>>>
50432>>>>>>>>>  procedure seq_write integer ch# // Dump contents through sequential channel
50434>>>>>>>>>    integer itm# max# obj#
50434>>>>>>>>>    writeln channel ch# (pMainFile(self))
50437>>>>>>>>>    writeln (p_min_len_descr_field(self))
50439>>>>>>>>>    get item_count to max#
50440>>>>>>>>>    writeln max#
50442>>>>>>>>>    for itm# from 0 to (max#-1)
50448>>>>>>>>>>
50448>>>>>>>>>      writeln (value(self,itm#))
50450>>>>>>>>>    loop
50451>>>>>>>>>>
50451>>>>>>>>>    move (oMoreInfo(self)) to obj#
50452>>>>>>>>>    get item_count of obj# to max#
50453>>>>>>>>>    writeln max#
50455>>>>>>>>>    for itm# from 0 to (max#-1)
50461>>>>>>>>>>
50461>>>>>>>>>      writeln (value(obj#,itm#))
50463>>>>>>>>>    loop
50464>>>>>>>>>>
50464>>>>>>>>>  end_procedure
50465>>>>>>>>>
50465>>>>>>>>>  procedure seq_read integer ch# // Read contents from sequential channel
50467>>>>>>>>>    integer itm# max# obj#
50467>>>>>>>>>    string tmp#
50467>>>>>>>>>    send reset
50468>>>>>>>>>    readln channel ch# tmp#
50470>>>>>>>>>    set pMainFile to tmp#
50471>>>>>>>>>    readln channel ch# tmp#
50473>>>>>>>>>    set p_min_len_descr_field to tmp#
50474>>>>>>>>>    readln max#
50475>>>>>>>>>    for itm# from 0 to (max#-1)
50481>>>>>>>>>>
50481>>>>>>>>>      readln tmp#
50482>>>>>>>>>      set value item itm# to tmp#
50483>>>>>>>>>    loop
50484>>>>>>>>>>
50484>>>>>>>>>    move (oMoreInfo(self)) to obj#
50485>>>>>>>>>    readln max#
50486>>>>>>>>>    for itm# from 0 to (max#-1)
50492>>>>>>>>>>
50492>>>>>>>>>      readln tmp#
50493>>>>>>>>>      set value of obj# item itm# to tmp#
50494>>>>>>>>>    loop
50495>>>>>>>>>>
50495>>>>>>>>>  end_procedure
50496>>>>>>>>>
50496>>>>>>>>>  procedure reset
50498>>>>>>>>>    send delete_data
50499>>>>>>>>>    send delete_data to (oMoreInfo(self))
50500>>>>>>>>>  end_procedure
50501>>>>>>>>>
50501>>>>>>>>>  // The procedure reads the index definitions into the array
50501>>>>>>>>>  procedure read_file_definition integer file#  // This one reads the index
50503>>>>>>>>>    integer idx# segment# max# fld#       // definitions into the
50503>>>>>>>>>    integer oMoreInfo# attr#              // array.
50503>>>>>>>>>    string str#
50503>>>>>>>>>    if (file#<>pMainFile(self)) begin
50505>>>>>>>>>      send reset
50506>>>>>>>>>      move (oMoreInfo(self)) to oMoreInfo#
50507>>>>>>>>>      for idx# from 1 to 15
50513>>>>>>>>>>
50513>>>>>>>>>        move "" to str#
50514>>>>>>>>>        get_attribute DF_INDEX_NUMBER_SEGMENTS of file# idx# to max#
50517>>>>>>>>>        if max# begin
50519>>>>>>>>>          get_attribute DF_INDEX_KEY_LENGTH of file# idx# to attr#
50522>>>>>>>>>          set pIndex_Key_Length of oMoreInfo# idx# to attr#
50523>>>>>>>>>          get_attribute DF_INDEX_LEVELS of file# idx# to attr#
50526>>>>>>>>>          set pIndex_Levels of oMoreInfo# idx# to attr#
50527>>>>>>>>>          get_attribute DF_INDEX_TYPE of file# idx# to attr#
50530>>>>>>>>>          set pIndex_Type of oMoreInfo# idx# to attr#
50531>>>>>>>>>
50531>>>>>>>>>          for segment# from 1 to max#
50537>>>>>>>>>>
50537>>>>>>>>>            get_attribute DF_INDEX_SEGMENT_FIELD of file# idx# segment# to fld#
50540>>>>>>>>>            move (str#+pad(string(fld#),4)) to str#
50541>>>>>>>>>            get_attribute DF_INDEX_SEGMENT_CASE of file# idx# segment# to attr#
50544>>>>>>>>>            set pIndex_Segment_Case of oMoreInfo# idx# segment# to attr#
50545>>>>>>>>>            get_attribute DF_INDEX_SEGMENT_DIRECTION of file# idx# segment# to attr#
50548>>>>>>>>>            set pIndex_Segment_Direction of oMoreInfo# idx# segment# to attr#
50549>>>>>>>>>          loop
50550>>>>>>>>>>
50550>>>>>>>>>        end
50550>>>>>>>>>>
50550>>>>>>>>>        set value item idx# to str#
50551>>>>>>>>>      loop
50552>>>>>>>>>>
50552>>>>>>>>>      set pMainFile to file#
50553>>>>>>>>>    end
50553>>>>>>>>>>
50553>>>>>>>>>  end_procedure
50554>>>>>>>>>
50554>>>>>>>>>  function idx_Key_Length integer idx# returns integer
50556>>>>>>>>>    function_return (pIndex_Key_Length(oMoreInfo(self),idx#))
50557>>>>>>>>>  end_function
50558>>>>>>>>>  function idx_Levels integer idx# returns integer
50560>>>>>>>>>    function_return (pIndex_Levels(oMoreInfo(self),idx#))
50561>>>>>>>>>  end_function
50562>>>>>>>>>  function idx_Type integer idx# returns integer
50564>>>>>>>>>    function_return (pIndex_Type(oMoreInfo(self),idx#))
50565>>>>>>>>>  end_function
50566>>>>>>>>>  function idx_Segment_Case integer idx# integer seg# returns integer
50568>>>>>>>>>    function_return (pIndex_Segment_Case(oMoreInfo(self),idx#,seg#))
50569>>>>>>>>>  end_function
50570>>>>>>>>>  function idx_Segment_Direction integer idx# integer seg# returns integer
50572>>>>>>>>>    function_return (pIndex_Segment_Direction(oMoreInfo(self),idx#,seg#))
50573>>>>>>>>>  end_function
50574>>>>>>>>>
50574>>>>>>>>>  function idx_Segment_Cases integer idx# returns string
50576>>>>>>>>>    integer seg# max#
50576>>>>>>>>>    string rval#
50576>>>>>>>>>    get idx_max_segment idx# to max#
50577>>>>>>>>>    move "" to rval#
50578>>>>>>>>>    for seg# from 1 to max#
50584>>>>>>>>>>
50584>>>>>>>>>      move (rval#+pad(string(idx_Segment_Case(self,idx#,seg#)),4)) to rval#
50585>>>>>>>>>    loop
50586>>>>>>>>>>
50586>>>>>>>>>    function_return rval#
50587>>>>>>>>>  end_function
50588>>>>>>>>>  function idx_Segment_Directions integer idx# returns string
50590>>>>>>>>>    integer seg# max#
50590>>>>>>>>>    string rval#
50590>>>>>>>>>    get idx_max_segment idx# to max#
50591>>>>>>>>>    move "" to rval#
50592>>>>>>>>>    for seg# from 1 to max#
50598>>>>>>>>>>
50598>>>>>>>>>      move (rval#+pad(string(idx_Segment_Direction(self,idx#,seg#)),4)) to rval#
50599>>>>>>>>>    loop
50600>>>>>>>>>>
50600>>>>>>>>>    function_return rval#
50601>>>>>>>>>  end_function
50602>>>>>>>>>
50602>>>>>>>>>  function idx_exists integer idx# returns integer
50604>>>>>>>>>    function_return (length(value(self,idx#)))
50605>>>>>>>>>  end_function
50606>>>>>>>>>
50606>>>>>>>>>  function idx_segment integer idx# integer segment# returns integer
50608>>>>>>>>>    function_return (integer(mid(value(self,idx#),4,segment#-1*4+1)))
50609>>>>>>>>>  end_function
50610>>>>>>>>>
50610>>>>>>>>>  function idx_max_segment integer idx# returns integer
50612>>>>>>>>>    function_return (length(value(self,idx#))/4)
50613>>>>>>>>>  end_function
50614>>>>>>>>>
50614>>>>>>>>>  function field_translate_overlap integer fld# returns string
50616>>>>>>>>>    integer type# max# field# overlaps# file#
50616>>>>>>>>>    string rval#
50616>>>>>>>>>    get pMainFile to file#
50617>>>>>>>>>    get attr_field_type file# fld# to type#
50618>>>>>>>>>    if type# eq DF_OVERLAP begin
50620>>>>>>>>>      move "" to rval#
50621>>>>>>>>>      get attr_file_number_fields file# to max#
50622>>>>>>>>>      for field# from 1 to max#
50628>>>>>>>>>>
50628>>>>>>>>>        if field# ne fld# begin
50630>>>>>>>>>          get attr_field_type file# field# to type#
50631>>>>>>>>>          if type# ne DF_OVERLAP begin
50633>>>>>>>>>            get attr_field_overlap file# fld# field# to overlaps#
50634>>>>>>>>>            if overlaps# move (rval#+pad(string(field#),4)) to rval#
50637>>>>>>>>>          end
50637>>>>>>>>>>
50637>>>>>>>>>        end
50637>>>>>>>>>>
50637>>>>>>>>>      loop
50638>>>>>>>>>>
50638>>>>>>>>>    end
50638>>>>>>>>>>
50638>>>>>>>>>    else move (pad(string(fld#),4)) to rval#
50640>>>>>>>>>    function_return rval#
50641>>>>>>>>>  end_function
50642>>>>>>>>>
50642>>>>>>>>>  function field_translate_overlaps string str# returns string
50644>>>>>>>>>    integer fld# max# segment#
50644>>>>>>>>>    string rval#
50644>>>>>>>>>    move "" to rval#
50645>>>>>>>>>    move (length(str#)/4) to max#
50646>>>>>>>>>    for segment# from 0 to (max#-1)
50652>>>>>>>>>>
50652>>>>>>>>>      move (mid(str#,4,segment#*4+1)) to fld#
50653>>>>>>>>>      move (rval#+field_translate_overlap(self,fld#)) to rval#
50654>>>>>>>>>    loop
50655>>>>>>>>>>
50655>>>>>>>>>    function_return rval#
50656>>>>>>>>>  end_function
50657>>>>>>>>>
50657>>>>>>>>>  procedure idx_translate_overlaps_all
50659>>>>>>>>>    integer idx#
50659>>>>>>>>>    for idx# from idx# to 15
50665>>>>>>>>>>
50665>>>>>>>>>      if (idx_exists(self,idx#)) ;        set value item idx# to (field_translate_overlaps(self,value(self,idx#)))
50668>>>>>>>>>    loop
50669>>>>>>>>>>
50669>>>>>>>>>  end_procedure
50670>>>>>>>>>
50670>>>>>>>>>  function idx_is_unique integer idx# returns integer // Is index unique?
50672>>>>>>>>>    string str#
50672>>>>>>>>>    get value item idx# to str#
50673>>>>>>>>>    function_return (length(str#) and integer(right(str#,4)))
50674>>>>>>>>>  end_function
50675>>>>>>>>>
50675>>>>>>>>>  function idx_next_index integer idx# returns integer
50677>>>>>>>>>    for idx# from (idx#+1) to 15
50683>>>>>>>>>>
50683>>>>>>>>>      if (idx_exists(self,idx#)) function_return idx#
50686>>>>>>>>>    loop
50687>>>>>>>>>>
50687>>>>>>>>>  end_function
50688>>>>>>>>>
50688>>>>>>>>>  function idx_next_unique_index integer idx# returns integer
50690>>>>>>>>>    for idx# from (idx#+1) to 15
50696>>>>>>>>>>
50696>>>>>>>>>      if (idx_exists(self,idx#) and idx_is_unique(self,idx#)) function_return idx#
50699>>>>>>>>>    loop
50700>>>>>>>>>>
50700>>>>>>>>>  end_function
50701>>>>>>>>>
50701>>>>>>>>>  function idx_next_nonunique_index integer idx# returns integer
50703>>>>>>>>>    for idx# from (idx#+1) to 15
50709>>>>>>>>>>
50709>>>>>>>>>      if (idx_exists(self,idx#) and not(idx_is_unique(self,idx#))) function_return idx#
50712>>>>>>>>>    loop
50713>>>>>>>>>>
50713>>>>>>>>>  end_function
50714>>>>>>>>>
50714>>>>>>>>>  function idx_is_field_present_index integer idx# integer fld# returns integer
50716>>>>>>>>>    integer segment# max#
50716>>>>>>>>>    string str#
50716>>>>>>>>>    get value item idx# to str#
50717>>>>>>>>>    move (length(str#)/4) to max#
50718>>>>>>>>>    for segment# from 0 to (max#-1)
50724>>>>>>>>>>
50724>>>>>>>>>      if fld# eq (integer(mid(str#,4,segment#*4+1))) function_return (segment#+1)
50727>>>>>>>>>    loop
50728>>>>>>>>>>
50728>>>>>>>>>  end_function
50729>>>>>>>>>
50729>>>>>>>>>  function idx_best_index returns integer
50731>>>>>>>>>    integer idx#
50731>>>>>>>>>    get idx_next_unique_index 0 to idx#
50732>>>>>>>>>    ifnot idx# get idx_next_nonunique_index 0 to idx#
50735>>>>>>>>>    function_return idx#
50736>>>>>>>>>  end_function
50737>>>>>>>>>
50737>>>>>>>>>  function idx_next_description_index integer idx# returns integer
50739>>>>>>>>>    integer type# len# fld# file#
50739>>>>>>>>>    string str#
50739>>>>>>>>>    get pMainFile to file#
50740>>>>>>>>>    for idx# from (idx#+1) to 15
50746>>>>>>>>>>
50746>>>>>>>>>      get value item idx# to str#
50747>>>>>>>>>      if (length(str#)) begin
50749>>>>>>>>>        move (left(str#,4)) to fld#
50750>>>>>>>>>        get attr_field_type file# fld# to type#
50751>>>>>>>>>        if type# eq df_overlap begin // Translate if overlap
50753>>>>>>>>>          get field_translate_overlap fld# to str#
50754>>>>>>>>>          move (left(str#,4)) to fld#
50755>>>>>>>>>          get attr_field_type file# fld# to type#
50756>>>>>>>>>        end
50756>>>>>>>>>>
50756>>>>>>>>>        if type# eq df_ascii begin // Examine the first segment
50758>>>>>>>>>          get attr_field_length file# fld# to len#
50759>>>>>>>>>          if len# ge (p_min_len_descr_field(self)) function_return idx#
50762>>>>>>>>>        end
50762>>>>>>>>>>
50762>>>>>>>>>      end
50762>>>>>>>>>>
50762>>>>>>>>>    loop
50763>>>>>>>>>>
50763>>>>>>>>>  end_function
50764>>>>>>>>>
50764>>>>>>>>>  function idx_next_field_not_index integer fld# returns integer
50766>>>>>>>>>    integer max# idx# file# type#
50766>>>>>>>>>    get pMainFile to file#
50767>>>>>>>>>    get attr_file_number_fields file# to max#
50768>>>>>>>>>    for fld# from (fld#+1) to max#
50774>>>>>>>>>>
50774>>>>>>>>>      get attr_field_index file# fld# to idx#
50775>>>>>>>>>      ifnot idx# begin
50777>>>>>>>>>        get attr_field_type file# fld# to type#
50778>>>>>>>>>        if (type#<>df_overlap and type#<>df_text and type#<>df_binary) function_return fld#
50781>>>>>>>>>      end
50781>>>>>>>>>>
50781>>>>>>>>>    loop
50782>>>>>>>>>>
50782>>>>>>>>>  end_function
50783>>>>>>>>>
50783>>>>>>>>>  function idx_next_description_field_not_index integer fld# returns integer
50785>>>>>>>>>    integer max# idx# type# len# min_len# file#
50785>>>>>>>>>    get pMainFile to file#
50786>>>>>>>>>    get attr_file_number_fields file# to max#
50787>>>>>>>>>    get p_min_len_descr_field to min_len#
50788>>>>>>>>>    for fld# from (fld#+1) to max#
50794>>>>>>>>>>
50794>>>>>>>>>      get attr_field_type file# fld# to type#
50795>>>>>>>>>      if type# eq df_ascii begin
50797>>>>>>>>>        get attr_field_length file# fld# to len#
50798>>>>>>>>>        if (len#>=min_len#) begin
50800>>>>>>>>>          get attr_field_index file# fld# to idx#
50801>>>>>>>>>          ifnot idx# function_return fld#
50804>>>>>>>>>        end
50804>>>>>>>>>>
50804>>>>>>>>>      end
50804>>>>>>>>>>
50804>>>>>>>>>    loop
50805>>>>>>>>>>
50805>>>>>>>>>    function_return 0
50806>>>>>>>>>  end_function
50807>>>>>>>>>
50807>>>>>>>>>  function idx_raw_definition integer idx# returns string
50809>>>>>>>>>    function_return (value(self,idx#))
50810>>>>>>>>>  end_function
50811>>>>>>>>>
50811>>>>>>>>>  function idx_definition integer idx# returns string
50813>>>>>>>>>    string rval#
50813>>>>>>>>>    if idx# begin
50815>>>>>>>>>      get idx_raw_definition idx# to rval#
50816>>>>>>>>>      get field_translate_overlaps rval# to rval#
50817>>>>>>>>>    end
50817>>>>>>>>>>
50817>>>>>>>>>    else move "0   " to rval#
50819>>>>>>>>>    function_return rval#
50820>>>>>>>>>  end_function
50821>>>>>>>>>
50821>>>>>>>>>  // This function returns the next index that has the fields listed in
50821>>>>>>>>>  // parameter fields# as its most significant segments regardless the
50821>>>>>>>>>  // order:
50821>>>>>>>>>  function idx_next_index_ms_segments integer idx# string fields# returns integer
50823>>>>>>>>>    integer segment# max# len# ok#
50823>>>>>>>>>    string ms_fields#
50823>>>>>>>>>    get field_translate_overlaps fields# to fields#
50824>>>>>>>>>    move (length(fields#)) to len#
50825>>>>>>>>>    move (len#/4) to max#
50826>>>>>>>>>    for idx# from (idx#+1) to 15
50832>>>>>>>>>>
50832>>>>>>>>>      if (idx_exists(self,idx#)) begin
50834>>>>>>>>>        move (left(idx_definition(self,idx#),len#)) to ms_fields#
50835>>>>>>>>>        move 1 to ok#
50836>>>>>>>>>        for segment# from 0 to (max#-1)
50842>>>>>>>>>>
50842>>>>>>>>>          ifnot (mid(fields#,4,segment#*4+1)) in ms_fields# move 0 to ok#
50845>>>>>>>>>        loop
50846>>>>>>>>>>
50846>>>>>>>>>        if ok# function_return idx#
50849>>>>>>>>>      end
50849>>>>>>>>>>
50849>>>>>>>>>    loop
50850>>>>>>>>>>
50850>>>>>>>>>  end_function
50851>>>>>>>>>
50851>>>>>>>>>  // This function returns the next index that has the fields listed in
50851>>>>>>>>>  // parameter fields# as its most significant segments in the same order
50851>>>>>>>>>  // (fixed order):
50851>>>>>>>>>  function idx_next_index_ms_segments_fo integer idx# string fields# returns integer
50853>>>>>>>>>    integer len#
50853>>>>>>>>>    string ms_fields#
50853>>>>>>>>>    get field_translate_overlaps fields# to fields#
50854>>>>>>>>>    move (length(fields#)) to len#
50855>>>>>>>>>    move (fields#+"*") to fields#
50856>>>>>>>>>    for idx# from (idx#+1) to 15
50862>>>>>>>>>>
50862>>>>>>>>>      if (idx_exists(self,idx#)) begin
50864>>>>>>>>>        move (left(idx_definition(self,idx#),len#)) to ms_fields#
50865>>>>>>>>>        if fields# match ms_fields# function_return idx#
50868>>>>>>>>>      end
50868>>>>>>>>>>
50868>>>>>>>>>    loop
50869>>>>>>>>>>
50869>>>>>>>>>  end_function
50870>>>>>>>>>
50870>>>>>>>>>  function field_remove_doubles string str# returns string
50872>>>>>>>>>    integer max# segment#
50872>>>>>>>>>    string rval# fld#
50872>>>>>>>>>    move "" to rval#
50873>>>>>>>>>    move (length(str#)/4) to max#
50874>>>>>>>>>    for segment# from 0 to (max#-1)
50880>>>>>>>>>>
50880>>>>>>>>>      move (mid(str#,4,segment#*4+1)) to fld#
50881>>>>>>>>>      ifnot fld# in rval# move (rval#+fld#) to rval#
50884>>>>>>>>>    loop
50885>>>>>>>>>>
50885>>>>>>>>>    function_return rval#
50886>>>>>>>>>  end_function
50887>>>>>>>>>
50887>>>>>>>>>  function field_remove_recnum string str# returns string
50889>>>>>>>>>    integer max# segment# file# fld#
50889>>>>>>>>>    string rval#
50889>>>>>>>>>    get pMainFile to file#
50890>>>>>>>>>    move "" to rval#
50891>>>>>>>>>    move (length(str#)/4) to max#
50892>>>>>>>>>    for segment# from 0 to (max#-1)
50898>>>>>>>>>>
50898>>>>>>>>>      move (mid(str#,4,segment#*4+1)) to fld#
50899>>>>>>>>>      if fld# move (rval#+pad(string(fld#),4)) to rval#
50902>>>>>>>>>    loop
50903>>>>>>>>>>
50903>>>>>>>>>    function_return rval#
50904>>>>>>>>>  end_function
50905>>>>>>>>>
50905>>>>>>>>>  function insert_file_reference string str# returns string
50907>>>>>>>>>    integer fld# max# segment# file#
50907>>>>>>>>>    string rval#
50907>>>>>>>>>    get pMainFile to file#
50908>>>>>>>>>    move "" to rval#
50909>>>>>>>>>    move (length(str#)/4) to max#
50910>>>>>>>>>    for segment# from 0 to (max#-1)
50916>>>>>>>>>>
50916>>>>>>>>>      move (mid(str#,4,segment#*4+1)) to fld#
50917>>>>>>>>>      move (rval#+pad(string(file#),4)+pad(string(fld#),4)) to rval#
50918>>>>>>>>>    loop
50919>>>>>>>>>>
50919>>>>>>>>>    function_return rval#
50920>>>>>>>>>  end_function
50921>>>>>>>>>
50921>>>>>>>>>  function idx_field_names integer idx# integer ovl# integer remove_rec# returns string
50923>>>>>>>>>    string str# rval# fname#
50923>>>>>>>>>    integer file# fld# segment# max#
50923>>>>>>>>>    get pMainFile to file#
50924>>>>>>>>>    get value item idx# to str#
50925>>>>>>>>>    if str# ne "" begin
50927>>>>>>>>>      if remove_rec# get field_remove_recnum str#      to str#
50930>>>>>>>>>      if ovl#        get field_translate_overlaps str# to str#
50933>>>>>>>>>      move (length(str#)/4) to max#
50934>>>>>>>>>      for segment# from 0 to (max#-1)
50940>>>>>>>>>>
50940>>>>>>>>>        if segment# ne 0 move (rval#+", ") to rval#
50943>>>>>>>>>        move (mid(str#,4,segment#*4+1)) to fld#
50944>>>>>>>>>        //get_attribute DF_FIELD_NAME of file# fld# to fname#
50944>>>>>>>>>        get attr_field_name file# fld# to fname#
50945>>>>>>>>>        move (lowercase(fname#)) to fname#
50946>>>>>>>>>        move (overstrike(uppercase(left(fname#,1)),fname#,1)) to fname#
50947>>>>>>>>>        move (rval#+fname#) to rval#
50948>>>>>>>>>      loop
50949>>>>>>>>>>
50949>>>>>>>>>    end
50949>>>>>>>>>>
50949>>>>>>>>>    else move "" to rval#
50951>>>>>>>>>    function_return rval#
50952>>>>>>>>>  end_function
50953>>>>>>>>>
50953>>>>>>>>>  function idx_field_value integer idx# integer ovl# integer remove_rec# returns string
50955>>>>>>>>>    string str# rval# fval#
50955>>>>>>>>>    integer file# fld# segment# max#
50955>>>>>>>>>    get pMainFile to file#
50956>>>>>>>>>    if idx# get value item idx# to str#
50959>>>>>>>>>    else begin // If idx# is 0 we un-conditionally return the recnum
50960>>>>>>>>>      get_field_value file# fld# to fval#
50963>>>>>>>>>      function_return fval#
50964>>>>>>>>>    end
50964>>>>>>>>>>
50964>>>>>>>>>    if str# ne "" begin
50966>>>>>>>>>      if remove_rec# get field_remove_recnum str#      to str#
50969>>>>>>>>>      if ovl#        get field_translate_overlaps str# to str#
50972>>>>>>>>>      move (length(str#)/4) to max#
50973>>>>>>>>>      for segment# from 0 to (max#-1)
50979>>>>>>>>>>
50979>>>>>>>>>        if segment# ne 0 move (rval#+", ") to rval#
50982>>>>>>>>>        move (mid(str#,4,segment#*4+1)) to fld#
50983>>>>>>>>>        get_field_value file# fld# to fval#
50986>>>>>>>>>        trim fval# to fval#
50987>>>>>>>>>>
50987>>>>>>>>>        move (rval#+fval#) to rval#
50988>>>>>>>>>      loop
50989>>>>>>>>>>
50989>>>>>>>>>    end
50989>>>>>>>>>>
50989>>>>>>>>>    else move "" to rval#
50991>>>>>>>>>    function_return rval#
50992>>>>>>>>>  end_function
50993>>>>>>>>>
50993>>>>>>>>>  // -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
50993>>>>>>>>>
50993>>>>>>>>>  // The function prompt_list_fields returns a bid for which fields
50993>>>>>>>>>  // a prompt list should include.
50993>>>>>>>>>  function prompt_list_fields integer file# returns string
50995>>>>>>>>>    integer best_idx# descr_idx# descr_fld# second_best_idx#
50995>>>>>>>>>    string rval#
50995>>>>>>>>>
50995>>>>>>>>>    send read_file_definition file#
50996>>>>>>>>>
50996>>>>>>>>>    get idx_best_index to best_idx# //
50997>>>>>>>>>
50997>>>>>>>>>    get idx_next_description_index 0 to descr_idx#
50998>>>>>>>>>    if descr_idx# begin
51000>>>>>>>>>      if descr_idx# eq best_idx# ;         get idx_next_description_index descr_idx# to descr_idx#
51003>>>>>>>>>    end
51003>>>>>>>>>>
51003>>>>>>>>>
51003>>>>>>>>>    ifnot descr_idx# begin
51005>>>>>>>>>      get idx_next_description_field_not_index 0 to descr_fld#
51006>>>>>>>>>      ifnot descr_idx# get idx_next_field_not_index 0 to descr_fld#
51009>>>>>>>>>    end
51009>>>>>>>>>>
51009>>>>>>>>>
51009>>>>>>>>>    get idx_next_index 0 to second_best_idx#
51010>>>>>>>>>    if second_best_idx# begin
51012>>>>>>>>>      repeat
51012>>>>>>>>>>
51012>>>>>>>>>        if (second_best_idx#=best_idx# or second_best_idx#=descr_idx#) begin
51014>>>>>>>>>          get idx_next_index second_best_idx# to second_best_idx#
51015>>>>>>>>>        end
51015>>>>>>>>>>
51015>>>>>>>>>      until (not(second_best_idx#) or (second_best_idx#<>best_idx# and second_best_idx#<>descr_idx#))
51017>>>>>>>>>    end
51017>>>>>>>>>>
51017>>>>>>>>>
51017>>>>>>>>>    if best_idx# move (idx_definition(self,best_idx#)) to rval#
51020>>>>>>>>>    else move "0   " to rval#
51022>>>>>>>>>
51022>>>>>>>>>    if descr_idx# move (rval#+idx_definition(self,descr_idx#)) to rval#
51025>>>>>>>>>    if descr_fld# move (rval#+pad(string(descr_fld#),4)) to rval#
51028>>>>>>>>>
51028>>>>>>>>>    if second_best_idx# move (rval#+idx_definition(self,second_best_idx#)) to rval#
51031>>>>>>>>>
51031>>>>>>>>>    get field_remove_doubles rval# to rval#
51032>>>>>>>>>    if best_idx# get field_remove_recnum rval# to rval#
51035>>>>>>>>>    get insert_file_reference rval# to rval#
51036>>>>>>>>>    function_return rval#
51037>>>>>>>>>  end_function
51038>>>>>>>>>end_class // cIndexAnalyzer
51039>>>>>>>>>
51039>>>>>>>>>integer oIndexAnalyzer#
51039>>>>>>>>>object oIndexAnalyzer is a cIndexAnalyzer
51041>>>>>>>>>  move self to oIndexAnalyzer#
51042>>>>>>>>>end_object
51043>>>>>>>//Use FdxField.nui // FDX Field things
51043>>>>>>>//Use FdxIndex.utl // Index analysing functions
51043>>>>>>>Use FieldInf.pkg // Global field info objects
51043>>>>>>>Use Strings.nui  // String manipulation for VDF
51043>>>>>>>Use Dates.nui    // Date manipulation for VDF and DF3.2
51043>>>>>>>Use QryExpr.utl  // Expression handling for queries
Including file: qryexpr.utl    (C:\projects\BRS\VDFQuery\AppSrc\qryexpr.utl)
51043>>>>>>>>>// Use QryExpr.utl  // Expression handling for queries
51043>>>>>>>>>Use DFScript.utl // DF-Script interpreter
Including file: dfscript.utl    (C:\projects\BRS\VDFQuery\AppSrc\dfscript.utl)
51043>>>>>>>>>>>//**********************************************************************
51043>>>>>>>>>>>// Use DFScript.utl // DF-Script interpreter
51043>>>>>>>>>>>//
51043>>>>>>>>>>>// by Sture Andersen
51043>>>>>>>>>>>//
51043>>>>>>>>>>>// Create: Fri  15-10-1999
51043>>>>>>>>>>>// Update:
51043>>>>>>>>>>>//
51043>>>>>>>>>>>//
51043>>>>>>>>>>>//
51043>>>>>>>>>>>//  ========================= SCRIPT SYNTAX: ===========================
51043>>>>>>>>>>>//
51043>>>>>>>>>>>//
51043>>>>>>>>>>>// INTEGER {symbol}+                      Global variable declaration(s)
51043>>>>>>>>>>>// STRING {symbol}+                       Global variable declaration(s)
51043>>>>>>>>>>>// NUMBER {symbol}+                       Global variable declaration(s)
51043>>>>>>>>>>>// DATE {symbol}+                         Global variable declaration(s)
51043>>>>>>>>>>>// MOVE {value} to {varname}              Assign value to variable
51043>>>>>>>>>>>// #REPLACE {symbol} {value}              Create compiler symbol
51043>>>>>>>>>>>// #NOISY {0|1}                           Toggles interpreter debug state
51043>>>>>>>>>>>// PAUSE                                  Pause program execution
51043>>>>>>>>>>>// GOTO {label}                           Jump to specified label
51043>>>>>>>>>>>// GOSUB {label}                          Execute subrutine
51043>>>>>>>>>>>// RETURN                                 Return from subroutine
51043>>>>>>>>>>>// ABORT                                  Halts program execution
51043>>>>>>>>>>>// INPUT {prompt} {varname}               Lets the operator enter a value
51043>>>>>>>>>>>// DEBUG {ON|OFF|SINGLE_STEP|DISPLAY_VAR} Control debug status
51043>>>>>>>>>>>// GOTOXY {line} {column}                 Positions the cursor (character mode)
51043>>>>>>>>>>>// CLEARSCREEN                            Blanks the screen
51043>>>>>>>>>>>//
51043>>>>>>>>>>>// DELETE_FIELD {field}
51043>>>>>>>>>>>// CREATE_FIELD {field} {name} {type}
51043>>>>>>>>>>>// SET_ATTRIBUTE {}
51043>>>>>>>>>>>// DELETE_INDEX {index}
51043>>>>>>>>>>>//
51043>>>>>>>>>>>//**********************************************************************
51043>>>>>>>>>>>
51043>>>>>>>>>>>
51043>>>>>>>>>>>Use APS         // Auto Positioning and Sizing classes for VDF
51043>>>>>>>>>>>Use vMachine.utl // Virtual machine class
Including file: vmachine.utl    (C:\projects\BRS\VDFQuery\AppSrc\vmachine.utl)
51043>>>>>>>>>>>>>//**********************************************************************
51043>>>>>>>>>>>>>// Use vMachine.utl // Virtual machine class (heart of DFScript)
51043>>>>>>>>>>>>>//
51043>>>>>>>>>>>>>// By Sture Andersen
51043>>>>>>>>>>>>>//
51043>>>>>>>>>>>>>// Create: Fri  01-10-1999
51043>>>>>>>>>>>>>// Update: Fri  15-10-1999 - Now handles DBMS field
51043>>>>>>>>>>>>>//                         - Repeat/Until macro added
51043>>>>>>>>>>>>>//
51043>>>>>>>>>>>>>//
51043>>>>>>>>>>>>>//   Functions for dbQuery:
51043>>>>>>>>>>>>>//
51043>>>>>>>>>>>>>//               Strings
51043>>>>>>>>>>>>>//
51043>>>>>>>>>>>>>//     Simple    Left
51043>>>>>>>>>>>>>//               Right
51043>>>>>>>>>>>>>//               Mid
51043>>>>>>>>>>>>>//               Pos
51043>>>>>>>>>>>>>//               Uppercase
51043>>>>>>>>>>>>>//               Lowercase
51043>>>>>>>>>>>>>//
51043>>>>>>>>>>>>>//     Advanced
51043>>>>>>>>>>>>>//
51043>>>>>>>>>>>>>//
51043>>>>>>>>>>>>>//               Dates
51043>>>>>>>>>>>>>//
51043>>>>>>>>>>>>>//     Simple    DateCompose     integer liDay integer liMonth integer liYear returns date
51043>>>>>>>>>>>>>//               StringToDate    string lsDate integer liFormat integer lbLong string lsSep returns date
51043>>>>>>>>>>>>>//               DateToString    date ldDate integer liFormat integer lbLong string lsSep returns string
51043>>>>>>>>>>>>>//               DateIncrement   date ldDate integer liSegment integer liAmount returns date
51043>>>>>>>>>>>>>//               DateSegment     date ldDate integer liSegment returns integer
51043>>>>>>>>>>>>>//               FirstDayInMonth date ldDate returns date
51043>>>>>>>>>>>>>//               LastDayInMonth  date ldDate returns date
51043>>>>>>>>>>>>>//               FirstDayInYear  date ldDate returns date
51043>>>>>>>>>>>>>//               LastDayInYear   date ldDate returns date
51043>>>>>>>>>>>>>//               DateWeekNumber  date ldDate returns integer
51043>>>>>>>>>>>>>//               DayName         integer liWeekDay returns string
51043>>>>>>>>>>>>>//               DateDayNumber   date ldDate returns integer
51043>>>>>>>>>>>>>//               DateDayName     date ldDate returns string
51043>>>>>>>>>>>>>//               WeekToDate      integer liYear integer liWeek returns date
51043>>>>>>>>>>>>>//               MonthName       integer liMonth returns string
51043>>>>>>>>>>>>>//               DateMonthName   date ldDate returns string
51043>>>>>>>>>>>>>//               DateAsText      date ldDate string lsFormat returns string
51043>>>>>>>>>>>>>//               SysDate         returns date
51043>>>>>>>>>>>>>//
51043>>>>>>>>>>>>>//**********************************************************************
51043>>>>>>>>>>>>>
51043>>>>>>>>>>>>>Use Base.nui
51043>>>>>>>>>>>>>Use MsgBox.utl   // obs procedure
Including file: msgbox.utl    (C:\projects\BRS\VDFQuery\AppSrc\msgbox.utl)
51043>>>>>>>>>>>>>>>// Use MsgBox.utl   // obs procedure
51043>>>>>>>>>>>>>>>Use UI // Necessary to define IS$WINDOWS (if windows)
51043>>>>>>>>>>>>>>>Use Language
51043>>>>>>>>>>>>>>>
51043>>>>>>>>>>>>>>>
51043>>>>>>>>>>>>>>>// ======================================================================
51043>>>>>>>>>>>>>>>//                           OBS MESSAGE
51043>>>>>>>>>>>>>>>// ======================================================================
51043>>>>>>>>>>>>>>>Use MsgBox      // DAC class
51043>>>>>>>>>>>>>>>Use Buttons.utl // Button texts
51043>>>>>>>>>>>>>>>
51043>>>>>>>>>>>>>>>procedure obs global string str#
51045>>>>>>>>>>>>>>>  integer iArg max# self# focus#
51045>>>>>>>>>>>>>>>  string msg# line#
51045>>>>>>>>>>>>>>>  move "" to msg#
51046>>>>>>>>>>>>>>>  for iArg from 1 to num_arguments
51052>>>>>>>>>>>>>>>>
51052>>>>>>>>>>>>>>>    MoveStr iArg& to line# // tricky way to parse passed arguments
51053>>>>>>>>>>>>>>>>
51053>>>>>>>>>>>>>>>    move (msg#+line#) to msg#
51054>>>>>>>>>>>>>>>    if iArg ne num_arguments move (msg#+character(10)) to msg#
51057>>>>>>>>>>>>>>>  loop
51058>>>>>>>>>>>>>>>>
51058>>>>>>>>>>>>>>>  move self to self#
51059>>>>>>>>>>>>>>>  get focus of desktop to focus#
51060>>>>>>>>>>>>>>>  if focus# gt desktop move focus# to self
51063>>>>>>>>>>>>>>>  send info_box msg# t.MsgBox.Message
51064>>>>>>>>>>>>>>>  move self# to self
51065>>>>>>>>>>>>>>>end_procedure
51066>>>>>>>>>>>>>>>
51066>>>>>>>>>>>>>>>// ======================================================================
51066>>>>>>>>>>>>>>>//                          CONFIRM LIST
51066>>>>>>>>>>>>>>>// ======================================================================
51066>>>>>>>>>>>>>>>
51066>>>>>>>>>>>>>>>use APS
51066>>>>>>>>>>>>>>>object oConfirm_List is a aps.ModalPanel
51068>>>>>>>>>>>>>>>  set locate_mode to center_on_screen
51069>>>>>>>>>>>>>>>  property integer pResult public 0
51071>>>>>>>>>>>>>>>  on_key kcancel send close_panel_ok
51072>>>>>>>>>>>>>>>  object lbl is a aps.textbox
51074>>>>>>>>>>>>>>>  end_object
51075>>>>>>>>>>>>>>>  send aps_goto_max_row
51076>>>>>>>>>>>>>>>  object lst is a aps.list no_image
51078>>>>>>>>>>>>>>>    set size to 105 150
51079>>>>>>>>>>>>>>>    set select_mode to no_select
51080>>>>>>>>>>>>>>>  end_object
51081>>>>>>>>>>>>>>>  procedure close_panel_ok
51084>>>>>>>>>>>>>>>    set pResult to 1
51085>>>>>>>>>>>>>>>    send close_panel
51086>>>>>>>>>>>>>>>  end_procedure
51087>>>>>>>>>>>>>>>  object btn1 is a aps.Multi_Button
51089>>>>>>>>>>>>>>>    on_item t.btn.ok send close_panel_ok
51090>>>>>>>>>>>>>>>  end_object
51091>>>>>>>>>>>>>>>  object btn2 is a aps.Multi_Button
51093>>>>>>>>>>>>>>>    on_item t.btn.cancel send close_panel
51094>>>>>>>>>>>>>>>  end_object
51095>>>>>>>>>>>>>>>  send aps_locate_multi_buttons
51096>>>>>>>>>>>>>>>  procedure delete_data
51099>>>>>>>>>>>>>>>    send delete_data to (lst(self))
51100>>>>>>>>>>>>>>>  end_procedure
51101>>>>>>>>>>>>>>>  procedure run.ss string title# string header#
51104>>>>>>>>>>>>>>>    integer grb#
51104>>>>>>>>>>>>>>>    set label to title#
51105>>>>>>>>>>>>>>>    set value of (lbl(self)) to header#
51106>>>>>>>>>>>>>>>    send popup
51107>>>>>>>>>>>>>>>    send delete_data
51108>>>>>>>>>>>>>>>  end_procedure
51109>>>>>>>>>>>>>>>  function irun.ss string title# string header# returns integer
51112>>>>>>>>>>>>>>>    integer rval#
51112>>>>>>>>>>>>>>>    set label to title#
51113>>>>>>>>>>>>>>>    set value of (lbl(self)) to header#
51114>>>>>>>>>>>>>>>    set pResult to 0
51115>>>>>>>>>>>>>>>    send popup
51116>>>>>>>>>>>>>>>    get pResult to rval#
51117>>>>>>>>>>>>>>>    send delete_data
51118>>>>>>>>>>>>>>>    function_return rval#
51119>>>>>>>>>>>>>>>  end_function
51120>>>>>>>>>>>>>>>end_object
51121>>>>>>>>>>>>>>>
51121>>>>>>>>>>>>>>>procedure Confirm_List_Reset
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
51123>>>>>>>>>>>>>>>  send delete_data to (oConfirm_List(self))
51124>>>>>>>>>>>>>>>end_procedure
51125>>>>>>>>>>>>>>>procedure Confirm_List_Add string str#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
51127>>>>>>>>>>>>>>>  integer obj#
51127>>>>>>>>>>>>>>>  move (lst(oConfirm_List(self))) to obj#
51128>>>>>>>>>>>>>>>  send add_item to obj# msg_none str#
51129>>>>>>>>>>>>>>>end_procedure
51130>>>>>>>>>>>>>>>procedure Confirm_List_Go string title# string header#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
51132>>>>>>>>>>>>>>>  send run.ss to (oConfirm_List(self)) title# header#
51133>>>>>>>>>>>>>>>end_procedure
51134>>>>>>>>>>>>>>>function Confirm_List_Confirm global string title# string header# returns integer
51136>>>>>>>>>>>>>>>  function_return (irun.ss(oConfirm_List(self),title#,header#))
51137>>>>>>>>>>>>>>>end_function
51138>>>>>>>>>>>>>>>
51138>>>>>>>>>>>>>>>// ======================================================================
51138>>>>>>>>>>>>>>>//                          YES/NO OBJECT
51138>>>>>>>>>>>>>>>// ======================================================================
51138>>>>>>>>>>>>>>>
51138>>>>>>>>>>>>>>>
51138>>>>>>>>>>>>>>>function MB_Verify global string str# integer def# returns integer
51140>>>>>>>>>>>>>>>  integer rval#
51140>>>>>>>>>>>>>>>  if def# move MB_DEFBUTTON1 to def#
51143>>>>>>>>>>>>>>>  else move MB_DEFBUTTON2 to def#
51145>>>>>>>>>>>>>>>  move (yesno_box(str#,t.MsgBox.Question,def#)) to rval#
51146>>>>>>>>>>>>>>>  function_return (rval#=mbr_yes)
51147>>>>>>>>>>>>>>>end_function
51148>>>>>>>>>>>>>>>
51148>>>>>>>>>>>>>>>function MB_Verify4 global string str1# string str2# string str3# string str4# integer def# returns integer
51150>>>>>>>>>>>>>>>  string lf#
51150>>>>>>>>>>>>>>>  move (character(10)) to lf#
51151>>>>>>>>>>>>>>>  function_return (MB_verify(str1#+lf#+str2#+lf#+str3#+lf#+str4#,def#))
51152>>>>>>>>>>>>>>>end_function
51153>>>>>>>>>>>>>>>
51153>>>>>>>>>>>>>>>function MB_CancelOnKeypress global string str# returns integer
51155>>>>>>>>>>>>>>>end_function
51156>>>>>>>>>>>>>>>
51156>>>>>>>>>>>>>Use Strings.nui  // String manipulation for VDF
51156>>>>>>>>>>>>>Use DBMS.utl     // Basic DBMS functions
Including file: dbms.utl    (C:\projects\BRS\VDFQuery\AppSrc\dbms.utl)
51156>>>>>>>>>>>>>>>Use DBMS.nui     // Basic DBMS functions
51156>>>>>>>>>>>>>>>Use MsgBox.utl   // obs procedure
51156>>>>>>>>>>>>>>>
51156>>>>>>>>>>>>>>>Use Windows
51156>>>>>>>>>>>>>>>Use file_dlg    // OpenDialog class (DAC)
51156>>>>>>>>>>>>>>>object oDBMS_FlDlg is a OpenDialog
51158>>>>>>>>>>>>>>>  set NoChangeDir_State to true
51159>>>>>>>>>>>>>>>end_object
51160>>>>>>>>>>>>>>>
51160>>>>>>>>>>>>>>>function DBMS_OpenFileBrowse global string fn# integer file# integer mode# integer buf_index# returns integer
51162>>>>>>>>>>>>>>>  integer obj# rval#
51162>>>>>>>>>>>>>>>  move 0 to rval#
51163>>>>>>>>>>>>>>>  move (oDBMS_FlDlg(self)) to obj#
51164>>>>>>>>>>>>>>>  set Dialog_Caption of obj# to ("Locate "+fn#)
51165>>>>>>>>>>>>>>>  set Filter_String  of obj# to ("Standard ("+fn#+")|"+fn#+"|DAT files|*.dat|All files|*.*")
51166>>>>>>>>>>>>>>>  if (Show_Dialog(obj#)) begin
51168>>>>>>>>>>>>>>>    move (File_Name(obj#)) to fn#
51169>>>>>>>>>>>>>>>    if fn# ne "" move (DBMS_OpenFileAs(fn#,file#,mode#,buf_index#)) to rval#
51172>>>>>>>>>>>>>>>  end
51172>>>>>>>>>>>>>>>>
51172>>>>>>>>>>>>>>>  function_return rval#
51173>>>>>>>>>>>>>>>end_function
51174>>>>>>>>>>>>>>>
51174>>>>>>>>>>>>>>>// Procedure private.DBMS_OpenFile is used by the DBMS_OPEN command.
51174>>>>>>>>>>>>>>>// It takes the following parameters:
51174>>>>>>>>>>>>>>>//
51174>>>>>>>>>>>>>>>// line_no#   integer Number of the calling command line
51174>>>>>>>>>>>>>>>// file#      integer Number of the file to open
51174>>>>>>>>>>>>>>>// as#        boolean Is this an 'OPEN AS' thing?
51174>>>>>>>>>>>>>>>// as_string# string  Name of the file to open if opened as
51174>>>>>>>>>>>>>>>// mode#      integer DF_SHARE or DF_EXCLUSIVE
51174>>>>>>>>>>>>>>>// index#     integer If non zero this specifies which index should be buffered
51174>>>>>>>>>>>>>>>// dfname#    string  Logical name of the file#
51174>>>>>>>>>>>>>>>
51174>>>>>>>>>>>>>>>procedure private.DBMS_OpenFile global integer line_no# integer file# integer as# string as_str# integer mode# integer index# string dffile#
51176>>>>>>>>>>>>>>>  integer ok#
51176>>>>>>>>>>>>>>>  string msg#
51176>>>>>>>>>>>>>>>  if as# move (DBMS_OpenFileAs(as_str#,file#,mode#,index#)) to ok#
51179>>>>>>>>>>>>>>>  else move (DBMS_OpenFile(file#,mode#,index#)) to ok#
51181>>>>>>>>>>>>>>>  ifnot ok# begin
51183>>>>>>>>>>>>>>>    move ("Datafile could not be opened."+character(10)) to msg#
51184>>>>>>>>>>>>>>>    move (msg#+"File number "+string(file#)+" was attempted opened in line "+string(line_no#)+"."+character(10)) to msg#
51185>>>>>>>>>>>>>>>    if as# move (msg#+"Physical file name is: "+as_str#+character(10)) to msg#
51188>>>>>>>>>>>>>>>    else   move (msg#+"Physical file name is: "+DBMS_Rootname(file#)+character(10)) to msg#
51190>>>>>>>>>>>>>>>    if dffile# eq "DFFILE_NAME_NOT_FOUND" move (msg#+"No logical file name was specified.") to msg#
51193>>>>>>>>>>>>>>>    else move (msg#+"Logical file name is: "+dffile#) to msg#
51195>>>>>>>>>>>>>>>    send obs msg#
51196>>>>>>>>>>>>>>>  end
51196>>>>>>>>>>>>>>>>
51196>>>>>>>>>>>>>>>end_procedure
51197>>>>>>>>>>>>>>>
51197>>>>>>>>>>>>>Use Focus.utl    // Retrieve basic information about object
Including file: focus.utl    (C:\projects\BRS\VDFQuery\AppSrc\focus.utl)
51197>>>>>>>>>>>>>>>// **********************************************************************
51197>>>>>>>>>>>>>>>// Use Focus.utl    // Retrieve basic information about object
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>// by Sture Andersen
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>// Create: Can't remember
51197>>>>>>>>>>>>>>>// Update: Fri  30-06-2000 - Changed and doc'ed
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>// This package is able to perform a runtime analysis of the object that
51197>>>>>>>>>>>>>>>// currently holds the focus. The following information may be retrieved:
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>//       Info-ID             Type       Description
51197>>>>>>>>>>>>>>>//      -----------------------------------------------------------
51197>>>>>>>>>>>>>>>//       FOCUS_OK            (Bool)     Did this work at all?
51197>>>>>>>>>>>>>>>//       FOCUS_DEO_ID        (Integer)  Who did we ask?
51197>>>>>>>>>>>>>>>//       FOCUS_ITEM_FILE     (Integer)  What's the data file of the current
51197>>>>>>>>>>>>>>>//                                      item.
51197>>>>>>>>>>>>>>>//       FOCUS_ITEM_FIELD    (Integer)  What's the data field of the
51197>>>>>>>>>>>>>>>//                                      current item.
51197>>>>>>>>>>>>>>>//       FOCUS_MAIN_INDEX    (Integer)  What's the main index (if any)
51197>>>>>>>>>>>>>>>//       FOCUS_DD            (Integer)  Who's the server
51197>>>>>>>>>>>>>>>//       FOCUS_INDIRECT_DD   (Integer)  Which DDO is taking care of
51197>>>>>>>>>>>>>>>//                                      FOCUS_ITEM_FILE
51197>>>>>>>>>>>>>>>//       FOCUS_DEO_MODAL     (Bool)     Is that panel modal?
51197>>>>>>>>>>>>>>>//       FOCUS_CLIENT_ID     (Integer)  What (if any) is the ID
51197>>>>>>>>>>>>>>>//                                      of the client area?
51197>>>>>>>>>>>>>>>//       FOCUS_DEO_ITEM      (Integer)  What's current item in
51197>>>>>>>>>>>>>>>//                                      that objects
51197>>>>>>>>>>>>>>>//       FOCUS_SCOPED_PARENT (Integer)  Object ID of scoped parent
51197>>>>>>>>>>>>>>>//       FOCUS_ITEM_VALUE    (String)   Value of current item
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>// To retrieve all this wonderful information send message Focus_Analyse_Focus.
51197>>>>>>>>>>>>>>>// After that you must use the Focus_Info function to actually get hold of if:
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>//   procedure OnlyIfCustomer
51197>>>>>>>>>>>>>>>//     integer iFile
51197>>>>>>>>>>>>>>>//     send Focus_Analyse_Focus
51197>>>>>>>>>>>>>>>//     get Focus_Info FOCUS_ITEM_FILE to iFile
51197>>>>>>>>>>>>>>>//     if iFile eq Customer.File_Number begin
51197>>>>>>>>>>>>>>>//       // Something fantastic
51197>>>>>>>>>>>>>>>//     end
51197>>>>>>>>>>>>>>>//     else send stop_box "Only do this from a Customer field!"
51197>>>>>>>>>>>>>>>//   end_procedure
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>// Public interface:
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>// * function Focus_Find_Scoped_Parent global integer iObj returns integer
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>//     This function returns the innermost scoped parent (Scope_State = True)
51197>>>>>>>>>>>>>>>//     of the object passed in parameter iObj. If no such object is found
51197>>>>>>>>>>>>>>>//     DESKTOP is returned. If 0 is passed as iObj, 0 will be returned.
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>// * procedure Focus_Analyze_DEO global integer iDEO integer iItem
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>//     Analyse object passed in the iDEO. The iItem parameter should indicate
51197>>>>>>>>>>>>>>>//     which item in iDeo should be used for retrieving item based info.
51197>>>>>>>>>>>>>>>//     Subsequently use the Focus_Info function to retrieve the information.
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>// * procedure Focus_Analyze_Focus global
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>//     Analyse object that currently holds the focus. Subsequently use the
51197>>>>>>>>>>>>>>>//     Focus_Info function to retrieve the information.
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>// * function Focus_Info global integer iItem returns string
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>//     Use this function to get hold of information previously recorded
51197>>>>>>>>>>>>>>>//     by the Focus_Analyze_Focus (or Focus_Analyze_DEO) function.
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>//     Parameter iItem may be any of the following values:
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>//                FOCUS_OK            (Boolean)
51197>>>>>>>>>>>>>>>//                FOCUS_DEO_ID        (Integer)
51197>>>>>>>>>>>>>>>//                FOCUS_ITEM_FILE     (Integer)
51197>>>>>>>>>>>>>>>//                FOCUS_ITEM_FIELD    (Integer)
51197>>>>>>>>>>>>>>>//                FOCUS_MAIN_INDEX    (Integer)
51197>>>>>>>>>>>>>>>//                FOCUS_DD            (Integer)
51197>>>>>>>>>>>>>>>//                FOCUS_INDIRECT_DD   (Integer)
51197>>>>>>>>>>>>>>>//                FOCUS_DEO_MODAL     (Boolean)
51197>>>>>>>>>>>>>>>//                FOCUS_CLIENT_ID     (Integer)
51197>>>>>>>>>>>>>>>//                FOCUS_DEO_ITEM      (Integer)
51197>>>>>>>>>>>>>>>//                FOCUS_SCOPED_PARENT (Integer)
51197>>>>>>>>>>>>>>>//                FOCUS_ITEM_VALUE    (String)
51197>>>>>>>>>>>>>>>//
51197>>>>>>>>>>>>>>>//     The return type of this function is String but the return value
51197>>>>>>>>>>>>>>>//     may be converted to the type indicated in parenthesis.
51197>>>>>>>>>>>>>>>
51197>>>>>>>>>>>>>>>
51197>>>>>>>>>>>>>>>use ui
51197>>>>>>>>>>>>>>>
51197>>>>>>>>>>>>>>>enumeration_list
51197>>>>>>>>>>>>>>>  define FOCUS_OK            // Bool     Did this work at all?
51197>>>>>>>>>>>>>>>  define FOCUS_DEO_ID        // Integer  Who did we ask?
51197>>>>>>>>>>>>>>>  define FOCUS_DEO_ITEM      // Integer  What's current item in that objects
51197>>>>>>>>>>>>>>>  define FOCUS_ITEM_FILE     // Integer  What's the data file
51197>>>>>>>>>>>>>>>  define FOCUS_ITEM_FIELD    // Integer  What's the data field
51197>>>>>>>>>>>>>>>  define FOCUS_MAIN_INDEX    // Integer  What's the main index (if any)
51197>>>>>>>>>>>>>>>  define FOCUS_DD            // Integer  Who's the server
51197>>>>>>>>>>>>>>>  define FOCUS_INDIRECT_DD   // Integer  Who's taking care of FOCUS_ITEM_FILE
51197>>>>>>>>>>>>>>>  define FOCUS_DEO_MODAL     // Bool     Is that panel modal?
51197>>>>>>>>>>>>>>>  define FOCUS_CLIENT_ID     // Integer  What (if any) is the ID of the client area?
51197>>>>>>>>>>>>>>>  define FOCUS_SCOPED_PARENT // Integer  Object ID of scoped parent
51197>>>>>>>>>>>>>>>  define FOCUS_ITEM_VALUE    // The current value of the focused field
51197>>>>>>>>>>>>>>>end_enumeration_list
51197>>>>>>>>>>>>>>>
51197>>>>>>>>>>>>>>>integer FocusInf_Array#
51197>>>>>>>>>>>>>>>object FocusInf_Array is an array
51199>>>>>>>>>>>>>>>  move self to FocusInf_Array#
51200>>>>>>>>>>>>>>>end_object
51201>>>>>>>>>>>>>>>
51201>>>>>>>>>>>>>>>function Focus_Find_Scoped_Parent global integer obj# returns integer
51203>>>>>>>>>>>>>>>  integer st#
51203>>>>>>>>>>>>>>>  repeat
51203>>>>>>>>>>>>>>>>
51203>>>>>>>>>>>>>>>    get scope_state of obj# to st#
51204>>>>>>>>>>>>>>>    ifnot st# get parent of obj# to obj#
51207>>>>>>>>>>>>>>>  until (st# or obj#=desktop)
51209>>>>>>>>>>>>>>>  function_return obj#
51210>>>>>>>>>>>>>>>end_function
51211>>>>>>>>>>>>>>>
51211>>>>>>>>>>>>>>>procedure Focus_Analyze_DEO global integer deo# integer itm#
51213>>>>>>>>>>>>>>>  integer st# file# fld# dd# tmp# scoped_parent#
51213>>>>>>>>>>>>>>>  send delete_data to FocusInf_Array#
51214>>>>>>>>>>>>>>>  if deo# gt desktop begin
51216>>>>>>>>>>>>>>>    set value of FocusInf_Array# item FOCUS_OK to dfTrue
51217>>>>>>>>>>>>>>>    set value of FocusInf_Array# item FOCUS_DEO_ID to deo#
51218>>>>>>>>>>>>>>>    move (Focus_Find_Scoped_Parent(deo#)) to scoped_parent#
51219>>>>>>>>>>>>>>>    set value of FocusInf_Array# item FOCUS_SCOPED_PARENT to scoped_parent#
51220>>>>>>>>>>>>>>>    if scoped_parent# begin
51222>>>>>>>>>>>>>>>      set value of FocusInf_Array# item FOCUS_DEO_MODAL to (modal_state(scoped_parent#))
51223>>>>>>>>>>>>>>>    end
51223>>>>>>>>>>>>>>>>
51223>>>>>>>>>>>>>>>    else set value of FocusInf_Array# item FOCUS_DEO_MODAL to dfFalse
51225>>>>>>>>>>>>>>>    get delegation_mode of deo# to st#
51226>>>>>>>>>>>>>>>    set delegation_mode of deo# to NO_DELEGATE_OR_ERROR
51227>>>>>>>>>>>>>>>    get server of deo# to dd#
51228>>>>>>>>>>>>>>>    get data_file  of deo# item itm# to file#
51229>>>>>>>>>>>>>>>    get data_field of deo# item itm# to fld#
51230>>>>>>>>>>>>>>>    if (file# and fld#) begin
51232>>>>>>>>>>>>>>>      get_attribute DF_FIELD_INDEX of file# fld# to tmp#
51235>>>>>>>>>>>>>>>      set value of FocusInf_Array# item FOCUS_MAIN_INDEX to tmp#
51236>>>>>>>>>>>>>>>    end
51236>>>>>>>>>>>>>>>>
51236>>>>>>>>>>>>>>>
51236>>>>>>>>>>>>>>>    set delegation_mode of deo# to st#
51237>>>>>>>>>>>>>>>    set value of FocusInf_Array# item FOCUS_DEO_ITEM to itm#
51238>>>>>>>>>>>>>>>    set value of FocusInf_Array# item FOCUS_ITEM_FILE to file#
51239>>>>>>>>>>>>>>>    set value of FocusInf_Array# item FOCUS_ITEM_FIELD to fld#
51240>>>>>>>>>>>>>>>    set value of FocusInf_Array# item FOCUS_ITEM_VALUE to (value(deo#,itm#))
51241>>>>>>>>>>>>>>>    if dd# begin
51243>>>>>>>>>>>>>>>      set value of FocusInf_Array# item FOCUS_DD to dd#
51244>>>>>>>>>>>>>>>      get which_data_set of dd# file# to dd#
51245>>>>>>>>>>>>>>>      set value of FocusInf_Array# item FOCUS_INDIRECT_DD to dd#
51246>>>>>>>>>>>>>>>    end
51246>>>>>>>>>>>>>>>>
51246>>>>>>>>>>>>>>>  end
51246>>>>>>>>>>>>>>>>
51246>>>>>>>>>>>>>>>end_procedure
51247>>>>>>>>>>>>>>>
51247>>>>>>>>>>>>>>>procedure Focus_Analyze_Focus global
51249>>>>>>>>>>>>>>>  integer focus# itm# st#
51249>>>>>>>>>>>>>>>  get focus of desktop to focus#
51250>>>>>>>>>>>>>>>  if focus# gt desktop begin
51252>>>>>>>>>>>>>>>    get delegation_mode of focus# to st#
51253>>>>>>>>>>>>>>>    set delegation_mode of focus# to NO_DELEGATE_OR_ERROR
51254>>>>>>>>>>>>>>>    get current_item of focus# to itm#
51255>>>>>>>>>>>>>>>    set delegation_mode of focus# to st#
51256>>>>>>>>>>>>>>>  end
51256>>>>>>>>>>>>>>>>
51256>>>>>>>>>>>>>>>  else move -1 to itm#
51258>>>>>>>>>>>>>>>  send Focus_Analyze_DEO focus# itm#
51259>>>>>>>>>>>>>>>end_procedure
51260>>>>>>>>>>>>>>>
51260>>>>>>>>>>>>>>>function Focus_Info global integer itm# returns string
51262>>>>>>>>>>>>>>>  function_return (value(FocusInf_Array#,itm#))
51263>>>>>>>>>>>>>>>end_function
51264>>>>>>>>>>>>>Use Structur.utl // Object for restructuring table definitions
Including file: structur.utl    (C:\projects\BRS\VDFQuery\AppSrc\structur.utl)
51264>>>>>>>>>>>>>>>//**********************************************************************
51264>>>>>>>>>>>>>>>// Use Structur.utl // Object for restructuring table definitions
51264>>>>>>>>>>>>>>>//
51264>>>>>>>>>>>>>>>// By Sture Andersen
51264>>>>>>>>>>>>>>>//
51264>>>>>>>>>>>>>>>// Create: Sun  24-10-1999
51264>>>>>>>>>>>>>>>// Update: Tue  25-01-2000 - Windows interface added to the waiter...
51264>>>>>>>>>>>>>>>//         Fri  03-03-2000 - RS_RestructureGroup class added
51264>>>>>>>>>>>>>>>//         Sat  22-04-2000 - RS_TableOpenName function added
51264>>>>>>>>>>>>>>>//**********************************************************************
51264>>>>>>>>>>>>>>>//
51264>>>>>>>>>>>>>>>// This package defines a global object for restructuring tables. This global
51264>>>>>>>>>>>>>>>// object is manipulated via a bunch of global messages all prefixed with
51264>>>>>>>>>>>>>>>// the letters "RS_".
51264>>>>>>>>>>>>>>>//
51264>>>>>>>>>>>>>>>// The advantage of using this object instead of using the SET_ATTRIBUTE and
51264>>>>>>>>>>>>>>>// GET_ATTRIBUTE commands directly is that the global object makes up for a
51264>>>>>>>>>>>>>>>// few shortcomings that these commands exhibits.
51264>>>>>>>>>>>>>>>//
51264>>>>>>>>>>>>>>>
51264>>>>>>>>>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
51264>>>>>>>>>>>>>>>Use Structur.nui
Including file: structur.nui    (C:\projects\BRS\VDFQuery\AppSrc\structur.nui)
51264>>>>>>>>>>>>>>>>>Use DBMS.nui     // Basic DBMS functions (No User Interface)
51264>>>>>>>>>>>>>>>>>Use Files.nui    // Utilities for handling file related stuff (No User Interface)
51264>>>>>>>>>>>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
51264>>>>>>>>>>>>>>>>>Use Strings.nui  // String manipulation for VDF (No User Interface)
51264>>>>>>>>>>>>>>>>>Use API_Attr.nui // Functions for querying API attributes (No User Interface)
51264>>>>>>>>>>>>>>>>>Use OpenStat.nui // cTablesOpenStatus class (formely cFileAllFiles) (No User Interface)
51264>>>>>>>>>>>>>>>>>
51264>>>>>>>>>>>>>>>>> define t.STRUCT.Restart for "The program will now attempt to re-start"
51264>>>>>>>>>>>>>>>>>
51264>>>>>>>>>>>>>>>>> string Struc$ErrDescr
51264>>>>>>>>>>>>>>>>>
51264>>>>>>>>>>>>>>>>>integer cRestructurer#
51264>>>>>>>>>>>>>>>>>if dfFalse begin
51266>>>>>>>>>>>>>>>>>  cRestructurer_Error:
51266>>>>>>>>>>>>>>>>>    send structure_error to cRestructurer#
51267>>>>>>>>>>>>>>>>>  return
51268>>>>>>>>>>>>>>>>>end
51268>>>>>>>>>>>>>>>>>>
51268>>>>>>>>>>>>>>>>>
51268>>>>>>>>>>>>>>>>>enumeration_list
51268>>>>>>>>>>>>>>>>>  define RSOP_BEGIN
51268>>>>>>>>>>>>>>>>>  define RSOP_CREATEFIELD
51268>>>>>>>>>>>>>>>>>  define RSOP_DELETEFIELD
51268>>>>>>>>>>>>>>>>>  define RSOP_DELETEINDEX
51268>>>>>>>>>>>>>>>>>  define RSOP_SETFILEATTR
51268>>>>>>>>>>>>>>>>>  define RSOP_SETFIELDATTR
51268>>>>>>>>>>>>>>>>>  define RSOP_SETINDEXATTR
51268>>>>>>>>>>>>>>>>>  define RSOP_SETINDEXSEGATTR
51268>>>>>>>>>>>>>>>>>  define RSOP_TRUNCATED
51268>>>>>>>>>>>>>>>>>  define RSOP_ERROR_OCCURRED
51268>>>>>>>>>>>>>>>>>  define RSOP_END
51268>>>>>>>>>>>>>>>>>end_enumeration_list
51268>>>>>>>>>>>>>>>>>
51268>>>>>>>>>>>>>>>>>enumeration_list
51268>>>>>>>>>>>>>>>>>  define ERRORTRAP_ATTRCHANGE
51268>>>>>>>>>>>>>>>>>  define ERRORTRAP_FIELDCREATE
51268>>>>>>>>>>>>>>>>>  define ERRORTRAP_FIELDDELETE
51268>>>>>>>>>>>>>>>>>  define ERRORTRAP_INDEXCREATE
51268>>>>>>>>>>>>>>>>>  define ERRORTRAP_INDEXDELETE
51268>>>>>>>>>>>>>>>>>end_enumeration_list
51268>>>>>>>>>>>>>>>>>
51268>>>>>>>>>>>>>>>>>object oStructureErrorInfo is a cArray no_image
51270>>>>>>>>>>>>>>>>>  property string psLine1 public ""
51272>>>>>>>>>>>>>>>>>  property string psLine2 public ""
51274>>>>>>>>>>>>>>>>>  procedure DoPrepare
51277>>>>>>>>>>>>>>>>>    integer attr# attr_type# field# index# segment# ErrTrapType#
51277>>>>>>>>>>>>>>>>>    string line1# line2# value#
51277>>>>>>>>>>>>>>>>>    get value item 0 to ErrTrapType#
51278>>>>>>>>>>>>>>>>>    move "" to line1#
51279>>>>>>>>>>>>>>>>>    move "" to line2#
51280>>>>>>>>>>>>>>>>>    if ErrTrapType# eq ERRORTRAP_ATTRCHANGE  begin
51282>>>>>>>>>>>>>>>>>      get value item 1 to attr#
51283>>>>>>>>>>>>>>>>>      get API_AttrType attr# to attr_type#
51284>>>>>>>>>>>>>>>>>      if attr_type# eq ATTRTYPE_FILELIST begin
51286>>>>>>>>>>>>>>>>>        get value item 3 to value#
51287>>>>>>>>>>>>>>>>>        move "Set_Attribute # to #" to line1#
51288>>>>>>>>>>>>>>>>>        replace "#" in line1# with (API_Attr_Name(attr#))
51290>>>>>>>>>>>>>>>>>        replace "#" in line1# with (API_Attr_ValueName(attr#,value#))
51292>>>>>>>>>>>>>>>>>      end
51292>>>>>>>>>>>>>>>>>>
51292>>>>>>>>>>>>>>>>>      if attr_type# eq ATTRTYPE_FILE begin
51294>>>>>>>>>>>>>>>>>        get value item 3 to value#
51295>>>>>>>>>>>>>>>>>        move "Set_Attribute # to #" to line1#
51296>>>>>>>>>>>>>>>>>        replace "#" in line1# with (API_Attr_Name(attr#))
51298>>>>>>>>>>>>>>>>>        replace "#" in line1# with (API_Attr_ValueName(attr#,value#))
51300>>>>>>>>>>>>>>>>>      end
51300>>>>>>>>>>>>>>>>>>
51300>>>>>>>>>>>>>>>>>      if attr_type# eq ATTRTYPE_FIELD begin
51302>>>>>>>>>>>>>>>>>        get value item 3 to field#
51303>>>>>>>>>>>>>>>>>        get value item 4 to value#
51304>>>>>>>>>>>>>>>>>        move "Set_Attribute # field #" to line1#
51305>>>>>>>>>>>>>>>>>        move "to #" to line2#
51306>>>>>>>>>>>>>>>>>        replace "#" in line1# with (API_Attr_Name(attr#))
51308>>>>>>>>>>>>>>>>>        replace "#" in line1# with (string(field#))
51310>>>>>>>>>>>>>>>>>        replace "#" in line2# with (API_Attr_ValueName(attr#,value#))
51312>>>>>>>>>>>>>>>>>      end
51312>>>>>>>>>>>>>>>>>>
51312>>>>>>>>>>>>>>>>>      if attr_type# eq ATTRTYPE_INDEX begin
51314>>>>>>>>>>>>>>>>>        get value item 3 to index#
51315>>>>>>>>>>>>>>>>>        get value item 4 to value#
51316>>>>>>>>>>>>>>>>>        move "Set_Attribute # index #" to line1#
51317>>>>>>>>>>>>>>>>>        move "to #" to line2#
51318>>>>>>>>>>>>>>>>>        replace "#" in line1# with (API_Attr_Name(attr#))
51320>>>>>>>>>>>>>>>>>        replace "#" in line1# with (string(index#))
51322>>>>>>>>>>>>>>>>>        replace "#" in line2# with (API_Attr_ValueName(attr#,value#))
51324>>>>>>>>>>>>>>>>>      end
51324>>>>>>>>>>>>>>>>>>
51324>>>>>>>>>>>>>>>>>      if attr_type# eq ATTRTYPE_IDXSEG begin
51326>>>>>>>>>>>>>>>>>        get value item 3 to index#
51327>>>>>>>>>>>>>>>>>        get value item 4 to segment#
51328>>>>>>>>>>>>>>>>>        get value item 5 to value#
51329>>>>>>>>>>>>>>>>>        move "Set_Attribute # index # segment #" to line1#
51330>>>>>>>>>>>>>>>>>        move "to #" to line2#
51331>>>>>>>>>>>>>>>>>        replace "#" in line1# with (API_Attr_Name(attr#))
51333>>>>>>>>>>>>>>>>>        replace "#" in line1# with (string(index#))
51335>>>>>>>>>>>>>>>>>        replace "#" in line1# with (string(segment#))
51337>>>>>>>>>>>>>>>>>        replace "#" in line2# with (API_Attr_ValueName(attr#,value#))
51339>>>>>>>>>>>>>>>>>      end
51339>>>>>>>>>>>>>>>>>>
51339>>>>>>>>>>>>>>>>>    end
51339>>>>>>>>>>>>>>>>>>
51339>>>>>>>>>>>>>>>>>    if ErrTrapType# eq ERRORTRAP_FIELDCREATE begin
51341>>>>>>>>>>>>>>>>>      move "Create_Field # at #" to line1#
51342>>>>>>>>>>>>>>>>>      move (replace("#",line1#,string(value(self,1)))) to line1#
51343>>>>>>>>>>>>>>>>>      move (replace("#",line1#,string(value(self,2)))) to line1#
51344>>>>>>>>>>>>>>>>>    end
51344>>>>>>>>>>>>>>>>>>
51344>>>>>>>>>>>>>>>>>    if ErrTrapType# eq ERRORTRAP_FIELDDELETE begin
51346>>>>>>>>>>>>>>>>>      move "Delete_Field #" to line1#
51347>>>>>>>>>>>>>>>>>      move (replace("#",line1#,string(value(self,1)))) to line1#
51348>>>>>>>>>>>>>>>>>    end
51348>>>>>>>>>>>>>>>>>>
51348>>>>>>>>>>>>>>>>>    if ErrTrapType# eq ERRORTRAP_INDEXCREATE begin
51350>>>>>>>>>>>>>>>>>      move "Create_Index # at #" to line1#
51351>>>>>>>>>>>>>>>>>      move (replace("#",line1#,string(value(self,1)))) to line1#
51352>>>>>>>>>>>>>>>>>      move (replace("#",line1#,string(value(self,2)))) to line1#
51353>>>>>>>>>>>>>>>>>    end
51353>>>>>>>>>>>>>>>>>>
51353>>>>>>>>>>>>>>>>>    if ErrTrapType# eq ERRORTRAP_INDEXDELETE begin
51355>>>>>>>>>>>>>>>>>      move "Delete_Index #" to line1#
51356>>>>>>>>>>>>>>>>>      move (replace("#",line1#,string(value(self,1)))) to line1#
51357>>>>>>>>>>>>>>>>>    end
51357>>>>>>>>>>>>>>>>>>
51357>>>>>>>>>>>>>>>>>    set psLine1 to line1#
51358>>>>>>>>>>>>>>>>>    set psLine2 to line2#
51359>>>>>>>>>>>>>>>>>    send NotifyTracer to cRestructurer# RSOP_ERROR_OCCURRED 0 0 0 0 (line1#*line2#)
51360>>>>>>>>>>>>>>>>>  end_procedure
51361>>>>>>>>>>>>>>>>>end_object // oStructureErrorInfo
51362>>>>>>>>>>>>>>>>>
51362>>>>>>>>>>>>>>>>>procedure set StructureErrorInfo global integer type# string value#
51364>>>>>>>>>>>>>>>>>  set value of (oStructureErrorInfo(self)) item type# to value#
51365>>>>>>>>>>>>>>>>>end_procedure
51366>>>>>>>>>>>>>>>>>function StructureErrorInfo global integer type# returns string
51368>>>>>>>>>>>>>>>>>  function_return (value(oStructureErrorInfo(self),type#))
51369>>>>>>>>>>>>>>>>>end_function
51370>>>>>>>>>>>>>>>>>procedure DoClearStructureErrorInfo global
51372>>>>>>>>>>>>>>>>>  send delete_data to (oStructureErrorInfo(self))
51373>>>>>>>>>>>>>>>>>end_procedure
51374>>>>>>>>>>>>>>>>>
51374>>>>>>>>>>>>>>>>>//#IFDEF Is$WebApp
51374>>>>>>>>>>>>>>>>>// define Structur$ErrorTrapping for 0
51374>>>>>>>>>>>>>>>>>//#ELSE
51374>>>>>>>>>>>>>>>>> define Structur$ErrorTrapping for 1
51374>>>>>>>>>>>>>>>>>//#ENDIF
51374>>>>>>>>>>>>>>>>>
51374>>>>>>>>>>>>>>>>>
51374>>>>>>>>>>>>>>>>>
51374>>>>>>>>>>>>>>>>>
51374>>>>>>>>>>>>>>>
51374>>>>>>>>>>>>>>>Use LogFile.nui  // Class for handling a log file (No User Interface)
Including file: logfile.nui    (C:\projects\BRS\VDFQuery\AppSrc\logfile.nui)
51374>>>>>>>>>>>>>>>>>// Use LogFile.nui  // Class for handling a log file (No User Interface)
51374>>>>>>>>>>>>>>>>>//
51374>>>>>>>>>>>>>>>>>// by Sture ApS
51374>>>>>>>>>>>>>>>>>//
51374>>>>>>>>>>>>>>>>>//
51374>>>>>>>>>>>>>>>>>// This package implements the cLogFile class. An object of this class may
51374>>>>>>>>>>>>>>>>>// be used to generate output to a logfile.
51374>>>>>>>>>>>>>>>>>//
51374>>>>>>>>>>>>>>>>>// Typical application:
51374>>>>>>>>>>>>>>>>>//
51374>>>>>>>>>>>>>>>>>//   Writing detailed information to a file as a batch process progresses.
51374>>>>>>>>>>>>>>>>>//   Could also be used to log information every time the application performs
51374>>>>>>>>>>>>>>>>>//   a specific action.
51374>>>>>>>>>>>>>>>>>//
51374>>>>>>>>>>>>>>>>>// Code sample:
51374>>>>>>>>>>>>>>>>>//
51374>>>>>>>>>>>>>>>>>//   object oStructure_LogFile is a cLogFile
51374>>>>>>>>>>>>>>>>>//     set psFileName to "dfmatrix.log" // Write to this file
51374>>>>>>>>>>>>>>>>>//     set piCloseOnWrite to DFTRUE     // Close the log file on each write
51374>>>>>>>>>>>>>>>>>//     set psPurpose to "Events during table restructuring" // A little friendliness won't hurt
51374>>>>>>>>>>>>>>>>>//   end_object // oStructure_LogFile
51374>>>>>>>>>>>>>>>>>//
51374>>>>>>>>>>>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
51374>>>>>>>>>>>>>>>>>Use Files.nui    // Utilities for handling file related stuff
51374>>>>>>>>>>>>>>>>>Use Dates.nui    // Date manipulation for VDF
51374>>>>>>>>>>>>>>>>>Use Strings.nui  // String manipulation for VDF (No User Interface)
51374>>>>>>>>>>>>>>>>>
51374>>>>>>>>>>>>>>>>>class cLogFile is a cArray
51375>>>>>>>>>>>>>>>>>  procedure construct_object integer liImg
51377>>>>>>>>>>>>>>>>>    forward send construct_object liImg
51379>>>>>>>>>>>>>>>>>    // Public
51379>>>>>>>>>>>>>>>>>    property integer piCloseOnWrite  public DFFALSE
51380>>>>>>>>>>>>>>>>>    property string  psPurpose       public ""
51381>>>>>>>>>>>>>>>>>    property integer pbANSI_State    public 1
51382>>>>>>>>>>>>>>>>>    // Private
51382>>>>>>>>>>>>>>>>>    property string  prv.psFileName  public ""
51383>>>>>>>>>>>>>>>>>    property integer prv.piChannel   public -1
51384>>>>>>>>>>>>>>>>>  end_procedure
51385>>>>>>>>>>>>>>>>>
51385>>>>>>>>>>>>>>>>>  function psFileName returns string
51387>>>>>>>>>>>>>>>>>    function_return (prv.psFileName(self))
51388>>>>>>>>>>>>>>>>>  end_function
51389>>>>>>>>>>>>>>>>>
51389>>>>>>>>>>>>>>>>>  procedure set psFileName string lsFileName
51391>>>>>>>>>>>>>>>>>    integer liExists
51391>>>>>>>>>>>>>>>>>    if (SEQ_ExtractPathFromFileName(lsFileName)="") begin
51393>>>>>>>>>>>>>>>>>      get SEQ_FileExists lsFileName to liExists
51394>>>>>>>>>>>>>>>>>      if liExists eq SEQIT_DIRECTORY error 123 "Illegal file name in cLogFile object"
51397>>>>>>>>>>>>>>>>>      else begin
51398>>>>>>>>>>>>>>>>>        if liExists eq SEQIT_NONE get SEQ_TranslatePathToAbsolute lsFileName to lsFileName
51401>>>>>>>>>>>>>>>>>        else get SEQ_ConvertToAbsoluteFileName lsFileName to lsFileName
51403>>>>>>>>>>>>>>>>>      end
51403>>>>>>>>>>>>>>>>>>
51403>>>>>>>>>>>>>>>>>    end
51403>>>>>>>>>>>>>>>>>>
51403>>>>>>>>>>>>>>>>>    set prv.psFileName to lsFileName
51404>>>>>>>>>>>>>>>>>  end_procedure
51405>>>>>>>>>>>>>>>>>
51405>>>>>>>>>>>>>>>>>            procedure DirectOutputHelp integer liAppend string lsFileName
51407>>>>>>>>>>>>>>>>>              integer liChannel liWasCreated
51407>>>>>>>>>>>>>>>>>              string lsFile
51407>>>>>>>>>>>>>>>>>              if NUM_ARGUMENTS eq 2 begin
51409>>>>>>>>>>>>>>>>>                move lsFileName to lsFile
51410>>>>>>>>>>>>>>>>>                set psFileName to lsFile
51411>>>>>>>>>>>>>>>>>              end
51411>>>>>>>>>>>>>>>>>>
51411>>>>>>>>>>>>>>>>>              else get psFileName to lsFile
51413>>>>>>>>>>>>>>>>>              if liAppend begin
51415>>>>>>>>>>>>>>>>>                move (not(SEQ_FileExists(lsFile))) to liWasCreated
51416>>>>>>>>>>>>>>>>>                get SEQ_AppendOutput lsFile to liChannel
51417>>>>>>>>>>>>>>>>>              end
51417>>>>>>>>>>>>>>>>>>
51417>>>>>>>>>>>>>>>>>              else begin
51418>>>>>>>>>>>>>>>>>                get SEQ_DirectOutput lsFile to liChannel
51419>>>>>>>>>>>>>>>>>                move 1 to liWasCreated
51420>>>>>>>>>>>>>>>>>              end
51420>>>>>>>>>>>>>>>>>>
51420>>>>>>>>>>>>>>>>>              set prv.piChannel to liChannel
51421>>>>>>>>>>>>>>>>>              if (piCloseOnWrite(self)) Close_Output channel liChannel
51425>>>>>>>>>>>>>>>>>              if liWasCreated send OnLogFileCreated
51428>>>>>>>>>>>>>>>>>              send OnLogFileOpen
51429>>>>>>>>>>>>>>>>>            end_procedure
51430>>>>>>>>>>>>>>>>>
51430>>>>>>>>>>>>>>>>>  procedure OnLogFileOpen
51432>>>>>>>>>>>>>>>>>  end_procedure
51433>>>>>>>>>>>>>>>>>  procedure OnLogFileClose
51435>>>>>>>>>>>>>>>>>  end_procedure
51436>>>>>>>>>>>>>>>>>  procedure OnLogFileCreated
51438>>>>>>>>>>>>>>>>>    string lsPurpose
51438>>>>>>>>>>>>>>>>>    get psPurpose to lsPurpose
51439>>>>>>>>>>>>>>>>>    if (lsPurpose<>"") begin
51441>>>>>>>>>>>>>>>>>      send WriteLn lsPurpose
51442>>>>>>>>>>>>>>>>>      send WriteLn (repeat("-",length(lsPurpose)))
51443>>>>>>>>>>>>>>>>>      send DoWriteTimeEntry "File created"
51444>>>>>>>>>>>>>>>>>    end
51444>>>>>>>>>>>>>>>>>>
51444>>>>>>>>>>>>>>>>>  end_procedure
51445>>>>>>>>>>>>>>>>>
51445>>>>>>>>>>>>>>>>>  procedure DeleteFile string lsFileName
51447>>>>>>>>>>>>>>>>>    string lsFile
51447>>>>>>>>>>>>>>>>>    if NUM_ARGUMENTS eq 1 move lsFileName to lsFile
51450>>>>>>>>>>>>>>>>>    else get psFileName to lsFile
51452>>>>>>>>>>>>>>>>>    get SEQ_TranslatePathToAbsolute lsFile to lsFile
51453>>>>>>>>>>>>>>>>>    erasefile lsFile
51454>>>>>>>>>>>>>>>>>>
51454>>>>>>>>>>>>>>>>>  end_procedure
51455>>>>>>>>>>>>>>>>>
51455>>>>>>>>>>>>>>>>>  procedure DirectOutput string lsFileName
51457>>>>>>>>>>>>>>>>>    if NUM_ARGUMENTS send DirectOutputHelp DFFALSE lsFileName
51460>>>>>>>>>>>>>>>>>    else send DirectOutputHelp DFFALSE (psFileName(self))
51462>>>>>>>>>>>>>>>>>  end_procedure
51463>>>>>>>>>>>>>>>>>
51463>>>>>>>>>>>>>>>>>  procedure AppendOutput string lsFileName
51465>>>>>>>>>>>>>>>>>    if NUM_ARGUMENTS send DirectOutputHelp DFTRUE lsFileName
51468>>>>>>>>>>>>>>>>>    else send DirectOutputHelp DFTRUE (psFileName(self))
51470>>>>>>>>>>>>>>>>>  end_procedure
51471>>>>>>>>>>>>>>>>>
51471>>>>>>>>>>>>>>>>>  procedure CloseOutput
51473>>>>>>>>>>>>>>>>>    send OnLogFileClose
51474>>>>>>>>>>>>>>>>>    ifnot (piCloseOnWrite(self)) send SEQ_CloseOutput (prv.piChannel(self))
51477>>>>>>>>>>>>>>>>>    else send Seq_Release_Channel (prv.piChannel(self))
51479>>>>>>>>>>>>>>>>>    set prv.piChannel to -1
51480>>>>>>>>>>>>>>>>>  end_procedure
51481>>>>>>>>>>>>>>>>>
51481>>>>>>>>>>>>>>>>>  procedure WriteLn string lsLine
51483>>>>>>>>>>>>>>>>>    integer liCloseOnWrite liChannel lbRelease liPos liOriginalCloseOnWrite
51483>>>>>>>>>>>>>>>>>    if (pbANSI_State(self)) move (StringOemToAnsi(lsLine)) to lsLine
51486>>>>>>>>>>>>>>>>>    get piCloseOnWrite to liCloseOnWrite
51487>>>>>>>>>>>>>>>>>    get prv.piChannel to liChannel
51488>>>>>>>>>>>>>>>>>
51488>>>>>>>>>>>>>>>>>    if (liChannel=-1) begin
51490>>>>>>>>>>>>>>>>>      get Seq_New_Channel to liChannel
51491>>>>>>>>>>>>>>>>>      move (TRUE) to lbRelease
51492>>>>>>>>>>>>>>>>>      move liCloseOnWrite to liOriginalCloseOnWrite
51493>>>>>>>>>>>>>>>>>      move 1 to liCloseOnWrite
51494>>>>>>>>>>>>>>>>>    end
51494>>>>>>>>>>>>>>>>>>
51494>>>>>>>>>>>>>>>>>
51494>>>>>>>>>>>>>>>>>    if liCloseOnWrite Append_Output channel liChannel (psFileName(self))
51498>>>>>>>>>>>>>>>>>    if lbRelease begin
51500>>>>>>>>>>>>>>>>>      get_channel_position liChannel to liPos
51501>>>>>>>>>>>>>>>>>>
51501>>>>>>>>>>>>>>>>>      if (liPos<=0) begin
51503>>>>>>>>>>>>>>>>>        set piCloseOnWrite to 0
51504>>>>>>>>>>>>>>>>>        set prv.piChannel to liChannel
51505>>>>>>>>>>>>>>>>>        send OnLogFileCreated
51506>>>>>>>>>>>>>>>>>        set prv.piChannel to -1
51507>>>>>>>>>>>>>>>>>        set piCloseOnWrite to liOriginalCloseOnWrite
51508>>>>>>>>>>>>>>>>>      end
51508>>>>>>>>>>>>>>>>>>
51508>>>>>>>>>>>>>>>>>    end
51508>>>>>>>>>>>>>>>>>>
51508>>>>>>>>>>>>>>>>>    writeln channel liChannel lsLine
51511>>>>>>>>>>>>>>>>>    if liCloseOnWrite Close_Output channel liChannel
51515>>>>>>>>>>>>>>>>>
51515>>>>>>>>>>>>>>>>>    if lbRelease send Seq_Release_Channel liChannel
51518>>>>>>>>>>>>>>>>>  end_procedure
51519>>>>>>>>>>>>>>>>>
51519>>>>>>>>>>>>>>>>>  procedure DoWriteTimeEntry string lsValue
51521>>>>>>>>>>>>>>>>>    if NUM_ARGUMENTS send WriteLn (TS_ConvertToString(TS_SysTime())+": "+lsValue)
51524>>>>>>>>>>>>>>>>>    else send WriteLn (TS_ConvertToString(TS_SysTime()))
51526>>>>>>>>>>>>>>>>>  end_procedure
51527>>>>>>>>>>>>>>>>>
51527>>>>>>>>>>>>>>>>>  procedure Output_Image integer liImg
51529>>>>>>>>>>>>>>>>>    integer liAuxChannel liChannel liCloseOnWrite liSeqEof lbRelease
51529>>>>>>>>>>>>>>>>>    string lsLine
51529>>>>>>>>>>>>>>>>>
51529>>>>>>>>>>>>>>>>>    get Seq_New_Channel to liAuxChannel
51530>>>>>>>>>>>>>>>>>    get piCloseOnWrite to liCloseOnWrite
51531>>>>>>>>>>>>>>>>>    get prv.piChannel to liChannel
51532>>>>>>>>>>>>>>>>>
51532>>>>>>>>>>>>>>>>>    if (liChannel=-1) begin
51534>>>>>>>>>>>>>>>>>      get Seq_New_Channel to liChannel
51535>>>>>>>>>>>>>>>>>      move (TRUE) to lbRelease
51536>>>>>>>>>>>>>>>>>      move 1 to liCloseOnWrite
51537>>>>>>>>>>>>>>>>>    end
51537>>>>>>>>>>>>>>>>>>
51537>>>>>>>>>>>>>>>>>
51537>>>>>>>>>>>>>>>>>    if liCloseOnWrite Append_Output channel liChannel (psFileName(self))
51541>>>>>>>>>>>>>>>>>
51541>>>>>>>>>>>>>>>>>    direct_input channel liAuxChannel ("image: "+string(liImg))
51543>>>>>>>>>>>>>>>>>    ifnot (SeqEof) readln channel liAuxChannel lsLine
51547>>>>>>>>>>>>>>>>>    repeat
51547>>>>>>>>>>>>>>>>>>
51547>>>>>>>>>>>>>>>>>      move (SeqEof) to liSeqEof
51548>>>>>>>>>>>>>>>>>      ifnot liSeqEof begin
51550>>>>>>>>>>>>>>>>>        writeln channel liChannel (rtrim(lsLine))
51553>>>>>>>>>>>>>>>>>        readln channel liAuxChannel lsLine
51555>>>>>>>>>>>>>>>>>      end
51555>>>>>>>>>>>>>>>>>>
51555>>>>>>>>>>>>>>>>>    until liSeqEof
51557>>>>>>>>>>>>>>>>>    close_input channel liAuxChannel
51559>>>>>>>>>>>>>>>>>
51559>>>>>>>>>>>>>>>>>    if liCloseOnWrite Close_Output channel liChannel
51563>>>>>>>>>>>>>>>>>    if lbRelease send Seq_Release_Channel liChannel
51566>>>>>>>>>>>>>>>>>
51566>>>>>>>>>>>>>>>>>    send Seq_Release_Channel liAuxChannel
51567>>>>>>>>>>>>>>>>>  end_procedure
51568>>>>>>>>>>>>>>>>>end_class // cLogFile
51569>>>>>>>>>>>>>>>>>
51569>>>>>>>>>>>>>>>Use FdxIndex.nui // Index analysing functions
51569>>>>>>>>>>>>>>>
51569>>>>>>>>>>>>>>>  define Structur$UI for 1
51569>>>>>>>>>>>>>>>
51569>>>>>>>>>>>>>>> Use Fdx2.utl     // FDX aware object for displaying a table definiton
Including file: fdx2.utl    (C:\projects\BRS\VDFQuery\AppSrc\fdx2.utl)
51569>>>>>>>>>>>>>>>>>//**********************************************************************
51569>>>>>>>>>>>>>>>>>// Use Fdx2.utl     // FDX aware object for displaying a table definition
51569>>>>>>>>>>>>>>>>>//
51569>>>>>>>>>>>>>>>>>// By Sture Andersen
51569>>>>>>>>>>>>>>>>>//
51569>>>>>>>>>>>>>>>>>// Create: Tue  09-02-2000
51569>>>>>>>>>>>>>>>>>// Update:
51569>>>>>>>>>>>>>>>>>//
51569>>>>>>>>>>>>>>>>>//**********************************************************************
51569>>>>>>>>>>>>>>>>>Use Fdx_Attr.nui // FDX compatible attribute functions
51569>>>>>>>>>>>>>>>>>Use DBMS.utl     // Basic DBMS functions
51569>>>>>>>>>>>>>>>>>Use GridUtil.utl // Grid and List utilities
Including file: gridutil.utl    (C:\projects\BRS\VDFQuery\AppSrc\gridutil.utl)
51569>>>>>>>>>>>>>>>>>>>// Use GridUtil.utl // Grid and List utilities (not for dbGrid's or Table's)
51569>>>>>>>>>>>>>>>>>>>
51569>>>>>>>>>>>>>>>>>>>//> This package provides a number of functions working on objects of
51569>>>>>>>>>>>>>>>>>>>//> these classes
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>       Grid (VDF)
51569>>>>>>>>>>>>>>>>>>>//>       List (DF)
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> And not: dbGrid (VDF), List (VDF), dbList (VDF) or Table (DF)
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> The Grid of VDF and the List of DF are so much alike that it makes
51569>>>>>>>>>>>>>>>>>>>//> sence to give them a common interface via this package.
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> For the rest of this package (except the first sentence of the next
51569>>>>>>>>>>>>>>>>>>>//> paragraph) VDF Grid's and DF List's will be referred to as grids.
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> Rather than having these functions implemented in a subclass of the
51569>>>>>>>>>>>>>>>>>>>//> Grid- or List classes I have made global functions and procedures
51569>>>>>>>>>>>>>>>>>>>//> that all takes the object ID of the Grid as the first parameter.
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> You may therefore use the functions of this package regardless of
51569>>>>>>>>>>>>>>>>>>>//> the class hierarchy you are using.
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> To sort the contents of a grid by the contents of column liColumn use:
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>    procedure Grid_SortByColumn global integer lhGrid integer liColumn
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> The set the entry_state of all items in a grid in one go use:
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>    procedure Grid_SetEntryState global integer lhObj integer liState
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> To figure out the number of the first item in the current row use:
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>    function Grid_BaseItem global integer lhObj returns integer
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> To figure out the current column use:
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>    function Grid_CurrentColumn global integer lhObj returns integer
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> And finally, to figure out the number of columns used:
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>    function Grid_Columns global integer lhObj returns integer
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> Added much later:
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> Use this to switch the contents of two rows (including aux_value, color
51569>>>>>>>>>>>>>>>>>>>//> entry_state and what have you):
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>    procedure Grid_SwapRows global integer lhObj integer liRow1 ;
51569>>>>>>>>>>>>>>>>>>>//>                                                        integer liRow2
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> Most often, when swapping rows you'd really like to swap the current row
51569>>>>>>>>>>>>>>>>>>>//> up or down:
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>    procedure Grid_SwapCurrentRowUp global integer lhGrid
51569>>>>>>>>>>>>>>>>>>>//>    procedure Grid_SwapCurrentRowDown global integer lhGrid
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>    Use like this (from within a Grid object):
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>      procedure MoveItemUp
51569>>>>>>>>>>>>>>>>>>>//>        send Grid_SwapCurrentRowUp self
51569>>>>>>>>>>>>>>>>>>>//>      end_procedure
51569>>>>>>>>>>>>>>>>>>>//>      procedure MoveItemDown
51569>>>>>>>>>>>>>>>>>>>//>        send Grid_SwapCurrentRowDown self
51569>>>>>>>>>>>>>>>>>>>//>      end_procedure
51569>>>>>>>>>>>>>>>>>>>//>      on_key KEY_CTRL+KEY_UP_ARROW   send MoveItemUp
51569>>>>>>>>>>>>>>>>>>>//>      on_key KEY_CTRL+KEY_DOWN_ARROW send MoveItemDown
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> In some cases you may want to swap the current row to the top or to the
51569>>>>>>>>>>>>>>>>>>>//> bottom of the grid. Use:
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>    procedure Grid_SwapCurrentRowTop global integer lhGrid
51569>>>>>>>>>>>>>>>>>>>//>    procedure Grid_SwapCurrentRowBottom global integer lhGrid
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> Delete a row:
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>   procedure Grid_DeleteRow global integer lhObj integer liRow
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> Delete current row:
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>   procedure Grid_DeleteCurrentRow global integer lhObj
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> If the first column of the grid is a checkbox column you may use these
51569>>>>>>>>>>>>>>>>>>>//> methods:
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>          Select all rows:
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>             procedure Grid_RowSelectAll global integer lhGrid
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>          Deselect all rows:
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>             procedure Grid_RowDeselectAll global integer lhGrid
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>          Invert row selection:
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>             procedure Grid_RowSelectInvert global integer lhGrid
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>          Call function liGet for each row in lhGrid to set the select
51569>>>>>>>>>>>>>>>>>>>//>          or deselect each row. The liGet function ID will receive two
51569>>>>>>>>>>>>>>>>>>>//>          parameter (Row number and number of the base item of that row)
51569>>>>>>>>>>>>>>>>>>>//>          and should return an integer value:
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>             procedure Grid_RowSelectCostum global integer lhGrid ;
51569>>>>>>>>>>>>>>>>>>>//>                                                           integer liGet
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>          Use this to call procedure liMsg in lhGrid for each selected
51569>>>>>>>>>>>>>>>>>>>//>          row. The procedure will receive two parameters (row number and
51569>>>>>>>>>>>>>>>>>>>//>          number of the base item of that row):
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>             procedure Grid_RowCallBackSelected global integer lhGrid ;
51569>>>>>>>>>>>>>>>>>>>//>                                                             integer liMsg
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> To write the contents of the Grid to a sequential channel use
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>    procedure Grid_WriteToFile global integer lhGrid integer liChannel ;
51569>>>>>>>>>>>>>>>>>>>//>                                                         integer liFormat
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> where liFormat may be GD_FORMAT (Nicely formatted into colums), GD_COMMA
51569>>>>>>>>>>>>>>>>>>>//> (each line containing a row with comma separated items) or GD_TAB (same
51569>>>>>>>>>>>>>>>>>>>//> as the former, but separated by a TAB character).
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> In order to dump the grid data into an editor use
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>    procedure Grid_DoWriteToFile global integer lhGrid
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> This will create a file called 'temp.txt' and launch an editor on it
51569>>>>>>>>>>>>>>>>>>>//> (NotePad, Edit or vi).
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> This is one of my best packages!
51569>>>>>>>>>>>>>>>>>>>//>
51569>>>>>>>>>>>>>>>>>>>//> =========================================================================
51569>>>>>>>>>>>>>>>>>>>//
51569>>>>>>>>>>>>>>>>>>>//  Update: Wed  07-11-2001 - Changed procedures Grid_RowSelectAll,
51569>>>>>>>>>>>>>>>>>>>//                            Grid_RowDeselectAll and Grid_RowSelectInvert
51569>>>>>>>>>>>>>>>>>>>//                            to avoid changing the select_state of a
51569>>>>>>>>>>>>>>>>>>>//                            shadowed item.
51569>>>>>>>>>>>>>>>>>>>//          Tue  25-12-2001 - Now also applies form_datatype it compiled
51569>>>>>>>>>>>>>>>>>>>//                            with VDF
51569>>>>>>>>>>>>>>>>>>>//          Wed  18-04-2002 - desktop_section problem corrected
51569>>>>>>>>>>>>>>>>>>>//          Mon  12-08-2002 - Function Grid_ItemRow added
51569>>>>>>>>>>>>>>>>>>>//          Thu  16-06-2003 - Added optional parameter to Grid_RowCallBackSelected
51569>>>>>>>>>>>>>>>>>>>//          Thu  01-07-2003 - Added functions Grid_AppendRow, Grid_InsertRow
51569>>>>>>>>>>>>>>>>>>>//                            and Grid_InsertCurrentRow
51569>>>>>>>>>>>>>>>>>>>//          Fri  21-10-2005 - Added procedure Grid_SetRowColor and Grid_AddRowToGrid
51569>>>>>>>>>>>>>>>>>>>//
51569>>>>>>>>>>>>>>>>>>>//    set Header_Visible_State to DFTRUE|DFFALSE
51569>>>>>>>>>>>>>>>>>>>//
51569>>>>>>>>>>>>>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
51569>>>>>>>>>>>>>>>>>>>Use Strings.nui  // String manipulation for VDF
51569>>>>>>>>>>>>>>>>>>>Use Files.nui    // Utilities for handling file related stuff (No User Interface)
51569>>>>>>>>>>>>>>>>>>>
51569>>>>>>>>>>>>>>>>>>>desktop_section // This makes sure the object is located on the desktop
51574>>>>>>>>>>>>>>>>>>>  object oGridMoveSelectedListItems is an cArray NO_IMAGE
51576>>>>>>>>>>>>>>>>>>>  end_object
51577>>>>>>>>>>>>>>>>>>>end_desktop_section
51582>>>>>>>>>>>>>>>>>>>
51582>>>>>>>>>>>>>>>>>>>//> Procedure Grid_CopySelectedListItems is meant for List objects (AHA! This
51582>>>>>>>>>>>>>>>>>>>//> is the only procedure that deals with the VDF list class)
51582>>>>>>>>>>>>>>>>>>>procedure Grid_CopySelectedListItems global integer lhSourceGrid integer lhTargetGrid integer lbAllItems integer lbDeleteFromSource
51584>>>>>>>>>>>>>>>>>>>  integer liMax liItem liSelect lhObj liDeleteItem
51584>>>>>>>>>>>>>>>>>>>  string lsValue
51584>>>>>>>>>>>>>>>>>>>  move (oGridMoveSelectedListItems(self)) to lhObj
51585>>>>>>>>>>>>>>>>>>>  get item_count of lhSourceGrid to liMax
51586>>>>>>>>>>>>>>>>>>>  for liItem from 0 to (liMax-1) // Copy selected items
51592>>>>>>>>>>>>>>>>>>>>
51592>>>>>>>>>>>>>>>>>>>    ifnot lbAllItems get select_state of lhSourceGrid item liItem to liSelect
51595>>>>>>>>>>>>>>>>>>>    if (liSelect or lbAllItems) begin
51597>>>>>>>>>>>>>>>>>>>      get value of lhSourceGrid item liItem to lsValue
51598>>>>>>>>>>>>>>>>>>>      send add_item to lhTargetGrid msg_none lsValue
51599>>>>>>>>>>>>>>>>>>>      set value of lhObj item (item_count(lhObj)) to liItem
51600>>>>>>>>>>>>>>>>>>>    end
51600>>>>>>>>>>>>>>>>>>>>
51600>>>>>>>>>>>>>>>>>>>  loop
51601>>>>>>>>>>>>>>>>>>>>
51601>>>>>>>>>>>>>>>>>>>  if lbAllItems send delete_data to lhSourceGrid
51604>>>>>>>>>>>>>>>>>>>  else begin
51605>>>>>>>>>>>>>>>>>>>    get item_count of lhObj to liMax
51606>>>>>>>>>>>>>>>>>>>    for_ex liItem from (liMax-1) down_to 0 // Remove selected items
51613>>>>>>>>>>>>>>>>>>>      get value of lhObj item liItem to liDeleteItem
51614>>>>>>>>>>>>>>>>>>>      send delete_item to lhSourceGrid liDeleteItem
51615>>>>>>>>>>>>>>>>>>>    loop
51616>>>>>>>>>>>>>>>>>>>>
51616>>>>>>>>>>>>>>>>>>>  end
51616>>>>>>>>>>>>>>>>>>>>
51616>>>>>>>>>>>>>>>>>>>  send delete_data to lhObj
51617>>>>>>>>>>>>>>>>>>>  send sort_items to lhSourceGrid
51618>>>>>>>>>>>>>>>>>>>  send sort_items to lhTargetGrid
51619>>>>>>>>>>>>>>>>>>>  set dynamic_update_state of lhSourceGrid to DFTRUE
51620>>>>>>>>>>>>>>>>>>>  set dynamic_update_state of lhTargetGrid to DFTRUE
51621>>>>>>>>>>>>>>>>>>>end_procedure
51622>>>>>>>>>>>>>>>>>>>
51622>>>>>>>>>>>>>>>>>>>//> Set Entry_State for all items in a Grid (that are not checkboxes)
51622>>>>>>>>>>>>>>>>>>>procedure Grid_SetEntryState global integer lhObj integer liState
51624>>>>>>>>>>>>>>>>>>>  integer liItem liMax
51624>>>>>>>>>>>>>>>>>>>  get item_count of lhObj to liMax
51625>>>>>>>>>>>>>>>>>>>  for liItem from 0 to (liMax-1)
51631>>>>>>>>>>>>>>>>>>>>
51631>>>>>>>>>>>>>>>>>>>    ifnot (checkbox_item_state(lhObj,liItem)) set entry_state of lhObj item liItem to liState
51634>>>>>>>>>>>>>>>>>>>  loop
51635>>>>>>>>>>>>>>>>>>>>
51635>>>>>>>>>>>>>>>>>>>end_procedure
51636>>>>>>>>>>>>>>>>>>>
51636>>>>>>>>>>>>>>>>>>>//> Function Grid_Columns takes the object ID of a Grid or List
51636>>>>>>>>>>>>>>>>>>>//> object and returns the number of columns in that object.
51636>>>>>>>>>>>>>>>>>>>function Grid_Columns global integer lhObj returns integer
51638>>>>>>>>>>>>>>>>>>>  integer liMs
51638>>>>>>>>>>>>>>>>>>>  get line_size of lhObj to liMs
51639>>>>>>>>>>>>>>>>>>>  function_return liMs
51640>>>>>>>>>>>>>>>>>>>end_function
51641>>>>>>>>>>>>>>>>>>>
51641>>>>>>>>>>>>>>>>>>>function Grid_CurrentColumn global integer lhObj returns integer
51643>>>>>>>>>>>>>>>>>>>  integer liColumns liCurrentItem liBase
51643>>>>>>>>>>>>>>>>>>>  get Grid_Columns lhObj to liColumns
51644>>>>>>>>>>>>>>>>>>>  get current_item of lhObj to liCurrentItem
51645>>>>>>>>>>>>>>>>>>>  move ((liCurrentItem/liColumns)*liColumns) to liBase
51646>>>>>>>>>>>>>>>>>>>  function_return (liCurrentItem-liBase)
51647>>>>>>>>>>>>>>>>>>>end_function
51648>>>>>>>>>>>>>>>>>>>
51648>>>>>>>>>>>>>>>>>>>function Grid_BaseItem global integer lhObj returns integer
51650>>>>>>>>>>>>>>>>>>>  integer liColumns liCurrentItem
51650>>>>>>>>>>>>>>>>>>>  get Grid_Columns lhObj to liColumns
51651>>>>>>>>>>>>>>>>>>>  get current_item of lhObj to liCurrentItem
51652>>>>>>>>>>>>>>>>>>>  function_return ((liCurrentItem/liColumns)*liColumns)
51653>>>>>>>>>>>>>>>>>>>end_function
51654>>>>>>>>>>>>>>>>>>>
51654>>>>>>>>>>>>>>>>>>>function Grid_ItemColumn global integer lhObj integer liItem returns integer
51656>>>>>>>>>>>>>>>>>>>  integer liColumns
51656>>>>>>>>>>>>>>>>>>>  get Grid_Columns lhObj to liColumns
51657>>>>>>>>>>>>>>>>>>>  if liItem eq -99 get current_item of lhObj to liItem
51660>>>>>>>>>>>>>>>>>>>  function_return (mod(liItem,liColumns))
51661>>>>>>>>>>>>>>>>>>>end_function
51662>>>>>>>>>>>>>>>>>>>
51662>>>>>>>>>>>>>>>>>>>function Grid_ItemRow global integer lhObj integer liItem returns integer
51664>>>>>>>>>>>>>>>>>>>  integer liColumns
51664>>>>>>>>>>>>>>>>>>>  get Grid_Columns lhObj to liColumns
51665>>>>>>>>>>>>>>>>>>>  if liItem eq -99 get current_item of lhObj to liItem
51668>>>>>>>>>>>>>>>>>>>  function_return (liItem/liColumns)
51669>>>>>>>>>>>>>>>>>>>end_function
51670>>>>>>>>>>>>>>>>>>>
51670>>>>>>>>>>>>>>>>>>>function Grid_ItemBaseItem global integer lhObj integer liItem returns integer
51672>>>>>>>>>>>>>>>>>>>  integer liColumns
51672>>>>>>>>>>>>>>>>>>>  if liItem eq -99 get current_item of lhObj to liItem
51675>>>>>>>>>>>>>>>>>>>  get Grid_Columns lhObj to liColumns
51676>>>>>>>>>>>>>>>>>>>  function_return ((liItem/liColumns)*liColumns)
51677>>>>>>>>>>>>>>>>>>>end_function
51678>>>>>>>>>>>>>>>>>>>
51678>>>>>>>>>>>>>>>>>>>//> What is the number of the base item of row liRow
51678>>>>>>>>>>>>>>>>>>>function Grid_RowBaseItem global integer lhObj integer liRow returns integer
51680>>>>>>>>>>>>>>>>>>>  integer liColumns
51680>>>>>>>>>>>>>>>>>>>  get Grid_Columns lhObj to liColumns
51681>>>>>>>>>>>>>>>>>>>  function_return (liRow*liColumns)
51682>>>>>>>>>>>>>>>>>>>end_function
51683>>>>>>>>>>>>>>>>>>>
51683>>>>>>>>>>>>>>>>>>>//> Return the number of the row that includes the current_item
51683>>>>>>>>>>>>>>>>>>>function Grid_CurrentRow global integer lhObj returns integer
51685>>>>>>>>>>>>>>>>>>>  integer liCurrentItem
51685>>>>>>>>>>>>>>>>>>>  get current_item of lhObj to liCurrentItem
51686>>>>>>>>>>>>>>>>>>>  function_return (liCurrentItem/Grid_Columns(lhObj))
51687>>>>>>>>>>>>>>>>>>>end_function
51688>>>>>>>>>>>>>>>>>>>
51688>>>>>>>>>>>>>>>>>>>//> Return the number of rows currently in the Grid
51688>>>>>>>>>>>>>>>>>>>function Grid_RowCount global integer lhObj returns integer
51690>>>>>>>>>>>>>>>>>>>  integer liColumns
51690>>>>>>>>>>>>>>>>>>>  get Grid_Columns lhObj to liColumns
51691>>>>>>>>>>>>>>>>>>>  function_return (item_count(lhObj)/liColumns)
51692>>>>>>>>>>>>>>>>>>>end_function
51693>>>>>>>>>>>>>>>>>>>
51693>>>>>>>>>>>>>>>>>>>procedure Grid_SwapRows global integer lhObj integer liRow1 integer liRow2
51695>>>>>>>>>>>>>>>>>>>  integer liBase1 liBase2 liItem liMax
51695>>>>>>>>>>>>>>>>>>>  string lsValue
51695>>>>>>>>>>>>>>>>>>>  get Grid_RowBaseItem lhObj liRow1 to liBase1
51696>>>>>>>>>>>>>>>>>>>  get Grid_RowBaseItem lhObj liRow2 to liBase2
51697>>>>>>>>>>>>>>>>>>>  get Grid_Columns lhObj to liMax
51698>>>>>>>>>>>>>>>>>>>  for liItem from 0 to (liMax-1)
51704>>>>>>>>>>>>>>>>>>>>
51704>>>>>>>>>>>>>>>>>>>    // value
51704>>>>>>>>>>>>>>>>>>>    get value of lhObj item (liBase1+liItem) to lsValue
51705>>>>>>>>>>>>>>>>>>>    set value of lhObj item (liBase1+liItem) to (value(lhObj,liBase2+liItem))
51706>>>>>>>>>>>>>>>>>>>    set value of lhObj item (liBase2+liItem) to lsValue
51707>>>>>>>>>>>>>>>>>>>    // entry_state
51707>>>>>>>>>>>>>>>>>>>    get entry_state of lhObj item (liBase1+liItem) to lsValue
51708>>>>>>>>>>>>>>>>>>>    set entry_state of lhObj item (liBase1+liItem) to (entry_state(lhObj,liBase2+liItem))
51709>>>>>>>>>>>>>>>>>>>    set entry_state of lhObj item (liBase2+liItem) to lsValue
51710>>>>>>>>>>>>>>>>>>>    // color
51710>>>>>>>>>>>>>>>>>>>    get itemcolor of lhObj item (liBase1+liItem) to lsValue
51711>>>>>>>>>>>>>>>>>>>    set itemcolor of lhObj item (liBase1+liItem) to (itemcolor(lhObj,liBase2+liItem))
51712>>>>>>>>>>>>>>>>>>>    set itemcolor of lhObj item (liBase2+liItem) to lsValue
51713>>>>>>>>>>>>>>>>>>>    // checkbox_item_state
51713>>>>>>>>>>>>>>>>>>>    get checkbox_item_state of lhObj item (liBase1+liItem) to lsValue
51714>>>>>>>>>>>>>>>>>>>    set checkbox_item_state of lhObj item (liBase1+liItem) to (checkbox_item_state(lhObj,liBase2+liItem))
51715>>>>>>>>>>>>>>>>>>>    set checkbox_item_state of lhObj item (liBase2+liItem) to lsValue
51716>>>>>>>>>>>>>>>>>>>    // aux_value
51716>>>>>>>>>>>>>>>>>>>    get aux_value of lhObj item (liBase1+liItem) to lsValue
51717>>>>>>>>>>>>>>>>>>>    set aux_value of lhObj item (liBase1+liItem) to (aux_value(lhObj,liBase2+liItem))
51718>>>>>>>>>>>>>>>>>>>    set aux_value of lhObj item (liBase2+liItem) to lsValue
51719>>>>>>>>>>>>>>>>>>>    // select_state
51719>>>>>>>>>>>>>>>>>>>    get select_state of lhObj item (liBase1+liItem) to lsValue
51720>>>>>>>>>>>>>>>>>>>    set select_state of lhObj item (liBase1+liItem) to (select_state(lhObj,liBase2+liItem))
51721>>>>>>>>>>>>>>>>>>>    set select_state of lhObj item (liBase2+liItem) to lsValue
51722>>>>>>>>>>>>>>>>>>>    // What about shadow_state (and item_shadow_state)?
51722>>>>>>>>>>>>>>>>>>>  loop
51723>>>>>>>>>>>>>>>>>>>>
51723>>>>>>>>>>>>>>>>>>>end_procedure
51724>>>>>>>>>>>>>>>>>>>
51724>>>>>>>>>>>>>>>>>>>function Grid_AppendRow global integer lhObj returns integer
51726>>>>>>>>>>>>>>>>>>>  integer liCount liMax liRow
51726>>>>>>>>>>>>>>>>>>>  set dynamic_update_state of lhObj to DFFALSE
51727>>>>>>>>>>>>>>>>>>>  get Grid_RowCount lhObj to liRow
51728>>>>>>>>>>>>>>>>>>>  get Grid_Columns lhObj to liMax
51729>>>>>>>>>>>>>>>>>>>  decrement liMax
51730>>>>>>>>>>>>>>>>>>>  for liCount from 0 to liMax
51736>>>>>>>>>>>>>>>>>>>>
51736>>>>>>>>>>>>>>>>>>>    send add_item to lhObj MSG_NONE ""
51737>>>>>>>>>>>>>>>>>>>  loop
51738>>>>>>>>>>>>>>>>>>>>
51738>>>>>>>>>>>>>>>>>>>  set dynamic_update_state of lhObj to DFTRUE
51739>>>>>>>>>>>>>>>>>>>  function_return liRow
51740>>>>>>>>>>>>>>>>>>>end_function
51741>>>>>>>>>>>>>>>>>>>
51741>>>>>>>>>>>>>>>>>>>function Grid_InsertRow global integer lhObj integer liRow returns integer
51743>>>>>>>>>>>>>>>>>>>  integer liCount liMax liItem
51743>>>>>>>>>>>>>>>>>>>  get Grid_RowBaseItem lhObj liRow to liItem
51744>>>>>>>>>>>>>>>>>>>  set dynamic_update_state of lhObj to DFFALSE
51745>>>>>>>>>>>>>>>>>>>  get Grid_Columns lhObj to liMax
51746>>>>>>>>>>>>>>>>>>>  decrement liMax
51747>>>>>>>>>>>>>>>>>>>  for liCount from 0 to liMax
51753>>>>>>>>>>>>>>>>>>>>
51753>>>>>>>>>>>>>>>>>>>    send insert_item to lhObj MSG_NONE "" liItem
51754>>>>>>>>>>>>>>>>>>>  loop
51755>>>>>>>>>>>>>>>>>>>>
51755>>>>>>>>>>>>>>>>>>>  set dynamic_update_state of lhObj to DFTRUE
51756>>>>>>>>>>>>>>>>>>>  function_return liRow
51757>>>>>>>>>>>>>>>>>>>end_function
51758>>>>>>>>>>>>>>>>>>>
51758>>>>>>>>>>>>>>>>>>>function Grid_InsertCurrentRow global integer lhObj returns integer
51760>>>>>>>>>>>>>>>>>>>  integer liRow
51760>>>>>>>>>>>>>>>>>>>  get Grid_InsertRow lhObj (Grid_CurrentRow(lhObj)) to liRow
51761>>>>>>>>>>>>>>>>>>>  function_return liRow
51762>>>>>>>>>>>>>>>>>>>end_function
51763>>>>>>>>>>>>>>>>>>>
51763>>>>>>>>>>>>>>>>>>>procedure Grid_DeleteRow global integer lhObj integer liRow
51765>>>>>>>>>>>>>>>>>>>  integer liBase liCount liMax
51765>>>>>>>>>>>>>>>>>>>  if (item_count(lhObj)) begin
51767>>>>>>>>>>>>>>>>>>>    set dynamic_update_state of lhObj to DFFALSE
51768>>>>>>>>>>>>>>>>>>>    get Grid_RowBaseItem lhObj liRow to liBase
51769>>>>>>>>>>>>>>>>>>>    get Grid_Columns lhObj to liMax
51770>>>>>>>>>>>>>>>>>>>    decrement liMax
51771>>>>>>>>>>>>>>>>>>>    for liCount from 0 to liMax
51777>>>>>>>>>>>>>>>>>>>>
51777>>>>>>>>>>>>>>>>>>>      send delete_item to lhObj liBase
51778>>>>>>>>>>>>>>>>>>>    loop
51779>>>>>>>>>>>>>>>>>>>>
51779>>>>>>>>>>>>>>>>>>>    set dynamic_update_state of lhObj to DFTRUE
51780>>>>>>>>>>>>>>>>>>>  end
51780>>>>>>>>>>>>>>>>>>>>
51780>>>>>>>>>>>>>>>>>>>end_procedure
51781>>>>>>>>>>>>>>>>>>>procedure Grid_DeleteCurrentRow global integer lhObj
51783>>>>>>>>>>>>>>>>>>>  send Grid_DeleteRow lhObj (Grid_CurrentRow(lhObj))
51784>>>>>>>>>>>>>>>>>>>end_procedure
51785>>>>>>>>>>>>>>>>>>>
51785>>>>>>>>>>>>>>>>>>>procedure Grid_SwapCurrentRowUp global integer lhObj
51787>>>>>>>>>>>>>>>>>>>  integer liCurrentRow liCurrentItem
51787>>>>>>>>>>>>>>>>>>>  get Grid_CurrentRow lhObj to liCurrentRow
51788>>>>>>>>>>>>>>>>>>>  if liCurrentRow gt 0 begin
51790>>>>>>>>>>>>>>>>>>>    get Current_Item of lhObj to liCurrentItem
51791>>>>>>>>>>>>>>>>>>>    send Grid_SwapRows lhObj liCurrentRow (liCurrentRow-1)
51792>>>>>>>>>>>>>>>>>>>    set Current_Item of lhObj to (liCurrentItem-Grid_Columns(lhObj))
51793>>>>>>>>>>>>>>>>>>>  end
51793>>>>>>>>>>>>>>>>>>>>
51793>>>>>>>>>>>>>>>>>>>end_procedure
51794>>>>>>>>>>>>>>>>>>>procedure Grid_SwapCurrentRowTop global integer lhObj
51796>>>>>>>>>>>>>>>>>>>  integer liCurrentRow liCurrentItem
51796>>>>>>>>>>>>>>>>>>>  repeat
51796>>>>>>>>>>>>>>>>>>>>
51796>>>>>>>>>>>>>>>>>>>    get Grid_CurrentRow lhObj to liCurrentRow
51797>>>>>>>>>>>>>>>>>>>    if liCurrentRow gt 0 send Grid_SwapCurrentRowUp lhObj
51800>>>>>>>>>>>>>>>>>>>  until (liCurrentRow=0)
51802>>>>>>>>>>>>>>>>>>>end_procedure
51803>>>>>>>>>>>>>>>>>>>procedure Grid_SwapCurrentRowDown global integer lhObj
51805>>>>>>>>>>>>>>>>>>>  integer liCurrentRow liCurrentItem
51805>>>>>>>>>>>>>>>>>>>  get Grid_CurrentRow lhObj to liCurrentRow
51806>>>>>>>>>>>>>>>>>>>  if liCurrentRow lt (Grid_RowCount(lhObj)-1) begin
51808>>>>>>>>>>>>>>>>>>>    get Current_Item of lhObj to liCurrentItem
51809>>>>>>>>>>>>>>>>>>>    send Grid_SwapRows lhObj liCurrentRow (liCurrentRow+1)
51810>>>>>>>>>>>>>>>>>>>    set Current_Item of lhObj to (liCurrentItem+Grid_Columns(lhObj))
51811>>>>>>>>>>>>>>>>>>>  end
51811>>>>>>>>>>>>>>>>>>>>
51811>>>>>>>>>>>>>>>>>>>end_procedure
51812>>>>>>>>>>>>>>>>>>>procedure Grid_SwapCurrentRowBottom global integer lhObj
51814>>>>>>>>>>>>>>>>>>>  integer liCurrentRow liCurrentItem
51814>>>>>>>>>>>>>>>>>>>  repeat
51814>>>>>>>>>>>>>>>>>>>>
51814>>>>>>>>>>>>>>>>>>>    get Grid_CurrentRow lhObj to liCurrentRow
51815>>>>>>>>>>>>>>>>>>>    if liCurrentRow lt (Grid_RowCount(lhObj)-1) send Grid_SwapCurrentRowDown lhObj
51818>>>>>>>>>>>>>>>>>>>  until (liCurrentRow=(Grid_RowCount(lhObj)-1))
51820>>>>>>>>>>>>>>>>>>>end_procedure
51821>>>>>>>>>>>>>>>>>>>
51821>>>>>>>>>>>>>>>>>>>Use FieldInf     // Global field info objects and abstract field types
51821>>>>>>>>>>>>>>>>>>>desktop_section
51826>>>>>>>>>>>>>>>>>>>  object oGridPrepare is a cArray
51828>>>>>>>>>>>>>>>>>>>    property integer piNextPrevious public 1
51830>>>>>>>>>>>>>>>>>>>    item_property_list
51830>>>>>>>>>>>>>>>>>>>      item_property string  psHeaderLabel.i
51830>>>>>>>>>>>>>>>>>>>      item_property integer piAbstractOrFile.i
51830>>>>>>>>>>>>>>>>>>>      item_property integer piField.i
51830>>>>>>>>>>>>>>>>>>>    end_item_property_list
#REM 51870 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 51875 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 51880 DEFINE FUNCTION PIABSTRACTORFILE.I INTEGER LIROW RETURNS INTEGER
#REM 51885 DEFINE PROCEDURE SET PIABSTRACTORFILE.I INTEGER LIROW INTEGER VALUE
#REM 51890 DEFINE FUNCTION PSHEADERLABEL.I INTEGER LIROW RETURNS STRING
#REM 51895 DEFINE PROCEDURE SET PSHEADERLABEL.I INTEGER LIROW STRING VALUE
51901>>>>>>>>>>>>>>>>>>>    procedure add_column string lsLabel integer liAbstract integer liField
51904>>>>>>>>>>>>>>>>>>>      integer liRow
51904>>>>>>>>>>>>>>>>>>>      get row_count to liRow
51905>>>>>>>>>>>>>>>>>>>      set psHeaderLabel.i liRow to lsLabel
51906>>>>>>>>>>>>>>>>>>>      set piAbstractOrFile.i liRow to liAbstract
51907>>>>>>>>>>>>>>>>>>>      set piField.i liRow to liField
51908>>>>>>>>>>>>>>>>>>>    end_procedure
51909>>>>>>>>>>>>>>>>>>>    procedure reset
51912>>>>>>>>>>>>>>>>>>>      send delete_data
51913>>>>>>>>>>>>>>>>>>>      set piNextPrevious to 1
51914>>>>>>>>>>>>>>>>>>>    end_procedure
51915>>>>>>>>>>>>>>>>>>>    procedure apply_settings integer lhObj integer lbDoColor
51918>>>>>>>>>>>>>>>>>>>      integer liRow liMax
51918>>>>>>>>>>>>>>>>>>>      get row_count to liMax
51919>>>>>>>>>>>>>>>>>>>      set line_width of lhObj to liMax 0
51920>>>>>>>>>>>>>>>>>>>      decrement liMax
51921>>>>>>>>>>>>>>>>>>>      for liRow from 0 to liMax
51927>>>>>>>>>>>>>>>>>>>>
51927>>>>>>>>>>>>>>>>>>>        set header_label of lhObj liRow to (psHeaderLabel.i(self,liRow))
51928>>>>>>>>>>>>>>>>>>>        if (piField.i(self,liRow)) eq -1 begin // Then it's an Abstract
51930>>>>>>>>>>>>>>>>>>>          set form_margin of lhObj liRow to (integer_value.ii(form_margin_array#,0,piAbstractOrFile.i(self,liRow)))
51931>>>>>>>>>>>>>>>>>>>          set form_datatype of lhObj liRow to (integer_value.ii(form_datatype_array#,0,piAbstractOrFile.i(self,liRow)))
51932>>>>>>>>>>>>>>>>>>>        end
51932>>>>>>>>>>>>>>>>>>>>
51932>>>>>>>>>>>>>>>>>>>        else begin // It's a file.field
51933>>>>>>>>>>>>>>>>>>>          set form_margin of lhObj liRow to (gl_effective_form_margin(piAbstractOrFile.i(self,liRow),piField.i(self,liRow)))
51934>>>>>>>>>>>>>>>>>>>          set form_datatype of lhObj liRow to (gl_effective_form_datatype(piAbstractOrFile.i(self,liRow),piField.i(self,liRow)))
51935>>>>>>>>>>>>>>>>>>>        end
51935>>>>>>>>>>>>>>>>>>>>
51935>>>>>>>>>>>>>>>>>>>      loop
51936>>>>>>>>>>>>>>>>>>>>
51936>>>>>>>>>>>>>>>>>>>      set select_mode of lhObj to no_select
51937>>>>>>>>>>>>>>>>>>>      if lbDoColor begin
51939>>>>>>>>>>>>>>>>>>>        set highlight_row_state of lhObj to DFTRUE
51940>>>>>>>>>>>>>>>>>>>        set CurrentCellColor     of lhObj to clHighlight
51941>>>>>>>>>>>>>>>>>>>        set CurrentCellTextColor of lhObj to clHighlightText
51942>>>>>>>>>>>>>>>>>>>        set CurrentRowColor      of lhObj to clHighlight
51943>>>>>>>>>>>>>>>>>>>        set CurrentRowTextColor  of lhObj to clHighlightText
51944>>>>>>>>>>>>>>>>>>>      end
51944>>>>>>>>>>>>>>>>>>>>
51944>>>>>>>>>>>>>>>>>>>      if (piNextPrevious(self)) begin
51946>>>>>>>>>>>>>>>>>>>        move self to liMax // Overload
51947>>>>>>>>>>>>>>>>>>>        move lhObj to self
51948>>>>>>>>>>>>>>>>>>>        on_key knext_item send switch
51949>>>>>>>>>>>>>>>>>>>        on_key kprevious_item send switch_back
51950>>>>>>>>>>>>>>>>>>>        move liMax to self
51951>>>>>>>>>>>>>>>>>>>      end
51951>>>>>>>>>>>>>>>>>>>>
51951>>>>>>>>>>>>>>>>>>>    end_procedure
51952>>>>>>>>>>>>>>>>>>>  end_object // oGridPrepare
51953>>>>>>>>>>>>>>>>>>>  procedure GridPrepare_Reset global
51955>>>>>>>>>>>>>>>>>>>    send reset to (oGridPrepare(self))
51956>>>>>>>>>>>>>>>>>>>  end_procedure
51957>>>>>>>>>>>>>>>>>>>  procedure GridPrepare_AddCheckBoxColumn global string lsHeader
51959>>>>>>>>>>>>>>>>>>>    string lsTmp
51959>>>>>>>>>>>>>>>>>>>    if num_arguments gt 0 move lsHeader to lsTmp
51962>>>>>>>>>>>>>>>>>>>    else move "" to lsTmp
51964>>>>>>>>>>>>>>>>>>>    send add_column to (oGridPrepare(self)) lsTmp AFT_ASCII3 -1
51965>>>>>>>>>>>>>>>>>>>  end_procedure
51966>>>>>>>>>>>>>>>>>>>  procedure GridPrepare_AddColumn global string lsLabel integer liAbstract
51968>>>>>>>>>>>>>>>>>>>    send add_column to (oGridPrepare(self)) lsLabel liAbstract -1
51969>>>>>>>>>>>>>>>>>>>  end_procedure
51970>>>>>>>>>>>>>>>>>>>  procedure GridPrepare_AddColumnFileField global string lsLabel integer liFile integer liField
51972>>>>>>>>>>>>>>>>>>>    send add_column to (oGridPrepare(self)) lsLabel liFile liField
51973>>>>>>>>>>>>>>>>>>>  end_procedure
51974>>>>>>>>>>>>>>>>>>>  procedure GridPrepare_Apply global integer lhObj integer lbDoColor
51976>>>>>>>>>>>>>>>>>>>    integer liTemp
51976>>>>>>>>>>>>>>>>>>>    if num_arguments gt 1 move lbDoColor to liTemp
51979>>>>>>>>>>>>>>>>>>>    else move 1 to liTemp
51981>>>>>>>>>>>>>>>>>>>    send apply_settings to (oGridPrepare(self)) lhObj liTemp
51982>>>>>>>>>>>>>>>>>>>    send GridPrepare_Reset
51983>>>>>>>>>>>>>>>>>>>  end_procedure
51984>>>>>>>>>>>>>>>>>>>end_desktop_section
51989>>>>>>>>>>>>>>>>>>>
51989>>>>>>>>>>>>>>>>>>>desktop_section
51994>>>>>>>>>>>>>>>>>>>  // Here is a temporary array used for storing different values while
51994>>>>>>>>>>>>>>>>>>>  // a grid is being sorted.
51994>>>>>>>>>>>>>>>>>>>  object oSortGrid_Data is a cArray NO_IMAGE
51996>>>>>>>>>>>>>>>>>>>    property integer piCurrentGridID public 0 // Not used
51998>>>>>>>>>>>>>>>>>>>    property integer piCurrentRow    public 0
52000>>>>>>>>>>>>>>>>>>>    property integer piCurrentColumn public 0
52002>>>>>>>>>>>>>>>>>>>    object oSortedData is a cArray NO_IMAGE
52004>>>>>>>>>>>>>>>>>>>    end_object
52005>>>>>>>>>>>>>>>>>>>    object oAuxValues is a cArray NO_IMAGE
52007>>>>>>>>>>>>>>>>>>>    end_object
52008>>>>>>>>>>>>>>>>>>>    object oEntryStates is a cArray NO_IMAGE
52010>>>>>>>>>>>>>>>>>>>    end_object
52011>>>>>>>>>>>>>>>>>>>    object oSelectStates is a cArray NO_IMAGE
52013>>>>>>>>>>>>>>>>>>>    end_object
52014>>>>>>>>>>>>>>>>>>>    object oItemColors is a cArray NO_IMAGE
52016>>>>>>>>>>>>>>>>>>>    end_object
52017>>>>>>>>>>>>>>>>>>>    object oCheckboxItemStates is a cArray NO_IMAGE
52019>>>>>>>>>>>>>>>>>>>    end_object
52020>>>>>>>>>>>>>>>>>>>    // Get data out of the grid to this structure
52020>>>>>>>>>>>>>>>>>>>    procedure reset
52023>>>>>>>>>>>>>>>>>>>      send delete_data
52024>>>>>>>>>>>>>>>>>>>      send delete_data to (oAuxValues(self))
52025>>>>>>>>>>>>>>>>>>>      send delete_data to (oSortedData(self))
52026>>>>>>>>>>>>>>>>>>>      send delete_data to (oEntryStates(self))
52027>>>>>>>>>>>>>>>>>>>      send delete_data to (oSelectStates(self))
52028>>>>>>>>>>>>>>>>>>>      send delete_data to (oCheckboxItemStates(self))
52029>>>>>>>>>>>>>>>>>>>    //send delete_data to (oMessages(self))
52029>>>>>>>>>>>>>>>>>>>      send delete_data to (oItemColors(self))
52030>>>>>>>>>>>>>>>>>>>      set piCurrentGridID to 0
52031>>>>>>>>>>>>>>>>>>>      set piCurrentRow to 0
52032>>>>>>>>>>>>>>>>>>>      set piCurrentColumn to 0
52033>>>>>>>>>>>>>>>>>>>    end_procedure
52034>>>>>>>>>>>>>>>>>>>    // Get data from grid
52034>>>>>>>>>>>>>>>>>>>    procedure load_grid_data integer lhGrid
52037>>>>>>>>>>>>>>>>>>>      integer liMax liItem lhAuxValues lhEntryStates liCurrentItem liColumns
52037>>>>>>>>>>>>>>>>>>>      integer lhSelectStates lhCheckboxItemStates lhItemColors
52037>>>>>>>>>>>>>>>>>>>      move (oAuxValues(self)) to lhAuxValues
52038>>>>>>>>>>>>>>>>>>>      move (oEntryStates(self)) to lhEntryStates
52039>>>>>>>>>>>>>>>>>>>      move (oSelectStates(self)) to lhSelectStates
52040>>>>>>>>>>>>>>>>>>>      move (oCheckboxItemStates(self)) to lhCheckboxItemStates
52041>>>>>>>>>>>>>>>>>>>      move (oItemColors(self)) to lhItemColors
52042>>>>>>>>>>>>>>>>>>>      send delete_data
52043>>>>>>>>>>>>>>>>>>>      send delete_data to lhAuxValues
52044>>>>>>>>>>>>>>>>>>>      send delete_data to lhEntryStates
52045>>>>>>>>>>>>>>>>>>>      send delete_data to lhSelectStates
52046>>>>>>>>>>>>>>>>>>>      send delete_data to lhCheckboxItemStates
52047>>>>>>>>>>>>>>>>>>>      send delete_data to lhItemColors
52048>>>>>>>>>>>>>>>>>>>      set piCurrentGridID to lhGrid
52049>>>>>>>>>>>>>>>>>>>      get item_count of lhGrid to liMax
52050>>>>>>>>>>>>>>>>>>>      for liItem from 0 to (liMax-1)
52056>>>>>>>>>>>>>>>>>>>>
52056>>>>>>>>>>>>>>>>>>>        set value item liItem to (value(lhGrid,liItem))
52057>>>>>>>>>>>>>>>>>>>        set value of lhAuxValues item liItem to (aux_value(lhGrid,liItem))
52058>>>>>>>>>>>>>>>>>>>        set value of lhEntryStates item liItem to (entry_state(lhGrid,liItem))
52059>>>>>>>>>>>>>>>>>>>        set value of lhSelectStates item liItem to (select_state(lhGrid,liItem))
52060>>>>>>>>>>>>>>>>>>>        set value of lhCheckboxItemStates item liItem to (checkbox_item_state(lhGrid,liItem))
52061>>>>>>>>>>>>>>>>>>>        set value of lhItemColors item liItem to (ItemColor(lhGrid,liItem))
52062>>>>>>>>>>>>>>>>>>>      loop
52063>>>>>>>>>>>>>>>>>>>>
52063>>>>>>>>>>>>>>>>>>>      get current_item of lhGrid to liCurrentItem
52064>>>>>>>>>>>>>>>>>>>      get Grid_Columns lhGrid to liColumns
52065>>>>>>>>>>>>>>>>>>>      set piCurrentRow    to (liCurrentItem/liColumns)
52066>>>>>>>>>>>>>>>>>>>      set piCurrentColumn to (liCurrentItem-(liColumns*piCurrentRow(self)))
52067>>>>>>>>>>>>>>>>>>>    end_procedure
52068>>>>>>>>>>>>>>>>>>>
52068>>>>>>>>>>>>>>>>>>>    register_function iSpecialSortValueOnColumn.i integer liColumn returns integer
52068>>>>>>>>>>>>>>>>>>>    register_function sSortValue.ii integer liColumn integer liItem returns string
52068>>>>>>>>>>>>>>>>>>>    procedure sort_data integer lhGrid integer liColumn integer liDir
52071>>>>>>>>>>>>>>>>>>>      integer lhSortArr liRow liMax liColumns liItem liState lbCustom
52071>>>>>>>>>>>>>>>>>>>      string lsValue
52071>>>>>>>>>>>>>>>>>>>      move (oSortedData(self)) to lhSortArr
52072>>>>>>>>>>>>>>>>>>>      send delete_data to lhSortArr
52073>>>>>>>>>>>>>>>>>>>      get Grid_Columns lhGrid to liColumns
52074>>>>>>>>>>>>>>>>>>>      get item_count of lhGrid to liMax
52075>>>>>>>>>>>>>>>>>>>      get delegation_mode of lhGrid to liState
52076>>>>>>>>>>>>>>>>>>>      set delegation_mode of lhGrid to NO_DELEGATE_OR_ERROR
52077>>>>>>>>>>>>>>>>>>>      get iSpecialSortValueOnColumn.i of lhGrid liColumn to lbCustom
52078>>>>>>>>>>>>>>>>>>>      set delegation_mode of lhGrid to liState
52079>>>>>>>>>>>>>>>>>>>      move (liMax/liColumns) to liMax // Number of rows
52080>>>>>>>>>>>>>>>>>>>      for liRow from 0 to (liMax-1)
52086>>>>>>>>>>>>>>>>>>>>
52086>>>>>>>>>>>>>>>>>>>        move (liRow*liColumns+liColumn) to liItem
52087>>>>>>>>>>>>>>>>>>>        if lbCustom get sSortValue.ii of lhGrid liColumn liItem to lsValue
52090>>>>>>>>>>>>>>>>>>>        else get value of lhGrid item liItem to lsValue
52092>>>>>>>>>>>>>>>>>>>        move (lsValue+IntToStrR(liRow,6)) to lsValue
52093>>>>>>>>>>>>>>>>>>>        set value of lhSortArr item liRow to lsValue
52094>>>>>>>>>>>>>>>>>>>      loop
52095>>>>>>>>>>>>>>>>>>>>
52095>>>>>>>>>>>>>>>>>>>      send sort_items to lhSortArr liDir //ASCENDING
52096>>>>>>>>>>>>>>>>>>>    end_procedure
52097>>>>>>>>>>>>>>>>>>>    procedure fill_grid integer lhGrid
52100>>>>>>>>>>>>>>>>>>>      integer lhSortArr liRow liMax liItem liColumns liItmMin liItmMax liCurrentRow
52100>>>>>>>>>>>>>>>>>>>      integer grid_liRow
52100>>>>>>>>>>>>>>>>>>>      integer lhEntryStates lhAuxValues grid_liItem
52100>>>>>>>>>>>>>>>>>>>      integer lhSelectStates lhCheckboxItemStates lhItemColors
52100>>>>>>>>>>>>>>>>>>>      move (oSortedData(self)) to lhSortArr
52101>>>>>>>>>>>>>>>>>>>      move (oAuxValues(self)) to lhAuxValues
52102>>>>>>>>>>>>>>>>>>>      move (oEntryStates(self)) to lhEntryStates
52103>>>>>>>>>>>>>>>>>>>      move (oSelectStates(self)) to lhSelectStates
52104>>>>>>>>>>>>>>>>>>>      move (oCheckboxItemStates(self)) to lhCheckboxItemStates
52105>>>>>>>>>>>>>>>>>>>      move (oItemColors(self)) to lhItemColors
52106>>>>>>>>>>>>>>>>>>>      send delete_data to lhGrid
52107>>>>>>>>>>>>>>>>>>>      get Grid_Columns lhGrid to liColumns
52108>>>>>>>>>>>>>>>>>>>      get item_count of lhSortArr to liMax
52109>>>>>>>>>>>>>>>>>>>      get piCurrentRow to liCurrentRow
52110>>>>>>>>>>>>>>>>>>>      move 0 to grid_liItem
52111>>>>>>>>>>>>>>>>>>>      for liRow from 0 to (liMax-1)
52117>>>>>>>>>>>>>>>>>>>>
52117>>>>>>>>>>>>>>>>>>>        move (right(value(lhSortArr,liRow),6)) to grid_liRow
52118>>>>>>>>>>>>>>>>>>>        if grid_liRow eq liCurrentRow set piCurrentRow to liRow
52121>>>>>>>>>>>>>>>>>>>        move (grid_liRow*liColumns) to liItmMin
52122>>>>>>>>>>>>>>>>>>>        move (liItmMin+liColumns-1) to liItmMax
52123>>>>>>>>>>>>>>>>>>>        for liItem from liItmMin to liItmMax
52129>>>>>>>>>>>>>>>>>>>>
52129>>>>>>>>>>>>>>>>>>>          send add_item to lhGrid msg_none (value(self,liItem))
52130>>>>>>>>>>>>>>>>>>>          set checkbox_item_state of lhGrid item grid_liItem to (value(lhCheckboxItemStates,liItem))
52131>>>>>>>>>>>>>>>>>>>          set select_state        of lhGrid item grid_liItem to (value(lhSelectStates,liItem))
52132>>>>>>>>>>>>>>>>>>>          set aux_value           of lhGrid item grid_liItem to (value(lhAuxValues,liItem))
52133>>>>>>>>>>>>>>>>>>>          set entry_state         of lhGrid item grid_liItem to (value(lhEntryStates,liItem))
52134>>>>>>>>>>>>>>>>>>>          set itemcolor          of lhGrid item grid_liItem to (value(lhItemColors,liItem))
52135>>>>>>>>>>>>>>>>>>>          increment grid_liItem
52136>>>>>>>>>>>>>>>>>>>        loop
52137>>>>>>>>>>>>>>>>>>>>
52137>>>>>>>>>>>>>>>>>>>      loop
52138>>>>>>>>>>>>>>>>>>>>
52138>>>>>>>>>>>>>>>>>>>    end_procedure
52139>>>>>>>>>>>>>>>>>>>    procedure Sort_Grid integer lhGrid integer liColumn integer liDir
52142>>>>>>>>>>>>>>>>>>>      integer liCurrentRow liCurrentColumn liColumns
52142>>>>>>>>>>>>>>>>>>>      send cursor_wait to (cursor_control(self))
52143>>>>>>>>>>>>>>>>>>>      set dynamic_update_state of lhGrid to DFFALSE
52144>>>>>>>>>>>>>>>>>>>      send reset
52145>>>>>>>>>>>>>>>>>>>      send load_grid_data lhGrid
52146>>>>>>>>>>>>>>>>>>>      send sort_data lhGrid liColumn liDir
52147>>>>>>>>>>>>>>>>>>>      send fill_grid lhGrid
52148>>>>>>>>>>>>>>>>>>>      set dynamic_update_state of lhGrid to DFTRUE
52149>>>>>>>>>>>>>>>>>>>      get piCurrentRow to liCurrentRow
52150>>>>>>>>>>>>>>>>>>>      get piCurrentColumn to liCurrentColumn
52151>>>>>>>>>>>>>>>>>>>      get Grid_Columns lhGrid to liColumns
52152>>>>>>>>>>>>>>>>>>>      set current_item of lhGrid to (liColumns*liCurrentRow+liCurrentColumn)
52153>>>>>>>>>>>>>>>>>>>      send reset // Clean it up
52154>>>>>>>>>>>>>>>>>>>      send cursor_ready to (cursor_control(self))
52155>>>>>>>>>>>>>>>>>>>    end_procedure
52156>>>>>>>>>>>>>>>>>>>  end_object // oSortGrid_Data
52157>>>>>>>>>>>>>>>>>>>end_desktop_section
52162>>>>>>>>>>>>>>>>>>>
52162>>>>>>>>>>>>>>>>>>>//> Sort grid ascending by column liColumn. Note that unless special
52162>>>>>>>>>>>>>>>>>>>//> sort value functions are set up all columns are sorted by their
52162>>>>>>>>>>>>>>>>>>>//> ASCII value (not what the user expects if the column contains numeric
52162>>>>>>>>>>>>>>>>>>>//> or date data).
52162>>>>>>>>>>>>>>>>>>>procedure Grid_SortByColumn global integer lhGrid integer liColumn
52164>>>>>>>>>>>>>>>>>>>  send Sort_Grid to (oSortGrid_Data(self)) lhGrid liColumn ASCENDING
52165>>>>>>>>>>>>>>>>>>>end_procedure
52166>>>>>>>>>>>>>>>>>>>
52166>>>>>>>>>>>>>>>>>>>//> Sort grid descending by column liColumn. Note that unless special
52166>>>>>>>>>>>>>>>>>>>//> sort value functions are set up all columns are sorted by their
52166>>>>>>>>>>>>>>>>>>>//> ASCII value (not what the user expects if the column contains numeric
52166>>>>>>>>>>>>>>>>>>>//> or date data).
52166>>>>>>>>>>>>>>>>>>>procedure Grid_SortByColumn_Descending global integer lhGrid integer liColumn
52168>>>>>>>>>>>>>>>>>>>  send Sort_Grid to (oSortGrid_Data(self)) lhGrid liColumn DESCENDING
52169>>>>>>>>>>>>>>>>>>>end_procedure
52170>>>>>>>>>>>>>>>>>>>
52170>>>>>>>>>>>>>>>>>>>procedure Grid_AddCheckBoxItem global integer lhGrid integer liState
52172>>>>>>>>>>>>>>>>>>>  integer liItm
52172>>>>>>>>>>>>>>>>>>>  get item_count of lhGrid to liItm
52173>>>>>>>>>>>>>>>>>>>  send add_item to lhGrid msg_none ""
52174>>>>>>>>>>>>>>>>>>>  set checkbox_item_state of lhGrid item liItm to DFTRUE
52175>>>>>>>>>>>>>>>>>>>  set select_state of lhGrid item liItm to liState
52176>>>>>>>>>>>>>>>>>>>end_procedure
52177>>>>>>>>>>>>>>>>>>>procedure Grid_RowMakeSelectable global integer lhGrid
52179>>>>>>>>>>>>>>>>>>>end_procedure
52180>>>>>>>>>>>>>>>>>>>procedure Grid_RowSelectAll global integer lhGrid
52182>>>>>>>>>>>>>>>>>>>  integer liRow liMax liBase
52182>>>>>>>>>>>>>>>>>>>  get Grid_RowCount lhGrid to liMax
52183>>>>>>>>>>>>>>>>>>>  decrement liMax
52184>>>>>>>>>>>>>>>>>>>  for liRow from 0 to liMax
52190>>>>>>>>>>>>>>>>>>>>
52190>>>>>>>>>>>>>>>>>>>    get Grid_RowBaseItem lhGrid liRow to liBase
52191>>>>>>>>>>>>>>>>>>>    ifnot (item_shadow_state(lhGrid,liBase)) set select_state of lhGrid item liBase to DFTRUE
52194>>>>>>>>>>>>>>>>>>>  loop
52195>>>>>>>>>>>>>>>>>>>>
52195>>>>>>>>>>>>>>>>>>>end_procedure
52196>>>>>>>>>>>>>>>>>>>procedure Grid_RowDeselectAll global integer lhGrid
52198>>>>>>>>>>>>>>>>>>>  integer liRow liMax liBase
52198>>>>>>>>>>>>>>>>>>>  get Grid_RowCount lhGrid to liMax
52199>>>>>>>>>>>>>>>>>>>  decrement liMax
52200>>>>>>>>>>>>>>>>>>>  for liRow from 0 to liMax
52206>>>>>>>>>>>>>>>>>>>>
52206>>>>>>>>>>>>>>>>>>>    get Grid_RowBaseItem lhGrid liRow to liBase
52207>>>>>>>>>>>>>>>>>>>    ifnot (item_shadow_state(lhGrid,liBase)) set select_state of lhGrid item liBase to DFFALSE
52210>>>>>>>>>>>>>>>>>>>  loop
52211>>>>>>>>>>>>>>>>>>>>
52211>>>>>>>>>>>>>>>>>>>end_procedure
52212>>>>>>>>>>>>>>>>>>>procedure Grid_RowSelectInvert global integer lhGrid
52214>>>>>>>>>>>>>>>>>>>  integer liRow liMax liSelect liBase
52214>>>>>>>>>>>>>>>>>>>  get Grid_RowCount lhGrid to liMax
52215>>>>>>>>>>>>>>>>>>>  decrement liMax
52216>>>>>>>>>>>>>>>>>>>  for liRow from 0 to liMax
52222>>>>>>>>>>>>>>>>>>>>
52222>>>>>>>>>>>>>>>>>>>    get Grid_RowBaseItem lhGrid liRow to liBase
52223>>>>>>>>>>>>>>>>>>>    get select_state of lhGrid item liBase to liSelect
52224>>>>>>>>>>>>>>>>>>>    ifnot (item_shadow_state(lhGrid,liBase)) set select_state of lhGrid item liBase to (not(liSelect))
52227>>>>>>>>>>>>>>>>>>>  loop
52228>>>>>>>>>>>>>>>>>>>>
52228>>>>>>>>>>>>>>>>>>>end_procedure
52229>>>>>>>>>>>>>>>>>>>procedure Grid_RowSelectCostum global integer lhGrid integer liGet
52231>>>>>>>>>>>>>>>>>>>  integer liRow liMax liSelect liBase
52231>>>>>>>>>>>>>>>>>>>  get Grid_RowCount lhGrid to liMax
52232>>>>>>>>>>>>>>>>>>>  decrement liMax
52233>>>>>>>>>>>>>>>>>>>  for liRow from 0 to liMax
52239>>>>>>>>>>>>>>>>>>>>
52239>>>>>>>>>>>>>>>>>>>    move (Grid_RowBaseItem(lhGrid,liRow)) to liBase
52240>>>>>>>>>>>>>>>>>>>    get liGet of lhGrid liRow liBase to liSelect
52241>>>>>>>>>>>>>>>>>>>    set select_state of lhGrid item liBase to liSelect
52242>>>>>>>>>>>>>>>>>>>  loop
52243>>>>>>>>>>>>>>>>>>>>
52243>>>>>>>>>>>>>>>>>>>end_procedure
52244>>>>>>>>>>>>>>>>>>>procedure Grid_RowCallBackSelected global integer lhGrid integer liMsg integer lhObj
52246>>>>>>>>>>>>>>>>>>>  integer liRow liMax liBase liSelect lhTmpObj
52246>>>>>>>>>>>>>>>>>>>  if (num_arguments>2) move lhObj to lhTmpObj
52249>>>>>>>>>>>>>>>>>>>  else move lhGrid to lhTmpObj
52251>>>>>>>>>>>>>>>>>>>  get Grid_RowCount lhGrid to liMax
52252>>>>>>>>>>>>>>>>>>>  decrement liMax
52253>>>>>>>>>>>>>>>>>>>  for liRow from 0 to liMax
52259>>>>>>>>>>>>>>>>>>>>
52259>>>>>>>>>>>>>>>>>>>    move (Grid_RowBaseItem(lhGrid,liRow)) to liBase
52260>>>>>>>>>>>>>>>>>>>    get select_state of lhGrid item liBase to liSelect
52261>>>>>>>>>>>>>>>>>>>    if liSelect send liMsg to lhTmpObj liRow liBase
52264>>>>>>>>>>>>>>>>>>>  loop
52265>>>>>>>>>>>>>>>>>>>>
52265>>>>>>>>>>>>>>>>>>>end_procedure
52266>>>>>>>>>>>>>>>>>>>
52266>>>>>>>>>>>>>>>>>>>procedure Grid_RowCallBackAll global integer lhGrid integer liMsg integer lhObj
52268>>>>>>>>>>>>>>>>>>>  integer liRow liMax liBase lhTmpObj
52268>>>>>>>>>>>>>>>>>>>  if (num_arguments>2) move lhObj to lhTmpObj
52271>>>>>>>>>>>>>>>>>>>  else move lhGrid to lhTmpObj
52273>>>>>>>>>>>>>>>>>>>  get Grid_RowCount lhGrid to liMax
52274>>>>>>>>>>>>>>>>>>>  decrement liMax
52275>>>>>>>>>>>>>>>>>>>  for liRow from 0 to liMax
52281>>>>>>>>>>>>>>>>>>>>
52281>>>>>>>>>>>>>>>>>>>    move (Grid_RowBaseItem(lhGrid,liRow)) to liBase
52282>>>>>>>>>>>>>>>>>>>    send liMsg to lhTmpObj liRow liBase
52283>>>>>>>>>>>>>>>>>>>  loop
52284>>>>>>>>>>>>>>>>>>>>
52284>>>>>>>>>>>>>>>>>>>end_procedure
52285>>>>>>>>>>>>>>>>>>>
52285>>>>>>>>>>>>>>>>>>>//> Returns number of selected rows
52285>>>>>>>>>>>>>>>>>>>function Grid_SelectedRows global integer lhGrid returns integer
52287>>>>>>>>>>>>>>>>>>>  integer liRow liMax liBase liSelect liRval
52287>>>>>>>>>>>>>>>>>>>  move 0 to liRval
52288>>>>>>>>>>>>>>>>>>>  get Grid_RowCount lhGrid to liMax
52289>>>>>>>>>>>>>>>>>>>  decrement liMax
52290>>>>>>>>>>>>>>>>>>>  for liRow from 0 to liMax
52296>>>>>>>>>>>>>>>>>>>>
52296>>>>>>>>>>>>>>>>>>>    move (Grid_RowBaseItem(lhGrid,liRow)) to liBase
52297>>>>>>>>>>>>>>>>>>>    get select_state of lhGrid item liBase to liSelect
52298>>>>>>>>>>>>>>>>>>>    if liSelect increment liRval
52301>>>>>>>>>>>>>>>>>>>  loop
52302>>>>>>>>>>>>>>>>>>>>
52302>>>>>>>>>>>>>>>>>>>  function_return liRval
52303>>>>>>>>>>>>>>>>>>>end_function
52304>>>>>>>>>>>>>>>>>>>
52304>>>>>>>>>>>>>>>>>>>procedure Set Grid_CurrentRow global integer lhGrid integer liRow
52306>>>>>>>>>>>>>>>>>>>  integer liBase
52306>>>>>>>>>>>>>>>>>>>  get Grid_RowBaseItem lhGrid liRow to liBase
52307>>>>>>>>>>>>>>>>>>>  set current_item to liBase
52308>>>>>>>>>>>>>>>>>>>end_procedure
52309>>>>>>>>>>>>>>>>>>>
52309>>>>>>>>>>>>>>>>>>>enumeration_list
52309>>>>>>>>>>>>>>>>>>>  define GD_FORMAT
52309>>>>>>>>>>>>>>>>>>>  define GD_COMMA
52309>>>>>>>>>>>>>>>>>>>  define GD_TAB
52309>>>>>>>>>>>>>>>>>>>end_enumeration_list
52309>>>>>>>>>>>>>>>>>>>
52309>>>>>>>>>>>>>>>>>>>desktop_section
52314>>>>>>>>>>>>>>>>>>>  object Grid_WriteToFileColumnWidthArray is a cArray
52316>>>>>>>>>>>>>>>>>>>    property integer phCurrentGrid public ""
52318>>>>>>>>>>>>>>>>>>>    item_property_list
52318>>>>>>>>>>>>>>>>>>>      item_property integer piWidth.i
52318>>>>>>>>>>>>>>>>>>>      item_property integer piRightAlign.i
52318>>>>>>>>>>>>>>>>>>>    end_item_property_list
#REM 52355 DEFINE FUNCTION PIRIGHTALIGN.I INTEGER LIROW RETURNS INTEGER
#REM 52360 DEFINE PROCEDURE SET PIRIGHTALIGN.I INTEGER LIROW INTEGER VALUE
#REM 52365 DEFINE FUNCTION PIWIDTH.I INTEGER LIROW RETURNS INTEGER
#REM 52370 DEFINE PROCEDURE SET PIWIDTH.I INTEGER LIROW INTEGER VALUE
52376>>>>>>>>>>>>>>>>>>>    procedure DoReadGrid integer lhGrid
52379>>>>>>>>>>>>>>>>>>>      integer liRows liColumns liRow liColumn liWidth liDecSep
52379>>>>>>>>>>>>>>>>>>>      string lsValue
52379>>>>>>>>>>>>>>>>>>>      get_attribute DF_DECIMAL_SEPARATOR to liDecSep
52382>>>>>>>>>>>>>>>>>>>      send delete_data
52383>>>>>>>>>>>>>>>>>>>      get Grid_Columns lhGrid to liColumns
52384>>>>>>>>>>>>>>>>>>>      get Grid_RowCount lhGrid to liRows
52385>>>>>>>>>>>>>>>>>>>      for liColumn from 0 to (liColumns-1)
52391>>>>>>>>>>>>>>>>>>>>
52391>>>>>>>>>>>>>>>>>>>        set piRightAlign.i liColumn to DFTRUE
52392>>>>>>>>>>>>>>>>>>>      loop
52393>>>>>>>>>>>>>>>>>>>>
52393>>>>>>>>>>>>>>>>>>>      for liRow from 0 to (liRows-1)
52399>>>>>>>>>>>>>>>>>>>>
52399>>>>>>>>>>>>>>>>>>>        for liColumn from 0 to (liColumns-1)
52405>>>>>>>>>>>>>>>>>>>>
52405>>>>>>>>>>>>>>>>>>>          if (checkbox_item_state(lhGrid,liRow*liColumns+liColumn)) move "XXX" to lsValue
52408>>>>>>>>>>>>>>>>>>>          else get value of lhGrid item (liRow*liColumns+liColumn) to lsValue
52410>>>>>>>>>>>>>>>>>>>          move (rtrim(lsValue)) to lsValue
52411>>>>>>>>>>>>>>>>>>>          move (length(lsValue)) to liWidth
52412>>>>>>>>>>>>>>>>>>>          if (liWidth>integer(piWidth.i(self,liColumn))) set piWidth.i liColumn to liWidth
52415>>>>>>>>>>>>>>>>>>>          ifnot (StringIsNumber(lsValue,liDecSep)) set piRightAlign.i liColumn to DFFALSE
52418>>>>>>>>>>>>>>>>>>>        loop
52419>>>>>>>>>>>>>>>>>>>>
52419>>>>>>>>>>>>>>>>>>>      loop
52420>>>>>>>>>>>>>>>>>>>>
52420>>>>>>>>>>>>>>>>>>>      set phCurrentGrid to liWidth
52421>>>>>>>>>>>>>>>>>>>    end_procedure
52422>>>>>>>>>>>>>>>>>>>  end_object
52423>>>>>>>>>>>>>>>>>>>end_desktop_section
52428>>>>>>>>>>>>>>>>>>>
52428>>>>>>>>>>>>>>>>>>>function Grid_DataWidth global integer lhGrid integer liColumn returns integer
52430>>>>>>>>>>>>>>>>>>>  function_return (piWidth.i(Grid_WriteToFileColumnWidthArray(self),liColumn))
52431>>>>>>>>>>>>>>>>>>>end_function
52432>>>>>>>>>>>>>>>>>>>
52432>>>>>>>>>>>>>>>>>>>procedure Grid_DoReadDataWidth global integer lhGrid
52434>>>>>>>>>>>>>>>>>>>  send DoReadGrid to (Grid_WriteToFileColumnWidthArray(self)) lhGrid
52435>>>>>>>>>>>>>>>>>>>end_procedure
52436>>>>>>>>>>>>>>>>>>>
52436>>>>>>>>>>>>>>>>>>>function Grid_WriteToFile_Help global integer liFormat string lsValue integer liWidth integer liRightAlign returns string
52438>>>>>>>>>>>>>>>>>>>  if (liFormat=GD_FORMAT) begin
52440>>>>>>>>>>>>>>>>>>>    if (length(lsValue)>liWidth) move (left(lsValue,liWidth)) to lsValue
52443>>>>>>>>>>>>>>>>>>>    if liRightAlign move (RightShift(lsValue,liWidth)) to lsValue
52446>>>>>>>>>>>>>>>>>>>    else move (pad(lsValue,liWidth)) to lsValue
52448>>>>>>>>>>>>>>>>>>>  end
52448>>>>>>>>>>>>>>>>>>>>
52448>>>>>>>>>>>>>>>>>>>  if (liFormat=GD_COMMA) begin
52450>>>>>>>>>>>>>>>>>>>    if "," in lsValue begin
52452>>>>>>>>>>>>>>>>>>>      move (replaces('"',lsValue,"'")) to lsValue
52453>>>>>>>>>>>>>>>>>>>      move ('"'+lsValue+'"') to lsValue
52454>>>>>>>>>>>>>>>>>>>    end
52454>>>>>>>>>>>>>>>>>>>>
52454>>>>>>>>>>>>>>>>>>>  end
52454>>>>>>>>>>>>>>>>>>>>
52454>>>>>>>>>>>>>>>>>>>  function_return lsValue
52455>>>>>>>>>>>>>>>>>>>end_function
52456>>>>>>>>>>>>>>>>>>>
52456>>>>>>>>>>>>>>>>>>>// This procedure will write the entire contents of the Grid passed as
52456>>>>>>>>>>>>>>>>>>>// object handle object to a
52456>>>>>>>>>>>>>>>>>>>// sequential
52456>>>>>>>>>>>>>>>>>>>procedure Grid_WriteToFile global integer lhGrid integer liChannel integer liFormat
52458>>>>>>>>>>>>>>>>>>>  integer liRows liColumns liRow liColumn liWidth liRightAlign
52458>>>>>>>>>>>>>>>>>>>  string lsValue
52458>>>>>>>>>>>>>>>>>>>  get Grid_Columns lhGrid to liColumns
52459>>>>>>>>>>>>>>>>>>>  get Grid_RowCount lhGrid to liRows
52460>>>>>>>>>>>>>>>>>>>  send Grid_DoReadDataWidth lhGrid
52461>>>>>>>>>>>>>>>>>>>  for liColumn from 0 to (liColumns-1)
52467>>>>>>>>>>>>>>>>>>>>
52467>>>>>>>>>>>>>>>>>>>    get header_label of lhGrid liColumn to lsValue
52468>>>>>>>>>>>>>>>>>>>    get Grid_DataWidth lhGrid liColumn to liWidth
52469>>>>>>>>>>>>>>>>>>>    get piRightAlign.i of (Grid_WriteToFileColumnWidthArray(self)) liColumn to liRightAlign
52470>>>>>>>>>>>>>>>>>>>    get Grid_WriteToFile_Help liFormat lsValue liWidth liRightAlign to lsValue
52471>>>>>>>>>>>>>>>>>>>    write channel liChannel (ToAnsi(lsValue))
52473>>>>>>>>>>>>>>>>>>>    if liColumn ne (liColumns-1) begin
52475>>>>>>>>>>>>>>>>>>>      if (liFormat=GD_FORMAT) write " "
52478>>>>>>>>>>>>>>>>>>>      if (liFormat=GD_COMMA ) write ","
52481>>>>>>>>>>>>>>>>>>>      if (liFormat=GD_TAB   ) write (character(8))
52484>>>>>>>>>>>>>>>>>>>    end
52484>>>>>>>>>>>>>>>>>>>>
52484>>>>>>>>>>>>>>>>>>>  loop
52485>>>>>>>>>>>>>>>>>>>>
52485>>>>>>>>>>>>>>>>>>>  writeln channel liChannel ""
52488>>>>>>>>>>>>>>>>>>>  for liRow from 0 to (liRows-1)
52494>>>>>>>>>>>>>>>>>>>>
52494>>>>>>>>>>>>>>>>>>>    for liColumn from 0 to (liColumns-1)
52500>>>>>>>>>>>>>>>>>>>>
52500>>>>>>>>>>>>>>>>>>>      if (checkbox_item_state(lhGrid,liRow*liColumns+liColumn)) get select_state of lhGrid item (liRow*liColumns+liColumn) to lsValue
52503>>>>>>>>>>>>>>>>>>>      else get value of lhGrid item (liRow*liColumns+liColumn) to lsValue
52505>>>>>>>>>>>>>>>>>>>      get Grid_DataWidth lhGrid liColumn to liWidth
52506>>>>>>>>>>>>>>>>>>>      get piRightAlign.i of (Grid_WriteToFileColumnWidthArray(self)) liColumn to liRightAlign
52507>>>>>>>>>>>>>>>>>>>      get Grid_WriteToFile_Help liFormat lsValue liWidth liRightAlign to lsValue
52508>>>>>>>>>>>>>>>>>>>      write channel liChannel (ToAnsi(lsValue))
52510>>>>>>>>>>>>>>>>>>>      if liColumn ne (liColumns-1) begin
52512>>>>>>>>>>>>>>>>>>>        if (liFormat=GD_FORMAT) write " "
52515>>>>>>>>>>>>>>>>>>>        if (liFormat=GD_COMMA ) write ","
52518>>>>>>>>>>>>>>>>>>>        if (liFormat=GD_TAB   ) write (character(8))
52521>>>>>>>>>>>>>>>>>>>      end
52521>>>>>>>>>>>>>>>>>>>>
52521>>>>>>>>>>>>>>>>>>>    loop
52522>>>>>>>>>>>>>>>>>>>>
52522>>>>>>>>>>>>>>>>>>>    writeln channel liChannel ""
52525>>>>>>>>>>>>>>>>>>>  loop
52526>>>>>>>>>>>>>>>>>>>>
52526>>>>>>>>>>>>>>>>>>>end_procedure
52527>>>>>>>>>>>>>>>>>>>
52527>>>>>>>>>>>>>>>>>>>// The Grid_StateValue was developed in order to be able to check if a Grid (not a dbGrid) had
52527>>>>>>>>>>>>>>>>>>>// been changed by the user (by comparing the Grid
52527>>>>>>>>>>>>>>>>>>>function Grid_StateValue global integer lhGrid returns string
52529>>>>>>>>>>>>>>>>>>>  integer liColumns liRows liColumn liRow
52529>>>>>>>>>>>>>>>>>>>  string lsState lsValue
52529>>>>>>>>>>>>>>>>>>>  get Grid_Columns lhGrid to liColumns
52530>>>>>>>>>>>>>>>>>>>  get Grid_RowCount lhGrid to liRows
52531>>>>>>>>>>>>>>>>>>>  for liRow from 0 to (liRows-1)
52537>>>>>>>>>>>>>>>>>>>>
52537>>>>>>>>>>>>>>>>>>>    for liColumn from 0 to (liColumns-1)
52543>>>>>>>>>>>>>>>>>>>>
52543>>>>>>>>>>>>>>>>>>>
52543>>>>>>>>>>>>>>>>>>>      if (checkbox_item_state(lhGrid,liRow*liColumns+liColumn)) get select_state of lhGrid item (liRow*liColumns+liColumn) to lsValue
52546>>>>>>>>>>>>>>>>>>>      else get value of lhGrid item (liRow*liColumns+liColumn) to lsValue
52548>>>>>>>>>>>>>>>>>>>      move (lsState+"|"+lsValue) to lsValue
52549>>>>>>>>>>>>>>>>>>>    loop
52550>>>>>>>>>>>>>>>>>>>>
52550>>>>>>>>>>>>>>>>>>>  loop
52551>>>>>>>>>>>>>>>>>>>>
52551>>>>>>>>>>>>>>>>>>>  function_return lsState
52552>>>>>>>>>>>>>>>>>>>end_function
52553>>>>>>>>>>>>>>>>>>>
52553>>>>>>>>>>>>>>>>>>>// procedure row_change integer liRowFrom integer liRowTo
52553>>>>>>>>>>>>>>>>>>>// end_procedure
52553>>>>>>>>>>>>>>>>>>>// procedure item_change integer liItm1 integer liItm2 returns integer
52553>>>>>>>>>>>>>>>>>>>//   integer liRval liColumns
52553>>>>>>>>>>>>>>>>>>>//   get Grid_Columns self to liColumns
52553>>>>>>>>>>>>>>>>>>>//   forward get msg_item_change liItm1 liItm2 to liRval
52553>>>>>>>>>>>>>>>>>>>//   if (liItm1/liColumns) ne (liItm2/liColumns) send row_change (liItm1/liColumns) (liItm2/liColumns)
52553>>>>>>>>>>>>>>>>>>>//   procedure_return liRval
52553>>>>>>>>>>>>>>>>>>>// end_procedure
52553>>>>>>>>>>>>>>>>>>>
52553>>>>>>>>>>>>>>>>>>>// procedure select_toggling integer liItem integer lbState
52553>>>>>>>>>>>>>>>>>>>//   integer liCurrentItem liColumns
52553>>>>>>>>>>>>>>>>>>>//   get Grid_Columns self to liColumns
52553>>>>>>>>>>>>>>>>>>>//   get current_item to liCurrentItem
52553>>>>>>>>>>>>>>>>>>>//   move ((liCurrentItem/liColumns)*liColumns) to liCurrentItem // Redirect to first column
52553>>>>>>>>>>>>>>>>>>>//   forward send select_toggling liCurrentItem lbState
52553>>>>>>>>>>>>>>>>>>>// end_procedure
52553>>>>>>>>>>>>>>>>>>>
52553>>>>>>>>>>>>>>>>>>>procedure Grid_DoWriteToFile global integer lhGrid
52555>>>>>>>>>>>>>>>>>>>  integer liChannel
52555>>>>>>>>>>>>>>>>>>>  string lsTempFileName
52555>>>>>>>>>>>>>>>>>>>  get SEQ_FirstDirInDfPath to lsTempFileName
52556>>>>>>>>>>>>>>>>>>>  get SEQ_ComposeAbsoluteFileName lsTempFileName "temp.txt" to lsTempFileName
52557>>>>>>>>>>>>>>>>>>>
52557>>>>>>>>>>>>>>>>>>>  get SEQ_DirectOutput lsTempFileName to liChannel
52558>>>>>>>>>>>>>>>>>>>  if liChannel ge 0 begin
52560>>>>>>>>>>>>>>>>>>>    send Grid_WriteToFile lhGrid liChannel GD_FORMAT
52561>>>>>>>>>>>>>>>>>>>    send SEQ_CloseOutput liChannel
52562>>>>>>>>>>>>>>>>>>>    runprogram BACKGROUND ("notepad "+lsTempFileName)
52563>>>>>>>>>>>>>>>>>>>  end
52563>>>>>>>>>>>>>>>>>>>>
52563>>>>>>>>>>>>>>>>>>>end_procedure
52564>>>>>>>>>>>>>>>>>>>
52564>>>>>>>>>>>>>>>>>>>procedure Grid_SetRowColor global integer lhGrid integer liRow integer liColor
52566>>>>>>>>>>>>>>>>>>>  integer liBase liMax liItem
52566>>>>>>>>>>>>>>>>>>>  get Grid_RowBaseItem lhGrid liRow to liBase
52567>>>>>>>>>>>>>>>>>>>  get Grid_Columns lhGrid to liMax
52568>>>>>>>>>>>>>>>>>>>  for liItem from 0 to (liMax-1)
52574>>>>>>>>>>>>>>>>>>>>
52574>>>>>>>>>>>>>>>>>>>    set itemcolor of lhGrid item (liBase+liItem) to liColor
52575>>>>>>>>>>>>>>>>>>>  loop
52576>>>>>>>>>>>>>>>>>>>>
52576>>>>>>>>>>>>>>>>>>>end_procedure
52577>>>>>>>>>>>>>>>>>>>
52577>>>>>>>>>>>>>>>>>>>procedure Grid_AddRowToGrid global integer lhGrid integer liRow integer lhTargetGrid
52579>>>>>>>>>>>>>>>>>>>  integer liBase liMax liItem liTargetBase
52579>>>>>>>>>>>>>>>>>>>  string lsValue
52579>>>>>>>>>>>>>>>>>>>  get Grid_RowBaseItem lhGrid liRow to liBase
52580>>>>>>>>>>>>>>>>>>>  get Grid_Columns lhGrid to liMax
52581>>>>>>>>>>>>>>>>>>>  get item_count of lhTargetGrid to liTargetBase
52582>>>>>>>>>>>>>>>>>>>  for liItem from 0 to (liMax-1)
52588>>>>>>>>>>>>>>>>>>>>
52588>>>>>>>>>>>>>>>>>>>    get value of lhGrid item (liBase+liItem) to lsValue
52589>>>>>>>>>>>>>>>>>>>    send add_item to lhTargetGrid MSG_NONE lsValue
52590>>>>>>>>>>>>>>>>>>>    set entry_state         of lhTargetGrid item (liTargetBase+liItem) to (entry_state(lhGrid,liBase+liItem))
52591>>>>>>>>>>>>>>>>>>>    set checkbox_item_state of lhTargetGrid item (liTargetBase+liItem) to (checkbox_item_state(lhGrid,liBase+liItem))
52592>>>>>>>>>>>>>>>>>>>    set aux_value           of lhTargetGrid item (liTargetBase+liItem) to (aux_value(lhGrid,liBase+liItem))
52593>>>>>>>>>>>>>>>>>>>    set select_state        of lhTargetGrid item (liTargetBase+liItem) to (select_state(lhGrid,liBase+liItem))
52594>>>>>>>>>>>>>>>>>>>    set itemcolor           of lhTargetGrid item (liTargetBase+liItem) to (itemcolor(lhGrid,liBase+liItem))
52595>>>>>>>>>>>>>>>>>>>  loop
52596>>>>>>>>>>>>>>>>>>>>
52596>>>>>>>>>>>>>>>>>>>end_procedure
52597>>>>>>>>>>>>>>>>>>>
52597>>>>>>>>>>>>>>>>>
52597>>>>>>>>>>>>>>>>>Use APS          // Auto Positioning and Sizing classes for VDF
52597>>>>>>>>>>>>>>>>>class cFDX.Display.FieldList is a aps.Grid
52598>>>>>>>>>>>>>>>>>  register_function piFDX_Server returns integer
52598>>>>>>>>>>>>>>>>>  register_function piMain_File  returns integer
52598>>>>>>>>>>>>>>>>>  procedure construct_object integer img#
52600>>>>>>>>>>>>>>>>>    forward send construct_object img#
52602>>>>>>>>>>>>>>>>>    property integer piDisplayOldNumbers public 0
52603>>>>>>>>>>>>>>>>>    on_key kuser send ToggleDisplayOldNumbers
52604>>>>>>>>>>>>>>>>>    send GridPrepare_AddColumn "#"        AFT_ASCII2
52605>>>>>>>>>>>>>>>>>    send GridPrepare_AddColumn "Name"     AFT_ASCII15
52606>>>>>>>>>>>>>>>>>    send GridPrepare_AddColumn "Type"     AFT_ASCII4
52607>>>>>>>>>>>>>>>>>    send GridPrepare_AddColumn "Len"      AFT_ASCII5
52608>>>>>>>>>>>>>>>>>    send GridPrepare_AddColumn "Offset"   AFT_ASCII5
52609>>>>>>>>>>>>>>>>>    send GridPrepare_AddColumn "Idx"      AFT_ASCII3
52610>>>>>>>>>>>>>>>>>    send GridPrepare_AddColumn "Relation" AFT_ASCII30
52611>>>>>>>>>>>>>>>>>    send GridPrepare_Apply self
52612>>>>>>>>>>>>>>>>>    set select_mode to no_select
52613>>>>>>>>>>>>>>>>>    on_key key_ctrl+key_w send DoWriteToFile
52614>>>>>>>>>>>>>>>>>  end_procedure
52615>>>>>>>>>>>>>>>>>  procedure DoWriteToFile
52617>>>>>>>>>>>>>>>>>    send Grid_DoWriteToFile self
52618>>>>>>>>>>>>>>>>>  end_procedure
52619>>>>>>>>>>>>>>>>>  procedure add_item integer msg# string value#
52621>>>>>>>>>>>>>>>>>    forward send add_item msg# value#
52623>>>>>>>>>>>>>>>>>    set entry_state item (item_count(self)-1) to false
52624>>>>>>>>>>>>>>>>>  end_procedure
52625>>>>>>>>>>>>>>>>>  function sRelFieldName.ii integer file# integer field# returns string
52627>>>>>>>>>>>>>>>>>    integer fdx#
52627>>>>>>>>>>>>>>>>>    string file_name# field_name#
52627>>>>>>>>>>>>>>>>>    ifnot file# function_return ""
52630>>>>>>>>>>>>>>>>>    get piFDX_Server to fdx#
52631>>>>>>>>>>>>>>>>>    if fdx# begin
52633>>>>>>>>>>>>>>>>>      get FDX_AttrValue_FILELIST fdx# DF_FILE_LOGICAL_NAME file# to file_name#
52634>>>>>>>>>>>>>>>>>      get FDX_AttrValue_FIELD fdx# DF_FIELD_NAME file# field# to field_name#
52635>>>>>>>>>>>>>>>>>    end
52635>>>>>>>>>>>>>>>>>>
52635>>>>>>>>>>>>>>>>>    else begin
52636>>>>>>>>>>>>>>>>>      get API_AttrValue_FILELIST DF_FILE_LOGICAL_NAME file# to file_name#
52637>>>>>>>>>>>>>>>>>      if file_name# eq "" move ("FILE"+string(file#)) to file_name#
52640>>>>>>>>>>>>>>>>>      if (DBMS_IsOpenFile(file#)) get API_AttrValue_FIELD DF_FIELD_NAME file# field# to field_name#
52643>>>>>>>>>>>>>>>>>      else move ("FIELD"+string(field#)) to field_name#
52645>>>>>>>>>>>>>>>>>    end
52645>>>>>>>>>>>>>>>>>>
52645>>>>>>>>>>>>>>>>>    function_return (file_name#+"."+field_name#)
52646>>>>>>>>>>>>>>>>>  end_function
52647>>>>>>>>>>>>>>>>>  procedure fill_list
52649>>>>>>>>>>>>>>>>>    integer file# fdx# max# field# st# type# len# dec# idx# iDisplayOldNumbers#
52649>>>>>>>>>>>>>>>>>    string str#
52649>>>>>>>>>>>>>>>>>    get piMain_File to file#
52650>>>>>>>>>>>>>>>>>    get piFDX_Server to fdx#
52651>>>>>>>>>>>>>>>>>    get dynamic_update_state to st#
52652>>>>>>>>>>>>>>>>>    set dynamic_update_state to false
52653>>>>>>>>>>>>>>>>>    get FDX_AttrValue_FILE fdx# DF_FILE_NUMBER_FIELDS file# to max#
52654>>>>>>>>>>>>>>>>>    get piDisplayOldNumbers to iDisplayOldNumbers#
52655>>>>>>>>>>>>>>>>>    send delete_data
52656>>>>>>>>>>>>>>>>>    for field# from 1 to max#
52662>>>>>>>>>>>>>>>>>>
52662>>>>>>>>>>>>>>>>>      send add_item msg_none (string(field#))
52663>>>>>>>>>>>>>>>>>      send add_item msg_none (FDX_AttrValue_FIELD(fdx#,DF_FIELD_NAME,file#,field#))
52664>>>>>>>>>>>>>>>>>      move (FDX_AttrValue_FIELD(fdx#,DF_FIELD_TYPE,file#,field#)) to type#
52665>>>>>>>>>>>>>>>>>      send add_item msg_none (API_ShortFieldTypeName(type#))
52666>>>>>>>>>>>>>>>>>      move (FDX_AttrValue_FIELD(fdx#,DF_FIELD_LENGTH,file#,field#)) to len#
52667>>>>>>>>>>>>>>>>>      if type# eq DF_BCD begin
52669>>>>>>>>>>>>>>>>>        move (FDX_AttrValue_FIELD(fdx#,DF_FIELD_PRECISION,file#,field#)) to dec#
52670>>>>>>>>>>>>>>>>>        send add_item msg_none (string(len#-dec#)+"."+string(dec#))
52671>>>>>>>>>>>>>>>>>      end
52671>>>>>>>>>>>>>>>>>>
52671>>>>>>>>>>>>>>>>>      else send add_item msg_none (string(len#))
52673>>>>>>>>>>>>>>>>>      send add_item msg_none (FDX_AttrValue_FIELD(fdx#,DF_FIELD_OFFSET,file#,field#))
52674>>>>>>>>>>>>>>>>>      move (FDX_AttrValue_FIELD(fdx#,DF_FIELD_INDEX,file#,field#)) to idx#
52675>>>>>>>>>>>>>>>>>      if idx# send add_item msg_none (string(idx#))
52678>>>>>>>>>>>>>>>>>      else    send add_item msg_none ""
52680>>>>>>>>>>>>>>>>>
52680>>>>>>>>>>>>>>>>>      if iDisplayOldNumbers# begin
52682>>>>>>>>>>>>>>>>>        move "(Old #) PhysLen: #" to str#
52683>>>>>>>>>>>>>>>>>        replace "#" in str# with (FDX_AttrValue_FIELD(fdx#,DF_FIELD_OLD_NUMBER,file#,field#))
52685>>>>>>>>>>>>>>>>>        replace "#" in str# with (FDX_AttrValue_FIELD(fdx#,DF_FIELD_NATIVE_LENGTH,file#,field#))
52687>>>>>>>>>>>>>>>>>        send add_item msg_none str#
52688>>>>>>>>>>>>>>>>>      end
52688>>>>>>>>>>>>>>>>>>
52688>>>>>>>>>>>>>>>>>      else send add_item msg_none (sRelFieldName.ii(self,FDX_AttrValue_FIELD(fdx#,DF_FIELD_RELATED_FILE,file#,field#),FDX_AttrValue_FIELD(fdx#,DF_FIELD_RELATED_FIELD,file#,field#)))
52690>>>>>>>>>>>>>>>>>    loop
52691>>>>>>>>>>>>>>>>>>
52691>>>>>>>>>>>>>>>>>    set dynamic_update_state to st#
52692>>>>>>>>>>>>>>>>>  end_procedure
52693>>>>>>>>>>>>>>>>>
52693>>>>>>>>>>>>>>>>>  procedure ToggleDisplayOldNumbers
52695>>>>>>>>>>>>>>>>>    set piDisplayOldNumbers to (not(piDisplayOldNumbers(self)))
52696>>>>>>>>>>>>>>>>>    send fill_list
52697>>>>>>>>>>>>>>>>>  end_procedure
52698>>>>>>>>>>>>>>>>>end_class // cFDX.Display.FieldList
52699>>>>>>>>>>>>>>>>>
52699>>>>>>>>>>>>>>>>>class cFDX.Display.IndexList is a aps.Grid
52700>>>>>>>>>>>>>>>>>  procedure construct_object integer img#
52702>>>>>>>>>>>>>>>>>    forward send construct_object img#
52704>>>>>>>>>>>>>>>>>    set select_mode to auto_select
52705>>>>>>>>>>>>>>>>>    set Line_Width to 1 0
52706>>>>>>>>>>>>>>>>>    set header_label item 0 to "#"
52707>>>>>>>>>>>>>>>>>    set form_margin  item 0 to  8
52708>>>>>>>>>>>>>>>>>    set highlight_row_state to true
52709>>>>>>>>>>>>>>>>>//   set highlight_row_color to (rgb(0,255,255))
52709>>>>>>>>>>>>>>>>>//   set current_item_color to (rgb(0,255,255))
52709>>>>>>>>>>>>>>>>>    set CurrentCellColor     to clHighlight
52710>>>>>>>>>>>>>>>>>    set CurrentCellTextColor to clHighlightText
52711>>>>>>>>>>>>>>>>>    set CurrentRowColor      to clHighlight
52712>>>>>>>>>>>>>>>>>    set CurrentRowTextColor  to clHighlightText
52713>>>>>>>>>>>>>>>>>    set select_mode to no_select
52714>>>>>>>>>>>>>>>>>    on_key knext_item send switch
52715>>>>>>>>>>>>>>>>>    on_key kprevious_item send switch_back
52716>>>>>>>>>>>>>>>>>    on_key key_ctrl+key_w send DoWriteToFile
52717>>>>>>>>>>>>>>>>>  end_procedure
52718>>>>>>>>>>>>>>>>>  procedure DoWriteToFile
52720>>>>>>>>>>>>>>>>>    send Grid_DoWriteToFile self
52721>>>>>>>>>>>>>>>>>  end_procedure
52722>>>>>>>>>>>>>>>>>  procedure add_item integer msg# string value#
52724>>>>>>>>>>>>>>>>>    forward send add_item msg# value#
52726>>>>>>>>>>>>>>>>>    set entry_state item (item_count(self)-1) to false
52727>>>>>>>>>>>>>>>>>  end_procedure
52728>>>>>>>>>>>>>>>>>  procedure fill_list
52730>>>>>>>>>>>>>>>>>    integer idx# file# fdx#
52730>>>>>>>>>>>>>>>>>    send delete_data
52731>>>>>>>>>>>>>>>>>    get piMain_File to file#
52732>>>>>>>>>>>>>>>>>    get piFDX_Server to fdx#
52733>>>>>>>>>>>>>>>>>    for idx# from 1 to 15
52739>>>>>>>>>>>>>>>>>>
52739>>>>>>>>>>>>>>>>>      send add_item msg_none ("Index "+string(idx#))
52740>>>>>>>>>>>>>>>>>      ifnot (integer(FDX_AttrValue_INDEX(fdx#,DF_INDEX_NUMBER_SEGMENTS,file#,idx#))) set shadow_state item (item_count(self)-1) to true
52743>>>>>>>>>>>>>>>>>    loop
52744>>>>>>>>>>>>>>>>>>
52744>>>>>>>>>>>>>>>>>    set dynamic_update_state to true
52745>>>>>>>>>>>>>>>>>  end_procedure
52746>>>>>>>>>>>>>>>>>end_class // cFDX.Display.IndexList
52747>>>>>>>>>>>>>>>>>
52747>>>>>>>>>>>>>>>>>class cFDX.Display.IndexSegmentList is a aps.Grid
52748>>>>>>>>>>>>>>>>>  procedure construct_object integer img#
52750>>>>>>>>>>>>>>>>>    forward send construct_object img#
52752>>>>>>>>>>>>>>>>>    set Line_Width to 3 0
52753>>>>>>>>>>>>>>>>>    set header_label item 0 to "Field"
52754>>>>>>>>>>>>>>>>>    set header_label item 1 to "U/C"
52755>>>>>>>>>>>>>>>>>    set header_label item 2 to "Dsc"
52756>>>>>>>>>>>>>>>>>    set form_margin  item 0 to 15
52757>>>>>>>>>>>>>>>>>    set form_margin  item 1 to 3
52758>>>>>>>>>>>>>>>>>    set form_margin  item 2 to 3
52759>>>>>>>>>>>>>>>>>    set highlight_row_state to true
52760>>>>>>>>>>>>>>>>>    set CurrentCellColor     to clHighlight
52761>>>>>>>>>>>>>>>>>    set CurrentCellTextColor to clHighlightText
52762>>>>>>>>>>>>>>>>>    set CurrentRowColor      to clHighlight
52763>>>>>>>>>>>>>>>>>    set CurrentRowTextColor  to clHighlightText
52764>>>>>>>>>>>>>>>>>//   set highlight_row_color to (rgb(0,255,255))
52764>>>>>>>>>>>>>>>>>//   set current_item_color to (rgb(0,255,255))
52764>>>>>>>>>>>>>>>>>    set select_mode to no_select
52765>>>>>>>>>>>>>>>>>    on_key knext_item send switch
52766>>>>>>>>>>>>>>>>>    on_key kprevious_item send switch_back
52767>>>>>>>>>>>>>>>>>    on_key key_ctrl+key_w send DoWriteToFile
52768>>>>>>>>>>>>>>>>>  end_procedure
52769>>>>>>>>>>>>>>>>>  procedure DoWriteToFile
52771>>>>>>>>>>>>>>>>>    send Grid_DoWriteToFile self
52772>>>>>>>>>>>>>>>>>  end_procedure
52773>>>>>>>>>>>>>>>>>  procedure add_item integer msg# string value#
52775>>>>>>>>>>>>>>>>>    forward send add_item msg# value#
52777>>>>>>>>>>>>>>>>>    set entry_state item (item_count(self)-1) to false
52778>>>>>>>>>>>>>>>>>  end_procedure
52779>>>>>>>>>>>>>>>>>  procedure fill_list
52781>>>>>>>>>>>>>>>>>    integer max# seg# file# field# attr# fdx# value# idx#
52781>>>>>>>>>>>>>>>>>    string fname#
52781>>>>>>>>>>>>>>>>>    send delete_data
52782>>>>>>>>>>>>>>>>>    get piMain_File to file#
52783>>>>>>>>>>>>>>>>>    get piFDX_Server to fdx#
52784>>>>>>>>>>>>>>>>>    get piIndex to idx#
52785>>>>>>>>>>>>>>>>>    move (FDX_AttrValue_INDEX(fdx#,DF_INDEX_NUMBER_SEGMENTS,file#,idx#)) to max#
52786>>>>>>>>>>>>>>>>>    for seg# from 1 to max#
52792>>>>>>>>>>>>>>>>>>
52792>>>>>>>>>>>>>>>>>      move (FDX_AttrValue_IDXSEG(fdx#,DF_INDEX_SEGMENT_FIELD,file#,idx#,seg#)) to field#
52793>>>>>>>>>>>>>>>>>      if field# move (FDX_AttrValue_FIELD(fdx#,DF_FIELD_NAME,file#,field#)) to fname#
52796>>>>>>>>>>>>>>>>>      else move "RECNUM" to fname#
52798>>>>>>>>>>>>>>>>>      send add_item msg_none fname#
52799>>>>>>>>>>>>>>>>>      move (FDX_AttrValue_IDXSEG(fdx#,DF_INDEX_SEGMENT_CASE,file#,idx#,seg#)) to value#
52800>>>>>>>>>>>>>>>>>      send add_item msg_none (if(value#=DF_CASE_IGNORED,"Yes","No"))
52801>>>>>>>>>>>>>>>>>      move (FDX_AttrValue_IDXSEG(fdx#,DF_INDEX_SEGMENT_DIRECTION,file#,idx#,seg#)) to value#
52802>>>>>>>>>>>>>>>>>      send add_item msg_none (if(value#=DF_DESCENDING,"Yes","No"))
52803>>>>>>>>>>>>>>>>>    loop
52804>>>>>>>>>>>>>>>>>>
52804>>>>>>>>>>>>>>>>>    set dynamic_update_state to true
52805>>>>>>>>>>>>>>>>>  end_procedure
52806>>>>>>>>>>>>>>>>>end_class // cFDX.Display.IndexSegmentList
52807>>>>>>>>>>>>>>>>>class cFDX.Display.FileOtherList is a aps.Grid
52808>>>>>>>>>>>>>>>>>  procedure construct_object integer img#
52810>>>>>>>>>>>>>>>>>    forward send construct_object img#
52812>>>>>>>>>>>>>>>>>    set Line_Width to 2 0
52813>>>>>>>>>>>>>>>>>    set header_label item 0 to "Parameter"
52814>>>>>>>>>>>>>>>>>    set header_label item 1 to "Value"
52815>>>>>>>>>>>>>>>>>    set form_margin  item 0 to  30
52816>>>>>>>>>>>>>>>>>    set form_margin  item 1 to  30
52817>>>>>>>>>>>>>>>>>    set highlight_row_state to true
52818>>>>>>>>>>>>>>>>>    set CurrentCellColor     to clHighlight
52819>>>>>>>>>>>>>>>>>    set CurrentCellTextColor to clHighlightText
52820>>>>>>>>>>>>>>>>>    set CurrentRowColor      to clHighlight
52821>>>>>>>>>>>>>>>>>    set CurrentRowTextColor  to clHighlightText
52822>>>>>>>>>>>>>>>>>//   set highlight_row_color to (rgb(0,255,255))
52822>>>>>>>>>>>>>>>>>//   set current_item_color to (rgb(0,255,255))
52822>>>>>>>>>>>>>>>>>    set select_mode to no_select
52823>>>>>>>>>>>>>>>>>    property integer piDisplayRuntimeOnlies public 0
52824>>>>>>>>>>>>>>>>>    on_key key_ctrl+key_w send DoWriteToFile
52825>>>>>>>>>>>>>>>>>  end_procedure
52826>>>>>>>>>>>>>>>>>  procedure DoWriteToFile
52828>>>>>>>>>>>>>>>>>    send Grid_DoWriteToFile self
52829>>>>>>>>>>>>>>>>>  end_procedure
52830>>>>>>>>>>>>>>>>>  procedure add_item integer msg# string value#
52832>>>>>>>>>>>>>>>>>    forward send add_item msg# value#
52834>>>>>>>>>>>>>>>>>    set entry_state item (item_count(self)-1) to false
52835>>>>>>>>>>>>>>>>>  end_procedure
52836>>>>>>>>>>>>>>>>>  procedure add_entry string param# string value#
52838>>>>>>>>>>>>>>>>>    send add_item msg_none param#
52839>>>>>>>>>>>>>>>>>    send add_item msg_none value#
52840>>>>>>>>>>>>>>>>>  end_procedure
52841>>>>>>>>>>>>>>>>>  procedure fill_list_help integer attr#
52843>>>>>>>>>>>>>>>>>    integer file# fdx#
52843>>>>>>>>>>>>>>>>>    string str#
52843>>>>>>>>>>>>>>>>>    if (piDisplayRuntimeOnlies(self) or not(API_AttrRuntimeOnly(attr#))) begin
52845>>>>>>>>>>>>>>>>>      get piMain_File to file#
52846>>>>>>>>>>>>>>>>>      get piFDX_Server to fdx#
52847>>>>>>>>>>>>>>>>>      move (FDX_AttrValue_FILE(fdx#,attr#,file#)) to str#
52848>>>>>>>>>>>>>>>>>      send add_entry (API_Attr_DisplayName(attr#)) (API_Attr_DisplayValueName(attr#,str#))
52849>>>>>>>>>>>>>>>>>    end
52849>>>>>>>>>>>>>>>>>>
52849>>>>>>>>>>>>>>>>>  end_procedure
52850>>>>>>>>>>>>>>>>>  procedure fill_list
52852>>>>>>>>>>>>>>>>>    send delete_data
52853>>>>>>>>>>>>>>>>>    send API_AttrType_Callback ATTRTYPE_FILE msg_fill_list_help self
52854>>>>>>>>>>>>>>>>>    set dynamic_update_state to true
52855>>>>>>>>>>>>>>>>>  end_procedure
52856>>>>>>>>>>>>>>>>>end_class // cFDX.Display.FileOtherList
52857>>>>>>>>>>>>>>>>>
52857>>>>>>>>>>>>>>>>>object oFdxModalDisplayFileAttributes is a aps.ModalPanel label "Display table definition"
52860>>>>>>>>>>>>>>>>>  property integer piFDX_Server public 0
52862>>>>>>>>>>>>>>>>>  property integer piMain_File  public 0
52864>>>>>>>>>>>>>>>>>  property integer piIndex      public 1
52866>>>>>>>>>>>>>>>>>  on_key kcancel send close_panel
52867>>>>>>>>>>>>>>>>>  set Locate_Mode to CENTER_ON_SCREEN
52868>>>>>>>>>>>>>>>>>  set Border_Style to BORDER_THICK   // Make panel resizeable
52869>>>>>>>>>>>>>>>>>  object oTabs is a aps.TabDialog
52871>>>>>>>>>>>>>>>>>    set peAnchors to (anTop+anLeft+anBottom+anRight)
52872>>>>>>>>>>>>>>>>>    object oTab1 is a aps.TabPage label "Fields"
52875>>>>>>>>>>>>>>>>>      set p_Auto_Column to false
52876>>>>>>>>>>>>>>>>>      object oFields is a cFDX.Display.FieldList
52878>>>>>>>>>>>>>>>>>        set size to 160 0
52879>>>>>>>>>>>>>>>>>        set peAnchors to (anTop+anLeft+anBottom+anRight)
52880>>>>>>>>>>>>>>>>>        set peResizeColumn to rcAll
52881>>>>>>>>>>>>>>>>>      end_object
52882>>>>>>>>>>>>>>>>>    end_object
52883>>>>>>>>>>>>>>>>>    register_object oIndexFields
52883>>>>>>>>>>>>>>>>>    object oTab2 is a aps.TabPage label "Indices"
52886>>>>>>>>>>>>>>>>>      object oIndexNo is a cFDX.Display.IndexList
52888>>>>>>>>>>>>>>>>>        set size to 160 0
52889>>>>>>>>>>>>>>>>>        set peAnchors to (anTop+anBottom)
52890>>>>>>>>>>>>>>>>>        set peResizeColumn to rcAll
52891>>>>>>>>>>>>>>>>>        procedure item_change integer from# integer to# returns integer
52894>>>>>>>>>>>>>>>>>          integer rval#
52894>>>>>>>>>>>>>>>>>          forward get msg_item_change from# to# to rval#
52896>>>>>>>>>>>>>>>>>          set piIndex to (rval#+1)
52897>>>>>>>>>>>>>>>>>          send fill_list to (oIndexFields(self))
52898>>>>>>>>>>>>>>>>>          send display_info
52899>>>>>>>>>>>>>>>>>          procedure_return rval#
52900>>>>>>>>>>>>>>>>>        end_procedure
52901>>>>>>>>>>>>>>>>>      end_object
52902>>>>>>>>>>>>>>>>>      set p_auto_column to false
52903>>>>>>>>>>>>>>>>>      object oIndexFields is a cFDX.Display.IndexSegmentList
52905>>>>>>>>>>>>>>>>>        set peAnchors to (anTop+anLeft+anBottom+anRight)
52906>>>>>>>>>>>>>>>>>        set peResizeColumn to rcAll
52907>>>>>>>>>>>>>>>>>        set size to 160 0
52908>>>>>>>>>>>>>>>>>      end_object
52909>>>>>>>>>>>>>>>>>      object oFrm1 is a aps.Form label "Key length:" abstract aft_numeric4.0 snap sl_right_space
52914>>>>>>>>>>>>>>>>>        set peAnchors to (anTop+anRight)
52915>>>>>>>>>>>>>>>>>        set object_shadow_state to true
52916>>>>>>>>>>>>>>>>>      end_object
52917>>>>>>>>>>>>>>>>>      object oFrm2 is a aps.Form label "Levels:" abstract aft_numeric4.0 snap sl_down
52922>>>>>>>>>>>>>>>>>        set peAnchors to (anTop+anRight)
52923>>>>>>>>>>>>>>>>>        set object_shadow_state to true
52924>>>>>>>>>>>>>>>>>        set label_offset to 0 0
52925>>>>>>>>>>>>>>>>>        set label_justification_mode to jmode_right
52926>>>>>>>>>>>>>>>>>      end_object
52927>>>>>>>>>>>>>>>>>      object oFrm3 is a aps.Form label "Batch:" abstract aft_ascii4 snap sl_down
52932>>>>>>>>>>>>>>>>>        set peAnchors to (anTop+anRight)
52933>>>>>>>>>>>>>>>>>        set object_shadow_state to true
52934>>>>>>>>>>>>>>>>>        set label_offset to 0 0
52935>>>>>>>>>>>>>>>>>        set label_justification_mode to jmode_right
52936>>>>>>>>>>>>>>>>>      end_object
52937>>>>>>>>>>>>>>>>>      procedure display_info
52940>>>>>>>>>>>>>>>>>        integer idx# attr#
52940>>>>>>>>>>>>>>>>>        integer file# fdx#
52940>>>>>>>>>>>>>>>>>        get piMain_File to file#
52941>>>>>>>>>>>>>>>>>        get piFDX_Server to fdx#
52942>>>>>>>>>>>>>>>>>        get piIndex to idx#
52943>>>>>>>>>>>>>>>>>        move (FDX_AttrValue_INDEX(fdx#,DF_INDEX_KEY_LENGTH,file#,idx#)) to attr#
52944>>>>>>>>>>>>>>>>>        set value of (oFrm1(self)) item 0 to attr#
52945>>>>>>>>>>>>>>>>>        move (FDX_AttrValue_INDEX(fdx#,DF_INDEX_LEVELS,file#,idx#)) to attr#
52946>>>>>>>>>>>>>>>>>        set value of (oFrm2(self)) item 0 to attr#
52947>>>>>>>>>>>>>>>>>        move (FDX_AttrValue_INDEX(fdx#,DF_INDEX_TYPE,file#,idx#)) to attr#
52948>>>>>>>>>>>>>>>>>        if attr# eq DF_INDEX_TYPE_ONLINE set value of (oFrm3(self)) item 0 to "No"
52951>>>>>>>>>>>>>>>>>        else                             set value of (oFrm3(self)) item 0 to "Yes"
52953>>>>>>>>>>>>>>>>>      end_procedure
52954>>>>>>>>>>>>>>>>>    end_object
52955>>>>>>>>>>>>>>>>>    object oTab3 is a aps.TabPage label "Attributes"
52958>>>>>>>>>>>>>>>>>      object oOther is a cFDX.Display.FileOtherList
52960>>>>>>>>>>>>>>>>>        set size to 160 0
52961>>>>>>>>>>>>>>>>>        set peAnchors to (anTop+anLeft+anBottom+anRight)
52962>>>>>>>>>>>>>>>>>        set peResizeColumn to rcAll
52963>>>>>>>>>>>>>>>>>      end_object
52964>>>>>>>>>>>>>>>>>    end_object
52965>>>>>>>>>>>>>>>>>  end_object
52966>>>>>>>>>>>>>>>>>  object oBtn is a aps.Multi_Button
52968>>>>>>>>>>>>>>>>>    on_item t.btn.close send close_panel
52969>>>>>>>>>>>>>>>>>    set peAnchors to (anBottom+anRight)
52970>>>>>>>>>>>>>>>>>  end_object
52971>>>>>>>>>>>>>>>>>  send aps_locate_multi_buttons
52972>>>>>>>>>>>>>>>>>  procedure run.ii integer obj# integer file#
52975>>>>>>>>>>>>>>>>>    set piFDX_Server to obj#
52976>>>>>>>>>>>>>>>>>    set piMain_File  to file#
52977>>>>>>>>>>>>>>>>>    send fill_list to (oFields(oTab1(oTabs(self))))
52978>>>>>>>>>>>>>>>>>    set piIndex to 1
52979>>>>>>>>>>>>>>>>>    send fill_list to (oIndexNo(oTab2(oTabs(self))))
52980>>>>>>>>>>>>>>>>>    send fill_list to (oIndexFields(oTab2(oTabs(self))))
52981>>>>>>>>>>>>>>>>>    send display_info to (oTab2(oTabs(self)))
52982>>>>>>>>>>>>>>>>>    send fill_list to (oOther(oTab3(oTabs(self)))) obj#
52983>>>>>>>>>>>>>>>>>    send popup
52984>>>>>>>>>>>>>>>>>  end_procedure
52985>>>>>>>>>>>>>>>>>end_object
52986>>>>>>>>>>>>>>>>>send aps_SetMinimumDialogSize (oFdxModalDisplayFileAttributes(self))
52987>>>>>>>>>>>>>>>>>
52987>>>>>>>>>>>>>>>>>object oABCDEFG is a cArray NO_IMAGE
52989>>>>>>>>>>>>>>>>>  register_function iFdxIsEncapsulated returns integer
52989>>>>>>>>>>>>>>>>>end_object
52990>>>>>>>>>>>>>>>>>
52990>>>>>>>>>>>>>>>>>register_function piMainFile returns integer
52990>>>>>>>>>>>>>>>>>procedure FDX_ModalDisplayFileAttributes global integer oFDX# integer file#
52992>>>>>>>>>>>>>>>>>  integer open# was_open# lbIsEncapsulated
52992>>>>>>>>>>>>>>>>>  ifnot oFDX# begin
52994>>>>>>>>>>>>>>>>>    move (DBMS_IsOpenFile(file#)) to was_open#
52995>>>>>>>>>>>>>>>>>    if was_open# move 1 to open#
52998>>>>>>>>>>>>>>>>>    else move (DBMS_OpenFile(file#,DF_SHARE,0)) to open#
53000>>>>>>>>>>>>>>>>>  end
53000>>>>>>>>>>>>>>>>>>
53000>>>>>>>>>>>>>>>>>  else begin
53001>>>>>>>>>>>>>>>>>    move 1 to open#
53002>>>>>>>>>>>>>>>>>    if file# eq 0 begin
53004>>>>>>>>>>>>>>>>>      // File not specified means the oFDX# holds only one file
53004>>>>>>>>>>>>>>>>>      get iFdxIsEncapsulated of oFDX# to lbIsEncapsulated
53005>>>>>>>>>>>>>>>>>      if lbIsEncapsulated begin
53007>>>>>>>>>>>>>>>>>        send obs "Missing file number argument"
53008>>>>>>>>>>>>>>>>>        move 0 to open#
53009>>>>>>>>>>>>>>>>>      end
53009>>>>>>>>>>>>>>>>>>
53009>>>>>>>>>>>>>>>>>      else get piMainFile of oFDX# to file#
53011>>>>>>>>>>>>>>>>>    end
53011>>>>>>>>>>>>>>>>>>
53011>>>>>>>>>>>>>>>>>  end
53011>>>>>>>>>>>>>>>>>>
53011>>>>>>>>>>>>>>>>>  if open# send run.ii to (oFdxModalDisplayFileAttributes(self)) oFDX# file#
53014>>>>>>>>>>>>>>>>>  else send obs "Table is not available"
53016>>>>>>>>>>>>>>>>>  ifnot oFDX# if (open# and not(was_open#)) close file#
53021>>>>>>>>>>>>>>>>>end_procedure
53022>>>>>>>>>>>>>>>>>
53022>>>>>>>>>>>>>>>>>// Test code
53022>>>>>>>>>>>>>>>>>//
53022>>>>>>>>>>>>>>>>>// open prtcomm
53022>>>>>>>>>>>>>>>>>// send FDX_DisplayFileAttributes 0 PrtComm.File_Number
53022>>>>>>>>>>>>>>> Use Wait.utl     // Something to put on screen while batching.
Including file: wait.utl    (C:\projects\BRS\VDFQuery\AppSrc\wait.utl)
53022>>>>>>>>>>>>>>>>>// **********************************************************************
53022>>>>>>>>>>>>>>>>>// Use Wait.utl     // Something to put on screen while batching.
53022>>>>>>>>>>>>>>>>>//
53022>>>>>>>>>>>>>>>>>// By Sture Andersen & Jakob Kruse
53022>>>>>>>>>>>>>>>>>//
53022>>>>>>>>>>>>>>>>>// Create: Sat  10-05-1997 -
53022>>>>>>>>>>>>>>>>>// Update: Fri  03-04-1998 - Top-most-thing added by Jakob Kruse
53022>>>>>>>>>>>>>>>>>//         Wed  03-03-1999 - Procedure batch_on now initalizes all text areas
53022>>>>>>>>>>>>>>>>>//
53022>>>>>>>>>>>>>>>>>// ***********************************************************************
53022>>>>>>>>>>>>>>>>>
53022>>>>>>>>>>>>>>>>>Use ui
53022>>>>>>>>>>>>>>>>>Use statpnl
53022>>>>>>>>>>>>>>>>>Use Strings.nui  // String manipulation for VDF
53022>>>>>>>>>>>>>>>>>Use OldStatPnl.pkg // load the old status panel. Status_Panel is now this old object
Including file: OldStatPnl.pkg    (C:\Programmer\Visual DataFlex 12.0\Pkg\OldStatPnl.pkg)
53022>>>>>>>>>>>>>>>>>>>//************************************************************************
53022>>>>>>>>>>>>>>>>>>>// NOTE: As of 12.0, this is obsolete. See StatPnl.pkg for more information about this.
53022>>>>>>>>>>>>>>>>>>>//       You encouraged to use the new cProcessStatusPanel class and Status_panel object
53022>>>>>>>>>>>>>>>>>>>//       defined in Status_panel.pkg       
53022>>>>>>>>>>>>>>>>>>>//
53022>>>>>>>>>>>>>>>>>>>// This adds support for the old Status_Panel object.
53022>>>>>>>>>>>>>>>>>>>// If you only need to add support for the old StatusPanel class, use OldStatusPanel.pkg
53022>>>>>>>>>>>>>>>>>>>// In earlier revisions, both the class and object were defined in a single file
53022>>>>>>>>>>>>>>>>>>>// named StatPnl.pkg. They have been moved to two files, OldStatusPanel.pkg, which
53022>>>>>>>>>>>>>>>>>>>// defines the class StatusPanel, and OldStatPnl.pkg (here), which defines the object
53022>>>>>>>>>>>>>>>>>>>//************************************************************************
53022>>>>>>>>>>>>>>>>>>>
53022>>>>>>>>>>>>>>>>>>>
53022>>>>>>>>>>>>>>>>>>>Use OldStatusPanel.pkg
Including file: OldStatusPanel.pkg    (C:\Programmer\Visual DataFlex 12.0\Pkg\OldStatusPanel.pkg)
53022>>>>>>>>>>>>>>>>>>>>>//************************************************************************
53022>>>>>>>>>>>>>>>>>>>>>// NOTE: As of 12.0, this is obsolete. See StatPnl.pkg for more information about this.
53022>>>>>>>>>>>>>>>>>>>>>//       You encouraged to use the new cProcessStatusPanel class and Status_panel object
53022>>>>>>>>>>>>>>>>>>>>>//       defined in Status_panel.pkg       
53022>>>>>>>>>>>>>>>>>>>>>//
53022>>>>>>>>>>>>>>>>>>>>>// This adds support for the old StatusPanel class.
53022>>>>>>>>>>>>>>>>>>>>>// If you also need to add support for the old Status_panel object, use OldStatPnl.pkg
53022>>>>>>>>>>>>>>>>>>>>>// In earlier revisions, both the class and object were defined in a single file
53022>>>>>>>>>>>>>>>>>>>>>// named StatPnl.pkg. They have been moved to two files, OldStatusPanel.pkg, (here) which
53022>>>>>>>>>>>>>>>>>>>>>// defines the class StatusPanel, and OldStatPnl.pkg, which defines the object
53022>>>>>>>>>>>>>>>>>>>>>//************************************************************************
53022>>>>>>>>>>>>>>>>>>>>>
53022>>>>>>>>>>>>>>>>>>>>>
53022>>>>>>>>>>>>>>>>>>>>>
53022>>>>>>>>>>>>>>>>>>>>>//************************************************************************
53022>>>>>>>>>>>>>>>>>>>>>// Confidential Trade Secret.
53022>>>>>>>>>>>>>>>>>>>>>// Copyright (c) 1997 Data Access Corporation, Miami Florida
53022>>>>>>>>>>>>>>>>>>>>>// as an unpublished work.  All rights reserved.
53022>>>>>>>>>>>>>>>>>>>>>// DataFlex is a registered trademark of Data Access Corporation.
53022>>>>>>>>>>>>>>>>>>>>>//
53022>>>>>>>>>>>>>>>>>>>>>//************************************************************************
53022>>>>>>>>>>>>>>>>>>>>>//
53022>>>>>>>>>>>>>>>>>>>>>// $File name  : OldStatPnl.pkg
53022>>>>>>>>>>>>>>>>>>>>>// $File title : OldStatus Panel Support for VDF. This has been replaced in 12.0
53022>>>>>>>>>>>>>>>>>>>>>// Notice      :
53022>>>>>>>>>>>>>>>>>>>>>// $Author(s)  : John Tuohy
53022>>>>>>>>>>>>>>>>>>>>>//
53022>>>>>>>>>>>>>>>>>>>>>// $Rev History
53022>>>>>>>>>>>>>>>>>>>>>//
53022>>>>>>>>>>>>>>>>>>>>>// SWB 11/15/00  Changed Start_StatusPanel, so that the Sentinel program could be a long-filename.
53022>>>>>>>>>>>>>>>>>>>>>// JT  5/18/00   Added code to keep panel on top.
53022>>>>>>>>>>>>>>>>>>>>>// JT  9/22/97   Added status_params, status_default_params and changed
53022>>>>>>>>>>>>>>>>>>>>>//               interface for no-cancel, and created interface for additional
53022>>>>>>>>>>>>>>>>>>>>>//               parameter passing
53022>>>>>>>>>>>>>>>>>>>>>// JT 06/27/97   Added no-cancel support w/ Allow_cancel_state
53022>>>>>>>>>>>>>>>>>>>>>// JT ??/??/96   File created for VDF 4.0
53022>>>>>>>>>>>>>>>>>>>>>//************************************************************************
53022>>>>>>>>>>>>>>>>>>>>>
53022>>>>>>>>>>>>>>>>>>>>>
53022>>>>>>>>>>>>>>>>>>>>>// Host/Sentinel Status Panel
53022>>>>>>>>>>>>>>>>>>>>>//
53022>>>>>>>>>>>>>>>>>>>>>use Windows.pkg
53022>>>>>>>>>>>>>>>>>>>>>use SentDat.pkg // define shared data positions
Including file: Sentdat.pkg    (C:\Programmer\Visual DataFlex 12.0\Pkg\Sentdat.pkg)
53022>>>>>>>>>>>>>>>>>>>>>>>//
53022>>>>>>>>>>>>>>>>>>>>>>>//  Sentinel/Host common shared data
53022>>>>>>>>>>>>>>>>>>>>>>>//
53022>>>>>>>>>>>>>>>>>>>>>>>
53022>>>>>>>>>>>>>>>>>>>>>>>DEFINE BUTTONSTART   for 10
53022>>>>>>>>>>>>>>>>>>>>>>>DEFINE BUTTONLENGTH  for 25
53022>>>>>>>>>>>>>>>>>>>>>>>
53022>>>>>>>>>>>>>>>>>>>>>>>DEFINE CAPTIONSTART  for 35
53022>>>>>>>>>>>>>>>>>>>>>>>DEFINE CAPTIONLENGTH for 250
53022>>>>>>>>>>>>>>>>>>>>>>>
53022>>>>>>>>>>>>>>>>>>>>>>>DEFINE TITLESTART    for 285
53022>>>>>>>>>>>>>>>>>>>>>>>DEFINE TITLELENGTH   for 250
53022>>>>>>>>>>>>>>>>>>>>>>>
53022>>>>>>>>>>>>>>>>>>>>>>>DEFINE MESSAGESTART  for 535
53022>>>>>>>>>>>>>>>>>>>>>>>DEFINE MESSAGELENGTH for 250
53022>>>>>>>>>>>>>>>>>>>>>>>
53022>>>>>>>>>>>>>>>>>>>>>>>DEFINE ACTIONSTART   for 785
53022>>>>>>>>>>>>>>>>>>>>>>>DEFINE ACTIONLENGTH  for 250
53022>>>>>>>>>>>>>>>>>>>>>use msgbox.pkg
53022>>>>>>>>>>>>>>>>>>>>>
53022>>>>>>>>>>>>>>>>>>>>>
53022>>>>>>>>>>>>>>>>>>>>>Class StatusPanel is a cObject
53023>>>>>>>>>>>>>>>>>>>>>
53023>>>>>>>>>>>>>>>>>>>>>   Procedure Construct_Object
53025>>>>>>>>>>>>>>>>>>>>>      Forward Send Construct_Object
53027>>>>>>>>>>>>>>>>>>>>>
53027>>>>>>>>>>>>>>>>>>>>>      Property String  Sentinel_Name      "Sentinel"
53028>>>>>>>>>>>>>>>>>>>>>      Property Integer Sentinel_Running_State     False
53029>>>>>>>>>>>>>>>>>>>>>      // progress bar stuff is not implemented
53029>>>>>>>>>>>>>>>>>>>>>      Property Integer ProgressBar_State  False
53030>>>>>>>>>>>>>>>>>>>>>      Property Integer Progress_Minimum   0
53031>>>>>>>>>>>>>>>>>>>>>      Property Integer Progress_Maximum   100
53032>>>>>>>>>>>>>>>>>>>>>      Property String  Private.Button_Text        ""
53033>>>>>>>>>>>>>>>>>>>>>      Property String  Private.Title_Text         ""
53034>>>>>>>>>>>>>>>>>>>>>      Property String  Private.Caption_Text       ""
53035>>>>>>>>>>>>>>>>>>>>>      Property String  Private.Message_Text       ""
53036>>>>>>>>>>>>>>>>>>>>>      Property String  Private.Action_Text        ""
53037>>>>>>>>>>>>>>>>>>>>>
53037>>>>>>>>>>>>>>>>>>>>>      Property Integer Allow_Cancel_State         True
53038>>>>>>>>>>>>>>>>>>>>>      // whenever a status is initialized, the default
53038>>>>>>>>>>>>>>>>>>>>>      // is used unless a different value is passed in
53038>>>>>>>>>>>>>>>>>>>>>      // initialize_StatusPanel
53038>>>>>>>>>>>>>>>>>>>>>      property string  Status_Params              ''
53039>>>>>>>>>>>>>>>>>>>>>      property string  Status_Default_params      ''
53040>>>>>>>>>>>>>>>>>>>>>      Set Button_Text to "Cancel"
53041>>>>>>>>>>>>>>>>>>>>>
53041>>>>>>>>>>>>>>>>>>>>>   End_Procedure // Construct_Object
53042>>>>>>>>>>>>>>>>>>>>>
53042>>>>>>>>>>>>>>>>>>>>>   Procedure Close_Panel
53044>>>>>>>>>>>>>>>>>>>>>   End_Procedure
53045>>>>>>>>>>>>>>>>>>>>>
53045>>>>>>>>>>>>>>>>>>>>>   Procedure Initialize_StatusPanel String sCaption String sTitle ;                        String sMessage String sParams
53047>>>>>>>>>>>>>>>>>>>>>      Set ProgressBar_State to False
53048>>>>>>>>>>>>>>>>>>>>>      Set Caption_text to sCaption
53049>>>>>>>>>>>>>>>>>>>>>      Set Title_Text   to sTitle
53050>>>>>>>>>>>>>>>>>>>>>      Set Message_Text to sMessage
53051>>>>>>>>>>>>>>>>>>>>>      // the 4th param is optional because it was not supported
53051>>>>>>>>>>>>>>>>>>>>>      // in vdf4. You are encouraged to supply this
53051>>>>>>>>>>>>>>>>>>>>>      If num_arguments gt 3 ;        set Status_params to sParams
53054>>>>>>>>>>>>>>>>>>>>>      else ;        set Status_params to (Status_Default_params(self))
53056>>>>>>>>>>>>>>>>>>>>>   End_Procedure
53057>>>>>>>>>>>>>>>>>>>>>
53057>>>>>>>>>>>>>>>>>>>>>   Procedure Set Caption_Text string sText
53059>>>>>>>>>>>>>>>>>>>>>      Send DoStatusPaneltoForeground
53060>>>>>>>>>>>>>>>>>>>>>      Set Private.Caption_Text to sText
53061>>>>>>>>>>>>>>>>>>>>>      Set SentinelData of Desktop to sText CAPTIONSTART CAPTIONLENGTH
53062>>>>>>>>>>>>>>>>>>>>>   End_Procedure // Set Caption_Text
53063>>>>>>>>>>>>>>>>>>>>>
53063>>>>>>>>>>>>>>>>>>>>>   Function Caption_Text returns string
53065>>>>>>>>>>>>>>>>>>>>>      Function_Return (Private.Caption_Text(self))
53066>>>>>>>>>>>>>>>>>>>>>   End_Function // Caption_Text
53067>>>>>>>>>>>>>>>>>>>>>
53067>>>>>>>>>>>>>>>>>>>>>   Procedure Set Message_Text string sText
53069>>>>>>>>>>>>>>>>>>>>>      Send DoStatusPaneltoForeground
53070>>>>>>>>>>>>>>>>>>>>>      Set Private.Message_Text to sText
53071>>>>>>>>>>>>>>>>>>>>>      Set SentinelData of Desktop to sText MESSAGESTART MESSAGELENGTH
53072>>>>>>>>>>>>>>>>>>>>>   End_Procedure // Set Message_Text
53073>>>>>>>>>>>>>>>>>>>>>
53073>>>>>>>>>>>>>>>>>>>>>   Function Message_Text returns string
53075>>>>>>>>>>>>>>>>>>>>>      Function_Return (Private.Message_Text(self))
53076>>>>>>>>>>>>>>>>>>>>>   End_Function // Message_Text
53077>>>>>>>>>>>>>>>>>>>>>
53077>>>>>>>>>>>>>>>>>>>>>   Procedure Set Action_Text string sText
53079>>>>>>>>>>>>>>>>>>>>>      Send DoStatusPaneltoForeground
53080>>>>>>>>>>>>>>>>>>>>>      Set Private.Action_Text to sText
53081>>>>>>>>>>>>>>>>>>>>>      Set SentinelData of Desktop to sText ACTIONSTART ACTIONLENGTH
53082>>>>>>>>>>>>>>>>>>>>>   End_Procedure // Set Action_Text
53083>>>>>>>>>>>>>>>>>>>>>
53083>>>>>>>>>>>>>>>>>>>>>   Function Action_Text returns string
53085>>>>>>>>>>>>>>>>>>>>>      Function_Return (Private.Action_Text(self))
53086>>>>>>>>>>>>>>>>>>>>>   End_Function // Action_Text
53087>>>>>>>>>>>>>>>>>>>>>
53087>>>>>>>>>>>>>>>>>>>>>   Procedure Set Button_Text string sText
53089>>>>>>>>>>>>>>>>>>>>>      Send DoStatusPaneltoForeground
53090>>>>>>>>>>>>>>>>>>>>>      Set Private.Button_Text to sText
53091>>>>>>>>>>>>>>>>>>>>>      Set SentinelData of Desktop to sText BUTTONSTART BUTTONLENGTH
53092>>>>>>>>>>>>>>>>>>>>>   End_Procedure // Set Button_Text
53093>>>>>>>>>>>>>>>>>>>>>
53093>>>>>>>>>>>>>>>>>>>>>   Function Button_Text returns string
53095>>>>>>>>>>>>>>>>>>>>>      Function_Return (Private.Button_Text(self))
53096>>>>>>>>>>>>>>>>>>>>>   End_Function // Button_Text
53097>>>>>>>>>>>>>>>>>>>>>
53097>>>>>>>>>>>>>>>>>>>>>   Procedure Set Title_Text string sText
53099>>>>>>>>>>>>>>>>>>>>>      Send DoStatusPaneltoForeground
53100>>>>>>>>>>>>>>>>>>>>>      Set Private.Title_Text to sText
53101>>>>>>>>>>>>>>>>>>>>>      Set SentinelData of Desktop to sText TITLESTART TITLELENGTH
53102>>>>>>>>>>>>>>>>>>>>>   End_Procedure // Set Title_Text
53103>>>>>>>>>>>>>>>>>>>>>
53103>>>>>>>>>>>>>>>>>>>>>   Function Title_Text returns string
53105>>>>>>>>>>>>>>>>>>>>>      Function_Return (Private.Title_Text(self))
53106>>>>>>>>>>>>>>>>>>>>>   End_Function // Title_Text
53107>>>>>>>>>>>>>>>>>>>>>
53107>>>>>>>>>>>>>>>>>>>>>   Procedure Start_StatusPanel
53109>>>>>>>>>>>>>>>>>>>>>      Integer iVal
53109>>>>>>>>>>>>>>>>>>>>>      String sParams
53109>>>>>>>>>>>>>>>>>>>>>
53109>>>>>>>>>>>>>>>>>>>>>      If Not (Sentinel_Running_State(self)) Begin
53111>>>>>>>>>>>>>>>>>>>>>         Get status_params to sParams
53112>>>>>>>>>>>>>>>>>>>>>         If Not (Allow_Cancel_State(self)) ;             Move (sParams * "-c0") to sParams
53115>>>>>>>>>>>>>>>>>>>>>
53115>>>>>>>>>>>>>>>>>>>>>         Set Sentinel_Program of Desktop to ('"' + Sentinel_Name(self) +'"' * sParams)
53116>>>>>>>>>>>>>>>>>>>>>
53116>>>>>>>>>>>>>>>>>>>>>         Get Start_Sentinel_Program of Desktop to iVal
53117>>>>>>>>>>>>>>>>>>>>>         //showln "start sent = " ival
53117>>>>>>>>>>>>>>>>>>>>>         //If iVal ;
53117>>>>>>>>>>>>>>>>>>>>>         Set Sentinel_Running_State to TRUE
53118>>>>>>>>>>>>>>>>>>>>>      End
53118>>>>>>>>>>>>>>>>>>>>>>
53118>>>>>>>>>>>>>>>>>>>>>   End_Procedure // Start_StatusPanel
53119>>>>>>>>>>>>>>>>>>>>>
53119>>>>>>>>>>>>>>>>>>>>>   Procedure Update_StatusPanel String sAction
53121>>>>>>>>>>>>>>>>>>>>>      Set Action_Text to sAction
53122>>>>>>>>>>>>>>>>>>>>>   End_Procedure
53123>>>>>>>>>>>>>>>>>>>>>
53123>>>>>>>>>>>>>>>>>>>>>   Function Check_StatusPanel returns integer
53125>>>>>>>>>>>>>>>>>>>>>      integer iRet
53125>>>>>>>>>>>>>>>>>>>>>      Send DoStatusPaneltoForeground
53126>>>>>>>>>>>>>>>>>>>>>      Get Sentinel_return_value of Desktop to iRet
53127>>>>>>>>>>>>>>>>>>>>>      // modified to cancel the status panel if MSG_CANCEL is returned. This way you
53127>>>>>>>>>>>>>>>>>>>>>      // don't have to remember to send Stop_StatusPanel
53127>>>>>>>>>>>>>>>>>>>>>      If (iRet=MSG_CANCEL) Send Stop_StatusPanel
53130>>>>>>>>>>>>>>>>>>>>>      Function_Return iRet
53131>>>>>>>>>>>>>>>>>>>>>   End_Function
53132>>>>>>>>>>>>>>>>>>>>>
53132>>>>>>>>>>>>>>>>>>>>>   // Do what we can to force the status panel to the top. If the main program gets
53132>>>>>>>>>>>>>>>>>>>>>   // the focus force the status panel to take the focus.
53132>>>>>>>>>>>>>>>>>>>>>   Procedure DoStatusPaneltoForeground
53134>>>>>>>>>>>>>>>>>>>>>       integer hwStat hwMain hMain
53134>>>>>>>>>>>>>>>>>>>>>       Get main_window of desktop to hMain
53135>>>>>>>>>>>>>>>>>>>>>       If hMain Get window_handle of hMain to hwMain
53138>>>>>>>>>>>>>>>>>>>>>       If hwMain Begin
53140>>>>>>>>>>>>>>>>>>>>>          If (GetForegroundWindow()=hwMain) Begin
53142>>>>>>>>>>>>>>>>>>>>>              Move (SentinelWindow(desktop)) to hwStat
53143>>>>>>>>>>>>>>>>>>>>>              If hwStat Move (SetForegroundWindow(hwStat)) to hwStat
53146>>>>>>>>>>>>>>>>>>>>>          End
53146>>>>>>>>>>>>>>>>>>>>>>
53146>>>>>>>>>>>>>>>>>>>>>       End
53146>>>>>>>>>>>>>>>>>>>>>>
53146>>>>>>>>>>>>>>>>>>>>>   End_procedure
53147>>>>>>>>>>>>>>>>>>>>>
53147>>>>>>>>>>>>>>>>>>>>>   Procedure Stop_StatusPanel
53149>>>>>>>>>>>>>>>>>>>>>      Integer iVal
53149>>>>>>>>>>>>>>>>>>>>>      If (Sentinel_Running_State(self)) ;         Get Stop_Sentinel_Program of Desktop to iVal
53152>>>>>>>>>>>>>>>>>>>>>      Set Sentinel_Running_State to False
53153>>>>>>>>>>>>>>>>>>>>>   End_Procedure
53154>>>>>>>>>>>>>>>>>>>>>
53154>>>>>>>>>>>>>>>>>>>>>End_Class
53155>>>>>>>>>>>>>>>>>>>
53155>>>>>>>>>>>>>>>>>>>Object Status_Panel is a StatusPanel
53157>>>>>>>>>>>>>>>>>>>End_Object
53158>>>>>>>>>>>>>>>>>Use buttons.utl
53158>>>>>>>>>>>>>>>>>
53158>>>>>>>>>>>>>>>>>
53158>>>>>>>>>>>>>>>>>class cBatchCompanion is an StatusPanel
53159>>>>>>>>>>>>>>>>> // in 12: class cBatchCompanion is a cProcessStatusPanel
53159>>>>>>>>>>>>>>>>>  procedure construct_object
53161>>>>>>>>>>>>>>>>>    forward send construct_object
53163>>>>>>>>>>>>>>>>>    property string pCancelQuestionCaption public t.Wait.Question
53164>>>>>>>>>>>>>>>>>    property string pCancelQuestion        public t.Wait.Cancel
53165>>>>>>>>>>>>>>>>>    set button_text to t.btn.cancel
53166>>>>>>>>>>>>>>>>>  end_procedure
53167>>>>>>>>>>>>>>>>>// procedure Start_StatusPanel
53167>>>>>>>>>>>>>>>>>//   handle hwnd#
53167>>>>>>>>>>>>>>>>>//   integer swp#
53167>>>>>>>>>>>>>>>>>//   string caption_text#
53167>>>>>>>>>>>>>>>>>//   forward send Start_StatusPanel
53167>>>>>>>>>>>>>>>>>//   get Caption_Text to Caption_Text#
53167>>>>>>>>>>>>>>>>>//   move (StringOemToAnsi(Caption_Text#)) to Caption_Text#
53167>>>>>>>>>>>>>>>>>//   // To make the status_panel stay-on-top, we first find it's window handle ...
53167>>>>>>>>>>>>>>>>>//   move (FindWindow("DFDialogClass",Caption_Text#)) to hwnd#
53167>>>>>>>>>>>>>>>>>//   // ... then we add the extended style WS_EX_TOPMOST to the window, but we use SetWindowPos
53167>>>>>>>>>>>>>>>>>//   // to make sure the change takes effect immediately.
53167>>>>>>>>>>>>>>>>>//   move (SetWindowPos(hwnd#, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE ior SWP_NOSIZE)) to swp#
53167>>>>>>>>>>>>>>>>>//   // To manipulate this object further we could do
53167>>>>>>>>>>>>>>>>>//   //   get Object_From_Window hwnd# to realobj#
53167>>>>>>>>>>>>>>>>>//   // and then work with the DFDialog object realobj#
53167>>>>>>>>>>>>>>>>>// end_procedure
53167>>>>>>>>>>>>>>>>>  procedure batch_on string caption#
53169>>>>>>>>>>>>>>>>>    set caption_text to caption#
53170>>>>>>>>>>>>>>>>>    set title_text to ""
53171>>>>>>>>>>>>>>>>>    set message_text to ""
53172>>>>>>>>>>>>>>>>>    set action_text to ""
53173>>>>>>>>>>>>>>>>>    send Start_StatusPanel
53174>>>>>>>>>>>>>>>>>  end_procedure
53175>>>>>>>>>>>>>>>>>  procedure batch_off
53177>>>>>>>>>>>>>>>>>    send Stop_StatusPanel
53178>>>>>>>>>>>>>>>>>  end_procedure
53179>>>>>>>>>>>>>>>>>  procedure batch_update string str#
53181>>>>>>>>>>>>>>>>>    Set Message_Text to str#
53182>>>>>>>>>>>>>>>>>  end_procedure
53183>>>>>>>>>>>>>>>>>  procedure batch_update2 string str#
53185>>>>>>>>>>>>>>>>>    set Action_Text to str#
53186>>>>>>>>>>>>>>>>>  end_procedure
53187>>>>>>>>>>>>>>>>>  procedure batch_update3 string str#
53189>>>>>>>>>>>>>>>>>    set title_text to str#
53190>>>>>>>>>>>>>>>>>  end_procedure
53191>>>>>>>>>>>>>>>>>  function batch_interrupt returns integer
53193>>>>>>>>>>>>>>>>>    integer cancel#
53193>>>>>>>>>>>>>>>>>    get Check_StatusPanel to cancel#
53194>>>>>>>>>>>>>>>>>    if cancel# begin
53196>>>>>>>>>>>>>>>>>      send stop_statuspanel
53197>>>>>>>>>>>>>>>>>      move (yesno_box(pCancelQuestion(self),pCancelQuestionCaption(self),MB_DEFBUTTON2)) to cancel#
53198>>>>>>>>>>>>>>>>>      move (cancel#=mbr_yes) to cancel#
53199>>>>>>>>>>>>>>>>>      if cancel# function_return 1
53202>>>>>>>>>>>>>>>>>      send Start_StatusPanel
53203>>>>>>>>>>>>>>>>>    end
53203>>>>>>>>>>>>>>>>>>
53203>>>>>>>>>>>>>>>>>  end_function
53204>>>>>>>>>>>>>>>>>end_class // cBatchCompanion
53205>>>>>>>>>>>>>>>>>procedure ScreenEndWait_On integer min# integer max#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
53207>>>>>>>>>>>>>>>>>end_procedure
53208>>>>>>>>>>>>>>>>>procedure ScreenEndWait_Update integer pos#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
53210>>>>>>>>>>>>>>>>>end_procedure
53211>>>>>>>>>>>>>>>>>procedure ScreenEndWait_SetText string str#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
53213>>>>>>>>>>>>>>>>>end_procedure
53214>>>>>>>>>>>>>>>>>procedure ScreenEndWait_SetText2 string str#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
53216>>>>>>>>>>>>>>>>>end_procedure
53217>>>>>>>>>>>>>>>>>procedure ScreenEndWait_Off
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
53219>>>>>>>>>>>>>>>>>end_procedure
53220>>>>>>>>>>>>>>> Use MsgBox.utl   // obs procedure
53220>>>>>>>>>>>>>>>
53220>>>>>>>>>>>>>>>desktop_section
53225>>>>>>>>>>>>>>>  object oStructure_LogFile is a cLogFile
53227>>>>>>>>>>>>>>>    set psFileName     to "dfmatrix.log"
53228>>>>>>>>>>>>>>>    set piCloseOnWrite to DFTRUE
53229>>>>>>>>>>>>>>>    set psPurpose      to "Events during table restructuring"
53230>>>>>>>>>>>>>>>    property integer pbError public 0
53232>>>>>>>>>>>>>>>    procedure OnLogFileOpen
53235>>>>>>>>>>>>>>>      set pbError to DFFALSE
53236>>>>>>>>>>>>>>>    end_procedure
53237>>>>>>>>>>>>>>>
53237>>>>>>>>>>>>>>>    register_object oBatchModeLogFile
53237>>>>>>>>>>>>>>>    procedure WriteLn string lsValue
53240>>>>>>>>>>>>>>>      forward send WriteLn lsValue
53242>>>>>>>>>>>>>>>    end_procedure
53243>>>>>>>>>>>>>>>
53243>>>>>>>>>>>>>>>    procedure OnLogFileClose
53246>>>>>>>>>>>>>>>    end_procedure
53247>>>>>>>>>>>>>>>    procedure WriteLnError string lsValue
53250>>>>>>>>>>>>>>>      send WriteLn ("Error: "+lsValue)
53251>>>>>>>>>>>>>>>      set pbError to DFTRUE
53252>>>>>>>>>>>>>>>    end_procedure
53253>>>>>>>>>>>>>>>  end_object
53254>>>>>>>>>>>>>>>end_desktop_section
53259>>>>>>>>>>>>>>>
53259>>>>>>>>>>>>>>>   Use APS          // Auto Positioning and Sizing classes for VDF
53259>>>>>>>>>>>>>>>   object oStructureError is a aps.ModalPanel label "Restructure error"
53262>>>>>>>>>>>>>>>     set Locate_Mode to CENTER_ON_SCREEN
53263>>>>>>>>>>>>>>>     on_key kcancel send close_panel
53264>>>>>>>>>>>>>>>
53264>>>>>>>>>>>>>>>     // Must be provided if local error handler is to be created
53264>>>>>>>>>>>>>>>
53264>>>>>>>>>>>>>>>     property integer error_processing_state      public DFFALSE
53266>>>>>>>>>>>>>>>     property integer piOriginalErrorObject       public 0
53268>>>>>>>>>>>>>>>
53268>>>>>>>>>>>>>>>     object oTb1 is a aps.TextBox label "DataFlex reported this error:"
53271>>>>>>>>>>>>>>>     end_object
53272>>>>>>>>>>>>>>>     object oFrm1 is a aps.Form abstract AFT_ASCII50 snap SL_DOWN
53276>>>>>>>>>>>>>>>       set object_shadow_state to true
53277>>>>>>>>>>>>>>>     end_object
53278>>>>>>>>>>>>>>>     object oFrm2 is a aps.Form abstract AFT_ASCII50 snap SL_DOWN
53282>>>>>>>>>>>>>>>       set object_shadow_state to true
53283>>>>>>>>>>>>>>>     end_object
53284>>>>>>>>>>>>>>>     object oTb2 is a aps.TextBox label "While executing this instruction:" snap SL_DOWN
53288>>>>>>>>>>>>>>>     end_object
53289>>>>>>>>>>>>>>>     object oFrm3 is a aps.Form abstract AFT_ASCII50 snap SL_DOWN
53293>>>>>>>>>>>>>>>       set object_shadow_state to true
53294>>>>>>>>>>>>>>>     end_object
53295>>>>>>>>>>>>>>>     object oFrm4 is a aps.Form abstract AFT_ASCII50 snap SL_DOWN
53299>>>>>>>>>>>>>>>       set object_shadow_state to true
53300>>>>>>>>>>>>>>>     end_object
53301>>>>>>>>>>>>>>>     object oFrm5 is a aps.Form abstract AFT_ASCII50 snap SL_DOWN
53305>>>>>>>>>>>>>>>       set object_shadow_state to true
53306>>>>>>>>>>>>>>>     end_object
53307>>>>>>>>>>>>>>>     object oBtn1 is a aps.Multi_Button
53309>>>>>>>>>>>>>>>       on_item "End script"  send end_script
53310>>>>>>>>>>>>>>>     end_object
53311>>>>>>>>>>>>>>>     object oBtn2 is a aps.Multi_Button
53313>>>>>>>>>>>>>>>       on_item "Display def" send display_definition
53314>>>>>>>>>>>>>>>     end_object
53315>>>>>>>>>>>>>>>     object oBtn3 is a aps.Multi_Button
53317>>>>>>>>>>>>>>>       on_item "Continue" send close_panel
53318>>>>>>>>>>>>>>>     end_object
53319>>>>>>>>>>>>>>>     send aps_locate_multi_buttons
53320>>>>>>>>>>>>>>>     procedure Error_Report integer liErrNum integer liErr_Line string lsValue
53323>>>>>>>>>>>>>>>       integer lhObj lhStructure_LogFile
53323>>>>>>>>>>>>>>>       string lsValue1 lsValue2 lsError1 lsError2
53323>>>>>>>>>>>>>>>       If (error_processing_state(self)) procedure_return // this prevents recursion
53326>>>>>>>>>>>>>>>       set error_processing_state to DFTRUE
53327>>>>>>>>>>>>>>>       move (Error_Description(self,liErrNum,lsValue))                      to lsError1
53328>>>>>>>>>>>>>>>       move ("(Error "+string(liErrNum)+" on line "+string(liErr_Line)+")") to lsError2
53329>>>>>>>>>>>>>>>       set value of (oFrm1(self)) item 0 to lsError1
53330>>>>>>>>>>>>>>>       set value of (oFrm2(self)) item 0 to lsError2
53331>>>>>>>>>>>>>>>       move (oStructureErrorInfo(self)) to lhObj
53332>>>>>>>>>>>>>>>       send DoPrepare to lhObj
53333>>>>>>>>>>>>>>>       get psLine1 of lhObj to lsValue1
53334>>>>>>>>>>>>>>>       get psLine2 of lhObj to lsValue2
53335>>>>>>>>>>>>>>>       set value of (oFrm3(self)) item 0 to lsValue1
53336>>>>>>>>>>>>>>>       set value of (oFrm4(self)) item 0 to lsValue2
53337>>>>>>>>>>>>>>>       set value of (oFrm5(self)) item 0 to Struc$ErrDescr
53338>>>>>>>>>>>>>>>       move (oStructure_LogFile(self)) to lhStructure_LogFile
53339>>>>>>>>>>>>>>>       send WriteLnError to lhStructure_LogFile "  DataFlex reported this error:"
53340>>>>>>>>>>>>>>>       send WriteLn to lhStructure_LogFile ("    "+lsError1)
53341>>>>>>>>>>>>>>>       send WriteLn to lhStructure_LogFile ("    "+lsError2)
53342>>>>>>>>>>>>>>>       if (lsValue1<>"" or lsValue2<>"") begin
53344>>>>>>>>>>>>>>>         send WriteLn to lhStructure_LogFile "  While executing this instruction:"
53345>>>>>>>>>>>>>>>         if lsValue1 ne "" send WriteLn to lhStructure_LogFile ("    "+lsValue1)
53348>>>>>>>>>>>>>>>         if lsValue2 ne "" send WriteLn to lhStructure_LogFile ("    "+lsValue2)
53351>>>>>>>>>>>>>>>         if Struc$ErrDescr ne "" send WriteLn to lhStructure_LogFile ("    "+Struc$ErrDescr)
53354>>>>>>>>>>>>>>>       end
53354>>>>>>>>>>>>>>>>
53354>>>>>>>>>>>>>>>       send popup
53355>>>>>>>>>>>>>>>       set error_processing_state to DFFALSE
53356>>>>>>>>>>>>>>>     end_procedure
53357>>>>>>>>>>>>>>>
53357>>>>>>>>>>>>>>>     // Stolen right out of error.pkg:
53357>>>>>>>>>>>>>>>     //*** Build complete error description from Flexerrs and user error message.
53357>>>>>>>>>>>>>>>     function Error_Description integer liError string lsErrMsg returns string
53360>>>>>>>>>>>>>>>       string lsFullErrorText
53360>>>>>>>>>>>>>>>       trim lsErrMsg to lsErrMsg
53361>>>>>>>>>>>>>>>>
53361>>>>>>>>>>>>>>>       move (trim(error_text(DESKTOP,liError))) to lsFullErrorText
53362>>>>>>>>>>>>>>>       if lsErrMsg ne "" begin
53364>>>>>>>>>>>>>>>         if ((lsFullErrorText ne "") AND error_text_available(DESKTOP,liError)) append lsFullErrorText " " lsErrMsg
53368>>>>>>>>>>>>>>>         else move lsErrMsg to lsFullErrorText
53370>>>>>>>>>>>>>>>       end
53370>>>>>>>>>>>>>>>>
53370>>>>>>>>>>>>>>>       function_return lsFullErrorText
53371>>>>>>>>>>>>>>>     end_function
53372>>>>>>>>>>>>>>>
53372>>>>>>>>>>>>>>>     procedure end_script
53375>>>>>>>>>>>>>>>       error 774 "No such thing as 'End script'"
53376>>>>>>>>>>>>>>>>
53376>>>>>>>>>>>>>>>     end_procedure
53377>>>>>>>>>>>>>>>
53377>>>>>>>>>>>>>>>     procedure display_definition
53380>>>>>>>>>>>>>>>       send RS_DisplayDef
53381>>>>>>>>>>>>>>>     end_procedure
53382>>>>>>>>>>>>>>>   end_object // oStructureError
53383>>>>>>>>>>>>>>>
53383>>>>>>>>>>>>>>>procedure DFMatrixError_On global // Set error trapping mode to DFMatrix
53385>>>>>>>>>>>>>>>    integer lhObj
53385>>>>>>>>>>>>>>>    move (oStructureError(self)) to lhObj
53386>>>>>>>>>>>>>>>    if Error_Object_Id ne lhObj begin
53388>>>>>>>>>>>>>>>      set piOriginalErrorObject of lhObj to Error_Object_Id
53389>>>>>>>>>>>>>>>      move lhObj to Error_Object_Id
53390>>>>>>>>>>>>>>>    end
53390>>>>>>>>>>>>>>>>
53390>>>>>>>>>>>>>>>end_procedure
53391>>>>>>>>>>>>>>>procedure DFMatrixError_Off global // Set error trapping mode back to normal
53393>>>>>>>>>>>>>>>    integer lhObj
53393>>>>>>>>>>>>>>>    move (oStructureError(self)) to lhObj
53394>>>>>>>>>>>>>>>    if Error_Object_Id eq lhObj get piOriginalErrorObject of lhObj to Error_Object_Id
53397>>>>>>>>>>>>>>>end_procedure
53398>>>>>>>>>>>>>>>
53398>>>>>>>>>>>>>>>
53398>>>>>>>>>>>>>>>enumeration_list // Progress modes
53398>>>>>>>>>>>>>>>  define RS_PG_DEFAULT
53398>>>>>>>>>>>>>>>  define RS_PG_NONE
53398>>>>>>>>>>>>>>>  define RS_PG_LEAVE_ON
53398>>>>>>>>>>>>>>>  define RS_PG_OFF
53398>>>>>>>>>>>>>>>end_enumeration_list
53398>>>>>>>>>>>>>>>
53398>>>>>>>>>>>>>>>
53398>>>>>>>>>>>>>>>  object oStructureWait is a cBatchCompanion
53400>>>>>>>>>>>>>>>    property string psMostRecentProgressTitle public ""
53402>>>>>>>>>>>>>>>    set allow_cancel_state to false
53403>>>>>>>>>>>>>>>    function callback string lsText integer liType returns integer
53406>>>>>>>>>>>>>>>      if liType eq DF_MESSAGE_HEADING_1 send batch_update lsText
53409>>>>>>>>>>>>>>>      else if liType eq DF_MESSAGE_PROGRESS_TITLE begin
53412>>>>>>>>>>>>>>>        set psMostRecentProgressTitle to (lsText+": ")
53413>>>>>>>>>>>>>>>        send batch_update2 lsText
53414>>>>>>>>>>>>>>>      end
53414>>>>>>>>>>>>>>>>
53414>>>>>>>>>>>>>>>      else if liType eq DF_MESSAGE_PROGRESS_VALUE send batch_update2 lsText (psMostRecentProgressTitle(self)+replace(",",lsText," of "))
53418>>>>>>>>>>>>>>>      else begin
53419>>>>>>>>>>>>>>>        if liType eq DF_MESSAGE_HEADING_2 send batch_update3 lsText ("HDR2: "+lsText)
53422>>>>>>>>>>>>>>>        else if liType eq DF_MESSAGE_HEADING_3 send batch_update3 ("HDR3: "+lsText)
53426>>>>>>>>>>>>>>>        else if liType eq DF_MESSAGE_HEADING_4 send batch_update3 ("HDR4: "+lsText)
53430>>>>>>>>>>>>>>>        else if liType eq DF_MESSAGE_HEADING_5 send batch_update3 ("HDR5: "+lsText)
53434>>>>>>>>>>>>>>>        else if liType eq DF_MESSAGE_WARNING   begin
53437>>>>>>>>>>>>>>>          send batch_update3 ("WARN: "+lsText)
53438>>>>>>>>>>>>>>>          send WriteLnError to (oStructure_LogFile(self)) ("  Warning: "+lsText)
53439>>>>>>>>>>>>>>>        end
53439>>>>>>>>>>>>>>>>
53439>>>>>>>>>>>>>>>        else if liType eq DF_MESSAGE_TEXT      send batch_update3 ("      "+lsText)
53443>>>>>>>>>>>>>>>        else send batch_update3 ("????: "+lsText)
53445>>>>>>>>>>>>>>>      end
53445>>>>>>>>>>>>>>>>
53445>>>>>>>>>>>>>>>      function_return 0 // Continue please
53446>>>>>>>>>>>>>>>    end_function
53447>>>>>>>>>>>>>>>    procedure activate_title string lsTitle
53450>>>>>>>>>>>>>>>      send batch_on lsTitle
53451>>>>>>>>>>>>>>>      send batch_update  "Doing something" // 1
53452>>>>>>>>>>>>>>>      send batch_update2 "No idea..."
53453>>>>>>>>>>>>>>>      send batch_update3 ""
53454>>>>>>>>>>>>>>>      set psMostRecentProgressTitle to ""
53455>>>>>>>>>>>>>>>    end_procedure
53456>>>>>>>>>>>>>>>    procedure deactivate_display
53459>>>>>>>>>>>>>>>      send batch_off
53460>>>>>>>>>>>>>>>    end_procedure
53461>>>>>>>>>>>>>>>    function batch_interrupt returns integer // Cancel (no interupting!)
53464>>>>>>>>>>>>>>>    end_function
53465>>>>>>>>>>>>>>>  end_object
53466>>>>>>>>>>>>>>>
53466>>>>>>>>>>>>>>>define FIX_31D_RESTRUCT_ERROR for 1
53466>>>>>>>>>>>>>>>
53466>>>>>>>>>>>>>>>define IMPLICIT_FIELD for -1
53466>>>>>>>>>>>>>>>
53466>>>>>>>>>>>>>>>
53466>>>>>>>>>>>>>>>function sRSErr_Text.i global integer op# returns string
53468>>>>>>>>>>>>>>>  enumeration_list
53468>>>>>>>>>>>>>>>    define_rserr RSERR.NO_ERROR         "No error"
53471>>>>>>>>>>>>>>>    define_rserr RSERR.NOTAVALIDFLENTRY "Not a valid FILELIST entry"
53474>>>>>>>>>>>>>>>    define_rserr RSERR.NOEXCLACCESS     "Exclusive access could not be obtained"
53477>>>>>>>>>>>>>>>    define_rserr RSERR.NOT_A_DF_FILE    "Cannot restructure files in foreign DB"
53480>>>>>>>>>>>>>>>  end_enumeration_list
53480>>>>>>>>>>>>>>>  function_return "Undefined error"
53481>>>>>>>>>>>>>>>end_function
53482>>>>>>>>>>>>>>>
53482>>>>>>>>>>>>>>>
53482>>>>>>>>>>>>>>>// This class is used for setting FILE attribute DF_FILE_RECORD_LENGTH. I would
53482>>>>>>>>>>>>>>>// agree if you argue that it seems gross overkill to handle this with an
53482>>>>>>>>>>>>>>>// array and procedures instead of simply a single property.
53482>>>>>>>>>>>>>>>register_function piTraceState returns integer
53482>>>>>>>>>>>>>>>class cPostponedFileSettings is a cArray
53483>>>>>>>>>>>>>>>  item_property_list
53483>>>>>>>>>>>>>>>    item_property integer piAttribute.i
53483>>>>>>>>>>>>>>>    item_property string  psValue.i
53483>>>>>>>>>>>>>>>  end_item_property_list cPostponedFileSettings
#REM 53515 DEFINE FUNCTION PSVALUE.I INTEGER LIROW RETURNS STRING
#REM 53519 DEFINE PROCEDURE SET PSVALUE.I INTEGER LIROW STRING VALUE
#REM 53523 DEFINE FUNCTION PIATTRIBUTE.I INTEGER LIROW RETURNS INTEGER
#REM 53527 DEFINE PROCEDURE SET PIATTRIBUTE.I INTEGER LIROW INTEGER VALUE
53532>>>>>>>>>>>>>>>  procedure postponed_setting integer attr# string value#
53534>>>>>>>>>>>>>>>    integer row#
53534>>>>>>>>>>>>>>>    get row_count to row#
53535>>>>>>>>>>>>>>>    set piAttribute.i row# to attr#
53536>>>>>>>>>>>>>>>    set psValue.i     row# to value#
53537>>>>>>>>>>>>>>>  end_procedure
53538>>>>>>>>>>>>>>>  procedure execute string physname#
53540>>>>>>>>>>>>>>>    integer row# max# liFile attr#
53540>>>>>>>>>>>>>>>    string value#
53540>>>>>>>>>>>>>>>    get piFileHandle to liFile
53541>>>>>>>>>>>>>>>    get row_count to max#
53542>>>>>>>>>>>>>>>    for row# from 0 to (max#-1)
53548>>>>>>>>>>>>>>>>
53548>>>>>>>>>>>>>>>      get piAttribute.i row# to attr#
53549>>>>>>>>>>>>>>>      get psValue.i     row# to value#
53550>>>>>>>>>>>>>>>      // If DF_FILE_RECORD_LENGTH and -1 we must trim the record size:
53550>>>>>>>>>>>>>>>      if (attr#=DF_FILE_RECORD_LENGTH and integer(value#)=-1) get_attribute DF_FILE_RECORD_LENGTH_USED of liFile to value#
53555>>>>>>>>>>>>>>>      ErrorTrapping.set_attribute attr# of liFile to value#
53563>>>>>>>>>>>>>>>      send NotifyTracer RSOP_SETFILEATTR attr# 0 0 0 value#
53564>>>>>>>>>>>>>>>    loop
53565>>>>>>>>>>>>>>>>
53565>>>>>>>>>>>>>>>  end_procedure
53566>>>>>>>>>>>>>>>end_class
53567>>>>>>>>>>>>>>>// This is used simply for postponing setting the DF_FIELD_INDEX attribute.
53567>>>>>>>>>>>>>>>class cPostponedFieldSettings is a cArray
53568>>>>>>>>>>>>>>>  item_property_list
53568>>>>>>>>>>>>>>>    item_property integer piAttribute.i
53568>>>>>>>>>>>>>>>    item_property integer piField.i
53568>>>>>>>>>>>>>>>    item_property string  psValue.i
53568>>>>>>>>>>>>>>>  end_item_property_list cPostponedFieldSettings
#REM 53603 DEFINE FUNCTION PSVALUE.I INTEGER LIROW RETURNS STRING
#REM 53607 DEFINE PROCEDURE SET PSVALUE.I INTEGER LIROW STRING VALUE
#REM 53611 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 53615 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 53619 DEFINE FUNCTION PIATTRIBUTE.I INTEGER LIROW RETURNS INTEGER
#REM 53623 DEFINE PROCEDURE SET PIATTRIBUTE.I INTEGER LIROW INTEGER VALUE
53628>>>>>>>>>>>>>>>  procedure postponed_setting integer attr# integer field# string value#
53630>>>>>>>>>>>>>>>    integer row#
53630>>>>>>>>>>>>>>>    get row_count to row#
53631>>>>>>>>>>>>>>>    set piAttribute.i row# to attr#
53632>>>>>>>>>>>>>>>    set piField.i     row# to field#
53633>>>>>>>>>>>>>>>    set psValue.i     row# to value#
53634>>>>>>>>>>>>>>>  end_procedure
53635>>>>>>>>>>>>>>>
53635>>>>>>>>>>>>>>>  function iCheckMainIndexSetting integer liFile integer field# integer index# returns integer
53637>>>>>>>>>>>>>>>    integer segment# max_seg# seg_field# liMaxField liTestField lbOverlaps
53637>>>>>>>>>>>>>>>    if index# begin
53639>>>>>>>>>>>>>>>      // Either index is non-zero in which case we need to check that the
53639>>>>>>>>>>>>>>>      // field is actuially part of the index:
53639>>>>>>>>>>>>>>>      get_attribute DF_INDEX_NUMBER_SEGMENTS of liFile index# to max_seg#
53642>>>>>>>>>>>>>>>      for segment# from 1 to max_seg#
53648>>>>>>>>>>>>>>>>
53648>>>>>>>>>>>>>>>        get_attribute DF_INDEX_SEGMENT_FIELD of liFile index# segment# to seg_field#
53651>>>>>>>>>>>>>>>        if seg_field# eq field# function_return 1
53654>>>>>>>>>>>>>>>        if (integer(FDX_AttrValue_SPECIAL1(0,DF_FIELD_OVERLAP,liFile,field#,seg_field#))) function_return 1
53657>>>>>>>>>>>>>>>      loop
53658>>>>>>>>>>>>>>>>
53658>>>>>>>>>>>>>>>    end
53658>>>>>>>>>>>>>>>>
53658>>>>>>>>>>>>>>>    else begin
53659>>>>>>>>>>>>>>>      // Or index is zero in which case field cannot be part of ANY index.
53659>>>>>>>>>>>>>>>      // (Unfortunately I don't have time to code this so we just say it's
53659>>>>>>>>>>>>>>>      // alright. The point is that if a field is not part of ANY index
53659>>>>>>>>>>>>>>>      // its main_index is automatically set to zero - I think).
53659>>>>>>>>>>>>>>>      function_return 1
53660>>>>>>>>>>>>>>>    end
53660>>>>>>>>>>>>>>>>
53660>>>>>>>>>>>>>>>    // function_return 0
53660>>>>>>>>>>>>>>>  end_function
53661>>>>>>>>>>>>>>>  procedure execute string physname#
53663>>>>>>>>>>>>>>>    integer row# max# attr# liFile field# lhStructure_LogFile
53663>>>>>>>>>>>>>>>    string value# test# lsValue
53663>>>>>>>>>>>>>>>    get piFileHandle to liFile
53664>>>>>>>>>>>>>>>    get row_count to max#
53665>>>>>>>>>>>>>>>    for row# from 0 to (max#-1)
53671>>>>>>>>>>>>>>>>
53671>>>>>>>>>>>>>>>      get piAttribute.i row# to attr#
53672>>>>>>>>>>>>>>>      get piField.i     row# to field#
53673>>>>>>>>>>>>>>>      get psValue.i     row# to value#
53674>>>>>>>>>>>>>>>      move "#, Field: #, value: #" to Struc$ErrDescr
53675>>>>>>>>>>>>>>>      replace "#" in Struc$ErrDescr with physname#
53677>>>>>>>>>>>>>>>      replace "#" in Struc$ErrDescr with field#
53679>>>>>>>>>>>>>>>      replace "#" in Struc$ErrDescr with value#
53681>>>>>>>>>>>>>>>      get_attribute attr# of liFile field# to test#
53684>>>>>>>>>>>>>>>      if (integer(value#)<>integer(test#)) begin
53686>>>>>>>>>>>>>>>        if (iCheckMainIndexSetting(self,liFile,field#,value#)) begin
53688>>>>>>>>>>>>>>>          ErrorTrapping.set_attribute attr# of liFile field# to value#
53697>>>>>>>>>>>>>>>          send NotifyTracer RSOP_SETFIELDATTR attr# field# 0 0 value#
53698>>>>>>>>>>>>>>>//        send obs Struc$ErrDescr (API_Attr_Name(ATTR#))
53698>>>>>>>>>>>>>>>        end
53698>>>>>>>>>>>>>>>>
53698>>>>>>>>>>>>>>>        else begin
53699>>>>>>>>>>>>>>>          move (oStructure_LogFile(self)) to lhStructure_LogFile
53700>>>>>>>>>>>>>>>          move "Can not set index.# as main index for field #." to lsValue
53701>>>>>>>>>>>>>>>          move (replace("#",lsValue,value#)) to lsValue
53702>>>>>>>>>>>>>>>          move (replace("#",lsValue,string(field#))) to lsValue
53703>>>>>>>>>>>>>>>//          send obs lsValue "" "Field is not part of (or overlapped by a field that" "is path of) the index."
53703>>>>>>>>>>>>>>>          send WriteLnError to lhStructure_LogFile ("  "+lsValue+" "+"Field is not part of (or overlapped by a field that is path of) the index.")
53704>>>>>>>>>>>>>>>        end
53704>>>>>>>>>>>>>>>>
53704>>>>>>>>>>>>>>>      end
53704>>>>>>>>>>>>>>>>
53704>>>>>>>>>>>>>>>    loop
53705>>>>>>>>>>>>>>>>
53705>>>>>>>>>>>>>>>    move "" to Struc$ErrDescr
53706>>>>>>>>>>>>>>>  end_procedure
53707>>>>>>>>>>>>>>>end_class // cPostponedFieldSettings
53708>>>>>>>>>>>>>>>
53708>>>>>>>>>>>>>>>//> The cRSIndexCreations class is used within an cBasicRestructurer object
53708>>>>>>>>>>>>>>>//> to keep track of indices that were created as part of a restructure
53708>>>>>>>>>>>>>>>//> operation. Why? Because we may need to manually move the corresponding
53708>>>>>>>>>>>>>>>//> index files next to the DAT files. Otherwise the index files will
53708>>>>>>>>>>>>>>>//> remain in the first directory in the current search path (DF_OPEN_PATH)
53708>>>>>>>>>>>>>>>class cRSIndexCreations is an cArray
53709>>>>>>>>>>>>>>>end_class
53710>>>>>>>>>>>>>>>
53710>>>>>>>>>>>>>>>//> This class is also used from within an cBasicRestructurer object for
53710>>>>>>>>>>>>>>>//> the following reason. The '@' is not allowed as part of a field name.
53710>>>>>>>>>>>>>>>//> However, in vintage DataFlex the '@' sign is perfectly valid and in fact
53710>>>>>>>>>>>>>>>//> was used as part of a field name as an indication that the field is an
53710>>>>>>>>>>>>>>>//> overlap field or otherwise should not be presented to the end user
53710>>>>>>>>>>>>>>>//> (DFQuery and VDFQuery automatically filters such fields out).
53710>>>>>>>>>>>>>>>//> The cFieldNameRepair class is used to temporarily substitute 'illegal'
53710>>>>>>>>>>>>>>>//> field names with something legal. After the restructure has ended
53710>>>>>>>>>>>>>>>//> this object will edit the resulting TAG file.
53710>>>>>>>>>>>>>>>class cFieldNameRepair is an cArray
53711>>>>>>>>>>>>>>>  item_property_list
53711>>>>>>>>>>>>>>>    item_property string psRealName.i // "@ROAD_ID"
53711>>>>>>>>>>>>>>>    item_property string psTempName.i // "RSTMPFLDNAME001"
53711>>>>>>>>>>>>>>>  end_item_property_list cFieldNameRepair
#REM 53743 DEFINE FUNCTION PSTEMPNAME.I INTEGER LIROW RETURNS STRING
#REM 53747 DEFINE PROCEDURE SET PSTEMPNAME.I INTEGER LIROW STRING VALUE
#REM 53751 DEFINE FUNCTION PSREALNAME.I INTEGER LIROW RETURNS STRING
#REM 53755 DEFINE PROCEDURE SET PSREALNAME.I INTEGER LIROW STRING VALUE
53760>>>>>>>>>>>>>>>  procedure construct_object integer img#
53762>>>>>>>>>>>>>>>    forward send construct_object img#
53764>>>>>>>>>>>>>>>    property integer piTmpCounter private 0
53765>>>>>>>>>>>>>>>    object oTagFileArray is an cArray no_image
53767>>>>>>>>>>>>>>>    end_object
53768>>>>>>>>>>>>>>>  end_procedure
53769>>>>>>>>>>>>>>>  procedure reset
53771>>>>>>>>>>>>>>>    send delete_data
53772>>>>>>>>>>>>>>>    set !$.piTmpCounter to 1
53773>>>>>>>>>>>>>>>  end_procedure
53774>>>>>>>>>>>>>>>  function sRealName.s string tempname# returns string
53776>>>>>>>>>>>>>>>    integer max# row#
53776>>>>>>>>>>>>>>>    get row_count to max#
53777>>>>>>>>>>>>>>>    for row# from 0 to (max#-1)
53783>>>>>>>>>>>>>>>>
53783>>>>>>>>>>>>>>>      if (psTempName.i(self,row#)) eq tempname# function_return (psRealName.i(self,row#))
53786>>>>>>>>>>>>>>>    loop
53787>>>>>>>>>>>>>>>>
53787>>>>>>>>>>>>>>>    function_return ""
53788>>>>>>>>>>>>>>>  end_function
53789>>>>>>>>>>>>>>>  function sTempName.s string realname# returns string
53791>>>>>>>>>>>>>>>    integer max# row#
53791>>>>>>>>>>>>>>>    get row_count to max#
53792>>>>>>>>>>>>>>>    for row# from 0 to (max#-1)
53798>>>>>>>>>>>>>>>>
53798>>>>>>>>>>>>>>>      if (psRealName.i(self,row#)) eq realname# function_return (psTempName.i(self,row#))
53801>>>>>>>>>>>>>>>    loop
53802>>>>>>>>>>>>>>>>
53802>>>>>>>>>>>>>>>    function_return ""
53803>>>>>>>>>>>>>>>  end_function
53804>>>>>>>>>>>>>>>  function sAddField.s string realname# returns string
53806>>>>>>>>>>>>>>>    integer counter# row#
53806>>>>>>>>>>>>>>>    string rval#
53806>>>>>>>>>>>>>>>    get !$.piTmpCounter to counter#
53807>>>>>>>>>>>>>>>    move ("RSTMPFLDNAME"+IntToStrRzf(counter#,3)) to rval#
53808>>>>>>>>>>>>>>>    get row_count to row#
53809>>>>>>>>>>>>>>>    set psRealName.i row# to realname#
53810>>>>>>>>>>>>>>>    set psTempName.i row# to rval#
53811>>>>>>>>>>>>>>>    set !$.piTmpCounter to (counter#+1)
53812>>>>>>>>>>>>>>>    function_return rval#
53813>>>>>>>>>>>>>>>  end_function
53814>>>>>>>>>>>>>>>  procedure fix_the_tag_file
53816>>>>>>>>>>>>>>>    integer arr# ch# max# itm#
53816>>>>>>>>>>>>>>>    string root# name# real_name#
53816>>>>>>>>>>>>>>>    if (row_count(self)) begin // Only if necessary
53818>>>>>>>>>>>>>>>      get sRootInclPath to root#
53819>>>>>>>>>>>>>>>      move (root#+".tag") to root#
53820>>>>>>>>>>>>>>>      //send obs "sRootInclPath" root#
53820>>>>>>>>>>>>>>>      move (SEQ_DirectInput(root#)) to ch#
53821>>>>>>>>>>>>>>>      if ch# ge 0 begin
53823>>>>>>>>>>>>>>>        move (oTagFileArray(self)) to arr#
53824>>>>>>>>>>>>>>>        send delete_data to arr#
53825>>>>>>>>>>>>>>>        repeat
53825>>>>>>>>>>>>>>>>
53825>>>>>>>>>>>>>>>          move (SEQ_ReadLn(ch#)) to name#
53826>>>>>>>>>>>>>>>          if name# ne "" set value of arr# item (item_count(arr#)) to name#
53829>>>>>>>>>>>>>>>        until name# eq ""
53831>>>>>>>>>>>>>>>        send SEQ_CloseInput ch#
53832>>>>>>>>>>>>>>>        move (SEQ_DirectOutput(root#)) to ch#
53833>>>>>>>>>>>>>>>        get item_count of arr# to max#
53834>>>>>>>>>>>>>>>        for itm# from 0 to (max#-1)
53840>>>>>>>>>>>>>>>>
53840>>>>>>>>>>>>>>>          move (value(arr#,itm#)) to name#
53841>>>>>>>>>>>>>>>          get sRealName.s name# to real_name#
53842>>>>>>>>>>>>>>>          if real_name# ne "" writeln real_name#
53846>>>>>>>>>>>>>>>          else writeln name#
53849>>>>>>>>>>>>>>>        loop
53850>>>>>>>>>>>>>>>>
53850>>>>>>>>>>>>>>>        send SEQ_CloseOutput ch#
53851>>>>>>>>>>>>>>>      end
53851>>>>>>>>>>>>>>>>
53851>>>>>>>>>>>>>>>      else error 672 ("TAG file not found ("+root#+")")
53853>>>>>>>>>>>>>>>    end
53853>>>>>>>>>>>>>>>>
53853>>>>>>>>>>>>>>>  end_procedure
53854>>>>>>>>>>>>>>>end_class // cFieldNameRepair
53855>>>>>>>>>>>>>>>
53855>>>>>>>>>>>>>>>//> Attribute DF_FILE_NUMBER_FIELDS does not work as stated by the
53855>>>>>>>>>>>>>>>//> documentation (it simply returns the current position of the
53855>>>>>>>>>>>>>>>//> field at any time). To overcome this a stunt based on this class
53855>>>>>>>>>>>>>>>//> is performed.
53855>>>>>>>>>>>>>>>class cBleedingOldFieldNumbers is a cArray // Godammit!
53856>>>>>>>>>>>>>>>  procedure initialize
53858>>>>>>>>>>>>>>>    integer liFile max# field#
53858>>>>>>>>>>>>>>>    send delete_data
53859>>>>>>>>>>>>>>>    get piFileHandle to liFile
53860>>>>>>>>>>>>>>>    get_attribute DF_FILE_NUMBER_FIELDS of liFile to max#
53863>>>>>>>>>>>>>>>    for field# from 1 to max#
53869>>>>>>>>>>>>>>>>
53869>>>>>>>>>>>>>>>      set value item field# to field#
53870>>>>>>>>>>>>>>>    loop
53871>>>>>>>>>>>>>>>>
53871>>>>>>>>>>>>>>>  end_procedure
53872>>>>>>>>>>>>>>>  procedure delete_field integer field#
53874>>>>>>>>>>>>>>>    send delete_item field#
53875>>>>>>>>>>>>>>>  end_procedure
53876>>>>>>>>>>>>>>>  procedure insert_item integer itm#
53878>>>>>>>>>>>>>>>    integer xitm# max#
53878>>>>>>>>>>>>>>>    get item_count to max#
53879>>>>>>>>>>>>>>>    for_ex xitm# from max# down_to (itm#+1)
53886>>>>>>>>>>>>>>>      set value item xitm# to (value(self,xitm#-1))
53887>>>>>>>>>>>>>>>    loop
53888>>>>>>>>>>>>>>>>
53888>>>>>>>>>>>>>>>    set value item itm# to 0
53889>>>>>>>>>>>>>>>  end_procedure
53890>>>>>>>>>>>>>>>  procedure create_field integer field#
53892>>>>>>>>>>>>>>>    integer append#
53892>>>>>>>>>>>>>>>    move 0 to append#
53893>>>>>>>>>>>>>>>    ifnot field# move 1 to append#
53896>>>>>>>>>>>>>>>    if field# gt (item_count(self)) move 1 to append#
53899>>>>>>>>>>>>>>>    if append# set value item (item_count(self)) to 0
53902>>>>>>>>>>>>>>>    else begin
53903>>>>>>>>>>>>>>>      send insert_item field#
53904>>>>>>>>>>>>>>>      set value item field# to 0
53905>>>>>>>>>>>>>>>    end
53905>>>>>>>>>>>>>>>>
53905>>>>>>>>>>>>>>>  end_procedure
53906>>>>>>>>>>>>>>>  function iFindFieldOldNumber.i integer old_field# returns integer
53908>>>>>>>>>>>>>>>    integer itm# max# field#
53908>>>>>>>>>>>>>>>    get item_count to max#
53909>>>>>>>>>>>>>>>    for itm# from 1 to (max#-1)
53915>>>>>>>>>>>>>>>>
53915>>>>>>>>>>>>>>>      get value item itm# to field#
53916>>>>>>>>>>>>>>>      if old_field# eq field# function_return itm#
53919>>>>>>>>>>>>>>>    loop
53920>>>>>>>>>>>>>>>>
53920>>>>>>>>>>>>>>>    function_return -1
53921>>>>>>>>>>>>>>>  end_function
53922>>>>>>>>>>>>>>>end_class // cBleedingOldFieldNumbers
53923>>>>>>>>>>>>>>>
53923>>>>>>>>>>>>>>>register_procedure RegisterUpdate integer op# integer attr# integer field# integer index# integer seg# string value#
53923>>>>>>>>>>>>>>>class cBasicRestructurer is a cArray
53924>>>>>>>>>>>>>>>  procedure construct_object integer img#
53926>>>>>>>>>>>>>>>    forward send construct_object img#
53928>>>>>>>>>>>>>>>    property integer         piRS_State        public 0 // Are preconditions ok for RS?
53929>>>>>>>>>>>>>>>    property integer         piFileHandle      public 0 // File handle during restructure, File number during probe
53930>>>>>>>>>>>>>>>    property integer         piMainFile        public 0 // File number during restructure and probe
53931>>>>>>>>>>>>>>>    property string          psDriver          public "DATAFLEX"
53932>>>>>>>>>>>>>>>    // Used for tracking field insertion error in DF31D:
53932>>>>>>>>>>>>>>>    property integer piInitialNumberOfFields   public 0
53933>>>>>>>>>>>>>>>    property integer piIgnoreTheRestState      public 0
53934>>>>>>>>>>>>>>>
53934>>>>>>>>>>>>>>>    property integer         piErrorHandling   public 0 // Catch DF errors?
53935>>>>>>>>>>>>>>>    property integer         piProbeState      public 0 //
53936>>>>>>>>>>>>>>>    property integer private.piOrigOnError     public 0
53937>>>>>>>>>>>>>>>    property integer private.piDropCounter     public 0
53938>>>>>>>>>>>>>>>    property integer private.piCurrentField    public 0
53939>>>>>>>>>>>>>>>    property integer         piFieldTrackState public 1
53940>>>>>>>>>>>>>>>    // Name of DAT file being restructured
53940>>>>>>>>>>>>>>>    property string          psDatFilePath     public ""
53941>>>>>>>>>>>>>>>    property string          psDatFileName     public "" //
53942>>>>>>>>>>>>>>>    property integer         piTraceState      public 0
53943>>>>>>>>>>>>>>>    property integer         piTraceObject     public 0
53944>>>>>>>>>>>>>>>    property integer         piProgressMode    public RS_PG_DEFAULT // Wait image behavior
53945>>>>>>>>>>>>>>>
53945>>>>>>>>>>>>>>>    property integer private.piSortOnEndStructure public DFFALSE
53946>>>>>>>>>>>>>>>
53946>>>>>>>>>>>>>>>    object oPostponedFileSettings is a cPostponedFileSettings no_image
53948>>>>>>>>>>>>>>>    end_object
53949>>>>>>>>>>>>>>>    object oPostponedFieldSettings is a cPostponedFieldSettings no_image
53951>>>>>>>>>>>>>>>    end_object
53952>>>>>>>>>>>>>>>    object oRSIndexCreations is a cRSIndexCreations no_image
53954>>>>>>>>>>>>>>>    end_object
53955>>>>>>>>>>>>>>>    object oTmpArray is a cArray no_image
53957>>>>>>>>>>>>>>>      // Used when creating indices.
53957>>>>>>>>>>>>>>>    end_object
53958>>>>>>>>>>>>>>>    object oFieldNameRepair is a cFieldNameRepair no_image
53960>>>>>>>>>>>>>>>    end_object
53961>>>>>>>>>>>>>>>    object oOldFieldNumbersRepair is a cBleedingOldFieldNumbers no_image
53963>>>>>>>>>>>>>>>    end_object
53964>>>>>>>>>>>>>>>  end_procedure
53965>>>>>>>>>>>>>>>
53965>>>>>>>>>>>>>>>//procedure reset // I don't know who'd call this
53965>>>>>>>>>>>>>>>//  set piRS_State to 0
53965>>>>>>>>>>>>>>>//  set piProbeState to 0
53965>>>>>>>>>>>>>>>//  set piFileHandle to 0
53965>>>>>>>>>>>>>>>//  set piMainFile   to 0
53965>>>>>>>>>>>>>>>//  set private.piCurrentField to -1
53965>>>>>>>>>>>>>>>//  send delete_data to (oRSIndexCreations(self))
53965>>>>>>>>>>>>>>>//end_procedure
53965>>>>>>>>>>>>>>>
53965>>>>>>>>>>>>>>>  function field_count returns integer
53967>>>>>>>>>>>>>>>    integer liFile rval#
53967>>>>>>>>>>>>>>>    get piFileHandle to liFile
53968>>>>>>>>>>>>>>>    get_attribute DF_FILE_NUMBER_FIELDS of liFile to rval#
53971>>>>>>>>>>>>>>>    function_return rval#
53972>>>>>>>>>>>>>>>  end_function
53973>>>>>>>>>>>>>>>
53973>>>>>>>>>>>>>>>  procedure SetFieldNumber integer field#
53975>>>>>>>>>>>>>>>    set private.piCurrentField to field#
53976>>>>>>>>>>>>>>>  end_procedure
53977>>>>>>>>>>>>>>>
53977>>>>>>>>>>>>>>>  procedure CreateField integer field# string name# integer type#
53979>>>>>>>>>>>>>>>    integer liFile WasIRightOrWasIRight# InitialNumberOfFields#
53979>>>>>>>>>>>>>>>    integer liFieldNameAlreadyExists
53979>>>>>>>>>>>>>>>    ifnot (piIgnoreTheRestState(self)) begin
53981>>>>>>>>>>>>>>>      get piFileHandle to liFile
53982>>>>>>>>>>>>>>>      if field# gt (field_count(self)) move 0 to field# // Append
53985>>>>>>>>>>>>>>>      get piInitialNumberOfFields to InitialNumberOfFields#
53986>>>>>>>>>>>>>>>      ErrorTrapping.create_field liFile at field#
53991>>>>>>>>>>>>>>>      send create_field to (oOldFieldNumbersRepair(self)) field#
53992>>>>>>>>>>>>>>>      // If fieldname begins with "@" we have to cheat
53992>>>>>>>>>>>>>>>      if "@"      in    name# move (sAddField.s(oFieldNameRepair(self),name#)) to name#
53995>>>>>>>>>>>>>>>      // If fieldname begins with "FIELD" we have to cheat
53995>>>>>>>>>>>>>>>      if (StringBeginsWith(name#,"FIELD")) move (sAddField.s(oFieldNameRepair(self),name#)) to name#
53998>>>>>>>>>>>>>>>      // If fieldname already exists (but we intend to create the other field later) we have to cheat
53998>>>>>>>>>>>>>>>      get iFindFieldName.s name# to liFieldNameAlreadyExists
53999>>>>>>>>>>>>>>>      if (liFieldNameAlreadyExists<>-1) move (sAddField.s(oFieldNameRepair(self),name#)) to name#
54002>>>>>>>>>>>>>>>      ErrorTrapping.set_attribute DF_FIELD_NAME of liFile field# to name#
54011>>>>>>>>>>>>>>>      ErrorTrapping.set_attribute DF_FIELD_TYPE of liFile field# to type#
54020>>>>>>>>>>>>>>>      if field# set private.piCurrentField to field#
54023>>>>>>>>>>>>>>>      else set private.piCurrentField to (field_count(self))
54025>>>>>>>>>>>>>>>      send NotifyTracer RSOP_CREATEFIELD 0 field# type# 0 name#
54026>>>>>>>>>>>>>>>    end
54026>>>>>>>>>>>>>>>>
54026>>>>>>>>>>>>>>>  end_procedure
54027>>>>>>>>>>>>>>>  procedure CreateField_OldNumber integer old_number# string name# integer type#
54029>>>>>>>>>>>>>>>    integer field#
54029>>>>>>>>>>>>>>>    get iFindFieldOldNumber.i old_number# to field#
54030>>>>>>>>>>>>>>>    if field# ne -1 send CreateField field# name# type#
54033>>>>>>>>>>>>>>>    else error 667 ("Old number not found ("+string(old_number#)+")")
54035>>>>>>>>>>>>>>>  end_procedure
54036>>>>>>>>>>>>>>>
54036>>>>>>>>>>>>>>>  procedure AppendField string name# integer type#
54038>>>>>>>>>>>>>>>    ifnot (piIgnoreTheRestState(self)) ;      send CreateField 0 name# type#
54041>>>>>>>>>>>>>>>  end_procedure
54042>>>>>>>>>>>>>>>  procedure DeleteField integer field#
54044>>>>>>>>>>>>>>>    integer liFile
54044>>>>>>>>>>>>>>>    ifnot (piIgnoreTheRestState(self)) begin
54046>>>>>>>>>>>>>>>      get piFileHandle to liFile
54047>>>>>>>>>>>>>>>      ErrorTrapping.delete_field liFile field#
54052>>>>>>>>>>>>>>>      send delete_field to (oOldFieldNumbersRepair(self)) field#
54053>>>>>>>>>>>>>>>      send NotifyTracer RSOP_DELETEFIELD 0 field# 0 0 ""
54054>>>>>>>>>>>>>>>    end
54054>>>>>>>>>>>>>>>>
54054>>>>>>>>>>>>>>>  end_procedure
54055>>>>>>>>>>>>>>>
54055>>>>>>>>>>>>>>>  procedure DeleteField_OldNumber integer old_number#
54057>>>>>>>>>>>>>>>    integer field#
54057>>>>>>>>>>>>>>>    get iFindFieldOldNumber.i old_number# to field#
54058>>>>>>>>>>>>>>>    if field# ne -1 send DeleteField field#
54061>>>>>>>>>>>>>>>    else error 668 ("Old number not found ("+string(old_number#)+")")
54063>>>>>>>>>>>>>>>  end_procedure
54064>>>>>>>>>>>>>>>
54064>>>>>>>>>>>>>>>  procedure DeleteIndex integer idx#
54066>>>>>>>>>>>>>>>    integer liFile segments#
54066>>>>>>>>>>>>>>>    ifnot (piIgnoreTheRestState(self)) begin
54068>>>>>>>>>>>>>>>      get piFileHandle to liFile
54069>>>>>>>>>>>>>>>      get_attribute DF_INDEX_NUMBER_SEGMENTS of liFile idx# to segments#
54072>>>>>>>>>>>>>>>      // We have to check if there are any segments in the index before we
54072>>>>>>>>>>>>>>>      // delete it. If there aren't we will get an error if we try to delete it.
54072>>>>>>>>>>>>>>>      if segments# delete_index liFile idx#
54075>>>>>>>>>>>>>>>      send NotifyTracer RSOP_DELETEINDEX 0 0 idx# 0 ""
54076>>>>>>>>>>>>>>>    end
54076>>>>>>>>>>>>>>>>
54076>>>>>>>>>>>>>>>  end_procedure
54077>>>>>>>>>>>>>>>
54077>>>>>>>>>>>>>>>  procedure structure_abort
54079>>>>>>>>>>>>>>>    integer liFile
54079>>>>>>>>>>>>>>>    get piFileHandle to liFile
54080>>>>>>>>>>>>>>>    structure_abort liFile
54081>>>>>>>>>>>>>>>    set piFileHandle to liFile
54082>>>>>>>>>>>>>>>    if (piErrorHandling(self)) get private.piOrigOnError to |VI31 // Restore normal error handling routine
54085>>>>>>>>>>>>>>>  end_procedure
54086>>>>>>>>>>>>>>>  procedure structure_error
54088>>>>>>>>>>>>>>>    integer liFile
54088>>>>>>>>>>>>>>>    get piFileHandle to liFile
54089>>>>>>>>>>>>>>>    error 673 ("An error occured while re-structuring file number "+string(liFile)+". Program will abort.")
54090>>>>>>>>>>>>>>>>
54090>>>>>>>>>>>>>>>    send structure_abort
54091>>>>>>>>>>>>>>>    system
54092>>>>>>>>>>>>>>>>
54092>>>>>>>>>>>>>>>  end_procedure
54093>>>>>>>>>>>>>>>  procedure structure_start
54095>>>>>>>>>>>>>>>    integer liFile
54095>>>>>>>>>>>>>>>    string root#
54095>>>>>>>>>>>>>>>    if (piErrorHandling(self)) begin
54097>>>>>>>>>>>>>>>      move self to cRestructurer#  // Make global integer cRestructurer# point to this object
54098>>>>>>>>>>>>>>>      set private.piOrigOnError to |VI31     // If an error occurs while restructuring we must abort the
54099>>>>>>>>>>>>>>>      on error gosub cRestructurer_Error     // re-structuring AND the program
54100>>>>>>>>>>>>>>>      indicate err false                     // This just needs to be done (can't remember why)
54101>>>>>>>>>>>>>>>    end
54101>>>>>>>>>>>>>>>>
54101>>>>>>>>>>>>>>>    send delete_data to (oPostponedFileSettings(self))
54102>>>>>>>>>>>>>>>    send delete_data to (oPostponedFieldSettings(self))
54103>>>>>>>>>>>>>>>    send reset to (oFieldNameRepair(self))
54104>>>>>>>>>>>>>>>    get piMainFile to liFile
54105>>>>>>>>>>>>>>>    structure_start liFile (psDriver(self))
54106>>>>>>>>>>>>>>>    set piFileHandle to liFile
54107>>>>>>>>>>>>>>>    send initialize to (oOldFieldNumbersRepair(self))
54108>>>>>>>>>>>>>>>    if (piTraceState(self)) begin
54110>>>>>>>>>>>>>>>      get sRootInclPath to root#
54111>>>>>>>>>>>>>>>      send NotifyTracer RSOP_BEGIN 0 0 0 0 root#
54112>>>>>>>>>>>>>>>    end
54112>>>>>>>>>>>>>>>>
54112>>>>>>>>>>>>>>>  end_procedure
54113>>>>>>>>>>>>>>>  procedure SetProgressMode integer mode#
54115>>>>>>>>>>>>>>>    // Possible values for mode# are: RS_PG_DEFAULT RS_PG_NONE RS_PG_LEAVE_ON RS_PG_OFF
54115>>>>>>>>>>>>>>>    if mode# eq RS_PG_OFF begin
54117>>>>>>>>>>>>>>>      send deactivate_display to (oStructureWait(self))
54118>>>>>>>>>>>>>>>      set piProgressMode to RS_PG_DEFAULT
54119>>>>>>>>>>>>>>>    end
54119>>>>>>>>>>>>>>>>
54119>>>>>>>>>>>>>>>    else set piProgressMode to mode#
54121>>>>>>>>>>>>>>>  end_procedure
54122>>>>>>>>>>>>>>>  procedure structure_end
54124>>>>>>>>>>>>>>>    integer liFile callback_obj# wmode# lbOpen
54124>>>>>>>>>>>>>>>    integer lhSortHandle
54124>>>>>>>>>>>>>>>    string physical_name#
54124>>>>>>>>>>>>>>>    if (piProbeState(self)) begin
54126>>>>>>>>>>>>>>>      error 773 "No STRUCTURE_END while in probe mode"
54127>>>>>>>>>>>>>>>>
54127>>>>>>>>>>>>>>>      procedure_return
54128>>>>>>>>>>>>>>>    end
54128>>>>>>>>>>>>>>>>
54128>>>>>>>>>>>>>>>    move (oStructureWait(self)) to callback_obj#
54129>>>>>>>>>>>>>>>    get piProgressMode to wmode#
54130>>>>>>>>>>>>>>>    get piFileHandle to liFile
54131>>>>>>>>>>>>>>>    get_attribute DF_FILE_PHYSICAL_NAME of liFile to physical_name#
54134>>>>>>>>>>>>>>>    send execute to (oPostponedFileSettings(self)) physical_name#
54135>>>>>>>>>>>>>>>    send execute to (oPostponedFieldSettings(self)) physical_name#
54136>>>>>>>>>>>>>>>    if wmode# ne RS_PG_NONE begin
54138>>>>>>>>>>>>>>>      send activate_title to callback_obj# physical_name#
54139>>>>>>>>>>>>>>>      structure_end liFile DF_STRUCTEND_OPT_NONE "." callback_obj# // (pRestuctOpt(self)) (pTempDir(self)) (pCallBackObj(self))
54141>>>>>>>>>>>>>>>    end
54141>>>>>>>>>>>>>>>>
54141>>>>>>>>>>>>>>>    else begin
54142>>>>>>>>>>>>>>>      structure_end liFile DF_STRUCTEND_OPT_NONE "." // (pRestuctOpt(self)) (pTempDir(self))
54144>>>>>>>>>>>>>>>    end
54144>>>>>>>>>>>>>>>>
54144>>>>>>>>>>>>>>>
54144>>>>>>>>>>>>>>>    send fix_the_tag_file to (oFieldNameRepair(self))
54145>>>>>>>>>>>>>>>    set piFileHandle to liFile
54146>>>>>>>>>>>>>>>//  send DFMatrixError_Off
54146>>>>>>>>>>>>>>>//  if (piErrorHandling(self)) get private.piOrigOnError to |VI31 // Restore normal error handling routine
54146>>>>>>>>>>>>>>>    send NotifyTracer RSOP_END 0 0 0 0 ""
54147>>>>>>>>>>>>>>>    send delete_data to (oOldFieldNumbersRepair(self))
54148>>>>>>>>>>>>>>>
54148>>>>>>>>>>>>>>>    if (private.piSortOnEndStructure(self)) begin
54150>>>>>>>>>>>>>>>      get piMainFile to lhSortHandle
54151>>>>>>>>>>>>>>>      if lhSortHandle begin // We don't reindex files that were just created
54153>>>>>>>>>>>>>>>        send WriteLn to (oStructure_LogFile(self)) "  Forcing reindex..."
54154>>>>>>>>>>>>>>>        close lhSortHandle
54155>>>>>>>>>>>>>>>//      send WriteLn to (oStructure_LogFile(self)) ("  And the sort handle is: "+string(lhSortHandle))
54155>>>>>>>>>>>>>>>//      send WriteLn to (oStructure_LogFile(self)) ("  And the rootname is: "+physical_name#)
54155>>>>>>>>>>>>>>>//      if (lhSortHandle=1 or lhSortHandle=21 or lhSortHandle=95) begin
54155>>>>>>>>>>>>>>>//        send obs "open physical_name# as" physical_name# lhSortHandle DF_EXCLUSIVE
54155>>>>>>>>>>>>>>>
54155>>>>>>>>>>>>>>>//        send obs "Errors?" WINDOWINDEX
54155>>>>>>>>>>>>>>>//      end
54155>>>>>>>>>>>>>>>//      open physical_name# as lhSortHandle DF_EXCLUSIVE
54155>>>>>>>>>>>>>>>
54155>>>>>>>>>>>>>>>        get DBMS_OpenFileAs physical_name# lhSortHandle DF_EXCLUSIVE 0 to lbOpen
54156>>>>>>>>>>>>>>>        if lbOpen begin
54158>>>>>>>>>>>>>>>          if wmode# ne RS_PG_NONE sort lhSortHandle '' (DF_SORT_OPTION_BAD_DATA_FILE ior DF_SORT_OPTION_DUP_DATA_FILE) callback_obj#
54162>>>>>>>>>>>>>>>          else sort lhSortHandle '' (DF_SORT_OPTION_BAD_DATA_FILE ior DF_SORT_OPTION_DUP_DATA_FILE)
54165>>>>>>>>>>>>>>>        end
54165>>>>>>>>>>>>>>>>
54165>>>>>>>>>>>>>>>        else send WriteLnError to (oStructure_LogFile(self)) "  Table could not be opened for reindexing!"
54167>>>>>>>>>>>>>>>//      if (FDX_SetOfIndices(0,lhSortHandle,DF_INDEX_TYPE_ONLINE)+FDX_SetOfIndices(0,lhSortHandle,DF_INDEX_TYPE_BATCH)) ne "" begin
54167>>>>>>>>>>>>>>>//        if wmode# ne RS_PG_NONE sort lhSortHandle '' (DF_SORT_OPTION_BAD_DATA_FILE ior DF_SORT_OPTION_DUP_DATA_FILE) callback_obj#
54167>>>>>>>>>>>>>>>//        else sort lhSortHandle '' (DF_SORT_OPTION_BAD_DATA_FILE ior DF_SORT_OPTION_DUP_DATA_FILE)
54167>>>>>>>>>>>>>>>//      end
54167>>>>>>>>>>>>>>>//      else send WriteLn to (oStructure_LogFile(self)) "  No indices on table, reindex abandoned!"
54167>>>>>>>>>>>>>>>        close lhSortHandle
54168>>>>>>>>>>>>>>>      end
54168>>>>>>>>>>>>>>>>
54168>>>>>>>>>>>>>>>    end
54168>>>>>>>>>>>>>>>>
54168>>>>>>>>>>>>>>>
54168>>>>>>>>>>>>>>>    send DFMatrixError_Off
54169>>>>>>>>>>>>>>>    if (piErrorHandling(self)) get private.piOrigOnError to |VI31 // Restore normal error handling routine
54172>>>>>>>>>>>>>>>
54172>>>>>>>>>>>>>>>    send CloseOutput to (oStructure_LogFile(self)) // Structure_End
54173>>>>>>>>>>>>>>>
54173>>>>>>>>>>>>>>>    if wmode# eq RS_PG_DEFAULT send deactivate_display to callback_obj#
54176>>>>>>>>>>>>>>>  end_procedure
54177>>>>>>>>>>>>>>>
54177>>>>>>>>>>>>>>>  procedure SetFileAttr integer attr# string value#
54179>>>>>>>>>>>>>>>    integer liFile
54179>>>>>>>>>>>>>>>    if (piProbeState(self)) begin
54181>>>>>>>>>>>>>>>      error 674 "Sorry, no SETFILEATTR while in probe mode"
54182>>>>>>>>>>>>>>>>
54182>>>>>>>>>>>>>>>      procedure_return
54183>>>>>>>>>>>>>>>    end
54183>>>>>>>>>>>>>>>>
54183>>>>>>>>>>>>>>>    ifnot (piIgnoreTheRestState(self)) begin
54185>>>>>>>>>>>>>>>      if attr# eq DF_FILE_RECORD_LENGTH send postponed_setting to (oPostponedFileSettings(self)) attr# value#
54188>>>>>>>>>>>>>>>      else begin
54189>>>>>>>>>>>>>>>        get piFileHandle to liFile
54190>>>>>>>>>>>>>>>        //send obs "SET FileAttribute of" liFile (API_Attr_Name(attr#)) value#
54190>>>>>>>>>>>>>>>        ErrorTrapping.set_attribute attr# of liFile to value#
54198>>>>>>>>>>>>>>>        send NotifyTracer RSOP_SETFILEATTR attr# 0 0 0 value#
54199>>>>>>>>>>>>>>>      end
54199>>>>>>>>>>>>>>>>
54199>>>>>>>>>>>>>>>    end
54199>>>>>>>>>>>>>>>>
54199>>>>>>>>>>>>>>>  end_procedure
54200>>>>>>>>>>>>>>>  procedure SetFieldAttr integer attr# integer field# string value#
54202>>>>>>>>>>>>>>>    integer liFile
54202>>>>>>>>>>>>>>>    if (piProbeState(self)) begin
54204>>>>>>>>>>>>>>>      error 675 "Sorry, no SETFIELDATTR while in probe mode"
54205>>>>>>>>>>>>>>>>
54205>>>>>>>>>>>>>>>      procedure_return
54206>>>>>>>>>>>>>>>    end
54206>>>>>>>>>>>>>>>>
54206>>>>>>>>>>>>>>>    ifnot (piIgnoreTheRestState(self)) begin
54208>>>>>>>>>>>>>>>      if attr# eq DF_FIELD_NAME begin
54210>>>>>>>>>>>>>>>        if "@" in value# move (sAddField.s(oFieldNameRepair(self),value#)) to value#
54213>>>>>>>>>>>>>>>        if (StringBeginsWith(value#,"FIELD")) move (sAddField.s(oFieldNameRepair(self),value#)) to value#
54216>>>>>>>>>>>>>>>      end
54216>>>>>>>>>>>>>>>>
54216>>>>>>>>>>>>>>>      if attr# eq DF_FIELD_INDEX begin
54218>>>>>>>>>>>>>>>        // We postpone main index setting until the very end. Then we are
54218>>>>>>>>>>>>>>>        // sure that the relevant index is present
54218>>>>>>>>>>>>>>>        if field# eq IMPLICIT_FIELD get private.piCurrentField to field#
54221>>>>>>>>>>>>>>>        send postponed_setting to (oPostponedFieldSettings(self)) attr# field# value#
54222>>>>>>>>>>>>>>>      end
54222>>>>>>>>>>>>>>>>
54222>>>>>>>>>>>>>>>      else begin
54223>>>>>>>>>>>>>>>        if field# eq IMPLICIT_FIELD get private.piCurrentField to field#
54226>>>>>>>>>>>>>>>        get piFileHandle to liFile
54227>>>>>>>>>>>>>>>        ErrorTrapping.set_attribute attr# of liFile field# to value#
54236>>>>>>>>>>>>>>>        send NotifyTracer RSOP_SETFIELDATTR attr# field# 0 0 value#
54237>>>>>>>>>>>>>>>      end
54237>>>>>>>>>>>>>>>>
54237>>>>>>>>>>>>>>>    end
54237>>>>>>>>>>>>>>>>
54237>>>>>>>>>>>>>>>  end_procedure
54238>>>>>>>>>>>>>>>  function iFindFieldOldNumber.i integer old_number# returns integer
54240>>>>>>>>>>>>>>>    integer liFile max# field# test#
54240>>>>>>>>>>>>>>>    // Very unfortunately, this function doesn't work! (DF_FIELD_OLD_NUMBER returns rubbish)
54240>>>>>>>>>>>>>>>    // Therefore we call another procedure until DAW gets it fixed
54240>>>>>>>>>>>>>>>    function_return (iFindFieldOldNumber.i(oOldFieldNumbersRepair(self),old_number#))
54241>>>>>>>>>>>>>>>    get piFileHandle to liFile
54242>>>>>>>>>>>>>>>    get_attribute DF_FILE_NUMBER_FIELDS of liFile to max#
54245>>>>>>>>>>>>>>>    for field# from 1 to max#
54251>>>>>>>>>>>>>>>>
54251>>>>>>>>>>>>>>>      get_attribute DF_FIELD_OLD_NUMBER of liFile field# to test#
54254>>>>>>>>>>>>>>>      if test# eq old_number# function_return field#
54257>>>>>>>>>>>>>>>    loop
54258>>>>>>>>>>>>>>>>
54258>>>>>>>>>>>>>>>    function_return -1
54259>>>>>>>>>>>>>>>  end_function
54260>>>>>>>>>>>>>>>  function iFindFieldName.s string name# returns integer
54262>>>>>>>>>>>>>>>    integer field# max# liFile
54262>>>>>>>>>>>>>>>    string test_name#
54262>>>>>>>>>>>>>>>    get piFileHandle to liFile
54263>>>>>>>>>>>>>>>    get field_count to max#
54264>>>>>>>>>>>>>>>    // First we look for the name passed:
54264>>>>>>>>>>>>>>>    for field# from 1 to max#
54270>>>>>>>>>>>>>>>>
54270>>>>>>>>>>>>>>>      get_attribute DF_FIELD_NAME of liFile field# to test_name#
54273>>>>>>>>>>>>>>>      if test_name# eq name# function_return field#
54276>>>>>>>>>>>>>>>    loop
54277>>>>>>>>>>>>>>>>
54277>>>>>>>>>>>>>>>    // If not found we now see if it helps to translate it:
54277>>>>>>>>>>>>>>>    get sTempName.s of (oFieldNameRepair(self)) name# to name#
54278>>>>>>>>>>>>>>>    if name# ne "" begin
54280>>>>>>>>>>>>>>>      for field# from 1 to max#
54286>>>>>>>>>>>>>>>>
54286>>>>>>>>>>>>>>>        get_attribute DF_FIELD_NAME of liFile field# to test_name#
54289>>>>>>>>>>>>>>>        if test_name# eq name# function_return field#
54292>>>>>>>>>>>>>>>      loop
54293>>>>>>>>>>>>>>>>
54293>>>>>>>>>>>>>>>    end
54293>>>>>>>>>>>>>>>>
54293>>>>>>>>>>>>>>>    function_return -1
54294>>>>>>>>>>>>>>>  end_function
54295>>>>>>>>>>>>>>>  procedure SetFieldAttr_OldNumber integer attr# integer old_number# string value#
54297>>>>>>>>>>>>>>>    integer field#
54297>>>>>>>>>>>>>>>    error 678 "Procedure SetFieldAttr_OldNumber in STRUCTUR.UTL) was called"
54298>>>>>>>>>>>>>>>>
54298>>>>>>>>>>>>>>>    get iFindFieldOldNumber.i old_number# to field#
54299>>>>>>>>>>>>>>>    if field# ne -1 send SetFieldAttr attr# field# value#
54302>>>>>>>>>>>>>>>    else error 669 ("Old number not found ("+string(old_number#)+")")
54304>>>>>>>>>>>>>>>  end_procedure
54305>>>>>>>>>>>>>>>  procedure SetFieldAttr_ByName integer attr# string name# string value#
54307>>>>>>>>>>>>>>>    integer field#
54307>>>>>>>>>>>>>>>    ifnot (piIgnoreTheRestState(self)) begin
54309>>>>>>>>>>>>>>>      get iFindFieldName.s name# to field#
54310>>>>>>>>>>>>>>>      if field# ne -1 send SetFieldAttr attr# field# value#
54313>>>>>>>>>>>>>>>      else error 670 ("Field name not found ("+name#+")")
54315>>>>>>>>>>>>>>>    end
54315>>>>>>>>>>>>>>>>
54315>>>>>>>>>>>>>>>  end_procedure
54316>>>>>>>>>>>>>>>  procedure SetIndexAttr_Help integer index#
54318>>>>>>>>>>>>>>>    integer liFile index_handle# arr# max#
54318>>>>>>>>>>>>>>>    if (index#<1 or index#>15) error 671 ("Index number out of bounds ("+string(index#)+")")
54321>>>>>>>>>>>>>>>    move (oTmpArray(self)) to arr#
54322>>>>>>>>>>>>>>>    send delete_data to arr#
54323>>>>>>>>>>>>>>>    get piFileHandle to liFile
54324>>>>>>>>>>>>>>>    move index# to index_handle#
54325>>>>>>>>>>>>>>>    repeat
54325>>>>>>>>>>>>>>>>
54325>>>>>>>>>>>>>>>      ErrorTrapping.create_index liFile at index_handle#
54330>>>>>>>>>>>>>>>      if index_handle# ne index# set value of arr# item index_handle# to 1
54333>>>>>>>>>>>>>>>    until index_handle# eq index#
54335>>>>>>>>>>>>>>>    get item_count of arr# to max#
54336>>>>>>>>>>>>>>>    for index# from 0 to (max#-1)
54342>>>>>>>>>>>>>>>>
54342>>>>>>>>>>>>>>>      if (integer(value(arr#,index#))) ErrorTrapping.delete_index liFile index#
54349>>>>>>>>>>>>>>>    loop
54350>>>>>>>>>>>>>>>>
54350>>>>>>>>>>>>>>>    send delete_data to arr#
54351>>>>>>>>>>>>>>>  end_procedure
54352>>>>>>>>>>>>>>>  procedure SetIndexAttr integer attr# integer index# string value#
54354>>>>>>>>>>>>>>>    integer liFile segments#
54354>>>>>>>>>>>>>>>    if (piProbeState(self)) begin
54356>>>>>>>>>>>>>>>      error 676 "Sorry, not while in probe mode"
54357>>>>>>>>>>>>>>>>
54357>>>>>>>>>>>>>>>      procedure_return
54358>>>>>>>>>>>>>>>    end
54358>>>>>>>>>>>>>>>>
54358>>>>>>>>>>>>>>>    ifnot (piIgnoreTheRestState(self)) begin
54360>>>>>>>>>>>>>>>      if (attr#=DF_INDEX_NUMBER_SEGMENTS and integer(value#)=0) send DeleteIndex index#
54363>>>>>>>>>>>>>>>      else begin
54364>>>>>>>>>>>>>>>        get piFileHandle to liFile
54365>>>>>>>>>>>>>>>        get_attribute DF_INDEX_NUMBER_SEGMENTS of liFile index# to segments#
54368>>>>>>>>>>>>>>>        ifnot segments# send SetIndexAttr_Help index# // create_index liFile at index#
54371>>>>>>>>>>>>>>>        ErrorTrapping.set_attribute attr# of liFile index# to value#
54380>>>>>>>>>>>>>>>        send NotifyTracer RSOP_SETINDEXATTR attr# 0 index# 0 value#
54381>>>>>>>>>>>>>>>      end
54381>>>>>>>>>>>>>>>>
54381>>>>>>>>>>>>>>>    end
54381>>>>>>>>>>>>>>>>
54381>>>>>>>>>>>>>>>  end_procedure
54382>>>>>>>>>>>>>>>  procedure SetIndexSegAttr integer attr# integer index# integer seg# string value#
54384>>>>>>>>>>>>>>>    integer liFile field# type#
54384>>>>>>>>>>>>>>>    if (piProbeState(self)) begin
54386>>>>>>>>>>>>>>>      error 677 "Sorry, not while in probe mode"
54387>>>>>>>>>>>>>>>>
54387>>>>>>>>>>>>>>>      procedure_return
54388>>>>>>>>>>>>>>>    end
54388>>>>>>>>>>>>>>>>
54388>>>>>>>>>>>>>>>    ifnot (piIgnoreTheRestState(self)) begin
54390>>>>>>>>>>>>>>>      get piFileHandle to liFile
54391>>>>>>>>>>>>>>>      if attr# eq DF_INDEX_SEGMENT_CASE begin
54393>>>>>>>>>>>>>>>        get_attribute DF_INDEX_SEGMENT_FIELD of liFile index# seg# to field#
54396>>>>>>>>>>>>>>>        get_attribute DF_FIELD_TYPE of liFile field# to type#
54399>>>>>>>>>>>>>>>        if (type#<>DF_ASCII and integer(value#)=DF_CASE_IGNORED) procedure_return // We only do this for ASCII fields
54402>>>>>>>>>>>>>>>      end
54402>>>>>>>>>>>>>>>>
54402>>>>>>>>>>>>>>>      ErrorTrapping.set_attribute attr# of liFile index# seg# to value#
54412>>>>>>>>>>>>>>>      send NotifyTracer RSOP_SETINDEXSEGATTR attr# 0 index# seg# value#
54413>>>>>>>>>>>>>>>    end
54413>>>>>>>>>>>>>>>>
54413>>>>>>>>>>>>>>>  end_procedure
54414>>>>>>>>>>>>>>>
54414>>>>>>>>>>>>>>>  function GetFileAttr integer attr# returns string
54416>>>>>>>>>>>>>>>    integer liFile
54416>>>>>>>>>>>>>>>    string value#
54416>>>>>>>>>>>>>>>    get piFileHandle to liFile
54417>>>>>>>>>>>>>>>    get_attribute attr# of liFile to value#
54420>>>>>>>>>>>>>>>    function_return value#
54421>>>>>>>>>>>>>>>  end_function
54422>>>>>>>>>>>>>>>  function GetFieldAttr integer attr# integer field# returns string
54424>>>>>>>>>>>>>>>    integer liFile
54424>>>>>>>>>>>>>>>    string value#
54424>>>>>>>>>>>>>>>    if field# eq IMPLICIT_FIELD get private.piCurrentField to field#
54427>>>>>>>>>>>>>>>    get piFileHandle to liFile
54428>>>>>>>>>>>>>>>    get_attribute attr# of liFile field# to value#
54431>>>>>>>>>>>>>>>    function_return value#
54432>>>>>>>>>>>>>>>  end_function
54433>>>>>>>>>>>>>>>  function GetIndexAttr integer attr# integer index# returns string
54435>>>>>>>>>>>>>>>    integer liFile
54435>>>>>>>>>>>>>>>    string value#
54435>>>>>>>>>>>>>>>    get piFileHandle to liFile
54436>>>>>>>>>>>>>>>    get_attribute attr# of liFile index# to value#
54439>>>>>>>>>>>>>>>    function_return value#
54440>>>>>>>>>>>>>>>  end_function
54441>>>>>>>>>>>>>>>  function GetIndexSegAttr integer attr# integer index# integer seg# returns string
54443>>>>>>>>>>>>>>>    integer liFile
54443>>>>>>>>>>>>>>>    string value#
54443>>>>>>>>>>>>>>>    get piFileHandle to liFile
54444>>>>>>>>>>>>>>>    get_attribute attr# of liFile index# seg# to value#
54447>>>>>>>>>>>>>>>    function_return value#
54448>>>>>>>>>>>>>>>  end_function
54449>>>>>>>>>>>>>>>  function GetFileListAttr integer attr# returns string
54451>>>>>>>>>>>>>>>    integer liFile
54451>>>>>>>>>>>>>>>    string value#
54451>>>>>>>>>>>>>>>    get piFileHandle to liFile
54452>>>>>>>>>>>>>>>    get_attribute attr# of liFile to value#
54455>>>>>>>>>>>>>>>    function_return value#
54456>>>>>>>>>>>>>>>  end_function
54457>>>>>>>>>>>>>>>
54457>>>>>>>>>>>>>>>  procedure TableDropHelp string lsFile
54459>>>>>>>>>>>>>>>    integer liError
54459>>>>>>>>>>>>>>>    move (uppercase(lsFile)) to lsFile
54460>>>>>>>>>>>>>>>    if (right(lsFile,3)="DAT") move 1 to liError
54463>>>>>>>>>>>>>>>    if (right(lsFile,3)="TAG") move 1 to liError
54466>>>>>>>>>>>>>>>    if (right(lsFile,3)="VLD") move 1 to liError
54469>>>>>>>>>>>>>>>    if (right(lsFile,3)="HDR") move 1 to liError
54472>>>>>>>>>>>>>>>//    if (right(lsFile,1)="K")   move 1 to liError
54472>>>>>>>>>>>>>>>    if (right(lsFile,3)="DEF") move 1 to liError
54475>>>>>>>>>>>>>>>    if (right(lsFile,2)="FD")  move 1 to liError
54478>>>>>>>>>>>>>>>    if liError set private.piDropCounter to (private.piDropCounter(self)+1)
54481>>>>>>>>>>>>>>>  end_procedure
54482>>>>>>>>>>>>>>>  function iTableDrop.s string lsRoot returns integer
54484>>>>>>>>>>>>>>>    string lsDatFile lsPath liGrb
54484>>>>>>>>>>>>>>>    move (lowercase(lsRoot)) to lsRoot
54485>>>>>>>>>>>>>>>    move (lsRoot+".dat") to lsDatFile
54486>>>>>>>>>>>>>>>    move (SEQ_FindFileAlongDFPath(lsDatFile)) to lsPath
54487>>>>>>>>>>>>>>>    move (SEQ_ComposeAbsoluteFileName(lsPath,lsRoot)) to lsRoot
54488>>>>>>>>>>>>>>>    get SEQ_EraseFile (lsRoot+".dat") to liGrb
54489>>>>>>>>>>>>>>>    get SEQ_EraseFile (lsRoot+".tag") to liGrb
54490>>>>>>>>>>>>>>>    get SEQ_EraseFile (lsRoot+".vld") to liGrb
54491>>>>>>>>>>>>>>>    get SEQ_EraseFile (lsRoot+".hdr") to liGrb
54492>>>>>>>>>>>>>>>    get SEQ_EraseFile (lsRoot+".k?") to liGrb
54493>>>>>>>>>>>>>>>    get SEQ_EraseFile (lsRoot+".def") to liGrb
54494>>>>>>>>>>>>>>>    get SEQ_EraseFile (lsRoot+".fd") to liGrb
54495>>>>>>>>>>>>>>>    send SEQ_Load_ItemsInDir (lsRoot+".*")
54496>>>>>>>>>>>>>>>    set private.piDropCounter to 0
54497>>>>>>>>>>>>>>>    send SEQ_CallBack_ItemsInDir SEQCB_FILES_ONLY msg_TableDropHelp self
54498>>>>>>>>>>>>>>>    function_return (private.piDropCounter(self))
54499>>>>>>>>>>>>>>>  end_function
54500>>>>>>>>>>>>>>>  function iTableProbe.i integer liFile returns integer
54502>>>>>>>>>>>>>>>    integer rval#
54502>>>>>>>>>>>>>>>    move (DBMS_OpenFile(liFile,DF_SHARE,0)) to rval#
54503>>>>>>>>>>>>>>>    set piProbeState to rval#
54504>>>>>>>>>>>>>>>    if rval# begin
54506>>>>>>>>>>>>>>>      set piMainFile to liFile
54507>>>>>>>>>>>>>>>      set piFileHandle to liFile
54508>>>>>>>>>>>>>>>    end
54508>>>>>>>>>>>>>>>>
54508>>>>>>>>>>>>>>>    function_return (not(rval#)) // Returns 0 if success
54509>>>>>>>>>>>>>>>  end_function
54510>>>>>>>>>>>>>>>  procedure Probe_End
54512>>>>>>>>>>>>>>>    if (piProbeState(self)) begin
54514>>>>>>>>>>>>>>>      close (piMainFile(self))
54515>>>>>>>>>>>>>>>      set piProbeState to false
54516>>>>>>>>>>>>>>>    end
54516>>>>>>>>>>>>>>>>
54516>>>>>>>>>>>>>>>    else error 679 "Probing not initialized"
54518>>>>>>>>>>>>>>>  end_procedure
54519>>>>>>>>>>>>>>>
54519>>>>>>>>>>>>>>>  procedure reset.is integer liFile string lsRootName
54521>>>>>>>>>>>>>>>    send DFMatrixError_On
54522>>>>>>>>>>>>>>>    if liFile send DoWriteTimeEntry to (oStructure_LogFile(self)) ("Restructuring table: "+lsRootName+" ("+string(liFile)+")")
54525>>>>>>>>>>>>>>>    else      send DoWriteTimeEntry to (oStructure_LogFile(self)) ("Creating table: "+lsRootName)
54527>>>>>>>>>>>>>>>    set piMainFile to liFile
54528>>>>>>>>>>>>>>>    if liFile set piInitialNumberOfFields to (API_AttrValue_FILE(DF_FILE_NUMBER_FIELDS,liFile))
54531>>>>>>>>>>>>>>>    else set piInitialNumberOfFields to 0
54533>>>>>>>>>>>>>>>    set piIgnoreTheRestState to 0
54534>>>>>>>>>>>>>>>  end_procedure
54535>>>>>>>>>>>>>>>
54535>>>>>>>>>>>>>>>  function iTableOpen.is integer liFile string fn# returns integer
54537>>>>>>>>>>>>>>>    integer rval#
54537>>>>>>>>>>>>>>>    string path#
54537>>>>>>>>>>>>>>>    move (DBMS_OpenFileAs(fn#,liFile,DF_EXCLUSIVE,0)) to rval#
54538>>>>>>>>>>>>>>>    if rval# begin
54540>>>>>>>>>>>>>>>      //move (rval#=DBMS_DRIVER_DATAFLEX) to rval# // Only DataFlex files
54540>>>>>>>>>>>>>>>      ifnot rval# close liFile
54543>>>>>>>>>>>>>>>    end
54543>>>>>>>>>>>>>>>>
54543>>>>>>>>>>>>>>>    if rval# begin
54545>>>>>>>>>>>>>>>      send AppendOutput to (oStructure_LogFile(self))
54546>>>>>>>>>>>>>>>      send reset.is liFile fn#
54547>>>>>>>>>>>>>>>      move (fn#+".dat") to fn#
54548>>>>>>>>>>>>>>>      move (SEQ_ExtractPathFromFileName(fn#)) to path#
54549>>>>>>>>>>>>>>>      set psDatFileName to (SEQ_RemovePathFromFileName(fn#))
54550>>>>>>>>>>>>>>>      if path# eq "" move (SEQ_FindFileAlongDFPath(fn#)) to path#
54553>>>>>>>>>>>>>>>      set psDatFilePath to path#
54554>>>>>>>>>>>>>>>      send structure_start
54555>>>>>>>>>>>>>>>    end
54555>>>>>>>>>>>>>>>>
54555>>>>>>>>>>>>>>>    else send CloseOutput to (oStructure_LogFile(self)) // Close log file if table could not open
54557>>>>>>>>>>>>>>>    set piRS_State to rval#
54558>>>>>>>>>>>>>>>    function_return (not(rval#)) // Returns 0 if success
54559>>>>>>>>>>>>>>>  end_function
54560>>>>>>>>>>>>>>>
54560>>>>>>>>>>>>>>>  function iTableOpen.i integer liFile returns integer
54562>>>>>>>>>>>>>>>    integer rval#
54562>>>>>>>>>>>>>>>    string fn# path#
54562>>>>>>>>>>>>>>>    move (DBMS_IsOpenFile(liFile)) to rval#
54563>>>>>>>>>>>>>>>    if rval# ifnot (integer(API_AttrValue_FILE(DF_FILE_OPEN_MODE,liFile))=DF_EXCLUSIVE) move 0 to rval#
54568>>>>>>>>>>>>>>>    ifnot rval# move (DBMS_OpenFile(liFile,DF_EXCLUSIVE,0)) to rval#
54571>>>>>>>>>>>>>>>    if rval# begin
54573>>>>>>>>>>>>>>>      //move (rval#=DBMS_DRIVER_DATAFLEX) to rval# // Only DataFlex files
54573>>>>>>>>>>>>>>>      ifnot rval# close liFile
54576>>>>>>>>>>>>>>>    end
54576>>>>>>>>>>>>>>>>
54576>>>>>>>>>>>>>>>    if rval# begin
54578>>>>>>>>>>>>>>>      move (API_AttrValue_FILELIST(DF_FILE_ROOT_NAME,liFile)) to fn#
54579>>>>>>>>>>>>>>>      send AppendOutput to (oStructure_LogFile(self))
54580>>>>>>>>>>>>>>>      send reset.is liFile fn#
54581>>>>>>>>>>>>>>>      move (fn#+".dat") to fn#
54582>>>>>>>>>>>>>>>      move (SEQ_ExtractPathFromFileName(fn#)) to path#
54583>>>>>>>>>>>>>>>      set psDatFileName to (SEQ_RemovePathFromFileName(fn#))
54584>>>>>>>>>>>>>>>      if path# eq "" move (SEQ_FindFileAlongDFPath(fn#)) to path#
54587>>>>>>>>>>>>>>>      set psDatFilePath to path#
54588>>>>>>>>>>>>>>>      send structure_start
54589>>>>>>>>>>>>>>>    end
54589>>>>>>>>>>>>>>>>
54589>>>>>>>>>>>>>>>    else send CloseOutput to (oStructure_LogFile(self)) //
54591>>>>>>>>>>>>>>>    set piRS_State to rval#
54592>>>>>>>>>>>>>>>    function_return (not(rval#)) // Returns 0 if success
54593>>>>>>>>>>>>>>>  end_function
54594>>>>>>>>>>>>>>>
54594>>>>>>>>>>>>>>>  function iTableExists.s string root# returns integer
54596>>>>>>>>>>>>>>>    integer rval#
54596>>>>>>>>>>>>>>>    function_return 1
54597>>>>>>>>>>>>>>>  end_function
54598>>>>>>>>>>>>>>>
54598>>>>>>>>>>>>>>>  //> Specifying a root name that does already exist on
54598>>>>>>>>>>>>>>>  //> disk will overwrite existing data.
54598>>>>>>>>>>>>>>>  //> Omitting the path from the root name will place the
54598>>>>>>>>>>>>>>>  //> table in the first directory of the current DFPATH.
54598>>>>>>>>>>>>>>>  //> Returns 0 if all is well
54598>>>>>>>>>>>>>>>  function iTableCreate.s string lsRoot returns integer
54600>>>>>>>>>>>>>>>    send AppendOutput to (oStructure_LogFile(self))
54601>>>>>>>>>>>>>>>    send reset.is 0 lsRoot
54602>>>>>>>>>>>>>>>    set psDatFileName to (SEQ_RemovePathFromFileName(lsRoot)+".dat")
54603>>>>>>>>>>>>>>>    set psDatFilePath to (SEQ_ExtractPathFromFileName(lsRoot))
54604>>>>>>>>>>>>>>>    if (SEQ_FileExists(ToAnsi(lsRoot)+".dat")=SEQIT_NONE) begin
54606>>>>>>>>>>>>>>>    //send obs "psDatFileName" (psDatFileName(self)) "psDatFilePath" (psDatFilePath(self))
54606>>>>>>>>>>>>>>>      send structure_start
54607>>>>>>>>>>>>>>>      send SetFileAttr DF_FILE_MAX_RECORDS   10000 // Set up a few default values
54608>>>>>>>>>>>>>>>      send SetFileAttr DF_FILE_MULTIUSER     DF_FILE_USER_MULTI
54609>>>>>>>>>>>>>>>      send SetFileAttr DF_FILE_REUSE_DELETED DF_FILE_DELETED_REUSE
54610>>>>>>>>>>>>>>>      send SetFileAttr DF_FILE_PHYSICAL_NAME (ToAnsi(lsRoot))
54611>>>>>>>>>>>>>>>      function_return 0 // 0 means OK
54612>>>>>>>>>>>>>>>    end
54612>>>>>>>>>>>>>>>>
54612>>>>>>>>>>>>>>>    send WriteLnError to (oStructure_LogFile(self)) ("  Cannot create existing file "+lsRoot+".dat")
54613>>>>>>>>>>>>>>>    send DFMatrixError_Off
54614>>>>>>>>>>>>>>>    send CloseOutput to (oStructure_LogFile(self)) // Closes log file if Table could not be created
54615>>>>>>>>>>>>>>>    function_return 1
54616>>>>>>>>>>>>>>>  end_function
54617>>>>>>>>>>>>>>>  procedure display_definition
54619>>>>>>>>>>>>>>>    integer liFile
54619>>>>>>>>>>>>>>>    get piFileHandle to liFile
54620>>>>>>>>>>>>>>>
54620>>>>>>>>>>>>>>>    send FDX_ModalDisplayFileAttributes 0 liFile
54621>>>>>>>>>>>>>>>  end_procedure
54622>>>>>>>>>>>>>>>  procedure NotifyTracer integer op# integer attr# integer field# integer index# integer seg# string value#
54624>>>>>>>>>>>>>>>    integer liFile
54624>>>>>>>>>>>>>>>    get piFileHandle to liFile
54625>>>>>>>>>>>>>>>    if (piTraceObject(self)) send RegisterUpdate to (piTraceObject(self)) liFile op# attr# field# index# seg# value#
54628>>>>>>>>>>>>>>>  end_procedure
54629>>>>>>>>>>>>>>>
54629>>>>>>>>>>>>>>>  //> This function returns the root name of the file including path
54629>>>>>>>>>>>>>>>  //> if a path was originally specified:
54629>>>>>>>>>>>>>>>  function sRootInclPath returns string
54631>>>>>>>>>>>>>>>    string root# path#
54631>>>>>>>>>>>>>>>    get psDatFileName to root#
54632>>>>>>>>>>>>>>>    move (replace(".dat",root#,"")) to root#
54633>>>>>>>>>>>>>>>    move (replace(".DAT",root#,"")) to root#
54634>>>>>>>>>>>>>>>    get psDatFilePath to path#
54635>>>>>>>>>>>>>>>    if path# ne "" move (SEQ_ComposeAbsoluteFileName(path#,root#)) to root#
54638>>>>>>>>>>>>>>>    function_return root#
54639>>>>>>>>>>>>>>>  end_function
54640>>>>>>>>>>>>>>>end_class // cBasicRestructurer
54641>>>>>>>>>>>>>>>
54641>>>>>>>>>>>>>>>integer oRestructurer#
54641>>>>>>>>>>>>>>>object oRestructurer is a cBasicRestructurer
54643>>>>>>>>>>>>>>>  move self to oRestructurer#
54644>>>>>>>>>>>>>>>end_object
54645>>>>>>>>>>>>>>>
54645>>>>>>>>>>>>>>>// This one is used to control whether the sentinel should be
54645>>>>>>>>>>>>>>>// removed from screen when a restructure has ended.
54645>>>>>>>>>>>>>>>procedure RS_Progress global integer mode#
54647>>>>>>>>>>>>>>>  send SetProgressMode to oRestructurer# mode#
54648>>>>>>>>>>>>>>>end_procedure
54649>>>>>>>>>>>>>>>
54649>>>>>>>>>>>>>>>// ********************** GLOBAL INTERFACE ******************************
54649>>>>>>>>>>>>>>>//> Display the definition as it looks right now. May be sent during a
54649>>>>>>>>>>>>>>>//> restructure for debug purposes.
54649>>>>>>>>>>>>>>>procedure RS_DisplayDef global
54651>>>>>>>>>>>>>>>  send Display_Definition to oRestructurer#
54652>>>>>>>>>>>>>>>end_procedure
54653>>>>>>>>>>>>>>>//> May be used to manually set the field pointed to by the symbol
54653>>>>>>>>>>>>>>>//> IMPLICIT_FIELD (which is in fact -1)
54653>>>>>>>>>>>>>>>procedure RS_SetFieldNumber global integer field#
54655>>>>>>>>>>>>>>>  send SetFieldNumber to oRestructurer# field#
54656>>>>>>>>>>>>>>>end_procedure
54657>>>>>>>>>>>>>>>//> Inserts a new field before existing field number field#. When this
54657>>>>>>>>>>>>>>>//> is done you should take care manually to change the offsets and
54657>>>>>>>>>>>>>>>//> lengths of affected overlap fields.
54657>>>>>>>>>>>>>>>procedure RS_CreateField global integer field# string name# integer type#
54659>>>>>>>>>>>>>>>  send CreateField to oRestructurer# field# name# type#
54660>>>>>>>>>>>>>>>end_procedure
54661>>>>>>>>>>>>>>>procedure RS_CreateField_OldNumber global integer field# string name# integer type#
54663>>>>>>>>>>>>>>>  send CreateField_OldNumber to oRestructurer# field# name# type#
54664>>>>>>>>>>>>>>>end_procedure
54665>>>>>>>>>>>>>>>//> Appends a field to the existing ones. Following this there should
54665>>>>>>>>>>>>>>>//> always be messages to set the length of the field.
54665>>>>>>>>>>>>>>>procedure RS_AppendField global string name# integer type#
54667>>>>>>>>>>>>>>>  send AppendField to oRestructurer# name# type#
54668>>>>>>>>>>>>>>>end_procedure
54669>>>>>>>>>>>>>>>//> Deletes a field.
54669>>>>>>>>>>>>>>>procedure RS_DeleteField global integer field#
54671>>>>>>>>>>>>>>>  send DeleteField to oRestructurer# field#
54672>>>>>>>>>>>>>>>end_procedure
54673>>>>>>>>>>>>>>>//> Deletes a field.
54673>>>>>>>>>>>>>>>procedure RS_DeleteField_OldNumber global integer old_field#
54675>>>>>>>>>>>>>>>  send DeleteField_OldNumber to oRestructurer# old_field#
54676>>>>>>>>>>>>>>>end_procedure
54677>>>>>>>>>>>>>>>//> Deletes an index.
54677>>>>>>>>>>>>>>>procedure RS_DeleteIndex global integer idx#
54679>>>>>>>>>>>>>>>  send DeleteIndex to oRestructurer# idx#
54680>>>>>>>>>>>>>>>end_procedure
54681>>>>>>>>>>>>>>>//> Abort the restructure.
54681>>>>>>>>>>>>>>>procedure RS_Structure_Abort global
54683>>>>>>>>>>>>>>>  send Structure_Abort to oRestructurer#
54684>>>>>>>>>>>>>>>end_procedure
54685>>>>>>>>>>>>>>>//> Lets the changes that you have made so far take effect.
54685>>>>>>>>>>>>>>>procedure RS_Structure_End global integer liForceExtraSort
54687>>>>>>>>>>>>>>>  integer liDoSort
54687>>>>>>>>>>>>>>>  if num_arguments gt 0 move liForceExtraSort to liDoSort
54690>>>>>>>>>>>>>>>  else move DFFALSE to liDoSort
54692>>>>>>>>>>>>>>>  set private.piSortOnEndStructure of oRestructurer# to liDoSort
54693>>>>>>>>>>>>>>>  send Structure_End to oRestructurer#
54694>>>>>>>>>>>>>>>  set private.piSortOnEndStructure of oRestructurer# to DFFALSE
54695>>>>>>>>>>>>>>>end_procedure
54696>>>>>>>>>>>>>>>//> Closes the file formerly opened for probing.
54696>>>>>>>>>>>>>>>procedure RS_Probe_End global
54698>>>>>>>>>>>>>>>  send Probe_End to oRestructurer#
54699>>>>>>>>>>>>>>>end_procedure
54700>>>>>>>>>>>>>>>
54700>>>>>>>>>>>>>>>//> Returns the current number of fields.
54700>>>>>>>>>>>>>>>function RS_CurrentFieldCount global returns integer
54702>>>>>>>>>>>>>>>  function_return (field_count(oRestructurer#))
54703>>>>>>>>>>>>>>>end_function
54704>>>>>>>>>>>>>>>
54704>>>>>>>>>>>>>>>//> RS_TableOpenNumber returns 1 if the file was successfully opened
54704>>>>>>>>>>>>>>>//> for restructuring. The restructuring presumably anout to take place
54704>>>>>>>>>>>>>>>//> should be terminated with a RS_Structure_End or RS_Structure_Abort
54704>>>>>>>>>>>>>>>//> message.
54704>>>>>>>>>>>>>>>function RS_TableOpenNumber global integer liFile returns integer
54706>>>>>>>>>>>>>>>  function_return (not(iTableOpen.i(oRestructurer#,liFile)))
54707>>>>>>>>>>>>>>>end_function
54708>>>>>>>>>>>>>>>
54708>>>>>>>>>>>>>>>//> RS_TableOpenName returns 1 if the file was successfully opened
54708>>>>>>>>>>>>>>>//> for restrucuring. The restructuring presumably anout to take place
54708>>>>>>>>>>>>>>>//> should be terminated with a RS_Structure_End or RS_Structure_Abort
54708>>>>>>>>>>>>>>>//> message.
54708>>>>>>>>>>>>>>>function RS_TableOpenName global integer liFile string fn# returns integer
54710>>>>>>>>>>>>>>>  function_return (not(iTableOpen.is(oRestructurer#,liFile,fn#)))
54711>>>>>>>>>>>>>>>end_function
54712>>>>>>>>>>>>>>>
54712>>>>>>>>>>>>>>>//> RS_TableProbeNumber returns 1 if the file was successfully opened
54712>>>>>>>>>>>>>>>//> for probing. Probing should be ended with a RS_Probe_End message.
54712>>>>>>>>>>>>>>>function RS_TableProbeNumber global integer liFile returns integer
54714>>>>>>>>>>>>>>>  function_return (not(iTableProbe.i(oRestructurer#,liFile)))
54715>>>>>>>>>>>>>>>end_function
54716>>>>>>>>>>>>>>>function RS_TableCreateName global string root# returns integer
54718>>>>>>>>>>>>>>>  function_return (not(iTableCreate.s(oRestructurer#,root#)))
54719>>>>>>>>>>>>>>>end_function
54720>>>>>>>>>>>>>>>
54720>>>>>>>>>>>>>>>function RS_TableDropName global string root# returns integer
54722>>>>>>>>>>>>>>>  function_return (not(iTableDrop.s(oRestructurer#,root#)))
54723>>>>>>>>>>>>>>>end_function
54724>>>>>>>>>>>>>>>function RS_TableExistsName global string root# returns integer
54726>>>>>>>>>>>>>>>  function_return (iTableExists.s(oRestructurer#,root#))
54727>>>>>>>>>>>>>>>end_function
54728>>>>>>>>>>>>>>>
54728>>>>>>>>>>>>>>>//> Set value of File type attribute during restructuring.
54728>>>>>>>>>>>>>>>procedure RS_SetFileAttr global integer attr# string value#
54730>>>>>>>>>>>>>>>  send SetFileAttr to oRestructurer# attr# value#
54731>>>>>>>>>>>>>>>end_procedure
54732>>>>>>>>>>>>>>>//> Set value of Field type attribute during restructuring.
54732>>>>>>>>>>>>>>>procedure RS_SetFieldAttr global integer attr# integer field# string value#
54734>>>>>>>>>>>>>>>  send SetFieldAttr to oRestructurer# attr# field# value#
54735>>>>>>>>>>>>>>>end_procedure
54736>>>>>>>>>>>>>>>//> Set value of Field type attribute during restructuring. Field referenced by OLD_NUMBER
54736>>>>>>>>>>>>>>>procedure RS_SetFieldAttr_OldNumber global integer attr# integer field# string value#
54738>>>>>>>>>>>>>>>  send SetFieldAttr_OldNumber to oRestructurer# attr# field# value#
54739>>>>>>>>>>>>>>>end_procedure
54740>>>>>>>>>>>>>>>//> Set value of Field type attribute during restructuring. Field referenced by NAME
54740>>>>>>>>>>>>>>>procedure RS_SetFieldAttr_ByName global integer attr# string name# string value#
54742>>>>>>>>>>>>>>>  send SetFieldAttr_ByName to oRestructurer# attr# name# value#
54743>>>>>>>>>>>>>>>end_procedure
54744>>>>>>>>>>>>>>>//> Set value of Index type attribute during restructuring.
54744>>>>>>>>>>>>>>>procedure RS_SetIndexAttr global integer attr# integer index# string value#
54746>>>>>>>>>>>>>>>  send SetIndexAttr to oRestructurer# attr# index# value#
54747>>>>>>>>>>>>>>>end_procedure
54748>>>>>>>>>>>>>>>//> Set value of Index Segment type attribute during restructuring.
54748>>>>>>>>>>>>>>>procedure RS_SetIndexSegAttr global integer attr# integer index# integer seg# string value#
54750>>>>>>>>>>>>>>>  send SetIndexSegAttr to oRestructurer# attr# index# seg# value#
54751>>>>>>>>>>>>>>>end_procedure
54752>>>>>>>>>>>>>>>//> Set value of FileList type attribute during restructuring.
54752>>>>>>>>>>>>>>>procedure RS_SetFileListAttr global integer attr# integer liFile string value#
54754>>>>>>>>>>>>>>>  ErrorTrapping.set_attribute attr# of liFile to value#
54762>>>>>>>>>>>>>>>end_procedure
54763>>>>>>>>>>>>>>>
54763>>>>>>>>>>>>>>>//> Get value of File type attribute while restructuring or probing.
54763>>>>>>>>>>>>>>>function RS_GetFileAttr global integer attr# returns string
54765>>>>>>>>>>>>>>>  function_return (GetFileAttr(oRestructurer#,attr#))
54766>>>>>>>>>>>>>>>end_function
54767>>>>>>>>>>>>>>>//> Get value of Field type attribute while restructuring or probing.
54767>>>>>>>>>>>>>>>function RS_GetFieldAttr global integer attr# integer field# returns string
54769>>>>>>>>>>>>>>>  function_return (GetFieldAttr(oRestructurer#,attr#,field#))
54770>>>>>>>>>>>>>>>end_function
54771>>>>>>>>>>>>>>>//> Get value of Index type attribute while restructuring or probing.
54771>>>>>>>>>>>>>>>function RS_GetIndexAttr global integer attr# integer index# returns string
54773>>>>>>>>>>>>>>>  function_return (GetIndexAttr(oRestructurer#,attr#,index#))
54774>>>>>>>>>>>>>>>end_function
54775>>>>>>>>>>>>>>>//> Get value of Index Segment type attribute while restructuring or probing.
54775>>>>>>>>>>>>>>>function RS_GetIndexSegAttr global integer attr# integer index# integer seg# returns string
54777>>>>>>>>>>>>>>>  function_return (GetIndexSegAttr(oRestructurer#,attr#,index#,seg#))
54778>>>>>>>>>>>>>>>end_function
54779>>>>>>>>>>>>>>>//> Get value of FileList type attribute while restructuring or probing.
54779>>>>>>>>>>>>>>>function RS_GetFileListAttr global integer attr# returns string
54781>>>>>>>>>>>>>>>  function_return (GetFileListAttr(oRestructurer#,attr#))
54782>>>>>>>>>>>>>>>end_function
54783>>>>>>>>>>>>>>>
54783>>>>>>>>>>>>>Use API_Attr.nui // Database API attributes characteristics
54783>>>>>>>>>>>>>Use Spec0006.utl // Function MakeStringConstant and MakeStringConstantMax255
Including file: spec0006.utl    (C:\projects\BRS\VDFQuery\AppSrc\spec0006.utl)
54783>>>>>>>>>>>>>>>// Use Spec0006.utl // Function MakeStringConstant
54783>>>>>>>>>>>>>>>
54783>>>>>>>>>>>>>>>Use Strings.nui  // String manipulation for VDF
54783>>>>>>>>>>>>>>>
54783>>>>>>>>>>>>>>>//> If the length of the return value is two longer than the length of
54783>>>>>>>>>>>>>>>//> the passed argument, the function only put qoutes around it. Otherwise
54783>>>>>>>>>>>>>>>//> the argument has been converted to a concatenation of string constants.
54783>>>>>>>>>>>>>>>//>
54783>>>>>>>>>>>>>>>//>  World tour '99          becomes   "World tour '99"
54783>>>>>>>>>>>>>>>//>  7" nails                becomes   '7" nails'
54783>>>>>>>>>>>>>>>//>  10" reels for an '88    becomes   "10"+'" reels for an '+"'88"
54783>>>>>>>>>>>>>>>//
54783>>>>>>>>>>>>>>>
54783>>>>>>>>>>>>>>>function MakeStringConstant global string str# returns string
54785>>>>>>>>>>>>>>>  integer len# pos#
54785>>>>>>>>>>>>>>>  string char# rval# current_quote#
54785>>>>>>>>>>>>>>>  ifnot "'" in str# function_return ("'"+str#+"'")
54788>>>>>>>>>>>>>>>  ifnot '"' in str# function_return ('"'+str#+'"')
54791>>>>>>>>>>>>>>>  move "" to rval#
54792>>>>>>>>>>>>>>>  move (length(str#)) to len#
54793>>>>>>>>>>>>>>>  if (left(str#,1)) eq '"' move "'" to current_quote#
54796>>>>>>>>>>>>>>>  else move '"' to current_quote#
54798>>>>>>>>>>>>>>>  move current_quote# to rval#
54799>>>>>>>>>>>>>>>  for pos# from 0 to len#
54805>>>>>>>>>>>>>>>>
54805>>>>>>>>>>>>>>>    move (mid(str#,1,pos#)) to char#
54806>>>>>>>>>>>>>>>    if char# eq current_quote# begin
54808>>>>>>>>>>>>>>>      move (rval#+current_quote#+"+") to rval#
54809>>>>>>>>>>>>>>>      if current_quote# eq "'" move '"' to current_quote#
54812>>>>>>>>>>>>>>>      else move "'" to current_quote#
54814>>>>>>>>>>>>>>>      move (rval#+current_quote#) to rval#
54815>>>>>>>>>>>>>>>    end
54815>>>>>>>>>>>>>>>>
54815>>>>>>>>>>>>>>>    move (rval#+char#) to rval#
54816>>>>>>>>>>>>>>>  loop
54817>>>>>>>>>>>>>>>>
54817>>>>>>>>>>>>>>>  move (rval#+current_quote#) to rval#
54818>>>>>>>>>>>>>>>  function_return rval#
54819>>>>>>>>>>>>>>>end_function
54820>>>>>>>>>>>>>>>
54820>>>>>>>>>>>>>>>function MakeStringConstantMax255Help global string str# returns string
54822>>>>>>>>>>>>>>>  integer len# pos#
54822>>>>>>>>>>>>>>>  string char# rval# current_quote#
54822>>>>>>>>>>>>>>>  ifnot "'" in str# function_return ("'"+str#+"'")
54825>>>>>>>>>>>>>>>  ifnot '"' in str# function_return ('"'+str#+'"')
54828>>>>>>>>>>>>>>>  move "" to rval#
54829>>>>>>>>>>>>>>>  move (length(str#)) to len#
54830>>>>>>>>>>>>>>>  if (left(str#,1)) eq '"' move "'" to current_quote#
54833>>>>>>>>>>>>>>>  else move '"' to current_quote#
54835>>>>>>>>>>>>>>>  move current_quote# to rval#
54836>>>>>>>>>>>>>>>  for pos# from 0 to len#
54842>>>>>>>>>>>>>>>>
54842>>>>>>>>>>>>>>>    move (mid(str#,1,pos#)) to char#
54843>>>>>>>>>>>>>>>    if char# eq current_quote# begin
54845>>>>>>>>>>>>>>>      move (rval#+current_quote#+"+") to rval#
54846>>>>>>>>>>>>>>>      if current_quote# eq "'" move '"' to current_quote#
54849>>>>>>>>>>>>>>>      else move "'" to current_quote#
54851>>>>>>>>>>>>>>>      move (rval#+current_quote#) to rval#
54852>>>>>>>>>>>>>>>    end
54852>>>>>>>>>>>>>>>>
54852>>>>>>>>>>>>>>>    move (rval#+char#) to rval#
54853>>>>>>>>>>>>>>>  loop
54854>>>>>>>>>>>>>>>>
54854>>>>>>>>>>>>>>>  move (rval#+current_quote#) to rval#
54855>>>>>>>>>>>>>>>  function_return rval#
54856>>>>>>>>>>>>>>>end_function
54857>>>>>>>>>>>>>>>
54857>>>>>>>>>>>>>>>function MakeStringConstantMax255 global string str# returns string
54859>>>>>>>>>>>>>>>  integer liLen liPos
54859>>>>>>>>>>>>>>>  string lsRval lsChunk
54859>>>>>>>>>>>>>>>  move (length(str#)) to liLen
54860>>>>>>>>>>>>>>>  move "" to lsRval
54861>>>>>>>>>>>>>>>  for liPos from 0 to (liLen-1/250)
54867>>>>>>>>>>>>>>>>
54867>>>>>>>>>>>>>>>    if liPos move (lsRval+"+") to lsRval
54870>>>>>>>>>>>>>>>    move (mid(str#,250,liPos*250+1)) to lsChunk
54871>>>>>>>>>>>>>>>    move (lsRval+MakeStringConstantMax255Help(lsChunk)) to lsRval
54872>>>>>>>>>>>>>>>  loop
54873>>>>>>>>>>>>>>>>
54873>>>>>>>>>>>>>>>  function_return lsRval
54874>>>>>>>>>>>>>>>end_function
54875>>>>>>>>>>>>>>>
54875>>>>>>>>>>>>>Use FdxField.utl // FDX Field things
54875>>>>>>>>>>>>>Use Dates.nui    // Date routines (No User Interface)
54875>>>>>>>>>>>>>Use Output.utl   // Sequential output to whatever
Including file: output.utl    (C:\projects\BRS\VDFQuery\AppSrc\output.utl)
54875>>>>>>>>>>>>>>>// Use Output.utl   // Sequential output to whatever
54875>>>>>>>>>>>>>>>
54875>>>>>>>>>>>>>>>Use Aps
54875>>>>>>>>>>>>>>>  Use VpeBase3 //JK: Now uses VPE 3.x
Including file: vpebase3.pkg    (C:\projects\BRS\VDFQuery\AppSrc\vpebase3.pkg)
54875>>>>>>>>>>>>>>>>>// **********************************************************************
54875>>>>>>>>>>>>>>>>>// Use VpeBase3
54875>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>// Version: 1.0
54875>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>// Create:
54875>>>>>>>>>>>>>>>>>// Update: 25/09/1998 - Implemented changes in procedures OpenDoc and
54875>>>>>>>>>>>>>>>>>//                      SetupPrinter. (Suggested by Peter Starkner, Nordteam)
54875>>>>>>>>>>>>>>>>>//         16/09/1998 - Fixed text vertical alignment.
54875>>>>>>>>>>>>>>>>>//         06/01/1999 - Changed vertical alignment.
54875>>>>>>>>>>>>>>>>>//         12/05/2000 - Updated to use VPE 3.x and changed name to VpeBase3.
54875>>>>>>>>>>>>>>>>>//                      Remove the AuxDoc in the process (uses rendering now).
54875>>>>>>>>>>>>>>>>>//                      All 3.x changes by Jakob Kruse.
54875>>>>>>>>>>>>>>>>>//         07/02/2002 - Compatibility with StarZen's VPE4VDF classes:
54875>>>>>>>>>>>>>>>>>//                      Commented out Procedure Vpe_Print (Peter van Mil).
54875>>>>>>>>>>>>>>>>>//         12/02/2002 - Uncommented Procedure Vpe_Print (Sture).
54875>>>>>>>>>>>>>>>>>//         27/02/2004 - Renamed procedure Vpe_Print to Vpe_Print_Print
54875>>>>>>>>>>>>>>>>>//         02/08/2004 - VpeWriteRTF error fixed
54875>>>>>>>>>>>>>>>>>//         29/07/2006 - Paper bin functions interfaced by David Lack (taken from the newsgroups)
54875>>>>>>>>>>>>>>>>>//                      Vpe_DevEnumPaperBins and Vpe_GetDevPaperBinName
54875>>>>>>>>>>>>>>>>>// ***********************************************************************
54875>>>>>>>>>>>>>>>>>
54875>>>>>>>>>>>>>>>>>Use VPE3X.pkg
Including file: vpe3x.pkg    (C:\projects\BRS\VDFQuery\AppSrc\vpe3x.pkg)
54875>>>>>>>>>>>>>>>>>>>// 2000/05/12 - Jakob Kruse
54875>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>// VPE3X.PKG  Virtual Print Engine 3.x for Visual DataFlex
54875>>>>>>>>>>>>>>>>>>>// =========
54875>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>// The DLL-Interface for the "Virtual Print Engine" version 3.x
54875>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>// To be "use"d by the calling applications.
54875>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>// =========================================================================
54875>>>>>>>>>>>>>>>>>>>// Always call VpeLicense with the two serial strings as parameters when
54875>>>>>>>>>>>>>>>>>>>// you use a licensed copy of VPE.
54875>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>// Remember to set _VPEDLL_ to the name of the VPE version you have.
54875>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>// Please note that several DLL calls and many constants have changed since
54875>>>>>>>>>>>>>>>>>>>// VPE 2.x.
54875>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>// If you need to use a VPE function that needs a parameter of type RECT
54875>>>>>>>>>>>>>>>>>>>// (you don't) you must use the type defined in DAC package file DFTYPES.DLL.
54875>>>>>>>>>>>>>>>>>>>// =========================================================================
54875>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>// 07/02/2002 - Peter van Mil
54875>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>// Compatibility with StarZen's VPE4VDF classes.
54875>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>// When VPE_EDITION is defined, External_Functions aren't defined again.
54875>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>// 25/01/2004 - Peter van Mil
54875>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>// VPE version 3.50 uses VPE?3235.DLL in stead VPE?32.DLL
54875>>>>>>>>>>>>>>>>>>>
54875>>>>>>>>>>>>>>>>>>> use DfAllent                // Everything (to get hold of external functions)
54875>>>>>>>>>>>>>>>>>>>
54875>>>>>>>>>>>>>>>>>>>// Valid values for _VPEDLL_ are:
54875>>>>>>>>>>>>>>>>>>> // Version 3.1:----------------
54875>>>>>>>>>>>>>>>>>>>// VPES32.DLL (for standard)
54875>>>>>>>>>>>>>>>>>>>// VPEX32.DLL (for enhanced)
54875>>>>>>>>>>>>>>>>>>>// VPEP32.DLL (for professional)
54875>>>>>>>>>>>>>>>>>>>// VPEE32.DLL (for enterprise)
54875>>>>>>>>>>>>>>>>>>> // Version 3.5:----------------
54875>>>>>>>>>>>>>>>>>>>// VPES3235.DLL (for standard)
54875>>>>>>>>>>>>>>>>>>>// VPEX3235.DLL (for enhanced)
54875>>>>>>>>>>>>>>>>>>>// VPEP3235.DLL (for professional)
54875>>>>>>>>>>>>>>>>>>>// VPEE3235.DLL (for enterprise)
54875>>>>>>>>>>>>>>>>>>> // Version 3.6:----------------
54875>>>>>>>>>>>>>>>>>>>// VPES3236.DLL (for standard)
54875>>>>>>>>>>>>>>>>>>>// VPEX3236.DLL (for enhanced)
54875>>>>>>>>>>>>>>>>>>>// VPEP3236.DLL (for professional)
54875>>>>>>>>>>>>>>>>>>>// VPEE3236.DLL (for enterprise)
54875>>>>>>>>>>>>>>>>>>> // Let everybody know which VPE version we use
54875>>>>>>>>>>>>>>>>>>>Define VPE_VERSION_3
54875>>>>>>>>>>>>>>>>>>>Use VPE3X.CFG
Including file: vpe3x.cfg    (C:\projects\BRS\VDFQuery\AppSrc\vpe3x.cfg)
54875>>>>>>>>>>>>>>>>>>>>>// !!!! Don't distribute this file with non-empty values !!!!
54875>>>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>>>// This package defines two symbols that are codes you receive when
54875>>>>>>>>>>>>>>>>>>>>>// purchasing a VPE license.
54875>>>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>>>// This package is used to inform the VPEBASE3.PKG which code to use
54875>>>>>>>>>>>>>>>>>>>>>// when opening the VPE 3.1 (or 3.5) dll.
54875>>>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>>>// If both names are empty the program will still run but a DEMO banner
54875>>>>>>>>>>>>>>>>>>>>>// will be part of all your previews.
54875>>>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>>>// Should you ever receive this file with non-empty values for the
54875>>>>>>>>>>>>>>>>>>>>>// constants VPE_SERIAL_CODE1 and VPE_SERIAL_CODE2, please understand
54875>>>>>>>>>>>>>>>>>>>>>// that it is an error and set both values to "demo"
54875>>>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>>>// Regular VPE code:
54875>>>>>>>>>>>>>>>>>>>>>//
54875>>>>>>>>>>>>>>>>>>>>>// Separate code to PDF enable VPE
54875>>>>>>>>>>>>>>>>>>>>>// (leave the "demo" value if you
54875>>>>>>>>>>>>>>>>>>>>>//  do not have such a code):
54875>>>>>>>>>>>>>>>>>>> External_Function VpeMoveWindow "MoveWindow" User32.DLL dword hwnd integer x integer y integer width integer height integer repaint returns integer
54876>>>>>>>>>>>>>>>>>>> External_Function VpeOemToCharA               "OemToCharA"                  User32.DLL Pointer hpszOem Pointer hpszWindow Returns Integer
54877>>>>>>>>>>>>>>>>>>> // Management functions
54877>>>>>>>>>>>>>>>>>>>  External_Function VpeOpenDoc                  "VpeOpenDoc"                  _VPEDLL_ Handle hwnd String title DWord flags Returns DWord
54878>>>>>>>>>>>>>>>>>>>  External_Function VpeOpenDocFile              "VpeOpenDocFile"              _VPEDLL_ Handle hwnd String file_name String title DWord flags Returns DWord
54879>>>>>>>>>>>>>>>>>>>  External_Function VpeLicense                  "VpeLicense"                  _VPEDLL_ DWord hdoc String scode1 String scode2 Returns Integer
54880>>>>>>>>>>>>>>>>>>>  External_Function VpeGetLastError             "VpeGetLastError"             _VPEDLL_ DWord hdoc Returns DWord
54881>>>>>>>>>>>>>>>>>>>  External_Function VpeCloseDoc                 "VpeCloseDoc"                 _VPEDLL_ DWord hdoc Returns Integer
54882>>>>>>>>>>>>>>>>>>>  External_Function VpePreviewDoc               "VpePreviewDoc"               _VPEDLL_ DWord hdoc Pointer recstruct Integer show_hide Returns Integer
54883>>>>>>>>>>>>>>>>>>>  External_Function VpePreviewDocSP             "VpePreviewDocSP"             _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Integer show_hide Returns Integer
54884>>>>>>>>>>>>>>>>>>>  External_Function VpeCenterPreview            "VpeCenterPreview"            _VPEDLL_ DWord hdoc Integer width Integer height Handle parent_window Returns Integer
54885>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPreviewCtrl           "VpeSetPreviewCtrl"           _VPEDLL_ DWord hdoc Integer setting Returns Integer
54886>>>>>>>>>>>>>>>>>>>  External_Function VpeClosePreview             "VpeClosePreview"             _VPEDLL_ DWord hdoc Returns Integer
54887>>>>>>>>>>>>>>>>>>>  External_Function VpeIsPreviewVisible         "VpeIsPreviewVisible"         _VPEDLL_ DWord hdoc Returns Integer
54888>>>>>>>>>>>>>>>>>>>  External_Function VpeGetVisualPage            "VpeGetVisualPage"            _VPEDLL_ DWord hdoc Returns Integer
54889>>>>>>>>>>>>>>>>>>>  External_Function VpeGotoVisualPage           "VpeGotoVisualPage"           _VPEDLL_ DWord hdoc Integer page Returns Integer
54890>>>>>>>>>>>>>>>>>>>  External_Function VpeDispatchAllMessages      "VpeDispatchAllMessages"      _VPEDLL_ DWord hdoc Returns Integer
54891>>>>>>>>>>>>>>>>>>>  // Warning: uses UINT parameter and return value
54891>>>>>>>>>>>>>>>>>>>  //External_Function VpeMapMessage               "VpeMapMessage"               _VPEDLL_ dword hdoc UINT message returns UINT
54891>>>>>>>>>>>>>>>>>>>  External_Function VpeRefreshDoc               "VpeRefreshDoc"               _VPEDLL_ DWord hdoc Returns Integer
54892>>>>>>>>>>>>>>>>>>>  External_Function VpeWriteDoc                 "VpeWriteDoc"                 _VPEDLL_ DWord hdoc String file_name Returns Integer
54893>>>>>>>>>>>>>>>>>>>  External_Function VpeReadDoc                  "VpeReadDoc"                  _VPEDLL_ DWord hdoc String file_name Returns Integer
54894>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDocFileReadOnly       "VpeSetDocFileReadOnly"       _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
54895>>>>>>>>>>>>>>>>>>>  External_Function VpeEnableAutoDelete         "VpeEnableAutoDelete"         _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
54896>>>>>>>>>>>>>>>>>>>  External_Function VpeEnablePrintSetupDialog   "VpeEnablePrintSetupDialog"   _VPEDLL_ DWord hdoc Integer enabled Returns Integer
54897>>>>>>>>>>>>>>>>>>>  External_Function VpeEnableMailButton         "VpeEnableMailButton"         _VPEDLL_ DWord hdoc Integer enabled Returns Integer
54898>>>>>>>>>>>>>>>>>>>  External_Function VpeEnableCloseButton        "VpeEnableCloseButton"        _VPEDLL_ DWord hdoc Integer enabled Returns Integer
54899>>>>>>>>>>>>>>>>>>>  External_Function VpeEnableMouseScaling       "VpeEnableMouseScaling"       _VPEDLL_ DWord hdoc Integer enabled Returns Integer
54900>>>>>>>>>>>>>>>>>>>  External_Function VpeEnableHelpRouting        "VpeEnableHelpRouting"        _VPEDLL_ DWord hdoc Integer enabled Returns Integer
54901>>>>>>>>>>>>>>>>>>>  External_Function VpeSetGridMode              "VpeSetGridMode"              _VPEDLL_ DWord hdoc Integer in_foreground Returns Integer
54902>>>>>>>>>>>>>>>>>>>  External_Function VpeSetGridVisible           "VpeSetGridVisible"           _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
54903>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPreviewWithScrollers  "VpeSetPreviewWithScrollers"  _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
54904>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPaperView             "VpeSetPaperView"             _VPEDLL_ DWord hdoc Integer on_off Returns Integer
54905>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPageScrollerTracking  "VpeSetPageScrollerTracking"  _VPEDLL_ DWord hdoc Integer on_off Returns Integer
54906>>>>>>>>>>>>>>>>>>>  External_Function VpeWriteStatusbar           "VpeWriteStatusbar"           _VPEDLL_ DWord hdoc String text Returns Integer
54907>>>>>>>>>>>>>>>>>>>  External_Function VpeOpenProgressBar          "VpeOpenProgressBar"          _VPEDLL_ DWord hdoc Returns Integer
54908>>>>>>>>>>>>>>>>>>>  External_Function VpeSetProgressBar           "VpeSetProgressBar"           _VPEDLL_ DWord hdoc Integer percent Returns Integer
54909>>>>>>>>>>>>>>>>>>>  External_Function VpeCloseProgressBar         "VpeCloseProgressBar"         _VPEDLL_ DWord hdoc Returns Integer
54910>>>>>>>>>>>>>>>>>>>  External_Function VpeSetBusyProgressBar       "VpeSetBusyProgressBar"       _VPEDLL_ DWord hdoc Integer visible Returns Integer
54911>>>>>>>>>>>>>>>>>>>  External_Function VpeSetRulersMeasure         "VpeSetRulersMeasure"         _VPEDLL_ DWord hdoc Integer rulers_measure Returns Integer
54912>>>>>>>>>>>>>>>>>>>  //External_Function VpeSetScale                 "VpeSetScale"                 _VPEDLL_ dword hdoc DOUBLE scale returns integer
54912>>>>>>>>>>>>>>>>>>>  //External_Function VpeGetScale                 "VpeGetScale"                 _VPEDLL_ dword hdoc returns DOUBLE
54912>>>>>>>>>>>>>>>>>>>  External_Function VpeSetScalePercent          "VpeSetScalePercent"          _VPEDLL_ DWord hdoc Integer scale Returns Integer
54913>>>>>>>>>>>>>>>>>>>  External_Function VpeGetScalePercent          "VpeGetScalePercent"          _VPEDLL_ DWord hdoc Returns Integer
54914>>>>>>>>>>>>>>>>>>>  //External_Function VpeSetMinScale              "VpeSetMinScale"              _VPEDLL_ dword hdoc DOUBLE min_scale returns integer
54914>>>>>>>>>>>>>>>>>>>  External_Function VpeSetMinScalePercent       "VpeSetMinScalePercent"       _VPEDLL_ DWord hdoc Integer min_scale_percent Returns Integer
54915>>>>>>>>>>>>>>>>>>>  //External_Function VpeSetMaxScale              "VpeSetMaxScale"              _VPEDLL_ dword hdoc DOUBLE max_scale returns integer
54915>>>>>>>>>>>>>>>>>>>  External_Function VpeSetMaxScalePercent       "VpeSetMaxScalePercent"       _VPEDLL_ DWord hdoc Integer max_scale_percent Returns Integer
54916>>>>>>>>>>>>>>>>>>>  //External_Function VpeSetScaleStep             "VpeSetScaleStep"             _VPEDLL_ dword hdoc DOUBLE scale_step returns integer
54916>>>>>>>>>>>>>>>>>>>  External_Function VpeSetScaleStepPercent      "VpeSetScaleStepPercent"      _VPEDLL_ DWord hdoc Integer scale_step_percent Returns Integer
54917>>>>>>>>>>>>>>>>>>>  External_Function VpeDefineKey                "VpeDefineKey"                _VPEDLL_ DWord hdoc Integer func Integer key_code Integer add_key_code1 Integer add_key_code2 Returns Integer
54918>>>>>>>>>>>>>>>>>>>  External_Function VpeSendKey                  "VpeSendKey"                  _VPEDLL_ DWord hdoc Integer vkey Returns Integer
54919>>>>>>>>>>>>>>>>>>>  External_Function VpeSetGUILanguage           "VpeSetGUILanguage"           _VPEDLL_ DWord hdoc Integer language Returns Integer
54920>>>>>>>>>>>>>>>>>>>  External_Function VpeGetWindowHandle          "VpeGetWindowHandle"          _VPEDLL_ DWord hdoc Returns Handle
54921>>>>>>>>>>>>>>>>>>>  External_Function VpeWindowHandle             "VpeWindowHandle"             _VPEDLL_ DWord hdoc Returns Handle
54922>>>>>>>>>>>>>>>>>>>  External_Function VpeGetVersion               "VpeGetVersion"               _VPEDLL_ Returns DWord
54923>>>>>>>>>>>>>>>>>>>  External_Function VpeGetEdition               "VpeGetEdition"               _VPEDLL_ Returns Integer
54924>>>>>>>>>>>>>>>>>>>  External_Function VpeRegisterCtl3D            "VpeRegisterCtl3D"            _VPEDLL_ Handle hinstance Returns DWord
54925>>>>>>>>>>>>>>>>>>>  External_Function VpeUnregisterCtl3D          "VpeUnregisterCtl3D"          _VPEDLL_ Handle hinstance Returns Integer
54926>>>>>>>>>>>>>>>>>>>
54926>>>>>>>>>>>>>>>>>>>  // Printing Functions
54926>>>>>>>>>>>>>>>>>>>  External_Function VpeSetupPrinter             "VpeSetupPrinter"             _VPEDLL_ DWord hdoc String file_name Integer dialog_control Returns Integer
54927>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPrintOptions          "VpeSetPrintOptions"          _VPEDLL_ DWord hdoc DWord flags Returns Integer
54928>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPrintPosMode          "VpeSetPrintPosMode"          _VPEDLL_ DWord hdoc Integer mode Returns Integer
54929>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPrintOffset           "VpeSetPrintOffset"           _VPEDLL_ DWord hdoc Integer offset_x Integer offset_y Returns Integer
54930>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPrintOffsetX          "VpeSetPrintOffsetX"          _VPEDLL_ DWord hdoc Integer offset_x Returns Integer
54931>>>>>>>>>>>>>>>>>>>  External_Function VpeGetPrintOffsetX          "VpeGetPrintOffsetX"          _VPEDLL_ DWord hdoc Returns Integer
54932>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPrintOffsetY          "VpeSetPrintOffsetY"          _VPEDLL_ DWord hdoc Integer offset_y Returns Integer
54933>>>>>>>>>>>>>>>>>>>  External_Function VpeGetPrintOffsetY          "VpeGetPrintOffsetY"          _VPEDLL_ DWord hdoc Returns Integer
54934>>>>>>>>>>>>>>>>>>>  External_Function VpePrintDoc                 "VpePrintDoc"                 _VPEDLL_ DWord hdoc Integer with_setup Returns Integer
54935>>>>>>>>>>>>>>>>>>>  External_Function VpeIsPrinting               "VpeIsPrinting"               _VPEDLL_ DWord hdoc Returns Integer
54936>>>>>>>>>>>>>>>>>>>
54936>>>>>>>>>>>>>>>>>>>  // Device Control Properties
54936>>>>>>>>>>>>>>>>>>>  External_Function VpeDevEnum                  "VpeDevEnum"                  _VPEDLL_ DWord hdoc Returns Integer
54937>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevEntry              "VpeGetDevEntry"              _VPEDLL_ DWord hdoc Integer Index Pointer device Integer size Returns Integer
54938>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevice                "VpeSetDevice"                _VPEDLL_ DWord hdoc String device Returns Integer
54939>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevice                "VpeGetDevice"                _VPEDLL_ DWord hdoc Pointer device Integer size Returns Integer
54940>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevOrientation        "VpeSetDevOrientation"        _VPEDLL_ DWord hdoc Integer orientation Returns Integer
54941>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevOrientation        "VpeGetDevOrientation"        _VPEDLL_ DWord hdoc Returns Integer
54942>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevPaperFormat        "VpeSetDevPaperFormat"        _VPEDLL_ DWord hdoc Integer iformat Returns Integer
54943>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevPaperFormat        "VpeGetDevPaperFormat"        _VPEDLL_ DWord hdoc Returns Integer
54944>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevPaperWidth         "VpeSetDevPaperWidth"         _VPEDLL_ DWord hdoc Integer width Returns Integer
54945>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevPaperWidth         "VpeGetDevPaperWidth"         _VPEDLL_ DWord hdoc Returns Integer
54946>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevPaperHeight        "VpeSetDevPaperHeight"        _VPEDLL_ DWord hdoc Integer height Returns Integer
54947>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevPaperHeight        "VpeGetDevPaperHeight"        _VPEDLL_ DWord hdoc Returns Integer
54948>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevScalePercent       "VpeSetDevScalePercent"       _VPEDLL_ DWord hdoc Integer scale Returns Integer
54949>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevScalePercent       "VpeGetDevScalePercent"       _VPEDLL_ DWord hdoc Returns Integer
54950>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevPrintQuality       "VpeSetDevPrintQuality"       _VPEDLL_ DWord hdoc Integer quality Returns Integer
54951>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevPrintQuality       "VpeGetDevPrintQuality"       _VPEDLL_ DWord hdoc Returns Integer
54952>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevYResolution        "VpeSetDevYResolution"        _VPEDLL_ DWord hdoc Integer yres Returns Integer
54953>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevYResolution        "VpeGetDevYResolution"        _VPEDLL_ DWord hdoc Returns Integer
54954>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevColor              "VpeSetDevColor"              _VPEDLL_ DWord hdoc Integer color Returns Integer
54955>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevColor              "VpeGetDevColor"              _VPEDLL_ DWord hdoc Returns Integer
54956>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevDuplex             "VpeSetDevDuplex"             _VPEDLL_ DWord hdoc Integer duplex Returns Integer
54957>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevDuplex             "VpeGetDevDuplex"             _VPEDLL_ DWord hdoc Returns Integer
54958>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevTTOption           "VpeSetDevTTOption"           _VPEDLL_ DWord hdoc Integer option Returns Integer
54959>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevTTOption           "VpeGetDevTTOption"           _VPEDLL_ DWord hdoc Returns Integer
54960>>>>>>>>>>>>>>>>>>>  External_Function VpeDevEnumPaperBins         "VpeDevEnumPaperBins"         _VPEDLL_ DWord hdoc Returns Integer
54961>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevPaperBinName       "VpeGetDevPaperBinName"       _VPEDLL_ DWord hdoc Integer Index Pointer bin_name_address Integer size Returns Integer
54962>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevPaperBinID         "VpeGetDevPaperBinID"         _VPEDLL_ DWord hdoc Integer Index Returns Integer
54963>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevPaperBin           "VpeSetDevPaperBin"           _VPEDLL_ DWord hdoc Integer bin_id Returns Integer
54964>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevPaperBin           "VpeGetDevPaperBin"           _VPEDLL_ DWord hdoc Returns Integer
54965>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevPrinterOffsetX     "VpeGetDevPrinterOffsetX"     _VPEDLL_ DWord hdoc Returns Integer
54966>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevPrinterOffsetY     "VpeGetDevPrinterOffsetY"     _VPEDLL_ DWord hdoc Returns Integer
54967>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevPhysPageWidth      "VpeGetDevPhysPageWidth"      _VPEDLL_ DWord hdoc Returns Integer
54968>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevPhysPageHeight     "VpeGetDevPhysPageHeight"     _VPEDLL_ DWord hdoc Returns Integer
54969>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevCopies             "VpeSetDevCopies"             _VPEDLL_ DWord hdoc Integer copies Returns Integer
54970>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevCopies             "VpeGetDevCopies"             _VPEDLL_ DWord hdoc Returns Integer
54971>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevCollate            "VpeSetDevCollate"            _VPEDLL_ DWord hdoc Integer collate Returns Integer
54972>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevCollate            "VpeGetDevCollate"            _VPEDLL_ DWord hdoc Returns Integer
54973>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevFromPage           "VpeSetDevFromPage"           _VPEDLL_ DWord hdoc Integer from_page Returns Integer
54974>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevFromPage           "VpeGetDevFromPage"           _VPEDLL_ DWord hdoc Returns Integer
54975>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevToPage             "VpeSetDevToPage"             _VPEDLL_ DWord hdoc Integer to_page Returns Integer
54976>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevToPage             "VpeGetDevToPage"             _VPEDLL_ DWord hdoc Returns Integer
54977>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevToFile             "VpeSetDevToFile"             _VPEDLL_ DWord hdoc Integer to_file Returns Integer
54978>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevToFile             "VpeGetDevToFile"             _VPEDLL_ DWord hdoc Returns Integer
54979>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevFileName           "VpeSetDevFileName"           _VPEDLL_ DWord hdoc String file_name Returns Integer
54980>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevFileName           "VpeGetDevFileName"           _VPEDLL_ DWord hdoc Pointer file_name_address Integer size Returns Integer
54981>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDevJobName            "VpeSetDevJobName"            _VPEDLL_ DWord hdoc String job_name Returns Integer
54982>>>>>>>>>>>>>>>>>>>  External_Function VpeGetDevJobName            "VpeGetDevJobName"            _VPEDLL_ DWord hdoc Pointer job_name_address Integer size Returns Integer
54983>>>>>>>>>>>>>>>>>>>  External_Function VpeDevSendData              "VpeDevSendData"              _VPEDLL_ DWord hdoc String data DWord size Returns Integer
54984>>>>>>>>>>>>>>>>>>>  External_Function VpeWritePrinterSetup        "VpeWritePrinterSetup"        _VPEDLL_ DWord hdoc String file_name Returns Integer
54985>>>>>>>>>>>>>>>>>>>  External_Function VpeReadPrinterSetup         "VpeReadPrinterSetup"         _VPEDLL_ DWord hdoc String file_name Returns Integer
54986>>>>>>>>>>>>>>>>>>>
54986>>>>>>>>>>>>>>>>>>>  // Layout functions
54986>>>>>>>>>>>>>>>>>>>  External_Function VpePageBreak                "VpePageBreak"                _VPEDLL_ DWord hdoc Returns Integer
54987>>>>>>>>>>>>>>>>>>>  External_Function VpeSetAutoBreak             "VpeSetAutoBreak"             _VPEDLL_ DWord hdoc Integer mode Returns Integer
54988>>>>>>>>>>>>>>>>>>>  External_Function VpeGetPageCount             "VpeGetPageCount"             _VPEDLL_ DWord hdoc Returns Integer
54989>>>>>>>>>>>>>>>>>>>  External_Function VpeGetCurrentPage           "VpeGetCurrentPage"           _VPEDLL_ DWord hdoc Returns Integer
54990>>>>>>>>>>>>>>>>>>>  External_Function VpeGotoPage                 "VpeGotoPage"                 _VPEDLL_ DWord hdoc Integer page Returns Integer
54991>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPageFormat            "VpeSetPageFormat"            _VPEDLL_ DWord hdoc Integer page_format Returns Integer
54992>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPageWidth             "VpeSetPageWidth"             _VPEDLL_ DWord hdoc Integer page_width Returns Integer
54993>>>>>>>>>>>>>>>>>>>  External_Function VpeGetPageWidth             "VpeGetPageWidth"             _VPEDLL_ DWord hdoc Returns Integer
54994>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPageHeight            "VpeSetPageHeight"            _VPEDLL_ DWord hdoc Integer page_height Returns Integer
54995>>>>>>>>>>>>>>>>>>>  External_Function VpeGetPageHeight            "VpeGetPageHeight"            _VPEDLL_ DWord hdoc Returns Integer
54996>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPageOrientation       "VpeSetPageOrientation"       _VPEDLL_ DWord hdoc Integer orientation Returns Integer
54997>>>>>>>>>>>>>>>>>>>  External_Function VpeGetPageOrientation       "VpeGetPageOrientation"       _VPEDLL_ DWord hdoc Returns Integer
54998>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPaperBin              "VpeSetPaperBin"              _VPEDLL_ DWord hdoc Integer bin Returns Integer
54999>>>>>>>>>>>>>>>>>>>  External_Function VpeGetPaperBin              "VpeGetPaperBin"              _VPEDLL_ DWord hdoc Returns Integer
55000>>>>>>>>>>>>>>>>>>>  External_Function VpeStoreSet                 "VpeStoreSet"                 _VPEDLL_ DWord hdoc Integer id Returns Integer
55001>>>>>>>>>>>>>>>>>>>  External_Function VpeUseSet                   "VpeUseSet"                   _VPEDLL_ DWord hdoc Integer id Returns Integer
55002>>>>>>>>>>>>>>>>>>>  External_Function VpeRemoveSet                "VpeRemoveSet"                _VPEDLL_ DWord hdoc Integer id Returns Integer
55003>>>>>>>>>>>>>>>>>>>  External_Function VpeGet                      "VpeGet"                      _VPEDLL_ DWord hdoc Integer what Returns Integer
55004>>>>>>>>>>>>>>>>>>>  External_Function VpeSet                      "VpeSet"                      _VPEDLL_ DWord hdoc Integer what Integer value Returns Integer
55005>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDefOutRect            "VpeSetDefOutRect"            _VPEDLL_ DWord hdoc Pointer rect Returns Integer
55006>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDefOutRectSP          "VpeSetDefOutRectSP"          _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Returns Integer
55007>>>>>>>>>>>>>>>>>>>  External_Function VpeSetOutRect               "VpeSetOutRect"               _VPEDLL_ DWord hdoc Pointer rect Returns Integer
55008>>>>>>>>>>>>>>>>>>>  External_Function VpeSetOutRectSP             "VpeSetOutRectSP"             _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Returns Integer
55009>>>>>>>>>>>>>>>>>>>  External_Function VpeGetOutRect               "VpeGetOutRect"               _VPEDLL_ DWord hdoc Pointer rect Returns Integer
55010>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPosRect               "VpeSetPosRect"               _VPEDLL_ DWord hdoc Pointer rect Returns Integer
55011>>>>>>>>>>>>>>>>>>>  External_Function VpeGetPosRect               "VpeGetPosRect"               _VPEDLL_ DWord hdoc Pointer rect Returns Integer
55012>>>>>>>>>>>>>>>>>>>  External_Function VpeStorePos                 "VpeStorePos"                 _VPEDLL_ DWord hdoc Returns Integer
55013>>>>>>>>>>>>>>>>>>>  External_Function VpeRestorePos               "VpeRestorePos"               _VPEDLL_ DWord hdoc Returns Integer
55014>>>>>>>>>>>>>>>>>>>  External_Function VpeSetRotation              "VpeSetRotation"              _VPEDLL_ DWord hdoc Integer angle Returns Integer
55015>>>>>>>>>>>>>>>>>>>  External_Function VpeSetViewable              "VpeSetViewable"              _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
55016>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPrintable             "VpeSetPrintable"             _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
55017>>>>>>>>>>>>>>>>>>>  External_Function VpeSetStreamable            "VpeSetStreamable"            _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
55018>>>>>>>>>>>>>>>>>>>  External_Function VpeSetShadowed              "VpeSetShadowed"              _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
55019>>>>>>>>>>>>>>>>>>>
55019>>>>>>>>>>>>>>>>>>>  // Rendering functions
55019>>>>>>>>>>>>>>>>>>>  External_Function VpeRenderPrint              "VpeRenderPrint"              _VPEDLL_ DWord hdoc Integer x Integer y String s Returns Integer
55020>>>>>>>>>>>>>>>>>>>  External_Function VpeRenderPrintBox           "VpeRenderPrintBox"           _VPEDLL_ DWord hdoc Integer x Integer y String s Returns Integer
55021>>>>>>>>>>>>>>>>>>>  External_Function VpeRenderWrite              "VpeRenderWrite"              _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String s Returns Integer
55022>>>>>>>>>>>>>>>>>>>  External_Function VpeRenderWriteBox           "VpeRenderWriteBox"           _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String s Returns Integer
55023>>>>>>>>>>>>>>>>>>>  External_Function VpeRenderPicture            "VpeRenderPicture"            _VPEDLL_ DWord hdoc Integer width Integer height String file_name Integer flags Returns Integer
55024>>>>>>>>>>>>>>>>>>>  //External_Function VpeRenderPictureResID       "VpeRenderPictureResID"       _VPEDLL_ dword hdoc integer width integer height handle hinstance UINT res_id returns integer
55024>>>>>>>>>>>>>>>>>>>  External_Function VpeRenderPictureResName     "VpeRenderPictureResName"     _VPEDLL_ DWord hdoc Integer width Integer height Handle hinstance String res_name Returns Integer
55025>>>>>>>>>>>>>>>>>>>  External_Function VpeRenderPictureDIB         "VpeRenderPictureDIB"         _VPEDLL_ DWord hdoc Integer width Integer height Handle hdib Returns Integer
55026>>>>>>>>>>>>>>>>>>>  External_Function VpeRenderRTF                "VpeRenderRTF"                _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String s Returns Integer
55027>>>>>>>>>>>>>>>>>>>  External_Function VpeRenderBoxRTF             "VpeRenderBoxRTF"             _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String s Returns Integer
55028>>>>>>>>>>>>>>>>>>>  External_Function VpeRenderRTFFile            "VpeRenderRTFFile"            _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String file_name Returns Integer
55029>>>>>>>>>>>>>>>>>>>  External_Function VpeRenderBoxRTFFile         "VpeRenderBoxRTFFile"         _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String file_name Returns Integer
55030>>>>>>>>>>>>>>>>>>>
55030>>>>>>>>>>>>>>>>>>>  // Drawing functions
55030>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPen                   "VpeSetPen"                   _VPEDLL_ DWord hdoc Integer pen_size Integer pen_style Integer pen_color Returns Integer
55031>>>>>>>>>>>>>>>>>>>  External_Function VpeNoPen                    "VpeNoPen"                    _VPEDLL_ DWord hdoc Returns Integer
55032>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPenSize               "VpeSetPenSize"               _VPEDLL_ DWord hdoc Integer pen_size Returns Integer
55033>>>>>>>>>>>>>>>>>>>  External_Function VpePenSize                  "VpePenSize"                  _VPEDLL_ DWord hdoc Integer pen_size Returns Integer
55034>>>>>>>>>>>>>>>>>>>  External_Function VpeGetPenSize               "VpeGetPenSize"               _VPEDLL_ DWord hdoc Returns Integer
55035>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPenStyle              "VpeSetPenStyle"              _VPEDLL_ DWord hdoc Integer pen_style Returns Integer
55036>>>>>>>>>>>>>>>>>>>  External_Function VpePenStyle                 "VpePenStyle"                 _VPEDLL_ DWord hdoc Integer pen_style Returns Integer
55037>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPenColor              "VpeSetPenColor"              _VPEDLL_ DWord hdoc Integer color Returns Integer
55038>>>>>>>>>>>>>>>>>>>  External_Function VpePenColor                 "VpePenColor"                 _VPEDLL_ DWord hdoc Integer color Returns Integer
55039>>>>>>>>>>>>>>>>>>>  External_Function VpeLine                     "VpeLine"                     _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Returns Integer
55040>>>>>>>>>>>>>>>>>>>  External_Function VpePolyLine                 "VpePolyLine"                 _VPEDLL_ DWord hdoc DWord point_array Integer size Returns DWord
55041>>>>>>>>>>>>>>>>>>>  External_Function VpeAddPolyPoint             "VpeAddPolyPoint"             _VPEDLL_ DWord hdoc DWord hpolyline Integer x Integer y Returns Integer
55042>>>>>>>>>>>>>>>>>>>  External_Function VpeSetBkgMode               "VpeSetBkgMode"               _VPEDLL_ DWord hdoc Integer mode Returns Integer
55043>>>>>>>>>>>>>>>>>>>  External_Function VpeSetBkgColor              "VpeSetBkgColor"              _VPEDLL_ DWord hdoc Integer color Returns Integer
55044>>>>>>>>>>>>>>>>>>>  External_Function VpeSetBkgGradientStartColor "VpeSetBkgGradientStartColor" _VPEDLL_ DWord hdoc Integer color_start Returns Integer
55045>>>>>>>>>>>>>>>>>>>  External_Function VpeSetBkgGradientEndColor   "VpeSetBkgGradientEndColor"   _VPEDLL_ DWord hdoc Integer color_end Returns Integer
55046>>>>>>>>>>>>>>>>>>>  External_Function VpeSetBkgGradientRotation   "VpeSetBkgGradientRotation"   _VPEDLL_ DWord hdoc Integer angle Returns Integer
55047>>>>>>>>>>>>>>>>>>>  External_Function VpeSetBkgGradientPrint      "VpeSetBkgGradientPrint"      _VPEDLL_ DWord hdoc Integer mode Returns Integer
55048>>>>>>>>>>>>>>>>>>>  External_Function VpeSetBkgGradientPrintSolidColor "VpeSetBkgGradientPrintSolidColor" _VPEDLL_ DWord hdoc Integer color Returns Integer
55049>>>>>>>>>>>>>>>>>>>  External_Function VpeSetTransparentMode       "VpeSetTransparentMode"       _VPEDLL_ DWord hdoc Integer on_off Returns Integer
55050>>>>>>>>>>>>>>>>>>>  External_Function VpeSetHatchStyle            "VpeSetHatchStyle"            _VPEDLL_ DWord hdoc Integer style Returns Integer
55051>>>>>>>>>>>>>>>>>>>  External_Function VpeSetHatchColor            "VpeSetHatchColor"            _VPEDLL_ DWord hdoc Integer color Returns Integer
55052>>>>>>>>>>>>>>>>>>>  External_Function VpeBox                      "VpeBox"                      _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer x3 Returns Integer
55053>>>>>>>>>>>>>>>>>>>  External_Function VpePolygon                  "VpePolygon"                  _VPEDLL_ DWord hdoc DWord point_array Integer size Returns DWord
55054>>>>>>>>>>>>>>>>>>>  External_Function VpeAddPolygonPoint          "VpeAddPolygonPoint"          _VPEDLL_ DWord hdoc DWord hpolygon Integer x Integer y Returns Integer
55055>>>>>>>>>>>>>>>>>>>  External_Function VpeEllipse                  "VpeEllipse"                  _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Returns Integer
55056>>>>>>>>>>>>>>>>>>>  External_Function VpePie                      "VpePie"                      _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Integer begin_angle Integer end_angle Returns Integer
55057>>>>>>>>>>>>>>>>>>>
55057>>>>>>>>>>>>>>>>>>>  // Text functions
55057>>>>>>>>>>>>>>>>>>>  External_Function VpeSetFont                  "VpeSetFont"                  _VPEDLL_ DWord hdoc String font_name Integer size Returns Integer
55058>>>>>>>>>>>>>>>>>>>  External_Function VpeSelectFont               "VpeSelectFont"               _VPEDLL_ DWord hdoc String font_name Integer size Returns Integer
55059>>>>>>>>>>>>>>>>>>>  External_Function VpeSetFontName              "VpeSetFontName"              _VPEDLL_ DWord hdoc String font_name Returns Integer
55060>>>>>>>>>>>>>>>>>>>  External_Function VpeSetFontSize              "VpeSetFontSize"              _VPEDLL_ DWord hdoc Integer size Returns Integer
55061>>>>>>>>>>>>>>>>>>>  External_Function VpeSetCharset               "VpeSetCharset"               _VPEDLL_ DWord hdoc DWord charset Returns Integer
55062>>>>>>>>>>>>>>>>>>>  External_Function VpeSetFontAttr              "VpeSetFontAttr"              _VPEDLL_ DWord hdoc Integer alignment Integer bold Integer underlined Integer italic Integer strikeout Returns Integer
55063>>>>>>>>>>>>>>>>>>>  External_Function VpeSetTextAlignment         "VpeSetTextAlignment"         _VPEDLL_ DWord hdoc Integer alignment Returns Integer
55064>>>>>>>>>>>>>>>>>>>  External_Function VpeSetAlign                 "VpeSetAlign"                 _VPEDLL_ DWord hdoc Integer alignment Returns Integer
55065>>>>>>>>>>>>>>>>>>>  External_Function VpeSetBold                  "VpeSetBold"                  _VPEDLL_ DWord hdoc Integer bold Returns Integer
55066>>>>>>>>>>>>>>>>>>>  External_Function VpeSetUnderlined            "VpeSetUnderlined"            _VPEDLL_ DWord hdoc Integer underlined Returns Integer
55067>>>>>>>>>>>>>>>>>>>  External_Function VpeSetItalic                "VpeSetItalic"                _VPEDLL_ DWord hdoc Integer italic Returns Integer
55068>>>>>>>>>>>>>>>>>>>  External_Function VpeSetStrikeOut             "VpeSetStrikeOut"             _VPEDLL_ DWord hdoc Integer strikeout Returns Integer
55069>>>>>>>>>>>>>>>>>>>  External_Function VpeSetTextColor             "VpeSetTextColor"             _VPEDLL_ DWord hdoc Integer color Returns Integer
55070>>>>>>>>>>>>>>>>>>>  External_Function VpeWrite                    "VpeWrite"                    _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String text Returns Integer
55071>>>>>>>>>>>>>>>>>>>  External_Function VpeWriteBox                 "VpeWriteBox"                 _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String text Returns Integer
55072>>>>>>>>>>>>>>>>>>>  External_Function VpePrint                    "VpePrint"                    _VPEDLL_ DWord hdoc Integer x Integer y String text Returns Integer
55073>>>>>>>>>>>>>>>>>>>  External_Function VpePrintBox                 "VpePrintBox"                 _VPEDLL_ DWord hdoc Integer x Integer y String text Returns Integer
55074>>>>>>>>>>>>>>>>>>>  External_Function VpeDefineHeader             "VpeDefineHeader"             _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String text Returns Integer
55075>>>>>>>>>>>>>>>>>>>  External_Function VpeDefineFooter             "VpeDefineFooter"             _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String text Returns Integer
55076>>>>>>>>>>>>>>>>>>>  External_Function VpeSetCharPlacement         "VpeSetCharPlacement"         _VPEDLL_ DWord hdoc Integer distance Returns Integer
55077>>>>>>>>>>>>>>>>>>>
55077>>>>>>>>>>>>>>>>>>>  // Picture functions
55077>>>>>>>>>>>>>>>>>>>  External_Function VpeSetKeepPictureAspect     "VpeSetKeepPictureAspect"     _VPEDLL_ DWord hdoc Integer on_off Returns Integer
55078>>>>>>>>>>>>>>>>>>>  //OBSOLETE: External_Function VpeKeepBitmapAspect         "VpeKeepBitmapAspect"         _VPEDLL_ dword hdoc integer on_off returns integer
55078>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDefaultPictureDPI     "VpeSetDefaultPictureDPI"     _VPEDLL_ DWord hdoc Integer dpix Integer dpiy Returns Integer
55079>>>>>>>>>>>>>>>>>>>  //OBSOLETE: External_Function VpeDefaultBitmapDPI         "VpeDefaultBitmapDPI"         _VPEDLL_ dword hdoc integer dpix integer dpiy returns integer
55079>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPictureCacheSize      "VpeSetPictureCacheSize"      _VPEDLL_ DWord hdoc DWord size Returns Integer
55080>>>>>>>>>>>>>>>>>>>  External_Function VpeGetPictureCacheSize      "VpeGetPictureCacheSize"      _VPEDLL_ DWord hdoc Returns DWord
55081>>>>>>>>>>>>>>>>>>>  External_Function VpeGetPictureCacheUsed      "VpeGetPictureCacheUsed"      _VPEDLL_ DWord hdoc Returns DWord
55082>>>>>>>>>>>>>>>>>>>  External_Function VpeGetPictureTypes          "VpeGetPictureTypes"          _VPEDLL_ DWord hdoc Integer with_filters Pointer s_address Integer size Returns Integer
55083>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPictureType           "VpeSetPictureType"           _VPEDLL_ DWord hdoc DWord type Returns Integer
55084>>>>>>>>>>>>>>>>>>>  External_Function VpePicture                  "VpePicture"                  _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String file_name Integer flags Returns Integer
55085>>>>>>>>>>>>>>>>>>>  External_Function VpePictureResID             "VpePictureResID"             _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Handle hinstance Integer res_id Integer flags Returns Integer
55086>>>>>>>>>>>>>>>>>>>  External_Function VpePictureResName           "VpePictureResName"           _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Handle hinstance String res_name Integer flags Returns Integer
55087>>>>>>>>>>>>>>>>>>>  External_Function VpePictureDIB               "VpePictureDIB"               _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Handle hdib Integer flags Returns Integer
55088>>>>>>>>>>>>>>>>>>>  External_Function VpeGetPicturePageCount      "VpeGetPicturePageCount"      _VPEDLL_ DWord hdoc String file_name Returns DWord
55089>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPicturePage           "VpeSetPicturePage"           _VPEDLL_ DWord hdoc DWord page_no Returns Integer
55090>>>>>>>>>>>>>>>>>>>  External_Function VpeGetPicturePage           "VpeGetPicturePage"           _VPEDLL_ DWord hdoc Returns DWord
55091>>>>>>>>>>>>>>>>>>>
55091>>>>>>>>>>>>>>>>>>>  // Barcode functions
55091>>>>>>>>>>>>>>>>>>>  External_Function VpeSetBarcodeParms          "VpeSetBarcodeParms"          _VPEDLL_ DWord hdoc Integer top_bottom Integer add_top_bottom Returns Integer
55092>>>>>>>>>>>>>>>>>>>  External_Function VpeSetBarcodeAlignment      "VpeSetBarcodeAlignment"      _VPEDLL_ DWord hdoc Integer alignment Returns Integer
55093>>>>>>>>>>>>>>>>>>>  External_Function VpeBarcode                  "VpeBarcode"                  _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Integer code_type String code String add_code Returns Integer
55094>>>>>>>>>>>>>>>>>>>
55094>>>>>>>>>>>>>>>>>>>  // Email functions
55094>>>>>>>>>>>>>>>>>>>  External_Function VpeIsMAPIInstalled          "VpeIsMAPIInstalled"          _VPEDLL_ DWord hdoc Returns Integer
55095>>>>>>>>>>>>>>>>>>>  External_Function VpeSetMailSender            "VpeSetMailSender"            _VPEDLL_ DWord hdoc String sender Returns Integer
55096>>>>>>>>>>>>>>>>>>>  External_Function VpeAddMailReceiver          "VpeAddMailReceiver"          _VPEDLL_ DWord hdoc String receiver DWord recip_class Returns Integer
55097>>>>>>>>>>>>>>>>>>>  External_Function VpeClearMailReceivers       "VpeClearMailReceivers"       _VPEDLL_ DWord hdoc Returns Integer
55098>>>>>>>>>>>>>>>>>>>  External_Function VpeAddMailAttachment        "VpeAddMailAttachment"        _VPEDLL_ DWord hdoc String path String file_name Returns Integer
55099>>>>>>>>>>>>>>>>>>>  External_Function VpeClearMailAttachments     "VpeClearMailAttachments"     _VPEDLL_ DWord hdoc Returns Integer
55100>>>>>>>>>>>>>>>>>>>  External_Function VpeSetMailSubject           "VpeSetMailSubject"           _VPEDLL_ DWord hdoc String subject Returns Integer
55101>>>>>>>>>>>>>>>>>>>  External_Function VpeSetMailText              "VpeSetMailText"              _VPEDLL_ DWord hdoc String text Returns Integer
55102>>>>>>>>>>>>>>>>>>>  External_Function VpeSetMailWithDialog        "VpeSetMailWithDialog"        _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
55103>>>>>>>>>>>>>>>>>>>  External_Function VpeMailDoc                  "VpeMailDoc"                  _VPEDLL_ DWord hdoc Returns Integer
55104>>>>>>>>>>>>>>>>>>>
55104>>>>>>>>>>>>>>>>>>>  // RTF functions
55104>>>>>>>>>>>>>>>>>>>  External_Function VpeWriteRTF                 "VpeWriteRTF"                 _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String rtf_text Returns Integer
55105>>>>>>>>>>>>>>>>>>>  External_Function VpeWriteBoxRTF              "VpeWriteBoxRTF"              _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String rtf_text Returns Integer
55106>>>>>>>>>>>>>>>>>>>  External_Function VpeWriteRTFFile             "VpeWriteRTFFile"             _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String file_name Returns Integer
55107>>>>>>>>>>>>>>>>>>>  External_Function VpeWriteBoxRTFFile          "VpeWriteBoxRTFFile"          _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String file_name Returns Integer
55108>>>>>>>>>>>>>>>>>>>  External_Function VpeSetRTFFont               "VpeSetRTFFont"               _VPEDLL_ DWord hdoc Integer id String font_name Returns Integer
55109>>>>>>>>>>>>>>>>>>>  External_Function VpeSetRTFColor              "VpeSetRTFColor"              _VPEDLL_ DWord hdoc Integer id DWord color Returns Integer
55110>>>>>>>>>>>>>>>>>>>  External_Function VpeSetFirstIndent           "VpeSetFirstIndent"           _VPEDLL_ DWord hdoc Integer indent Returns Integer
55111>>>>>>>>>>>>>>>>>>>  External_Function VpeSetLeftIndent            "VpeSetLeftIndent"            _VPEDLL_ DWord hdoc Integer indent Returns Integer
55112>>>>>>>>>>>>>>>>>>>  External_Function VpeSetRightIndent           "VpeSetRightIndent"           _VPEDLL_ DWord hdoc Integer indent Returns Integer
55113>>>>>>>>>>>>>>>>>>>  External_Function VpeSetSpaceBefore           "VpeSetSpaceBefore"           _VPEDLL_ DWord hdoc Integer space Returns Integer
55114>>>>>>>>>>>>>>>>>>>  External_Function VpeSetSpaceAfter            "VpeSetSpaceAfter"            _VPEDLL_ DWord hdoc Integer space Returns Integer
55115>>>>>>>>>>>>>>>>>>>  External_Function VpeSetSpaceBetween          "VpeSetSpaceBetween"          _VPEDLL_ DWord hdoc Integer space Returns Integer
55116>>>>>>>>>>>>>>>>>>>  External_Function VpeSetDefaultTabSize        "VpeSetDefaultTabSize"        _VPEDLL_ DWord hdoc Integer default_tab_size Returns Integer
55117>>>>>>>>>>>>>>>>>>>  External_Function VpeSetTab                   "VpeSetTab"                   _VPEDLL_ DWord hdoc Integer tab_position Integer reserved Returns Integer
55118>>>>>>>>>>>>>>>>>>>  External_Function VpeClearTab                 "VpeClearTab"                 _VPEDLL_ DWord hdoc Integer tab_position Returns Integer
55119>>>>>>>>>>>>>>>>>>>  External_Function VpeClearAllTabs             "VpeClearAllTabs"             _VPEDLL_ DWord hdoc Returns Integer
55120>>>>>>>>>>>>>>>>>>>  External_Function VpeResetParagraph           "VpeResetParagraph"           _VPEDLL_ DWord hdoc Returns Integer
55121>>>>>>>>>>>>>>>>>>>  External_Function VpeSetKeepLines             "VpeSetKeepLines"             _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
55122>>>>>>>>>>>>>>>>>>>  External_Function VpeSetKeepNextParagraph     "VpeSetKeepNextParagraph"     _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
55123>>>>>>>>>>>>>>>>>>>  External_Function VpeSetParagraphControl      "VpeSetParagraphControl"      _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
55124>>>>>>>>>>>>>>>>>>>
55124>>>>>>>>>>>>>>>>>>>  // Interactive objects
55124>>>>>>>>>>>>>>>>>>>  External_Function VpeEnableClickEvents        "VpeEnableClickEvents"        _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
55125>>>>>>>>>>>>>>>>>>>  External_Function VpeSetObjectID              "VpeSetObjectID"              _VPEDLL_ DWord hdoc DWord id Returns Integer
55126>>>>>>>>>>>>>>>>>>>  External_Function VpeGetObjectID              "VpeGetObjectID"              _VPEDLL_ DWord hdoc Returns DWord
55127>>>>>>>>>>>>>>>>>>>
55127>>>>>>>>>>>>>>>>>>>  // UDO
55127>>>>>>>>>>>>>>>>>>>  External_Function VpeCreateUDO                "VpeCreateUDO"                _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 DWord lparam Returns Integer
55128>>>>>>>>>>>>>>>>>>>  External_Function VpeGetUDOlParam             "VpeGetUDOlParam"             _VPEDLL_ DWord hdoc Returns DWord
55129>>>>>>>>>>>>>>>>>>>  External_Function VpeGetUDODC                 "VpeGetUDODC"                 _VPEDLL_ DWord hdoc Returns Handle
55130>>>>>>>>>>>>>>>>>>>  External_Function VpeGetUDODrawRect           "VpeGetUDODrawRect"           _VPEDLL_ DWord hdoc Pointer rect_address Returns Integer
55131>>>>>>>>>>>>>>>>>>>
55131>>>>>>>>>>>>>>>>>>>  // Picture export functions
55131>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPictureExportOptions  "VpeSetPictureExportOptions"  _VPEDLL_ DWord hdoc DWord options Returns Integer
55132>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPictureExportColorDepth "VpeSetPictureExportColorDepth" _VPEDLL_ DWord hdoc Integer depth Returns Integer
55133>>>>>>>>>>>>>>>>>>>  External_Function VpeSetPictureExportDither   "VpeSetPictureExportDither"   _VPEDLL_ DWord hdoc Integer dither Returns Integer
55134>>>>>>>>>>>>>>>>>>>  External_Function VpePictureExportPage        "VpePictureExportPage"        _VPEDLL_ DWord hdoc String file_name Integer page_no Returns Integer
55135>>>>>>>>>>>>>>>>>>>  External_Function VpePictureExport            "VpePictureExport"            _VPEDLL_ DWord hdoc String file_name Integer page_no Integer x Integer y Integer x2 Integer y2 Returns Integer
55136>>>>>>>>>>>>>>>>>>>
55136>>>>>>>>>>>>>>>>>>>  // Chart functions
55136>>>>>>>>>>>>>>>>>>>  External_Function VpeInitCharts               "VpeInitCharts"               _VPEDLL_ DWord hdoc Returns Integer
55137>>>>>>>>>>>>>>>>>>>  External_Function VpeChartDataCreate          "VpeChartDataCreate"          _VPEDLL_ DWord hdoc Integer columns Integer rows Returns DWord
55138>>>>>>>>>>>>>>>>>>>  // Value parameter is really a double in the next function
55138>>>>>>>>>>>>>>>>>>>  External_Function VpeChartDataAddValue        "VpeChartDataAddValue"        _VPEDLL_ DWord hdoc DWord hdata Integer column DWord value Returns Integer
55139>>>>>>>>>>>>>>>>>>>  External_Function VpeChartDataAddLegend       "VpeChartDataAddLegend"       _VPEDLL_ DWord hdoc DWord hdata String legend Returns Integer
55140>>>>>>>>>>>>>>>>>>>  External_Function VpeChartDataSetXAxisTitle   "VpeChartDataSetXAxisTitle"   _VPEDLL_ DWord hdoc DWord hdata String x_axis_title Returns Integer
55141>>>>>>>>>>>>>>>>>>>  External_Function VpeChartDataSetYAxisTitle   "VpeChartDataSetYAxisTitle"   _VPEDLL_ DWord hdoc DWord hdata String y_axis_title Returns Integer
55142>>>>>>>>>>>>>>>>>>>  External_Function VpeChartDataAddXLabel       "VpeChartDataAddXLabel"       _VPEDLL_ DWord hdoc DWord hdata String xlabel Returns Integer
55143>>>>>>>>>>>>>>>>>>>  External_Function VpeChartDataAddYLabel       "VpeChartDataAddYLabel"       _VPEDLL_ DWord hdoc DWord hdata String ylabel Returns Integer
55144>>>>>>>>>>>>>>>>>>>  External_Function VpeChartDataSetColor        "VpeChartDataSetColor"        _VPEDLL_ DWord hdoc DWord hdata Integer column DWord color Returns Integer
55145>>>>>>>>>>>>>>>>>>>  External_Function VpeChartDataSetLineStyle    "VpeChartDataSetLineStyle"    _VPEDLL_ DWord hdoc DWord hdata Integer column Integer pen_style Returns Integer
55146>>>>>>>>>>>>>>>>>>>  External_Function VpeChartDataSetHatchStyle   "VpeChartDataSetHatchStyle"   _VPEDLL_ DWord hdoc DWord hdata Integer column Integer style Returns Integer
55147>>>>>>>>>>>>>>>>>>>  External_Function VpeChartDataSetPointType    "VpeChartDataSetPointType"    _VPEDLL_ DWord hdoc DWord hdata Integer column Integer pointtype Returns Integer
55148>>>>>>>>>>>>>>>>>>>  // Parameter minimum is actually a double in the following function
55148>>>>>>>>>>>>>>>>>>>  External_Function VpeChartDataSetMinimum      "VpeChartDataSetMinimum"      _VPEDLL_ DWord hdoc DWord hdata DWord minimum Returns Integer
55149>>>>>>>>>>>>>>>>>>>  // Parameter maximum is actually a double in the following function
55149>>>>>>>>>>>>>>>>>>>  External_Function VpeChartDataSetMaximum      "VpeChartDataSetMaximum"      _VPEDLL_ DWord hdoc DWord hdata DWord maximum Returns Integer
55150>>>>>>>>>>>>>>>>>>>  External_Function VpeChartDataAddGap          "VpeChartDataAddGap"          _VPEDLL_ DWord hdoc DWord hdata Integer column Returns Integer
55151>>>>>>>>>>>>>>>>>>>  External_Function VpeChartDataAddRow          "VpeChartDataAddRow"          _VPEDLL_ DWord hdoc DWord hdata Returns Integer
55152>>>>>>>>>>>>>>>>>>>  External_Function VpeChartDataAddColumn       "VpeChartDataAddColumn"       _VPEDLL_ DWord hdoc DWord hdata Returns Integer
55153>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartTitle            "VpeSetChartTitle"            _VPEDLL_ DWord hdoc String title Returns Integer
55154>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartSubTitle         "VpeSetChartSubTitle"         _VPEDLL_ DWord hdoc String subtitle Returns Integer
55155>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartFootNote         "VpeSetChartFootNote"         _VPEDLL_ DWord hdoc String footnote Returns Integer
55156>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartRow              "VpeSetChartRow"              _VPEDLL_ DWord hdoc Integer row Returns Integer
55157>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartGridBkgColor     "VpeSetChartGridBkgColor"     _VPEDLL_ DWord hdoc DWord bkgcolor Returns Integer
55158>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartGridBkgMode      "VpeSetChartGridBkgMode"      _VPEDLL_ DWord hdoc Integer mode Returns Integer
55159>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartGridType         "VpeSetChartGridType"         _VPEDLL_ DWord hdoc Integer gridtype Returns Integer
55160>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartGridColor        "VpeSetChartGridColor"        _VPEDLL_ DWord hdoc DWord gridcolor Returns Integer
55161>>>>>>>>>>>>>>>>>>>  // Parameter gridstepy is actually a double in the following function
55161>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartYGridStep        "VpeSetChartYGridStep"        _VPEDLL_ DWord hdoc DWord gridstepy Returns Integer
55162>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartYAutoGridStep    "VpeSetChartYAutoGridStep"    _VPEDLL_ DWord hdoc Returns Integer
55163>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartLegendPosition   "VpeSetChartLegendPosition"   _VPEDLL_ DWord hdoc Integer legendpos Returns Integer
55164>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartLegendBorderStat "VpeSetChartLegendBorderStat" _VPEDLL_ DWord hdoc Integer legendborderstat Returns Integer
55165>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartXLabelState      "VpeSetChartXLabelState"      _VPEDLL_ DWord hdoc Integer xlabelstate Returns Integer
55166>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartXLabelAngle      "VpeSetChartXLabelAngle"      _VPEDLL_ DWord hdoc Integer xlabelangle Returns Integer
55167>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartXLabelStartValue "VpeSetChartXLabelStartValue" _VPEDLL_ DWord hdoc Integer xlabelstartvalue Returns Integer
55168>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartYLabelState      "VpeSetChartYLabelState"      _VPEDLL_ DWord hdoc Integer ylabelstate Returns Integer
55169>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartYLabelStep       "VpeSetChartYLabelStep"       _VPEDLL_ DWord hdoc Integer ylabelstep Returns Integer
55170>>>>>>>>>>>>>>>>>>>  // Parameter ylabeldivisor is actually a double in the following function
55170>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartYLabelDivisor    "VpeSetChartYLabelDivisor"    _VPEDLL_ DWord hdoc DWord ylabeldivisor Returns Integer
55171>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartGridRotation     "VpeSetChartGridRotation"     _VPEDLL_ DWord hdoc Integer axisangle Returns Integer
55172>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartYAxisAngle       "VpeSetChartYAxisAngle"       _VPEDLL_ DWord hdoc Integer yangle Returns Integer
55173>>>>>>>>>>>>>>>>>>>  External_Function VpeSetChartXAxisAngle       "VpeSetChartXAxisAngle"       _VPEDLL_ DWord hdoc Integer xangle Returns Integer
55174>>>>>>>>>>>>>>>>>>>  External_Function VpeChart                    "VpeChart"                    _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 DWord hdata Integer chart_type Returns Integer
55175>>>>>>>>>>>>>>>>>>>  //PDF-functions
55175>>>>>>>>>>>>>>>>>>>  External_Function VpeAddBookmark              "VpeAddBookmark"              _VPEDLL_ DWord hdoc Integer parent String title Returns Integer
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VPE-constants :  /////////////////////////////////////////////////////////
55176>>>>>>>>>>>>>>>>>>>//
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// Constants for internal use:
55176>>>>>>>>>>>>>>>>>>>Define VPE_NULL   for $0000
55176>>>>>>>>>>>>>>>>>>>Define VPE_TRUE   for 1
55176>>>>>>>>>>>>>>>>>>>Define VPE_FALSE  for 0
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeOpenDoc - flags :
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>Define VPE_NO_TOOLBAR               for 1
55176>>>>>>>>>>>>>>>>>>>Define VPE_NO_PRINTBUTTON           for 8
55176>>>>>>>>>>>>>>>>>>>Define VPE_NO_MAILBUTTON            for 16
55176>>>>>>>>>>>>>>>>>>>Define VPE_NO_SCALEBTNS             for 32
55176>>>>>>>>>>>>>>>>>>>Define VPE_GRIDBUTTON               for 64
55176>>>>>>>>>>>>>>>>>>>Define VPE_NO_MOVEBTNS              for 128
55176>>>>>>>>>>>>>>>>>>>Define VPE_NO_HELPBUTTON            for 256
55176>>>>>>>>>>>>>>>>>>>Define VPE_NO_INFOBUTTON            for 512
55176>>>>>>>>>>>>>>>>>>>Define VPE_NO_USER_CLOSE            for 1024
55176>>>>>>>>>>>>>>>>>>>Define VPE_NO_STATBAR               for 2048
55176>>>>>>>>>>>>>>>>>>>Define VPE_NO_PAGESCROLLER          for 4096
55176>>>>>>>>>>>>>>>>>>>Define VPE_NO_STATUSSEG             for 8192
55176>>>>>>>>>>>>>>>>>>>Define VPE_NO_RULERS                for 16384
55176>>>>>>>>>>>>>>>>>>>Define VPE_EMBEDDED                 for 32768
55176>>>>>>>>>>>>>>>>>>>Define VPE_DOCFILE_READONLY         for 65536
55176>>>>>>>>>>>>>>>>>>>Define VPE_FIXED_MESSAGES           for 131072
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeGetLastError - return values :
55176>>>>>>>>>>>>>>>>>>>Enum_List
55176>>>>>>>>>>>>>>>>>>>  Define VERR_OK
55176>>>>>>>>>>>>>>>>>>>  Define VERR_COMMON
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MEMORY                for 100
55176>>>>>>>>>>>>>>>>>>>  Define VERR_FILE_OPEN             for 200
55176>>>>>>>>>>>>>>>>>>>  Define VERR_FILE_DOCVERSION
55176>>>>>>>>>>>>>>>>>>>  Define VERR_FILE_CREATE
55176>>>>>>>>>>>>>>>>>>>  Define VERR_FILE_ACCESS
55176>>>>>>>>>>>>>>>>>>>  Define VERR_FILE_READ
55176>>>>>>>>>>>>>>>>>>>  Define VERR_FILE_WRITE
55176>>>>>>>>>>>>>>>>>>>  Define VERR_PIC_IMPORT            for 300
55176>>>>>>>>>>>>>>>>>>>  Define VERR_PIC_NOLICENSE
55176>>>>>>>>>>>>>>>>>>>  Define VERR_PIC_DXFCOORD
55176>>>>>>>>>>>>>>>>>>>  Define VERR_PIC_EXPORT            for 350
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MOD_GRAPH_IMP         for 400
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MOD_GRAPH_PROC
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MOD_BARCODE
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MOD_CHART
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_LOAD_MAPI        for 450
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_CREATE
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_USER_ABORT
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_FAILURE
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_LOGON_FAILURE
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_DISK_FULL
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_INSUFFICIENT_MEMORY
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_ACCESS_DENIED
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_RESERVED
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_TOO_MANY_SESSIONS
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_TOO_MANY_FILES
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_TOO_MANY_RECIPIENTS
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_ATTACHMENT_NOT_FOUND
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_ATTACHMENT_OPEN_FAILURE
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_ATTACHMENT_WRITE_FAILURE
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_UNKNOWN_RECIPIENT
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_BAD_RECIPTYPE
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_NO_MESSAGES
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_INVALID_MESSAGE
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_TEXT_TOO_LARGE
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_INVALID_SESSION
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_TYPE_NOT_SUPPORTED
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_AMBIGUOUS_RECIPIENT
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_MESSAGE_IN_USE
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_NETWORK_FAILURE
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_INVALID_EDITFIELDS
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_INVALID_RECIPS
55176>>>>>>>>>>>>>>>>>>>  Define VERR_MAIL_NOT_SUPPORTED
55176>>>>>>>>>>>>>>>>>>>  Define VERR_RTF_BRACES            for 1000
55176>>>>>>>>>>>>>>>>>>>  Define VERR_RTF_OVERFLOW
55176>>>>>>>>>>>>>>>>>>>  Define VERR_RTF_FONTTBL
55176>>>>>>>>>>>>>>>>>>>  Define VERR_RTF_COLORTBL
55176>>>>>>>>>>>>>>>>>>>End_Enum_List
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpePreviewDoc - parameters :
55176>>>>>>>>>>>>>>>>>>>Define VPE_SHOW_NORMAL              for 1
55176>>>>>>>>>>>>>>>>>>>Define VPE_SHOW_MAXIMIZED           for 2
55176>>>>>>>>>>>>>>>>>>>Define VPE_SHOW_HIDE                for 3
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetPreviewCtrl - parameters :
55176>>>>>>>>>>>>>>>>>>>Define PREVIEW_STAY                 for 0
55176>>>>>>>>>>>>>>>>>>>Define PREVIEW_JUMPTOP              for 1
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>   // VpeDefineKey/VpeDefineKey - parameters :
55176>>>>>>>>>>>>>>>>>>>   Enum_List
55176>>>>>>>>>>>>>>>>>>>     Define VKEY_SCROLL_LEFT
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_SCROLL_PAGE_LEFT
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_SCROLL_RIGHT
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_SCROLL_PAGE_RIGHT
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_SCROLL_UP
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_SCROLL_PAGE_UP
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_SCROLL_DOWN
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_SCROLL_PAGE_DOWN
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_SCROLL_TOP
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_SCROLL_BOTTOM
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_PRINT
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_MAIL
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_1_1
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_FULL_PAGE
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_ZOOM_IN
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_ZOOM_OUT
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_GRID
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_PAGE_FIRST
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_PAGE_LEFT
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_PAGE_RIGHT
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_PAGE_LAST
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_HELP
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_INFO
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_CLOSE
55176>>>>>>>>>>>>>>>>>>>     DEFINE VKEY_GOTO_PAGE
55176>>>>>>>>>>>>>>>>>>>   End_Enum_List
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>    // VpeSetGUILanguage - parameters :
55176>>>>>>>>>>>>>>>>>>>    Enum_List
55176>>>>>>>>>>>>>>>>>>>      DEFINE VGUI_LANGUAGE_ENGLISH
55176>>>>>>>>>>>>>>>>>>>      DEFINE VGUI_LANGUAGE_GERMAN
55176>>>>>>>>>>>>>>>>>>>      DEFINE VGUI_LANGUAGE_FRENCH
55176>>>>>>>>>>>>>>>>>>>      DEFINE VGUI_LANGUAGE_DUTCH
55176>>>>>>>>>>>>>>>>>>>      DEFINE VGUI_LANGUAGE_SPANISH
55176>>>>>>>>>>>>>>>>>>>      DEFINE VGUI_LANGUAGE_DANISH
55176>>>>>>>>>>>>>>>>>>>      DEFINE VGUI_LANGUAGE_SWEDISH
55176>>>>>>>>>>>>>>>>>>>      DEFINE VGUI_LANGUAGE_FINNISH
55176>>>>>>>>>>>>>>>>>>>      DEFINE VGUI_LANGUAGE_ITALIAN
55176>>>>>>>>>>>>>>>>>>>      DEFINE VGUI_LANGUAGE_NORWEGIAN
55176>>>>>>>>>>>>>>>>>>>    End_Enum_List
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeGetEdition - return values :
55176>>>>>>>>>>>>>>>>>>>Define VEDITION_STANDARD      for 1000
55176>>>>>>>>>>>>>>>>>>>Define VEDITION_ENHANCED      for 2000
55176>>>>>>>>>>>>>>>>>>>Define VEDITION_PROFESSIONAL  for 3000
55176>>>>>>>>>>>>>>>>>>>Define VEDITION_ENTERPRISE    for 4000
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetupPrinter - parameters :
55176>>>>>>>>>>>>>>>>>>>Define PRINTDLG_NEVER         for 0    // never show setup-dialog
55176>>>>>>>>>>>>>>>>>>>Define PRINTDLG_ONFAIL        for 1    // show setup-dialog if file-read fail
55176>>>>>>>>>>>>>>>>>>>Define PRINTDLG_ALWAYS        for 2    // show setup-dialog always
55176>>>>>>>>>>>>>>>>>>>Define PRINTDLG_FULL          for 4    // show full dialog, add this to the other flags!
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetPrintOptions - parameters :
55176>>>>>>>>>>>>>>>>>>>Define PRINT_ALL              for 0    // print all pages
55176>>>>>>>>>>>>>>>>>>>Define PRINT_EVEN             for 1    // print only even pages
55176>>>>>>>>>>>>>>>>>>>Define PRINT_ODD              for 2    // print only oss pages
55176>>>>>>>>>>>>>>>>>>>Define PRINT_NOABORTDLG       for 4    // no abort/progress dialog
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetPrintPosMode - parameters :
55176>>>>>>>>>>>>>>>>>>>Define PRINTPOS_ABSOLUTE      for 0
55176>>>>>>>>>>>>>>>>>>>Define PRINTPOS_RELATIVE      for 1
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetDevOrientation - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpeSetPageOrientation - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpeGetPageOrientation - return values :
55176>>>>>>>>>>>>>>>>>>>Define VORIENTATION_PORTRAIT  for 1
55176>>>>>>>>>>>>>>>>>>>Define VORIENTATION_LANDSCAPE for 2 // Formerly VPE_LANDSCAPE
55176>>>>>>>>>>>>>>>>>>>Define VPE_LANDSCAPE for 8192 // Just so we are able to compile
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetDevPaperFormat - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpeGetDevPaperFormat - return values, and
55176>>>>>>>>>>>>>>>>>>>// VpeSetPageFormat - parameters :
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_A4                  for -1   // Formerly: DIN_A_4
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_LETTER              for -2   // Formerly: US_LETTER
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_LEGAL               for -3
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_CSHEET              for -4
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_DSHEET              for -5
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ESHEET              for -6
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_LETTERSMALL         for -7
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_TABLOID             for -8
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_LEDGER              for -9
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_STATEMENT           for -10
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_EXECUTIVE           for -11
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_A3                  for -12
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_A4SMALL             for -13
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_A5                  for -14
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_B4                  for -15
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_B5                  for -16
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_FOLIO               for -17
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_QUARTO              for -18
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_10X14               for -19
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_11X17               for -20
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_NOTE                for -21
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ENV_9               for -22
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ENV_10              for -23
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ENV_11              for -24
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ENV_12              for -25
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ENV_14              for -26
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ENV_DL              for -27
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ENV_C5              for -28
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ENV_C3              for -29
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ENV_C4              for -30
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ENV_C6              for -31
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ENV_C65             for -32
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ENV_B4              for -33
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ENV_B5              for -34
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ENV_B6              for -35
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ENV_ITALY           for -36
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ENV_MONARCH         for -37
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_ENV_PERSONAL        for -38
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_FANFOLD_US          for -39
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_FANFOLD_STD_GERMAN  for -40
55176>>>>>>>>>>>>>>>>>>>Define VPAPER_FANFOLD_LGL_GERMAN  for -41
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetDevPrintQuality - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpeGetDevPrintQuality - return values :
55176>>>>>>>>>>>>>>>>>>>Define VRES_DRAFT                 for -1
55176>>>>>>>>>>>>>>>>>>>Define VRES_LOW                   for -2
55176>>>>>>>>>>>>>>>>>>>Define VRES_MEDIUM                for -3
55176>>>>>>>>>>>>>>>>>>>Define VRES_HIGH                  for -4
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetDevColor - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpeGetDevColor - return values :
55176>>>>>>>>>>>>>>>>>>>Define VCOLOR_MONOCHROME          for 1
55176>>>>>>>>>>>>>>>>>>>Define VCOLOR_COLOR               for 2
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetDevDuplex - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpeGetDevDuplex - return values :
55176>>>>>>>>>>>>>>>>>>>Define VDUP_SIMPLEX               for 1
55176>>>>>>>>>>>>>>>>>>>Define VDUP_VERTICAL              for 2
55176>>>>>>>>>>>>>>>>>>>Define VDUP_HORIZONTAL            for 3
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetDevTTOption - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpeGetDevTTOption - return values :
55176>>>>>>>>>>>>>>>>>>>Define VTT_BITMAP                 for 1
55176>>>>>>>>>>>>>>>>>>>Define VTT_DOWNLOAD               for 2
55176>>>>>>>>>>>>>>>>>>>Define VTT_SUBDEV                 for 3
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeGetDevPaperBinID - return values, and
55176>>>>>>>>>>>>>>>>>>>// VpeSetDevPaperBin - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpeGetDevPaperBin - return values, and
55176>>>>>>>>>>>>>>>>>>>// VpeSetPaperBin - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpeGetPaperBin - return values :
55176>>>>>>>>>>>>>>>>>>>Define VBIN_UNTOUCHED             for -1 // not for the ...Dev... functions
55176>>>>>>>>>>>>>>>>>>>Define VBIN_UPPER                 for 1
55176>>>>>>>>>>>>>>>>>>>Define VBIN_ONLYONE               for 1 // yes, also 1
55176>>>>>>>>>>>>>>>>>>>Define VBIN_LOWER                 for 2
55176>>>>>>>>>>>>>>>>>>>Define VBIN_MIDDLE                for 3
55176>>>>>>>>>>>>>>>>>>>Define VBIN_MANUAL                for 4
55176>>>>>>>>>>>>>>>>>>>Define VBIN_ENVELOPE              for 5
55176>>>>>>>>>>>>>>>>>>>Define VBIN_ENVMANUAL             for 6
55176>>>>>>>>>>>>>>>>>>>Define VBIN_AUTO                  for 7
55176>>>>>>>>>>>>>>>>>>>Define VBIN_TRACTOR               for 8
55176>>>>>>>>>>>>>>>>>>>Define VBIN_SMALLFMT              for 9
55176>>>>>>>>>>>>>>>>>>>Define VBIN_LARGEFMT              for 10
55176>>>>>>>>>>>>>>>>>>>Define VBIN_LARGECAPACITY         for 11
55176>>>>>>>>>>>>>>>>>>>Define VBIN_CASSETTE              for 14
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetAutoBreak - parameters :
55176>>>>>>>>>>>>>>>>>>>Define AUTO_BREAK_ON              for 0    // auto break
55176>>>>>>>>>>>>>>>>>>>Define AUTO_BREAK_OFF             for 1    // limited positioning, rendering
55176>>>>>>>>>>>>>>>>>>>Define AUTO_BREAK_NO_LIMITS       for 2    // none of above
55176>>>>>>>>>>>>>>>>>>>Define AUTO_BREAK_FULL            for 3
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// Positioning codes, and
55176>>>>>>>>>>>>>>>>>>>// VpeGet - parameters :
55176>>>>>>>>>>>>>>>>>>>Define VFREE                      for -1   // not vpeget
55176>>>>>>>>>>>>>>>>>>>Define VLEFT                      for -2
55176>>>>>>>>>>>>>>>>>>>Define VRIGHT                     for -3
55176>>>>>>>>>>>>>>>>>>>Define VLEFTMARGIN                for -4
55176>>>>>>>>>>>>>>>>>>>Define VRIGHTMARGIN               for -5
55176>>>>>>>>>>>>>>>>>>>Define VTOP                       for -6
55176>>>>>>>>>>>>>>>>>>>Define VBOTTOM                    for -7
55176>>>>>>>>>>>>>>>>>>>Define VTOPMARGIN                 for -8
55176>>>>>>>>>>>>>>>>>>>Define VBOTTOMMARGIN              for -9
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>Define VWIDTH                     for -100
55176>>>>>>>>>>>>>>>>>>>Define VHEIGHT                    for -101
55176>>>>>>>>>>>>>>>>>>>Define VRENDERWIDTH               for -102
55176>>>>>>>>>>>>>>>>>>>Define VRENDERHEIGHT              for -103
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>Define VUDO_LEFT                  for -104
55176>>>>>>>>>>>>>>>>>>>Define VUDO_RIGHT                 for -105
55176>>>>>>>>>>>>>>>>>>>Define VUDO_TOP                   for -106
55176>>>>>>>>>>>>>>>>>>>Define VUDO_BOTTOM                for -107
55176>>>>>>>>>>>>>>>>>>>Define VUDO_WIDTH                 for -108
55176>>>>>>>>>>>>>>>>>>>Define VUDO_HEIGHT                for -109
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeRender... - return values :
55176>>>>>>>>>>>>>>>>>>>Define RENDER_NO_BREAK            for 0
55176>>>>>>>>>>>>>>>>>>>Define RENDER_BREAK               for 1
55176>>>>>>>>>>>>>>>>>>>Define RENDER_SKIP_BREAK          for 2
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetPen - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpeSetPenStyle - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpePenStyle - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpeChartDataSetLineStyle - parameters :
55176>>>>>>>>>>>>>>>>>>>Define PS_SOLID                   for 0
55176>>>>>>>>>>>>>>>>>>>Define PS_DASH                    for 1
55176>>>>>>>>>>>>>>>>>>>Define PS_DOT                     for 2
55176>>>>>>>>>>>>>>>>>>>Define PS_DASHDOT                 for 3
55176>>>>>>>>>>>>>>>>>>>Define PS_DASHDOTDOT              for 4
55176>>>>>>>>>>>>>>>>>>>Define PS_NULL                    for 5
55176>>>>>>>>>>>>>>>>>>>//DEFINE PS_INSIDEFRAME         for 6
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetBkgMode - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpeSetChartGridBkgMode - parameters :
55176>>>>>>>>>>>>>>>>>>>Define VBKG_SOLID                 for 0
55176>>>>>>>>>>>>>>>>>>>Define VBKG_TRANSPARENT           for 1
55176>>>>>>>>>>>>>>>>>>>Define VBKG_GRD_LINE              for 2
55176>>>>>>>>>>>>>>>>>>>Define VBKG_GRD_RECT              for 3
55176>>>>>>>>>>>>>>>>>>>Define VBKG_GRD_ELLIPSE           for 4
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetBkgGradientPrint - parameters :
55176>>>>>>>>>>>>>>>>>>>Define VGRD_PRINT_AUTO            for 0
55176>>>>>>>>>>>>>>>>>>>Define VGRD_PRINT_GRADIENT        for 1
55176>>>>>>>>>>>>>>>>>>>Define VGRD_PRINT_SOLID           for 2
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetHatchStyle - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpeChartDataSetHatchStyle - parameters :
55176>>>>>>>>>>>>>>>>>>>Define HS_NONE                    for -1
55176>>>>>>>>>>>>>>>>>>>Define HS_HORIZONTAL              for 0
55176>>>>>>>>>>>>>>>>>>>Define HS_VERTICAL                for 1
55176>>>>>>>>>>>>>>>>>>>Define HS_FDIAGONAL               for 2
55176>>>>>>>>>>>>>>>>>>>Define HS_BDIAGONAL               for 3
55176>>>>>>>>>>>>>>>>>>>Define HS_CROSS                   for 4
55176>>>>>>>>>>>>>>>>>>>Define HS_DIAGCROSS               for 5
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetCharset - parameters :
55176>>>>>>>>>>>>>>>>>>>Define ANSI_CHARSET               for 0
55176>>>>>>>>>>>>>>>>>>>Define DEFAULT_CHARSET            for 1
55176>>>>>>>>>>>>>>>>>>>Define SYMBOL_CHARSET             for 2
55176>>>>>>>>>>>>>>>>>>>Define SHIFTJIS_CHARSET           for 128
55176>>>>>>>>>>>>>>>>>>>Define HANGEUL_CHARSET            for 129
55176>>>>>>>>>>>>>>>>>>>Define GB2312_CHARSET             for 134
55176>>>>>>>>>>>>>>>>>>>Define CHINESEBIG5_CHARSET        for 136
55176>>>>>>>>>>>>>>>>>>>Define OEM_CHARSET                for 255
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>Define JOHAB_CHARSET              for 130 // the following are only for win9x
55176>>>>>>>>>>>>>>>>>>>Define HEBREW_CHARSET             for 177
55176>>>>>>>>>>>>>>>>>>>Define ARABIC_CHARSET             for 178
55176>>>>>>>>>>>>>>>>>>>Define GREEK_CHARSET              for 161
55176>>>>>>>>>>>>>>>>>>>Define TURKISH_CHARSET            for 162
55176>>>>>>>>>>>>>>>>>>>Define THAI_CHARSET               for 222
55176>>>>>>>>>>>>>>>>>>>Define EASTEUROPE_CHARSET         for 238
55176>>>>>>>>>>>>>>>>>>>Define RUSSIAN_CHARSET            for 204
55176>>>>>>>>>>>>>>>>>>>Define MAC_CHARSET                for 77
55176>>>>>>>>>>>>>>>>>>>Define BALTIC_CHARSET             for 186
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetFontAttr - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpeSetTextAlignment - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpeSetAlign - parameters :
55176>>>>>>>>>>>>>>>>>>>Define ALIGN_LEFT                 for 0
55176>>>>>>>>>>>>>>>>>>>Define ALIGN_RIGHT                for 1
55176>>>>>>>>>>>>>>>>>>>Define ALIGN_CENTER               for 2
55176>>>>>>>>>>>>>>>>>>>Define ALIGN_JUSTIFIED            for 3
55176>>>>>>>>>>>>>>>>>>>//DEFINE ALIGN_PRINT                for 4     // internal, do not use !
55176>>>>>>>>>>>>>>>>>>>Define ALIGN_JUSTIFIED_AB         for 5
55176>>>>>>>>>>>>>>>>>>>Define ALIGN_LEFT_CUT             for 7
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetPictureType - parameters :
55176>>>>>>>>>>>>>>>>>>>Define PIC_TYPE_AUTO              for 255
55176>>>>>>>>>>>>>>>>>>>Define PIC_TYPE_BMP               for 0
55176>>>>>>>>>>>>>>>>>>>Define PIC_TYPE_WMF               for 5
55176>>>>>>>>>>>>>>>>>>>Define PIC_TYPE_EMF               for 6
55176>>>>>>>>>>>>>>>>>>>Define PIC_TYPE_DXF               for 7
55176>>>>>>>>>>>>>>>>>>>Define PIC_TYPE_TIFF              for 64
55176>>>>>>>>>>>>>>>>>>>Define PIC_TYPE_GIF               for 65
55176>>>>>>>>>>>>>>>>>>>Define PIC_TYPE_PCX               for 66
55176>>>>>>>>>>>>>>>>>>>Define PIC_TYPE_FLT               for 67
55176>>>>>>>>>>>>>>>>>>>Define PIC_TYPE_JPEG              for 68
55176>>>>>>>>>>>>>>>>>>>Define PIC_TYPE_PNG               for 69
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpePicture - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpePictureResID - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpePictureResName - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpePictureDIB - parameters :
55176>>>>>>>>>>>>>>>>>>>Define PIC_MERGE                  for 1
55176>>>>>>>>>>>>>>>>>>>Define PIC_KEEPIMAGE              for 2  // Formerly: VPE_PIC_KEEPIMAGE
55176>>>>>>>>>>>>>>>>>>>Define PIC_DISCARD_DIB_DRAW       for 4
55176>>>>>>>>>>>>>>>>>>>Define PIC_KEEP_DIB_PAGE          for 8
55176>>>>>>>>>>>>>>>>>>>Define PIC_BESTFIT                for 16
55176>>>>>>>>>>>>>>>>>>>Define PIC_IN_FILE                for 32
55176>>>>>>>>>>>>>>>>>>>Define PIC_ALLOWLZW               for 64
55176>>>>>>>>>>>>>>>>>>>Define PIC_X2YRESOLUTION          for 128
55176>>>>>>>>>>>>>>>>>>>Define PIC_DXF_BW                 for 256
55176>>>>>>>>>>>>>>>>>>>Define PIC_SCALE2GRAY             for 512
55176>>>>>>>>>>>>>>>>>>>Define PIC_SCALE2GRAY_FLOAT       for 1024
55176>>>>>>>>>>>>>>>>>>>Define PIC_EXACT                  for 32768
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetBarcodeParms - parameters :
55176>>>>>>>>>>>>>>>>>>>Define BCP_BOTTOM                 for 0
55176>>>>>>>>>>>>>>>>>>>Define BCP_TOP                    for 1
55176>>>>>>>>>>>>>>>>>>>Define BCP_HIDE                   for 2
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeBarcode - parameters :
55176>>>>>>>>>>>>>>>>>>>Define BCT_EAN13                  for 1
55176>>>>>>>>>>>>>>>>>>>Define BCT_EAN8                   for 2
55176>>>>>>>>>>>>>>>>>>>Define BCT_UPCA                   for 3
55176>>>>>>>>>>>>>>>>>>>Define BCT_CODABAR                for 5
55176>>>>>>>>>>>>>>>>>>>Define BCT_CODE39                 for 6
55176>>>>>>>>>>>>>>>>>>>Define BCT_2OF5                   for 7
55176>>>>>>>>>>>>>>>>>>>Define BCT_INTERLEAVED2OF5        for 8
55176>>>>>>>>>>>>>>>>>>>Define BCT_UPCE                   for 9
55176>>>>>>>>>>>>>>>>>>>Define BCT_EAN13_2                for 10
55176>>>>>>>>>>>>>>>>>>>Define BCT_EAN13_5                for 11
55176>>>>>>>>>>>>>>>>>>>Define BCT_EAN8_2                 for 12
55176>>>>>>>>>>>>>>>>>>>Define BCT_EAN8_5                 for 13
55176>>>>>>>>>>>>>>>>>>>Define BCT_UPCA_2                 for 14
55176>>>>>>>>>>>>>>>>>>>Define BCT_UPCA_5                 for 15
55176>>>>>>>>>>>>>>>>>>>Define BCT_UPCE_2                 for 16
55176>>>>>>>>>>>>>>>>>>>Define BCT_UPCE_5                 for 17
55176>>>>>>>>>>>>>>>>>>>Define BCT_EAN128A                for 18
55176>>>>>>>>>>>>>>>>>>>Define BCT_EAN128B                for 19
55176>>>>>>>>>>>>>>>>>>>Define BCT_EAN128C                for 20
55176>>>>>>>>>>>>>>>>>>>Define BCT_CODE93                 for 21
55176>>>>>>>>>>>>>>>>>>>Define BCT_POSTNET                for 22
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeIsMAPIInstalled - return values :
55176>>>>>>>>>>>>>>>>>>>Define VMAPI_NOT_INSTALLED        for 0
55176>>>>>>>>>>>>>>>>>>>Define VMAPI_INSTALLED            for 1
55176>>>>>>>>>>>>>>>>>>>Define VMAPI_UNSURE               for 2
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeAddMailReceiver - parameters :
55176>>>>>>>>>>>>>>>>>>>Define VMAIL_ORIG                 for 0
55176>>>>>>>>>>>>>>>>>>>Define VMAIL_TO                   for 1
55176>>>>>>>>>>>>>>>>>>>Define VMAIL_CC                   for 2
55176>>>>>>>>>>>>>>>>>>>Define VMAIL_BCC                  for 3
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// Colors :
55176>>>>>>>>>>>>>>>>>>>// ??? on page 239
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetPictureExportOptions - parameters :
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_WRITE_COMPRESSED    for 2
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_TIFF_NOCOMP         for 32
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_TIFF_LZW            for 64
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_TIFF_CCITTRLE       for 96
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_TIFF_CCITTFAX3      for 128
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_TIFF_CCITTFAX4      for 160
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_TIFF_PACKBITS       for 192
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_TIFF_APPEND         for 2097152
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_ALLOWLZW            for 1024
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_JPEG_HIQUALITY      for 61440
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_JPEG_GOODQUALITY    for 36864
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_JPEG_MIDQUALITY     for 12288
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_JPEG_LOQUALITY      for 4096
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_PNG_INTERLACED      for 65536
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetPictureExportColorDepth - parameters :
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_COLOR_MONO          for 1
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_COLOR_16            for 4
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_COLOR_256           for 8
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_COLOR_HI            for 16
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_COLOR_TRUE          for 24
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetPictureExportDither - parameters :
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_DITHER_NONE         for 0
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_DITHER_MONO         for 1
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_DITHER_16           for 2
55176>>>>>>>>>>>>>>>>>>>Define PICEXP_DITHER_256          for 3
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeChartDataSetPointType - parameters :
55176>>>>>>>>>>>>>>>>>>>Define VCHART_SYMBOL_NONE         for -1
55176>>>>>>>>>>>>>>>>>>>Define VCHART_SYMBOL_SQUARE       for 0
55176>>>>>>>>>>>>>>>>>>>Define VCHART_SYMBOL_TRIANGLE     for 1
55176>>>>>>>>>>>>>>>>>>>Define VCHART_SYMBOL_CIRCLE       for 2
55176>>>>>>>>>>>>>>>>>>>Define VCHART_SYMBOL_CROSS        for 3
55176>>>>>>>>>>>>>>>>>>>Define VCHART_SYMBOL_X            for 4
55176>>>>>>>>>>>>>>>>>>>Define VCHART_SYMBOL_POINT        for 5
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetChartGridType - parameters :
55176>>>>>>>>>>>>>>>>>>>Define VCHART_GRID_NONE           for -1
55176>>>>>>>>>>>>>>>>>>>Define VCHART_GRID_BOTH_AXIS      for 0
55176>>>>>>>>>>>>>>>>>>>Define VCHART_GRID_X_AXIS         for 1
55176>>>>>>>>>>>>>>>>>>>Define VCHART_GRID_Y_AXIS         for 2
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetChartLegendPosition - parameters :
55176>>>>>>>>>>>>>>>>>>>Define VCHART_LEGENDPOS_NONE          for -1
55176>>>>>>>>>>>>>>>>>>>Define VCHART_LEGENDPOS_RIGHT         for 0
55176>>>>>>>>>>>>>>>>>>>Define VCHART_LEGENDPOS_RIGHT_TOP     for 1
55176>>>>>>>>>>>>>>>>>>>Define VCHART_LEGENDPOS_RIGHT_BOTTOM  for 2
55176>>>>>>>>>>>>>>>>>>>Define VCHART_LEGENDPOS_LEFT          for 3
55176>>>>>>>>>>>>>>>>>>>Define VCHART_LEGENDPOS_LEFT_TOP      for 4
55176>>>>>>>>>>>>>>>>>>>Define VCHART_LEGENDPOS_LEFT_BOTTOM   for 5
55176>>>>>>>>>>>>>>>>>>>Define VCHART_LEGENDPOS_TOP           for 6
55176>>>>>>>>>>>>>>>>>>>Define VCHART_LEGENDPOS_BOTTOM        for 7
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeSetChartXLabelState - parameters, and
55176>>>>>>>>>>>>>>>>>>>// VpeSetChartYLabelState - parameters :
55176>>>>>>>>>>>>>>>>>>>Define VCHART_LABEL_NONE              for -1
55176>>>>>>>>>>>>>>>>>>>Define VCHART_LABEL_USER              for 0
55176>>>>>>>>>>>>>>>>>>>Define VCHART_LABEL_AUTO              for 1
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>// VpeChart - parameters :
55176>>>>>>>>>>>>>>>>>>>Define VCHART_POINT                   for 0
55176>>>>>>>>>>>>>>>>>>>Define VCHART_LINE                    for 1
55176>>>>>>>>>>>>>>>>>>>Define VCHART_BAR                     for 2
55176>>>>>>>>>>>>>>>>>>>Define VCHART_STACKED_BAR_ABSOLUTE    for 3
55176>>>>>>>>>>>>>>>>>>>Define VCHART_STACKED_BAR_PERCENT     for 4
55176>>>>>>>>>>>>>>>>>>>Define VCHART_3D_BAR                  for 5
55176>>>>>>>>>>>>>>>>>>>Define VCHART_3D_STACKED_BAR_ABSOLUTE for 6
55176>>>>>>>>>>>>>>>>>>>Define VCHART_3D_STACKED_BAR_PERCENT  for 7
55176>>>>>>>>>>>>>>>>>>>Define VCHART_PIE                     for 8
55176>>>>>>>>>>>>>>>>>>>Define VCHART_3D_PIE                  for 9
55176>>>>>>>>>>>>>>>>>>>Define VCHART_AREA_ABSOLUTE           for 10
55176>>>>>>>>>>>>>>>>>>>Define VCHART_AREA_PERCENT            for 11
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>Integer Vpe$ReturnGrb#
55176>>>>>>>>>>>>>>>>>>>
55176>>>>>>>>>>>>>>>>>>>Function VPE_OemToChar Global String OemStr Returns String
55178>>>>>>>>>>>>>>>>>>>  String  CharStr
55178>>>>>>>>>>>>>>>>>>>  Integer OemAdress CharAdress
55178>>>>>>>>>>>>>>>>>>>  Append OemStr (Character(0))
55179>>>>>>>>>>>>>>>>>>>  Move (Repeat(Character(0), (Length(OemStr)))) to CharStr
55180>>>>>>>>>>>>>>>>>>>  GetAddress of OemStr  to OemAdress
55181>>>>>>>>>>>>>>>>>>>  GetAddress of CharStr to CharAdress
55182>>>>>>>>>>>>>>>>>>>  Move (VpeOemToCharA(OemAdress, CharAdress)) to Vpe$ReturnGrb#
55183>>>>>>>>>>>>>>>>>>>  Function_Return (CString(CharStr))
55184>>>>>>>>>>>>>>>>>>>End_Function
55185>>>>>>>>>>>>>>>>>>>
55185>>>>>>>>>>>>>>>>>>>// This function may be used in conjunction with the Win2Pdf product
55185>>>>>>>>>>>>>>>>>>>// from Dane Prairie Systems: "http://www.daneprairie.com"
55185>>>>>>>>>>>>>>>>>>>Function Vpe_PrintDocToPdf Global String lsVpeDocFile String lsPdfFileName String lsTitle Returns Integer
55187>>>>>>>>>>>>>>>>>>>  Integer lhDoc lhGarbage
55187>>>>>>>>>>>>>>>>>>>  
55187>>>>>>>>>>>>>>>>>>>  Get VPE_OemToChar lsTitle to lsTitle
55188>>>>>>>>>>>>>>>>>>>  Move (VpeOpenDocFile(0,lsVpeDocFile,"",DFFALSE)) to lhDoc
55189>>>>>>>>>>>>>>>>>>>  Move (VpeLicense(lhDoc,VPE_SERIAL_CODE1,VPE_SERIAL_CODE2)) to lhGarbage
55190>>>>>>>>>>>>>>>>>>>  Move (VpeSetDevice(lhDoc,"Win2PDF")) to lhGarbage // Use printer called "Win2PDF"
55191>>>>>>>>>>>>>>>>>>>  
55191>>>>>>>>>>>>>>>>>>>  Set_Registry_Root to HKEY_CURRENT_USER "Software"
55192>>>>>>>>>>>>>>>>>>>  // This assigns a file name to the PDF file about to be generated
55192>>>>>>>>>>>>>>>>>>>  Set_Foreign_Profile_String "VB and VBA Program Settings\Dane Prairie Systems" "Win2PDF" "PDFFileName" to lsPdfFileName
55195>>>>>>>>>>>>>>>>>>>  Set_Foreign_Profile_String "VB and VBA Program Settings\Dane Prairie Systems" "Win2PDF" "PDFFileNameWas" to lsPdfFileName
55198>>>>>>>>>>>>>>>>>>>   // Restore registry pointer:
55198>>>>>>>>>>>>>>>>>>>  Set_Registry_Root to HKEY_LOCAL_MACHINE "SoftWare"
55199>>>>>>>>>>>>>>>>>>>
55199>>>>>>>>>>>>>>>>>>>  Move (VpePrintDoc(lhDoc,DFFALSE)) to lhGarbage // DFFALSE=>No dialog
55200>>>>>>>>>>>>>>>>>>>  Move (VpeCloseDoc(lhDoc)) to windowindex
55201>>>>>>>>>>>>>>>>>>>  Function_Return lhGarbage
55202>>>>>>>>>>>>>>>>>>>End_Function
55203>>>>>>>>>>>>>>>>>Use VPE3X.CFG
55203>>>>>>>>>>>>>>>>>Use Files.utl    // Utilities for handling file related stuff
Including file: files.utl    (C:\projects\BRS\VDFQuery\AppSrc\files.utl)
55203>>>>>>>>>>>>>>>>>>>//**********************************************************************
55203>>>>>>>>>>>>>>>>>>>// Use Files.utl    // Utilities for handling file related stuff
55203>>>>>>>>>>>>>>>>>>>//
55203>>>>>>>>>>>>>>>>>>>// By Sture Andersen
55203>>>>>>>>>>>>>>>>>>>//
55203>>>>>>>>>>>>>>>>>>>// Create: Wed  01-02-1998
55203>>>>>>>>>>>>>>>>>>>// Update: Sat  02-05-1998 - Functions SEQ_FindFileAlongPath, SEQ_FileLineCount
55203>>>>>>>>>>>>>>>>>>>//                           and SEQ_FindFileAlongDFPath added.
55203>>>>>>>>>>>>>>>>>>>//         Fri  08-05-1998 - Error in cChannelAdmin fixed. Something to do with
55203>>>>>>>>>>>>>>>>>>>//                           channel positions has changed between 3.0x and
55203>>>>>>>>>>>>>>>>>>>//                           3.1c. On_Error trick has been taken out and a
55203>>>>>>>>>>>>>>>>>>>//                           'sneak in' on the right position trick has been
55203>>>>>>>>>>>>>>>>>>>//                           introduced.
55203>>>>>>>>>>>>>>>>>>>//              09-07-1998 - Procedure SEQ_WriteRecordBuffer_LD added.
55203>>>>>>>>>>>>>>>>>>>//              14-07-1998 - Grave error fixed in SEQ_WriteRecordBuffer_LD
55203>>>>>>>>>>>>>>>>>>>//                           by Jrgen Legin and Torsten Balslw.
55203>>>>>>>>>>>>>>>>>>>//                         - SEQ_ReadRecordBuffer_LD added
55203>>>>>>>>>>>>>>>>>>>//              05-09-1998 - SEQ_ExtractPathFromFileName added
55203>>>>>>>>>>>>>>>>>>>//              06-09-1998 - SEQ_DfPath fixed
55203>>>>>>>>>>>>>>>>>>>//         Sun  07-02-1999 - Directory selector added. Based on work of
55203>>>>>>>>>>>>>>>>>>>//                           Dennis Piccioni and Torben Lund. Function
55203>>>>>>>>>>>>>>>>>>>//                           name is SEQ_SelectDirectory. Windows only!
55203>>>>>>>>>>>>>>>>>>>//                         - aps.SelectDirForm class added. Windows only!
55203>>>>>>>>>>>>>>>>>>>//         Fri  23-04-1999 - SEQ_DeleteFileToBin added. Based entirely on
55203>>>>>>>>>>>>>>>>>>>//                           upload from Andy Kaplan
55203>>>>>>>>>>>>>>>>>>>//                           (DAC NG user-contributed-files)
55203>>>>>>>>>>>>>>>>>>>//         Sun  02-05-1999 - Added function SEQ_FileModTime
55203>>>>>>>>>>>>>>>>>>>//         Mon  10-05-1999 - Fixes for VDF 6 (Vincent Oorsprong)
55203>>>>>>>>>>>>>>>>>>>//         Mon  30-08-1999 - Function SEQ_DirectInput and SEQ_DirectOutput added
55203>>>>>>>>>>>>>>>>>>>//         Wed  29-09-1999 - Function SEQ_SelectDirectory now converts to
55203>>>>>>>>>>>>>>>>>>>//                           OEM before returning its value.
55203>>>>>>>>>>>>>>>>>>>//         Sat  09-10-1999 - Procedures SEQ_CloseOutput, SEQ_CloseInput and
55203>>>>>>>>>>>>>>>>>>>//                           SEQ_AppendOutput added.
55203>>>>>>>>>>>>>>>>>>>//         Wed  01-12-1999 - Function SEQ_ReadLnProbe added.
55203>>>>>>>>>>>>>>>>>>>//         Sun  06-02-2000 - Save- and OpenDialogs are now created dynamically
55203>>>>>>>>>>>>>>>>>>>//                           in appropriate places
55203>>>>>>>>>>>>>>>>>>>//         Sat  11-03-2000 - Fix in SEQ_FileExists
55203>>>>>>>>>>>>>>>>>>>//         Wed  22-03-2000 - Function SEQ_FindFileAlongPath would cause an
55203>>>>>>>>>>>>>>>>>>>//                           "Access violation" if asked to locate a file
55203>>>>>>>>>>>>>>>>>>>//                           opened exclusive by an application (including the
55203>>>>>>>>>>>>>>>>>>>//                           current). Fixed.
55203>>>>>>>>>>>>>>>>>>>//         Mon  10-07-2000 - Function SEQ_FileSizeToString added
55203>>>>>>>>>>>>>>>>>>>//         Wed  01-11-2000 - Functions SEQ_EraseFile, SEQ_CopyFile and
55203>>>>>>>>>>>>>>>>>>>//                           SEQ_MoveFile added.
55203>>>>>>>>>>>>>>>>>>>//         Tue  07-11-2000 - Added function SEQ_ConvertToAbsoluteFileName
55203>>>>>>>>>>>>>>>>>>>//         Tue  02-01-2001 - Added procedures SEQ_AppendOutputImageClose and
55203>>>>>>>>>>>>>>>>>>>//                           SEQ_AppendLineClose.
55203>>>>>>>>>>>>>>>>>>>//         Thu  04-01-2001 - Added function SEQ_FindDataFileFromRootName
55203>>>>>>>>>>>>>>>>>>>//         Mon  15-04-2002 - aps.dbSelectDirForm added
55203>>>>>>>>>>>>>>>>>>>//         Mon  27-01-2003 - Function SEQ_SelectFileStartDir added
55203>>>>>>>>>>>>>>>>>>>//         Sat  06-09-2003 - Added function SEQ_ValidateFolder
55203>>>>>>>>>>>>>>>>>>>//         Thu  06-07-2006 - Fixed SEQ_SelectOutFile. It assumed work space
55203>>>>>>>>>>>>>>>>>>>//                           objects VDF 7 style.
55203>>>>>>>>>>>>>>>>>>>//
55203>>>>>>>>>>>>>>>>>>>//**********************************************************************
55203>>>>>>>>>>>>>>>>>>>use ui
55203>>>>>>>>>>>>>>>>>>>Use Files.nui    // Utilities for handling file related stuff
55203>>>>>>>>>>>>>>>>>>>Use MsgBox.utl   // obs procedure
55203>>>>>>>>>>>>>>>>>>>Use Strings.nui  // String manipulation for VDF
55203>>>>>>>>>>>>>>>>>>>Use Dates.nui    // Date manipulation for VDF
55203>>>>>>>>>>>>>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
55203>>>>>>>>>>>>>>>>>>>Use Version.nui
55203>>>>>>>>>>>>>>>>>>>Use Language
55203>>>>>>>>>>>>>>>>>>>
55203>>>>>>>>>>>>>>>>>>>Use wvaW32fh.pkg // Package by Wil van Antwerpen from www.vdf-guidance.com
55203>>>>>>>>>>>>>>>>>>>
55203>>>>>>>>>>>>>>>>>>>
55203>>>>>>>>>>>>>>>>>>>Use File_Dlg   // DAC package
55203>>>>>>>>>>>>>>>>>>>integer oSEQ_OpenFlDlg# oSEQ_SaveFlDlg#
55203>>>>>>>>>>>>>>>>>>>move 0 to oSEQ_OpenFlDlg#
55204>>>>>>>>>>>>>>>>>>>move 0 to oSEQ_SaveFlDlg#
55205>>>>>>>>>>>>>>>>>>>class cSEQ_OpenFlDlg is a OpenDialog
55206>>>>>>>>>>>>>>>>>>>  procedure construct_object
55208>>>>>>>>>>>>>>>>>>>    forward send construct_object
55210>>>>>>>>>>>>>>>>>>>    set NoChangeDir_State to true
55211>>>>>>>>>>>>>>>>>>>    set HideReadOnly_State To True
55212>>>>>>>>>>>>>>>>>>>    move self to oSEQ_OpenFlDlg#
55213>>>>>>>>>>>>>>>>>>>  end_procedure
55214>>>>>>>>>>>>>>>>>>>end_class
55215>>>>>>>>>>>>>>>>>>>class cSEQ_SaveFlDlg is a SaveAsDialog
55216>>>>>>>>>>>>>>>>>>>  procedure construct_object
55218>>>>>>>>>>>>>>>>>>>    forward send construct_object
55220>>>>>>>>>>>>>>>>>>>    set NoChangeDir_State to true
55221>>>>>>>>>>>>>>>>>>>    set HideReadOnly_State To True
55222>>>>>>>>>>>>>>>>>>>    move self to oSEQ_SaveFlDlg#
55223>>>>>>>>>>>>>>>>>>>  end_procedure
55224>>>>>>>>>>>>>>>>>>>  procedure set Dialog_Caption string lsCaption
55226>>>>>>>>>>>>>>>>>>>    forward set Dialog_Caption to lsCaption
55228>>>>>>>>>>>>>>>>>>>  end_procedure
55229>>>>>>>>>>>>>>>>>>>end_class
55230>>>>>>>>>>>>>>>>>>>
55230>>>>>>>>>>>>>>>>>>>procedure SEQ_Prepare_OpenDialog global
55232>>>>>>>>>>>>>>>>>>>  integer parent# self#
55232>>>>>>>>>>>>>>>>>>>  move (focus(desktop)) to parent#
55233>>>>>>>>>>>>>>>>>>>  ifnot parent# move desktop to parent#
55236>>>>>>>>>>>>>>>>>>>  if oSEQ_OpenFlDlg# send request_destroy_object to oSEQ_OpenFlDlg#
55239>>>>>>>>>>>>>>>>>>>  move self to self#
55240>>>>>>>>>>>>>>>>>>>  move parent# to self
55241>>>>>>>>>>>>>>>>>>>  object oSEQ_OpenFlDlg is a cSEQ_OpenFlDlg
55243>>>>>>>>>>>>>>>>>>>  end_object
55244>>>>>>>>>>>>>>>>>>>  move self# to self
55245>>>>>>>>>>>>>>>>>>>end_procedure
55246>>>>>>>>>>>>>>>>>>>
55246>>>>>>>>>>>>>>>>>>>procedure SEQ_Prepare_SaveDialog global
55248>>>>>>>>>>>>>>>>>>>  integer parent# self#
55248>>>>>>>>>>>>>>>>>>>  move (focus(desktop)) to parent#
55249>>>>>>>>>>>>>>>>>>>  ifnot parent# move desktop to parent#
55252>>>>>>>>>>>>>>>>>>>  if oSEQ_SaveFlDlg# send request_destroy_object to oSEQ_SaveFlDlg#
55255>>>>>>>>>>>>>>>>>>>  move self to self#
55256>>>>>>>>>>>>>>>>>>>  move parent# to self
55257>>>>>>>>>>>>>>>>>>>  object oSEQ_SaveFlDlg is a cSEQ_SaveFlDlg
55259>>>>>>>>>>>>>>>>>>>  end_object
55260>>>>>>>>>>>>>>>>>>>  move self# to self
55261>>>>>>>>>>>>>>>>>>>end_procedure
55262>>>>>>>>>>>>>>>>>>>
55262>>>>>>>>>>>>>>>>>>>//declare C structure struct_browseinfo
55262>>>>>>>>>>>>>>>>>>>//as documented in MSDN under Windows Shell API
55262>>>>>>>>>>>>>>>>>>>Type tFilesBrowseInfo
55262>>>>>>>>>>>>>>>>>>>  Field tFilesBrowseInfo.hWndOwner      as handle
55262>>>>>>>>>>>>>>>>>>>  Field tFilesBrowseInfo.pIDLRoot       as Pointer
55262>>>>>>>>>>>>>>>>>>>  Field tFilesBrowseInfo.pszDisplayName as Pointer
55262>>>>>>>>>>>>>>>>>>>  Field tFilesBrowseInfo.lpszTitle      as Pointer
55262>>>>>>>>>>>>>>>>>>>  Field tFilesBrowseInfo.ulFlags        as dWord
55262>>>>>>>>>>>>>>>>>>>  Field tFilesBrowseInfo.lpfnCallback   as Pointer
55262>>>>>>>>>>>>>>>>>>>  Field tFilesBrowseInfo.lParam         as dWord
55262>>>>>>>>>>>>>>>>>>>  Field tFilesBrowseInfo.iImage         as dWord
55262>>>>>>>>>>>>>>>>>>>End_Type  // tFilesBrowseInfo
55262>>>>>>>>>>>>>>>>>>>
55262>>>>>>>>>>>>>>>>>>>External_Function FilesSHBrowseForFolder   "SHBrowseForFolder"   shell32.dll pointer lpdWordx returns dWord
55263>>>>>>>>>>>>>>>>>>>External_Function FilesSHGetPathFromIDList "SHGetPathFromIDList" shell32.dll pointer pidList pointer lpBuffer returns dWord
55264>>>>>>>>>>>>>>>>>>>External_Function FilesCoTaskMemFree       "CoTaskMemFree"       ole32.dll   pointer pv returns Integer
55265>>>>>>>>>>>>>>>>>>>
55265>>>>>>>>>>>>>>>>>>>// If function ConvertChar is not already defined we define it here:
55265>>>>>>>>>>>>>>>>>>>
55265>>>>>>>>>>>>>>>>>>>// returns folder name if a folder was selected, otherwise returns ""
55265>>>>>>>>>>>>>>>>>>>function SEQ_SelectDirectory global string lsCaption returns string
55267>>>>>>>>>>>>>>>>>>>  string sFolder sBrowseInfo sTitle sRval
55267>>>>>>>>>>>>>>>>>>>  pointer lpItemIdList lpsFolder lpsBrowseInfo lpsTitle
55267>>>>>>>>>>>>>>>>>>>  integer iFolderSelected iObj iRetval
55267>>>>>>>>>>>>>>>>>>>
55267>>>>>>>>>>>>>>>>>>>  // fill string variable with null characters
55267>>>>>>>>>>>>>>>>>>>  ZeroType tFilesBrowseInfo to sBrowseInfo
55268>>>>>>>>>>>>>>>>>>>
55268>>>>>>>>>>>>>>>>>>>  if (lsCaption<>"") begin
55270>>>>>>>>>>>>>>>>>>>    move (ConvertChar(1,lsCaption)) to sTitle // toAnsi
55271>>>>>>>>>>>>>>>>>>>    GetAddress of sTitle to lpsTitle
55272>>>>>>>>>>>>>>>>>>>    put lpsTitle to sBrowseInfo at tFilesBrowseInfo.lpszTitle
55273>>>>>>>>>>>>>>>>>>>  end
55273>>>>>>>>>>>>>>>>>>>>
55273>>>>>>>>>>>>>>>>>>>
55273>>>>>>>>>>>>>>>>>>>  put (window_handle(focus(desktop))) to sBrowseInfo at tFilesBrowseInfo.hWndOwner
55274>>>>>>>>>>>>>>>>>>>
55274>>>>>>>>>>>>>>>>>>>  GetAddress of sBrowseInfo to lpsBrowseInfo
55275>>>>>>>>>>>>>>>>>>>
55275>>>>>>>>>>>>>>>>>>>  // null 128 chars into var (make space)
55275>>>>>>>>>>>>>>>>>>>  move (repeat(character(0), 128)) to sFolder
55276>>>>>>>>>>>>>>>>>>>  GetAddress of sFolder to lpsFolder
55277>>>>>>>>>>>>>>>>>>>
55277>>>>>>>>>>>>>>>>>>>  // select folder
55277>>>>>>>>>>>>>>>>>>>  move (FilesSHBrowseForFolder(lpsBrowseInfo)) to lpItemIdList
55278>>>>>>>>>>>>>>>>>>>  // get selected folder name
55278>>>>>>>>>>>>>>>>>>>  move (FilesSHGetPathFromIDList(lpItemIdList, lpsFolder)) to iFolderSelected
55279>>>>>>>>>>>>>>>>>>>
55279>>>>>>>>>>>>>>>>>>>  // free memory and IDL
55279>>>>>>>>>>>>>>>>>>>  Move (FilesCoTaskMemFree(lpItemIdList)) To iRetval
55280>>>>>>>>>>>>>>>>>>>
55280>>>>>>>>>>>>>>>>>>>  if (iFolderSelected<>0) move (CString(sFolder)) to sRval
55283>>>>>>>>>>>>>>>>>>>  else move "" to sRval
55285>>>>>>>>>>>>>>>>>>>  function_return (ConvertChar(0,sRval))
55286>>>>>>>>>>>>>>>>>>>End_Function  // GetSelectFolder
55287>>>>>>>>>>>>>>>>>>>
55287>>>>>>>>>>>>>>>>>>>class aps.SelectDirForm is a aps.Form
55288>>>>>>>>>>>>>>>>>>>  procedure construct_object
55290>>>>>>>>>>>>>>>>>>>    forward send construct_object
55292>>>>>>>>>>>>>>>>>>>    property string pSelectDialogCaption public t.files.SelectDir
55293>>>>>>>>>>>>>>>>>>>    set form_button item 0 to 1           // Manually add a prompt button
55294>>>>>>>>>>>>>>>>>>>    set form_button_value item 0 to "..." //              "
55295>>>>>>>>>>>>>>>>>>>    on_key kprompt send prompt
55296>>>>>>>>>>>>>>>>>>>  end_procedure
55297>>>>>>>>>>>>>>>>>>>  procedure OnDirectorySelected
55299>>>>>>>>>>>>>>>>>>>  end_procedure
55300>>>>>>>>>>>>>>>>>>>  Procedure Prompt
55302>>>>>>>>>>>>>>>>>>>    string sDir
55302>>>>>>>>>>>>>>>>>>>    move (SEQ_SelectDirectory(pSelectDialogCaption(self))) to sDir
55303>>>>>>>>>>>>>>>>>>>    if sDir ne "" begin
55305>>>>>>>>>>>>>>>>>>>      set Value item 0 to sDir
55306>>>>>>>>>>>>>>>>>>>      send OnDirectorySelected
55307>>>>>>>>>>>>>>>>>>>    end
55307>>>>>>>>>>>>>>>>>>>>
55307>>>>>>>>>>>>>>>>>>>  End_Procedure
55308>>>>>>>>>>>>>>>>>>>  procedure form_button_notification integer itm#
55310>>>>>>>>>>>>>>>>>>>    send prompt
55311>>>>>>>>>>>>>>>>>>>  end_procedure
55312>>>>>>>>>>>>>>>>>>>end_class
55313>>>>>>>>>>>>>>>>>>>class aps.dbSelectDirForm is a aps.dbForm
55314>>>>>>>>>>>>>>>>>>>  procedure construct_object
55316>>>>>>>>>>>>>>>>>>>    forward send construct_object
55318>>>>>>>>>>>>>>>>>>>    property string pSelectDialogCaption public t.files.SelectDir
55319>>>>>>>>>>>>>>>>>>>//   set form_button item 0 to 1           // Manually add a prompt button
55319>>>>>>>>>>>>>>>>>>>//   set form_button_value item 0 to "..." //              "
55319>>>>>>>>>>>>>>>>>>>    set prompt_button_mode to PB_PromptOn
55320>>>>>>>>>>>>>>>>>>>    on_key kprompt send prompt
55321>>>>>>>>>>>>>>>>>>>  end_procedure
55322>>>>>>>>>>>>>>>>>>>  procedure OnDirectorySelected
55324>>>>>>>>>>>>>>>>>>>  end_procedure
55325>>>>>>>>>>>>>>>>>>>  Procedure Prompt
55327>>>>>>>>>>>>>>>>>>>    string sDir
55327>>>>>>>>>>>>>>>>>>>    move (SEQ_SelectDirectory(pSelectDialogCaption(self))) to sDir
55328>>>>>>>>>>>>>>>>>>>    if sDir ne "" begin
55330>>>>>>>>>>>>>>>>>>>      set changed_value item 0 to sDir
55331>>>>>>>>>>>>>>>>>>>      send OnDirectorySelected
55332>>>>>>>>>>>>>>>>>>>    end
55332>>>>>>>>>>>>>>>>>>>>
55332>>>>>>>>>>>>>>>>>>>  End_Procedure
55333>>>>>>>>>>>>>>>>>>>  procedure form_button_notification integer itm#
55335>>>>>>>>>>>>>>>>>>>    send prompt
55336>>>>>>>>>>>>>>>>>>>  end_procedure
55337>>>>>>>>>>>>>>>>>>>end_class
55338>>>>>>>>>>>>>>>>>>>class aps.SelectFileForm is a aps.Form
55339>>>>>>>>>>>>>>>>>>>  procedure construct_object
55341>>>>>>>>>>>>>>>>>>>    forward send construct_object
55343>>>>>>>>>>>>>>>>>>>    property string psFileMask public ""
55344>>>>>>>>>>>>>>>>>>>    property string pSelectDialogCaption public t.files.SelectFile
55345>>>>>>>>>>>>>>>>>>>    set form_button item 0 to 1           // Manually add a prompt button
55346>>>>>>>>>>>>>>>>>>>    set form_button_value item 0 to "..." //              "
55347>>>>>>>>>>>>>>>>>>>    on_key kprompt send prompt
55348>>>>>>>>>>>>>>>>>>>  end_procedure
55349>>>>>>>>>>>>>>>>>>>  Procedure Prompt
55351>>>>>>>>>>>>>>>>>>>    string fn#
55351>>>>>>>>>>>>>>>>>>>    get SEQ_SelectInFile (pSelectDialogCaption(self)) (psFileMask(self)) to fn#
55352>>>>>>>>>>>>>>>>>>>    if fn# ne ""  set Value item 0 to fn#
55355>>>>>>>>>>>>>>>>>>>  End_Procedure
55356>>>>>>>>>>>>>>>>>>>  procedure form_button_notification integer itm#
55358>>>>>>>>>>>>>>>>>>>    send prompt
55359>>>>>>>>>>>>>>>>>>>  end_procedure
55360>>>>>>>>>>>>>>>>>>>end_class
55361>>>>>>>>>>>>>>>>>>>
55361>>>>>>>>>>>>>>>>>>>function SEQ_SelectOutFile global string lsCaption string filter# returns string
55363>>>>>>>>>>>>>>>>>>>  string fn#
55363>>>>>>>>>>>>>>>>>>>  send SEQ_Prepare_SaveDialog
55364>>>>>>>>>>>>>>>>>>>  set NoChangeDir_State of oSEQ_SaveFlDlg# to True
55365>>>>>>>>>>>>>>>>>>>  set Dialog_Caption of oSEQ_SaveFlDlg# to lsCaption
55366>>>>>>>>>>>>>>>>>>>  set Filter_String of oSEQ_SaveFlDlg# to filter#
55367>>>>>>>>>>>>>>>>>>>  if (Show_Dialog(oSEQ_SaveFlDlg#)) move (File_Name(oSEQ_SaveFlDlg#)) to fn#
55370>>>>>>>>>>>>>>>>>>>  else move "" to fn#
55372>>>>>>>>>>>>>>>>>>>  function_return fn#
55373>>>>>>>>>>>>>>>>>>>end_function
55374>>>>>>>>>>>>>>>>>>>
55374>>>>>>>>>>>>>>>>>>>// Example of filter# values for VDF program:   "Text files|*.txt|XML files|*.xml|All files|*.*"
55374>>>>>>>>>>>>>>>>>>>
55374>>>>>>>>>>>>>>>>>>>function SEQ_SelectOutFileStartDir global string lsCaption string filter# string lsStartDir returns string
55376>>>>>>>>>>>>>>>>>>>  string fn#
55376>>>>>>>>>>>>>>>>>>>  send SEQ_Prepare_SaveDialog
55377>>>>>>>>>>>>>>>>>>>  set Initial_Folder of oSEQ_SaveFlDlg# to lsStartDir
55378>>>>>>>>>>>>>>>>>>>  set NoChangeDir_State of oSEQ_SaveFlDlg# to True
55379>>>>>>>>>>>>>>>>>>>  set Dialog_Caption of oSEQ_SaveFlDlg# to lsCaption
55380>>>>>>>>>>>>>>>>>>>  set Filter_String of oSEQ_SaveFlDlg# to filter#
55381>>>>>>>>>>>>>>>>>>>  if (Show_Dialog(oSEQ_SaveFlDlg#)) move (File_Name(oSEQ_SaveFlDlg#)) to fn#
55384>>>>>>>>>>>>>>>>>>>  else move "" to fn#
55386>>>>>>>>>>>>>>>>>>>  function_return fn#
55387>>>>>>>>>>>>>>>>>>>end_function
55388>>>>>>>>>>>>>>>>>>>
55388>>>>>>>>>>>>>>>>>>>function SEQ_SelectInFile global string lsCaption string filter# returns string
55390>>>>>>>>>>>>>>>>>>>  string fn#
55390>>>>>>>>>>>>>>>>>>>  send SEQ_Prepare_OpenDialog
55391>>>>>>>>>>>>>>>>>>>  set NoChangeDir_State of oSEQ_OpenFlDlg# to True
55392>>>>>>>>>>>>>>>>>>>  set Dialog_Caption of oSEQ_OpenFlDlg# to lsCaption
55393>>>>>>>>>>>>>>>>>>>  set Filter_String of oSEQ_OpenFlDlg# to filter#
55394>>>>>>>>>>>>>>>>>>>  if (Show_Dialog(oSEQ_OpenFlDlg#)) move (File_Name(oSEQ_OpenFlDlg#)) to fn#
55397>>>>>>>>>>>>>>>>>>>  else move "" to fn#
55399>>>>>>>>>>>>>>>>>>>  function_return fn#
55400>>>>>>>>>>>>>>>>>>>end_function
55401>>>>>>>>>>>>>>>>>>>
55401>>>>>>>>>>>>>>>>>>>function SEQ_SelectFile global string lsCaption string filter# returns string
55403>>>>>>>>>>>>>>>>>>>  function_return (SEQ_SelectInFile(lsCaption,filter#))
55404>>>>>>>>>>>>>>>>>>>end_function
55405>>>>>>>>>>>>>>>>>>>
55405>>>>>>>>>>>>>>>>>>>function SEQ_SelectFileStartDir global string lsCaption string filter# string dir# returns string
55407>>>>>>>>>>>>>>>>>>>  string fn#
55407>>>>>>>>>>>>>>>>>>>  send SEQ_Prepare_OpenDialog
55408>>>>>>>>>>>>>>>>>>>  set Initial_Folder of oSEQ_OpenFlDlg# to dir#
55409>>>>>>>>>>>>>>>>>>>  set NoChangeDir_State of oSEQ_OpenFlDlg# to True //False
55410>>>>>>>>>>>>>>>>>>>  set Dialog_Caption of oSEQ_OpenFlDlg# to lsCaption
55411>>>>>>>>>>>>>>>>>>>  set Filter_String of oSEQ_OpenFlDlg# to filter#
55412>>>>>>>>>>>>>>>>>>>  if (Show_Dialog(oSEQ_OpenFlDlg#)) move (File_Name(oSEQ_OpenFlDlg#)) to fn#
55415>>>>>>>>>>>>>>>>>>>  else move "" to fn#
55417>>>>>>>>>>>>>>>>>>>  function_return fn#
55418>>>>>>>>>>>>>>>>>>>end_function
55419>>>>>>>>>>>>>>>>>>>
55419>>>>>>>>>>>>>>>>>>>//[found ~found] begin
55419>>>>>>>>>>>>>>>>>>>//  files$nothing: return
55419>>>>>>>>>>>>>>>>>>>//end
55419>>>>>>>>>>>>>>>>>>>
55419>>>>>>>>>>>>>>>>>>>use APS
55419>>>>>>>>>>>>>>>>>>>use Wait.utl
55419>>>>>>>>>>>>>>>>>>>object oFn_Exists is a aps.ModalPanel label t.files.Warning
55422>>>>>>>>>>>>>>>>>>>  on_key kCancel send fn_cancel
55423>>>>>>>>>>>>>>>>>>>  property integer pResult public 0
55425>>>>>>>>>>>>>>>>>>>  object oMsg is a aps.TextBox
55427>>>>>>>>>>>>>>>>>>>    set p_fixed_width to 240
55428>>>>>>>>>>>>>>>>>>>    set justification_mode to (JMODE_CENTER+JMODE_WRAP+JMODE_VCENTER)
55429>>>>>>>>>>>>>>>>>>>  end_object
55430>>>>>>>>>>>>>>>>>>>  procedure fn_Append
55433>>>>>>>>>>>>>>>>>>>    set pResult to 1
55434>>>>>>>>>>>>>>>>>>>    send close_panel
55435>>>>>>>>>>>>>>>>>>>  end_procedure
55436>>>>>>>>>>>>>>>>>>>  procedure fn_OverWr
55439>>>>>>>>>>>>>>>>>>>    set pResult to 2
55440>>>>>>>>>>>>>>>>>>>    send close_panel
55441>>>>>>>>>>>>>>>>>>>  end_procedure
55442>>>>>>>>>>>>>>>>>>>  procedure fn_Cancel
55445>>>>>>>>>>>>>>>>>>>    set pResult to 3
55446>>>>>>>>>>>>>>>>>>>    send close_panel
55447>>>>>>>>>>>>>>>>>>>  end_procedure
55448>>>>>>>>>>>>>>>>>>>  object oBtn_Over is a aps.Multi_Button
55450>>>>>>>>>>>>>>>>>>>    on_item t.files.Overwrite send fn_overwr
55451>>>>>>>>>>>>>>>>>>>  end_object
55452>>>>>>>>>>>>>>>>>>>  object oBtn_Append is a aps.Multi_Button
55454>>>>>>>>>>>>>>>>>>>    on_item t.files.Append send fn_append
55455>>>>>>>>>>>>>>>>>>>  end_object
55456>>>>>>>>>>>>>>>>>>>  object oBtn_Cancel is a aps.Multi_Button
55458>>>>>>>>>>>>>>>>>>>    on_item t.btn.cancel send fn_cancel
55459>>>>>>>>>>>>>>>>>>>  end_object
55460>>>>>>>>>>>>>>>>>>>  send aps_locate_multi_buttons
55461>>>>>>>>>>>>>>>>>>>  function iRun.si string file_name# integer allow_append# returns integer
55464>>>>>>>>>>>>>>>>>>>    integer rval#
55464>>>>>>>>>>>>>>>>>>>    //set shadow_state of (Btn(self)) item 1 to (not(allow_append#))
55464>>>>>>>>>>>>>>>>>>>    set value of (oMsg(self)) to (replace("#",t.files.FileExists,file_name#))
55465>>>>>>>>>>>>>>>>>>>    send popup
55466>>>>>>>>>>>>>>>>>>>    get pResult to rval#
55467>>>>>>>>>>>>>>>>>>>    if rval# eq 3 move 0 to rval#
55470>>>>>>>>>>>>>>>>>>>    function_return rval#
55471>>>>>>>>>>>>>>>>>>>  end_function
55472>>>>>>>>>>>>>>>>>>>end_object
55473>>>>>>>>>>>>>>>>>>>
55473>>>>>>>>>>>>>>>>>>>//         Return value: 0=cancel, 1=append, 2=overwrite
55473>>>>>>>>>>>>>>>>>>>function SEQ_Filename_Exists_Action global string file_name# integer allow_append# returns integer
55475>>>>>>>>>>>>>>>>>>>  function_return (iRun.si(oFn_Exists(self),file_name#,allow_append#))
55476>>>>>>>>>>>>>>>>>>>end_function
55477>>>>>>>>>>>>>>>>>>>
55477>>>>>>>>>>>>>>>>>>>procedure SEQ_WriteGridItems global integer ch# integer obj#
55479>>>>>>>>>>>>>>>>>>>  integer itm# max# shadow# checkbox# select# aux# msg#
55479>>>>>>>>>>>>>>>>>>>  get item_count of obj# to max#
55480>>>>>>>>>>>>>>>>>>>  writeln channel ch# max#
55483>>>>>>>>>>>>>>>>>>>  for itm# from 0 to (max#-1)
55489>>>>>>>>>>>>>>>>>>>>
55489>>>>>>>>>>>>>>>>>>>    writeln (value(obj#,itm#))
55491>>>>>>>>>>>>>>>>>>>    get checkbox_item_state of obj# item itm# to checkbox#
55492>>>>>>>>>>>>>>>>>>>    get select_state        of obj# item itm# to select#
55493>>>>>>>>>>>>>>>>>>>    get item_shadow_state  of obj# item itm# to shadow#
55494>>>>>>>>>>>>>>>>>>>    get aux_value of obj# item itm# to aux#
55495>>>>>>>>>>>>>>>>>>>    get message of obj# item itm# to msg#
55496>>>>>>>>>>>>>>>>>>>    writeln checkbox#
55498>>>>>>>>>>>>>>>>>>>    writeln select#
55500>>>>>>>>>>>>>>>>>>>    writeln shadow#
55502>>>>>>>>>>>>>>>>>>>    writeln aux#
55504>>>>>>>>>>>>>>>>>>>    writeln msg#
55506>>>>>>>>>>>>>>>>>>>  loop
55507>>>>>>>>>>>>>>>>>>>>
55507>>>>>>>>>>>>>>>>>>>end_procedure
55508>>>>>>>>>>>>>>>>>>>
55508>>>>>>>>>>>>>>>>>>>procedure SEQ_ReadGridItems global integer ch# integer obj#
55510>>>>>>>>>>>>>>>>>>>  integer itm# max# shadow# checkbox# select# aux# msg#
55510>>>>>>>>>>>>>>>>>>>  string value#
55510>>>>>>>>>>>>>>>>>>>  send delete_data to obj#
55511>>>>>>>>>>>>>>>>>>>  readln channel ch# max#
55513>>>>>>>>>>>>>>>>>>>  for itm# from 0 to (max#-1)
55519>>>>>>>>>>>>>>>>>>>>
55519>>>>>>>>>>>>>>>>>>>    readln value#
55520>>>>>>>>>>>>>>>>>>>    readln checkbox#
55521>>>>>>>>>>>>>>>>>>>    readln select#
55522>>>>>>>>>>>>>>>>>>>    readln shadow#
55523>>>>>>>>>>>>>>>>>>>    readln aux#
55524>>>>>>>>>>>>>>>>>>>    readln msg#
55525>>>>>>>>>>>>>>>>>>>    send add_item to obj# msg# value#
55526>>>>>>>>>>>>>>>>>>>    set checkbox_item_state of obj# item itm# to checkbox#
55527>>>>>>>>>>>>>>>>>>>    set select_state        of obj# item itm# to select#
55528>>>>>>>>>>>>>>>>>>>    set item_shadow_state of obj# item itm# to shadow#
55529>>>>>>>>>>>>>>>>>>>    set aux_value of obj# item itm# to aux#
55530>>>>>>>>>>>>>>>>>>>  loop
55531>>>>>>>>>>>>>>>>>>>>
55531>>>>>>>>>>>>>>>>>>>  set dynamic_update_state of obj# to true
55532>>>>>>>>>>>>>>>>>>>end_procedure
55533>>>>>>>>>>>>>>>>>>>
55533>>>>>>>>>>>>>>>>>>>define xFO_MOVE               for |CI$0001
55533>>>>>>>>>>>>>>>>>>>define xFO_COPY               for |CI$0002
55533>>>>>>>>>>>>>>>>>>>define xFO_DELETE             for |CI$0003
55533>>>>>>>>>>>>>>>>>>>define xFO_RENAME             for |CI$0004
55533>>>>>>>>>>>>>>>>>>>
55533>>>>>>>>>>>>>>>>>>>define xFOF_MULTIDESTFILES    for |CI$0001
55533>>>>>>>>>>>>>>>>>>>define xFOF_CONFIRMMOUSE      for |CI$0002
55533>>>>>>>>>>>>>>>>>>>define xFOF_SILENT            for |CI$0004  // don't create progress/report
55533>>>>>>>>>>>>>>>>>>>define xFOF_RENAMEONCOLLISION for |CI$0008
55533>>>>>>>>>>>>>>>>>>>define xFOF_NOCONFIRMATION    for |CI$0010  // Don't prompt the user.
55533>>>>>>>>>>>>>>>>>>>define xFOF_WANTMAPPINGHANDLE for |CI$0020  // Fill in SHFILEOPSTRUCT.hNameMappings
55533>>>>>>>>>>>>>>>>>>>                                           // Must be freed using SHFreeNameMappings
55533>>>>>>>>>>>>>>>>>>>define xFOF_ALLOWUNDO         for |CI$0040
55533>>>>>>>>>>>>>>>>>>>define xFOF_FILESONLY         for |CI$0080  // on *.*, do only files
55533>>>>>>>>>>>>>>>>>>>define xFOF_SIMPLEPROGRESS    for |CI$0100  // means don't show names of files
55533>>>>>>>>>>>>>>>>>>>define xFOF_NOCONFIRMMKDIR    for |CI$0200  // don't confirm making any needed dirs
55533>>>>>>>>>>>>>>>>>>>
55533>>>>>>>>>>>>>>>>>>>Type tFILES_SHFILEOPSTRUCT
55533>>>>>>>>>>>>>>>>>>>  Field files_hWnd                   as Handle
55533>>>>>>>>>>>>>>>>>>>  Field files_wFunc                  as Integer
55533>>>>>>>>>>>>>>>>>>>  Field files_pFrom                  as Pointer
55533>>>>>>>>>>>>>>>>>>>  Field files_pTo                    as Pointer
55533>>>>>>>>>>>>>>>>>>>  Field files_fFlags                 as Short
55533>>>>>>>>>>>>>>>>>>>  Field files_fAnyOperationsAborted  as Short
55533>>>>>>>>>>>>>>>>>>>  Field files_hNameMappings          as Pointer
55533>>>>>>>>>>>>>>>>>>>  Field files_lpszProgressTitle      as Pointer // only used if xFOF_SIMPLEPROGRESS
55533>>>>>>>>>>>>>>>>>>>End_Type
55533>>>>>>>>>>>>>>>>>>>
55533>>>>>>>>>>>>>>>>>>>External_Function FILES_SHFileOperation "SHFileOperationA" Shell32.dll ;        pointer lpFileOp returns integer
55534>>>>>>>>>>>>>>>>>>>
55534>>>>>>>>>>>>>>>>>>>procedure SEQ_DeleteFileToBin global string fn#
55536>>>>>>>>>>>>>>>>>>>  string  strFileOpt
55536>>>>>>>>>>>>>>>>>>>  Pointer lpFileOpt lpFileName
55536>>>>>>>>>>>>>>>>>>>  ZeroType tFILES_SHFILEOPSTRUCT to strFileOpt
55537>>>>>>>>>>>>>>>>>>>  Put xFO_DELETE to strFileOpt at files_wFunc
55538>>>>>>>>>>>>>>>>>>>  GetAddress of fn# to lpFileName
55539>>>>>>>>>>>>>>>>>>>  Put lpFileName to strFileOpt at files_pFrom
55540>>>>>>>>>>>>>>>>>>>  Put (xFOF_SILENT ior xFOF_NOCONFIRMATION ior xFOF_ALLOWUNDO) to strFileOpt at files_fFlags
55541>>>>>>>>>>>>>>>>>>>  GetAddress of strFileOpt to lpFileOpt
55542>>>>>>>>>>>>>>>>>>>  Move (FILES_SHFileOperation(lpFileOpt)) to strmark
55543>>>>>>>>>>>>>>>>>>>end_procedure
55544>>>>>>>>>>>>>>>>>>>
55544>>>>>>>>>>>>>>>>>>>class cSEQ_FileReader is a TS_TimeEstimator
55545>>>>>>>>>>>>>>>>>>>  procedure construct_object integer img#
55547>>>>>>>>>>>>>>>>>>>    forward send construct_object img#
55549>>>>>>>>>>>>>>>>>>>
55549>>>>>>>>>>>>>>>>>>>    property integer pReadCount      public 0  // record counter (lines or records)
55550>>>>>>>>>>>>>>>>>>>    property string  pFileName       public "" // name of input file
55551>>>>>>>>>>>>>>>>>>>    property integer pChannel        public 0  // input channel
55552>>>>>>>>>>>>>>>>>>>    property integer pPrevPos        public 0  // last record was read starting
55553>>>>>>>>>>>>>>>>>>>                                               // in this channel position
55553>>>>>>>>>>>>>>>>>>>    property integer pRejectRecord   public 0  //
55554>>>>>>>>>>>>>>>>>>>
55554>>>>>>>>>>>>>>>>>>>    property date    pReadDate       public 0  // Date and time of read
55555>>>>>>>>>>>>>>>>>>>    property string  pReadTime       public "" // initialization
55556>>>>>>>>>>>>>>>>>>>
55556>>>>>>>>>>>>>>>>>>>    property integer pOkToCancel     public 1  // Ok to interrupt?
55557>>>>>>>>>>>>>>>>>>>    property string  pCancelQuestion public t.files.StopRead
55558>>>>>>>>>>>>>>>>>>>
55558>>>>>>>>>>>>>>>>>>>    property integer piInterrupted   public 0
55559>>>>>>>>>>>>>>>>>>>  end_procedure
55560>>>>>>>>>>>>>>>>>>>
55560>>>>>>>>>>>>>>>>>>>  procedure display_init
55562>>>>>>>>>>>>>>>>>>>  end_procedure
55563>>>>>>>>>>>>>>>>>>>  procedure display_update
55565>>>>>>>>>>>>>>>>>>>  end_procedure
55566>>>>>>>>>>>>>>>>>>>
55566>>>>>>>>>>>>>>>>>>>  function iPreconditions_Direct_Input returns integer
55568>>>>>>>>>>>>>>>>>>>    integer fn_ok# file_size# ch# itm#
55568>>>>>>>>>>>>>>>>>>>    string fn#
55568>>>>>>>>>>>>>>>>>>>
55568>>>>>>>>>>>>>>>>>>>    get pChannel to ch#
55569>>>>>>>>>>>>>>>>>>>    get pFileName to fn#
55570>>>>>>>>>>>>>>>>>>>    trim fn# to fn#
55571>>>>>>>>>>>>>>>>>>>>
55571>>>>>>>>>>>>>>>>>>>    if fn# eq "" send obs t.files.FileNotSpec
55574>>>>>>>>>>>>>>>>>>>    direct_input channel ch# fn#
55576>>>>>>>>>>>>>>>>>>>    [ SeqEof] move 0 to fn_ok#
55577>>>>>>>>>>>>>>>>>>>    [~SeqEof] move 1 to fn_ok#
55578>>>>>>>>>>>>>>>>>>>    close_input
55579>>>>>>>>>>>>>>>>>>>    ifnot fn_ok# begin
55581>>>>>>>>>>>>>>>>>>>      send obs (replace("#",t.files.FileNotFound,fn#))
55582>>>>>>>>>>>>>>>>>>>      function_return 0
55583>>>>>>>>>>>>>>>>>>>    end
55583>>>>>>>>>>>>>>>>>>>>
55583>>>>>>>>>>>>>>>>>>>    else begin
55584>>>>>>>>>>>>>>>>>>>      append_output channel ch# fn#
55586>>>>>>>>>>>>>>>>>>>      get_channel_position ch# to file_size#
55587>>>>>>>>>>>>>>>>>>>>
55587>>>>>>>>>>>>>>>>>>>      set piMin to 0
55588>>>>>>>>>>>>>>>>>>>      set piMax to file_size#
55589>>>>>>>>>>>>>>>>>>>      close_output channel ch#
55591>>>>>>>>>>>>>>>>>>>    end
55591>>>>>>>>>>>>>>>>>>>>
55591>>>>>>>>>>>>>>>>>>>
55591>>>>>>>>>>>>>>>>>>>    set piInterrupted to 0
55592>>>>>>>>>>>>>>>>>>>    function_return 1
55593>>>>>>>>>>>>>>>>>>>  end_function
55594>>>>>>>>>>>>>>>>>>>
55594>>>>>>>>>>>>>>>>>>>  function iDirect_Input returns integer
55596>>>>>>>>>>>>>>>>>>>    integer ch#
55596>>>>>>>>>>>>>>>>>>>    string fn#
55596>>>>>>>>>>>>>>>>>>>    if (iPreconditions_Direct_Input(self)) begin
55598>>>>>>>>>>>>>>>>>>>      send display_init
55599>>>>>>>>>>>>>>>>>>>      get pChannel to ch#
55600>>>>>>>>>>>>>>>>>>>      get pFileName to fn#
55601>>>>>>>>>>>>>>>>>>>      direct_input channel ch# fn#
55603>>>>>>>>>>>>>>>>>>>      set pReadCount to 0 // initialize counter
55604>>>>>>>>>>>>>>>>>>>      set pReadDate to (dSysDate())
55605>>>>>>>>>>>>>>>>>>>      set pReadTime to (sSysTime())
55606>>>>>>>>>>>>>>>>>>>      set pPrevPos to 0
55607>>>>>>>>>>>>>>>>>>>      function_return 1
55608>>>>>>>>>>>>>>>>>>>    end
55608>>>>>>>>>>>>>>>>>>>>
55608>>>>>>>>>>>>>>>>>>>    function_return 0
55609>>>>>>>>>>>>>>>>>>>  end_function
55610>>>>>>>>>>>>>>>>>>>
55610>>>>>>>>>>>>>>>>>>>  procedure read_reset
55612>>>>>>>>>>>>>>>>>>>    set_channel_position (pChannel(self)) to (pPrevPos(self))
55613>>>>>>>>>>>>>>>>>>>>
55613>>>>>>>>>>>>>>>>>>>  end_procedure
55614>>>>>>>>>>>>>>>>>>>
55614>>>>>>>>>>>>>>>>>>>  procedure read_header returns integer // augment this
55616>>>>>>>>>>>>>>>>>>>    procedure_return 0
55617>>>>>>>>>>>>>>>>>>>  end_procedure
55618>>>>>>>>>>>>>>>>>>>
55618>>>>>>>>>>>>>>>>>>>  procedure read_one returns integer // augment this
55620>>>>>>>>>>>>>>>>>>>    procedure_return 1
55621>>>>>>>>>>>>>>>>>>>  end_procedure
55622>>>>>>>>>>>>>>>>>>>
55622>>>>>>>>>>>>>>>>>>>  function iUserInterrupt returns integer
55624>>>>>>>>>>>>>>>>>>>  end_function
55625>>>>>>>>>>>>>>>>>>>
55625>>>>>>>>>>>>>>>>>>>  procedure roll_back // augment this to undo the effect
55627>>>>>>>>>>>>>>>>>>>  end_procedure       // of a interrupted read
55628>>>>>>>>>>>>>>>>>>>
55628>>>>>>>>>>>>>>>>>>>  procedure read_begin
55630>>>>>>>>>>>>>>>>>>>  end_procedure
55631>>>>>>>>>>>>>>>>>>>  procedure read_end
55633>>>>>>>>>>>>>>>>>>>  end_procedure
55634>>>>>>>>>>>>>>>>>>>
55634>>>>>>>>>>>>>>>>>>>  procedure run string fn#
55636>>>>>>>>>>>>>>>>>>>    integer finish# ch# PrevPos#
55636>>>>>>>>>>>>>>>>>>>    if Num_Arguments gt 0 set pFileName to fn#
55639>>>>>>>>>>>>>>>>>>>    if (iDirect_Input(self)) begin
55641>>>>>>>>>>>>>>>>>>>      get pChannel to ch#
55642>>>>>>>>>>>>>>>>>>>      send read_begin
55643>>>>>>>>>>>>>>>>>>>      get msg_read_header to finish#
55644>>>>>>>>>>>>>>>>>>>      ifnot finish# begin
55646>>>>>>>>>>>>>>>>>>>        repeat
55646>>>>>>>>>>>>>>>>>>>>
55646>>>>>>>>>>>>>>>>>>>          set pRejectRecord to false
55647>>>>>>>>>>>>>>>>>>>          get msg_read_one to finish#
55648>>>>>>>>>>>>>>>>>>>          ifnot finish# begin
55650>>>>>>>>>>>>>>>>>>>            get_channel_position ch# to PrevPos#
55651>>>>>>>>>>>>>>>>>>>>
55651>>>>>>>>>>>>>>>>>>>            set pPrevPos to PrevPos#
55652>>>>>>>>>>>>>>>>>>>            set pReadCount to (pReadCount(self)+1)
55653>>>>>>>>>>>>>>>>>>>            send display_update
55654>>>>>>>>>>>>>>>>>>>          end
55654>>>>>>>>>>>>>>>>>>>>
55654>>>>>>>>>>>>>>>>>>>          if (iUserInterrupt(self)) move 1 to finish# // keypress
55657>>>>>>>>>>>>>>>>>>>          if (piInterrupted(self))  move 1 to finish# // program interrupt
55660>>>>>>>>>>>>>>>>>>>        until finish#
55662>>>>>>>>>>>>>>>>>>>      end
55662>>>>>>>>>>>>>>>>>>>>
55662>>>>>>>>>>>>>>>>>>>      close_input channel ch#
55664>>>>>>>>>>>>>>>>>>>      send read_end
55665>>>>>>>>>>>>>>>>>>>      if (piInterrupted(self)) send roll_back
55668>>>>>>>>>>>>>>>>>>>    end
55668>>>>>>>>>>>>>>>>>>>>
55668>>>>>>>>>>>>>>>>>>>  end_procedure
55669>>>>>>>>>>>>>>>>>>>end_class // cSEQ_FileReader
55670>>>>>>>>>>>>>>>>>>>
55670>>>>>>>>>>>>>>>>>>>define xMAX_PATH for 200
55670>>>>>>>>>>>>>>>>>>>External_function Files_GetWindowsDirectory "GetWindowsDirectoryA" kernel32.dll Pointer lpBuffer Integer nSize returns integer
55671>>>>>>>>>>>>>>>>>>>function SEQ_WindowsDirectory global returns string
55673>>>>>>>>>>>>>>>>>>>  string sVal
55673>>>>>>>>>>>>>>>>>>>  integer iGrb
55673>>>>>>>>>>>>>>>>>>>  pointer pVal
55673>>>>>>>>>>>>>>>>>>>  ZeroString xMAX_PATH to sVal
55674>>>>>>>>>>>>>>>>>>>  GetAddress of sVal to pVal
55675>>>>>>>>>>>>>>>>>>>  move (Files_GetWindowsDirectory(pVal, xMAX_PATH)) to iGrb
55676>>>>>>>>>>>>>>>>>>> function_return sVal
55677>>>>>>>>>>>>>>>>>>>end_function
55678>>>>>>>>>>>>>>>>>>>
55678>>>>>>>>>>>>>>>>>>>enumeration_list
55678>>>>>>>>>>>>>>>>>>>  define VALIDFOLDER_CREATE_FALSE
55678>>>>>>>>>>>>>>>>>>>  define VALIDFOLDER_CREATE_PROMPT
55678>>>>>>>>>>>>>>>>>>>  define VALIDFOLDER_CREATE_QUIET
55678>>>>>>>>>>>>>>>>>>>end_enumeration_list
55678>>>>>>>>>>>>>>>>>>>enumeration_list
55678>>>>>>>>>>>>>>>>>>>  define VALIDFOLDER_EXISTS                // The folder exists
55678>>>>>>>>>>>>>>>>>>>  define VALIDFOLDER_NAME_IS_FILE          // The specified name points to a file
55678>>>>>>>>>>>>>>>>>>>  define VALIDFOLDER_CREATION_FAILED       // Folder could not be created
55678>>>>>>>>>>>>>>>>>>>  define VALIDFOLDER_NO_FOLDER_SPECIFIED   // Folder not specified
55678>>>>>>>>>>>>>>>>>>>  define VALIDFOLDER_USER_CANCEL           // User cancelled directory create
55678>>>>>>>>>>>>>>>>>>>  define VALIDFOLDER_PARENT_PATH_NOT_FOUND // Path to parent folder not found
55678>>>>>>>>>>>>>>>>>>>  define VALIDFOLDER_PATH_NOT_FOUND        // Path to parent folder not found
55678>>>>>>>>>>>>>>>>>>>end_enumeration_list
55678>>>>>>>>>>>>>>>>>>>
55678>>>>>>>>>>>>>>>>>>>function SEQ_ValidateFolder_ErrorText global integer liError returns string
55680>>>>>>>>>>>>>>>>>>>  if (liError=VALIDFOLDER_EXISTS)                function_return ""
55683>>>>>>>>>>>>>>>>>>>  if (liError=VALIDFOLDER_NAME_IS_FILE)          function_return t.files.Error1
55686>>>>>>>>>>>>>>>>>>>  if (liError=VALIDFOLDER_CREATION_FAILED)       function_return t.files.Error2
55689>>>>>>>>>>>>>>>>>>>  if (liError=VALIDFOLDER_NO_FOLDER_SPECIFIED)   function_return t.files.Error3
55692>>>>>>>>>>>>>>>>>>>  if (liError=VALIDFOLDER_PATH_NOT_FOUND)        function_return t.files.Error5
55695>>>>>>>>>>>>>>>>>>>  if (liError=VALIDFOLDER_PARENT_PATH_NOT_FOUND) function_return t.files.Error5
55698>>>>>>>>>>>>>>>>>>>end_function
55699>>>>>>>>>>>>>>>>>>>
55699>>>>>>>>>>>>>>>>>>>function SEQ_ValidateFolder global string lsFolder integer liAllowCreate integer lbNoErrorMsg returns integer
55701>>>>>>>>>>>>>>>>>>>  integer liError liExists lbCreate liGarbage
55701>>>>>>>>>>>>>>>>>>>  string lsParentFolder lsError
55701>>>>>>>>>>>>>>>>>>>  move (trim(lsFolder)) to lsFolder
55702>>>>>>>>>>>>>>>>>>>  if (lsFolder="") move VALIDFOLDER_NO_FOLDER_SPECIFIED to liError // Error: No folder specified
55705>>>>>>>>>>>>>>>>>>>  else begin
55706>>>>>>>>>>>>>>>>>>>    if (length(lsFolder)>1 and right(lsFolder,2)=(":"+sysconf(SYSCONF_DIR_SEPARATOR))) ;                                               move (StringLeftBut(lsFolder,1)) to lsFolder
55709>>>>>>>>>>>>>>>>>>>    get SEQ_FileExists lsFolder to liExists
55710>>>>>>>>>>>>>>>>>>>    if (liExists=SEQIT_FILE) move VALIDFOLDER_NAME_IS_FILE to liError // Error: it's a file
55713>>>>>>>>>>>>>>>>>>>    else begin
55714>>>>>>>>>>>>>>>>>>>      if (liExists=SEQIT_DIRECTORY) move VALIDFOLDER_EXISTS to liError // All is well!
55717>>>>>>>>>>>>>>>>>>>      else begin
55718>>>>>>>>>>>>>>>>>>>        if (liAllowCreate<>VALIDFOLDER_CREATE_FALSE) begin
55720>>>>>>>>>>>>>>>>>>>          get SEQ_ExtractPathFromFileName lsFolder to lsParentFolder
55721>>>>>>>>>>>>>>>>>>>          get SEQ_FileExists lsParentFolder to liExists // Does parent folder exist?
55722>>>>>>>>>>>>>>>>>>>          if (liExists=SEQIT_DIRECTORY) begin
55724>>>>>>>>>>>>>>>>>>>            if (liAllowCreate=VALIDFOLDER_CREATE_PROMPT) get MB_Verify4 t.files.PromptDirCreate1 ("("+lsFolder+")") t.files.PromptDirCreate2 "" 1 to lbCreate
55727>>>>>>>>>>>>>>>>>>>            else move 1 to lbCreate
55729>>>>>>>>>>>>>>>>>>>            if lbCreate begin
55731>>>>>>>>>>>>>>>>>>>              get wvaWin32_CreateDirectory (ToAnsi(lsFolder)) to liGarbage
55732>>>>>>>>>>>>>>>>>>>              get SEQ_FileExists lsFolder to liExists // Does the folder exist now?
55733>>>>>>>>>>>>>>>>>>>              if (liExists=SEQIT_DIRECTORY) move VALIDFOLDER_EXISTS to liError
55736>>>>>>>>>>>>>>>>>>>              else move VALIDFOLDER_CREATION_FAILED to liError
55738>>>>>>>>>>>>>>>>>>>            end
55738>>>>>>>>>>>>>>>>>>>>
55738>>>>>>>>>>>>>>>>>>>            else move VALIDFOLDER_USER_CANCEL to liError
55740>>>>>>>>>>>>>>>>>>>          end
55740>>>>>>>>>>>>>>>>>>>>
55740>>>>>>>>>>>>>>>>>>>          else move VALIDFOLDER_PARENT_PATH_NOT_FOUND to liError
55742>>>>>>>>>>>>>>>>>>>        end
55742>>>>>>>>>>>>>>>>>>>>
55742>>>>>>>>>>>>>>>>>>>        else move VALIDFOLDER_PATH_NOT_FOUND to liError
55744>>>>>>>>>>>>>>>>>>>      end
55744>>>>>>>>>>>>>>>>>>>>
55744>>>>>>>>>>>>>>>>>>>    end
55744>>>>>>>>>>>>>>>>>>>>
55744>>>>>>>>>>>>>>>>>>>  end
55744>>>>>>>>>>>>>>>>>>>>
55744>>>>>>>>>>>>>>>>>>>  ifnot lbNoErrorMsg begin
55746>>>>>>>>>>>>>>>>>>>    get SEQ_ValidateFolder_ErrorText liError to lsError
55747>>>>>>>>>>>>>>>>>>>    if (liError=VALIDFOLDER_NAME_IS_FILE)          send obs lsError lsFolder
55750>>>>>>>>>>>>>>>>>>>    if (liError=VALIDFOLDER_CREATION_FAILED)       send obs lsError lsFolder
55753>>>>>>>>>>>>>>>>>>>    if (liError=VALIDFOLDER_NO_FOLDER_SPECIFIED)   send obs lsError
55756>>>>>>>>>>>>>>>>>>>    if (liError=VALIDFOLDER_PARENT_PATH_NOT_FOUND) send obs lsError lsParentFolder
55759>>>>>>>>>>>>>>>>>>>    if (liError=VALIDFOLDER_PATH_NOT_FOUND)        send obs lsError lsFolder
55762>>>>>>>>>>>>>>>>>>>  end
55762>>>>>>>>>>>>>>>>>>>>
55762>>>>>>>>>>>>>>>>>>>  function_return liError
55763>>>>>>>>>>>>>>>>>>>end_function // SEQ_ValidateFolder
55764>>>>>>>>>>>>>>>>>>>
55764>>>>>>>>>>>>>>>>>>>
55764>>>>>>>>>>>>>>>>>Use WinUser.nui  // User_Windows_User_Name function
Including file: winuser.nui    (C:\projects\BRS\VDFQuery\AppSrc\winuser.nui)
55764>>>>>>>>>>>>>>>>>>>// Use WinUser.nui  // User_Windows_User_Name function
55764>>>>>>>>>>>>>>>>>>>Use Windows
55764>>>>>>>>>>>>>>>>>>>Use DLL
55764>>>>>>>>>>>>>>>>>>>// External_Function User_WNetGetUser "WNetGetUserA" mpr.dll pointer lpName pointer lpUserName string lpnLength returns DWord
55764>>>>>>>>>>>>>>>>>>>External_Function User_WNetGetUser "WNetGetUserA" mpr.dll pointer lpName pointer lpUserName pointer lpLength returns DWord
55765>>>>>>>>>>>>>>>>>>>
55765>>>>>>>>>>>>>>>>>>>Function User_Windows_User_Name global Returns String
55767>>>>>>>>>>>>>>>>>>>    String sName sLength
55767>>>>>>>>>>>>>>>>>>>    Pointer lpName_Addr lpLength_Addr
55767>>>>>>>>>>>>>>>>>>>    Integer iRetval
55767>>>>>>>>>>>>>>>>>>>
55767>>>>>>>>>>>>>>>>>>>    Movestr (Repeat (Character (0), 255)) To sName
55768>>>>>>>>>>>>>>>>>>>>
55768>>>>>>>>>>>>>>>>>>>    GetAddress Of sName To lpName_Addr
55769>>>>>>>>>>>>>>>>>>>    Movestr (DwordToBytes (255)) To sLength
55770>>>>>>>>>>>>>>>>>>>>
55770>>>>>>>>>>>>>>>>>>>    GetAddress Of sLength To lpLength_Addr
55771>>>>>>>>>>>>>>>>>>>
55771>>>>>>>>>>>>>>>>>>>    Moveint (User_WNetGetUser (0, lpName_Addr, lpLength_Addr)) To iRetval
55772>>>>>>>>>>>>>>>>>>>>
55772>>>>>>>>>>>>>>>>>>>
55772>>>>>>>>>>>>>>>>>>>    If iRetval Eq 0 Function_Return (CString (sName))
55775>>>>>>>>>>>>>>>>>>>    Else Function_Return "User Unknown"
55777>>>>>>>>>>>>>>>>>>>End_Function // Network_User_Name
55778>>>>>>>>>>>>>>>>>Use FList.nui    // A lot of FLIST- procedures and functions
Including file: flist.nui    (C:\projects\BRS\VDFQuery\AppSrc\flist.nui)
55778>>>>>>>>>>>>>>>>>>>// Use FList.nui    // A lot of FLIST- procedures and functions
55778>>>>>>>>>>>>>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
55778>>>>>>>>>>>>>>>>>>>Use Files.nui    // Utilities for handling file related stuff
55778>>>>>>>>>>>>>>>>>>>
55778>>>>>>>>>>>>>>>>>>>desktop_section
55783>>>>>>>>>>>>>>>>>>>  object oFileListStack is a cStack no_image
55785>>>>>>>>>>>>>>>>>>>  end_object
55786>>>>>>>>>>>>>>>>>>>end_desktop_section
55791>>>>>>>>>>>>>>>>>>>
55791>>>>>>>>>>>>>>>>>>>procedure FLIST_CloseAllFiles global
55793>>>>>>>>>>>>>>>>>>>  close DF_ALL
55794>>>>>>>>>>>>>>>>>>>end_procedure
55795>>>>>>>>>>>>>>>>>>>
55795>>>>>>>>>>>>>>>>>>>function FLIST_CurrentFilelist global returns string
55797>>>>>>>>>>>>>>>>>>>  string lsRval
55797>>>>>>>>>>>>>>>>>>>  get_attribute DF_FILELIST_NAME to lsRval
55800>>>>>>>>>>>>>>>>>>>  move (ToOem(lsRval)) to lsRval
55801>>>>>>>>>>>>>>>>>>>  function_return lsRval
55802>>>>>>>>>>>>>>>>>>>end_function
55803>>>>>>>>>>>>>>>>>>>
55803>>>>>>>>>>>>>>>>>>>procedure FLIST_SetCurrentFilelist global string lsFileName
55805>>>>>>>>>>>>>>>>>>>  set_attribute DF_FILELIST_NAME to (ToAnsi(lsFileName))
55808>>>>>>>>>>>>>>>>>>>end_procedure
55809>>>>>>>>>>>>>>>>>>>
55809>>>>>>>>>>>>>>>>>>>procedure FLIST_SetOpenPath global string lsPath
55811>>>>>>>>>>>>>>>>>>>  set_attribute DF_OPEN_PATH to (ToAnsi(lsPath))
55814>>>>>>>>>>>>>>>>>>>end_procedure
55815>>>>>>>>>>>>>>>>>>>
55815>>>>>>>>>>>>>>>>>>>procedure FLIST_PushCurrentFilelist global
55817>>>>>>>>>>>>>>>>>>>  send Push.s to (oFileListStack(self)) (FLIST_CurrentFilelist())
55818>>>>>>>>>>>>>>>>>>>end_procedure
55819>>>>>>>>>>>>>>>>>>>procedure FLIST_PopCurrentFilelist global
55821>>>>>>>>>>>>>>>>>>>  send FLIST_CloseAllFiles
55822>>>>>>>>>>>>>>>>>>>  send FLIST_SetCurrentFilelist (sPop(oFileListStack(self)))
55823>>>>>>>>>>>>>>>>>>>end_procedure
55824>>>>>>>>>>>>>>>>>>>
55824>>>>>>>>>>>>>>>>>>>function FLIST_CurrentFileListFolder global returns string
55826>>>>>>>>>>>>>>>>>>>  string lsFileList lsFolder
55826>>>>>>>>>>>>>>>>>>>  get FLIST_CurrentFilelist to lsFileList
55827>>>>>>>>>>>>>>>>>>>  if (lsFileList<>SEQ_RemovePathFromFileName(lsFileList)) function_return (SEQ_ExtractPathFromFileName(lsFileList))
55830>>>>>>>>>>>>>>>>>>>  get SEQ_FindFileAlongDFPath lsFileList to lsFolder
55831>>>>>>>>>>>>>>>>>>>  function_return lsFolder
55832>>>>>>>>>>>>>>>>>>>end_function
55833>>>>>>>>>>>>>>>>>>>
55833>>>>>>>>>>>>>>>>>>>// Find an empty entry in filelist cfg, that is not temporarily used
55833>>>>>>>>>>>>>>>>>>>// by an "open as" statement. Start the search at entry liFile + 1.
55833>>>>>>>>>>>>>>>>>>>function FLIST_TemporaryEntry global integer liFile returns integer
55835>>>>>>>>>>>>>>>>>>>  integer lbOpened
55835>>>>>>>>>>>>>>>>>>>  repeat
55835>>>>>>>>>>>>>>>>>>>>
55835>>>>>>>>>>>>>>>>>>>    get_attribute DF_FILE_NEXT_EMPTY of liFile to liFile
55838>>>>>>>>>>>>>>>>>>>    if liFile begin
55840>>>>>>>>>>>>>>>>>>>      get_attribute DF_FILE_OPENED of liFile to lbOpened
55843>>>>>>>>>>>>>>>>>>>      ifnot lbOpened function_return liFile
55846>>>>>>>>>>>>>>>>>>>    end
55846>>>>>>>>>>>>>>>>>>>>
55846>>>>>>>>>>>>>>>>>>>  until liFile eq 0
55848>>>>>>>>>>>>>>>>>>>  function_return -1
55849>>>>>>>>>>>>>>>>>>>end_function
55850>>>>>>>>>>>>>>>>>>>
55850>>>>>>>>>>>>>>>>>>>// Returns DFTRUE if a filelist.cfg was created OK.
55850>>>>>>>>>>>>>>>>>>>function FLIST_CreateEmptyFileList global string lsFileListPathAndName returns integer
55852>>>>>>>>>>>>>>>>>>>  integer liCount liOrg liChannel
55852>>>>>>>>>>>>>>>>>>>  string lsFiller
55852>>>>>>>>>>>>>>>>>>>  send FLIST_PushCurrentFilelist // Remember who we where.
55853>>>>>>>>>>>>>>>>>>>  send FLIST_CloseAllFiles       // Close all files just in case.
55854>>>>>>>>>>>>>>>>>>>  get SEQ_DirectOutput ("binary:"+lsFileListPathAndName) to liChannel
55855>>>>>>>>>>>>>>>>>>>
55855>>>>>>>>>>>>>>>>>>>  if (liChannel>=0) begin
55857>>>>>>>>>>>>>>>>>>>    if 1 begin
55859>>>>>>>>>>>>>>>>>>>      get_argument_size To liOrg      // Create the filelist. It has to be of size
55860>>>>>>>>>>>>>>>>>>>      set_argument_size 524277        // 32128, if it is any smaller errors occur
55861>>>>>>>>>>>>>>>>>>>>
55861>>>>>>>>>>>>>>>>>>>      pad "" To lsFiller 524277       // when setting the filelist attributes.
55863>>>>>>>>>>>>>>>>>>>>
55863>>>>>>>>>>>>>>>>>>>      move (repeat(character(0),524277)) to lsFiller
55864>>>>>>>>>>>>>>>>>>>      write "filelist.cfg"            // This has to be the first 13 characters
55865>>>>>>>>>>>>>>>>>>>      write lsFiller                  //
55866>>>>>>>>>>>>>>>>>>>      send SEQ_CloseOutput liChannel
55867>>>>>>>>>>>>>>>>>>>      set_argument_size liOrg         // Restore max argument size.
55868>>>>>>>>>>>>>>>>>>>>
55868>>>>>>>>>>>>>>>>>>>//      set_attribute DF_FILELIST_NAME To lsFileListPathAndName // Setup the file list for DataFlex.
55868>>>>>>>>>>>>>>>>>>>      send FLIST_SetCurrentFilelist lsFileListPathAndName
55869>>>>>>>>>>>>>>>>>>>
55869>>>>>>>>>>>>>>>>>>>      set_attribute DF_FILE_ROOT_NAME    of 4095 to "temp"
55872>>>>>>>>>>>>>>>>>>>      set_attribute DF_FILE_LOGICAL_NAME of 4095 to "temp"
55875>>>>>>>>>>>>>>>>>>>      set_attribute DF_FILE_DISPLAY_NAME of 4095 to "temp"
55878>>>>>>>>>>>>>>>>>>>      set_attribute DF_FILE_ROOT_NAME    of 4095 to ""
55881>>>>>>>>>>>>>>>>>>>      set_attribute DF_FILE_LOGICAL_NAME of 4095 to ""
55884>>>>>>>>>>>>>>>>>>>      set_attribute DF_FILE_DISPLAY_NAME of 4095 to ""
55887>>>>>>>>>>>>>>>>>>>
55887>>>>>>>>>>>>>>>>>>>      set_attribute DF_FILE_ROOT_NAME    of 50 to "flexerrs"
55890>>>>>>>>>>>>>>>>>>>      set_attribute DF_FILE_LOGICAL_NAME of 50 to "FLEXERRS"
55893>>>>>>>>>>>>>>>>>>>      set_attribute DF_FILE_DISPLAY_NAME of 50 to "@DataFlex Error File"
55896>>>>>>>>>>>>>>>>>>>
55896>>>>>>>>>>>>>>>>>>>    //for liCount from 1 to 250                               // Fill the filelist.
55896>>>>>>>>>>>>>>>>>>>    //  set_attribute DF_FILE_ROOT_NAME    of liCount to ""   // Every slot must be
55896>>>>>>>>>>>>>>>>>>>    //  set_attribute DF_FILE_LOGICAL_NAME of liCount to ""   // emptied out. Otherwise
55896>>>>>>>>>>>>>>>>>>>    //  set_attribute DF_FILE_DISPLAY_NAME of liCount to ""   // the API thinks some of
55896>>>>>>>>>>>>>>>>>>>    //loop                                                    // the slots are used.
55896>>>>>>>>>>>>>>>>>>>    end
55896>>>>>>>>>>>>>>>>>>>>
55896>>>>>>>>>>>>>>>>>>>    else begin
55897>>>>>>>>>>>>>>>>>>>      get_argument_size To liOrg      // Create the filelist. It has to be of size
55898>>>>>>>>>>>>>>>>>>>      set_argument_size 32117         // 32128, if it is any smaller errors occur
55899>>>>>>>>>>>>>>>>>>>>
55899>>>>>>>>>>>>>>>>>>>      pad "" To lsFiller 32117        // when setting the filelist attributes.
55901>>>>>>>>>>>>>>>>>>>>
55901>>>>>>>>>>>>>>>>>>>      write "filelist.cfg"            // This has to be the first 13 characters
55902>>>>>>>>>>>>>>>>>>>      write lsFiller                  //
55903>>>>>>>>>>>>>>>>>>>      send SEQ_CloseOutput liChannel
55904>>>>>>>>>>>>>>>>>>>      set_argument_size liOrg         // Restore max argument size.
55905>>>>>>>>>>>>>>>>>>>>
55905>>>>>>>>>>>>>>>>>>>      set_attribute DF_FILELIST_NAME To lsFileListPathAndName // Setup the file list for DataFlex.
55908>>>>>>>>>>>>>>>>>>>      for liCount from 1 to 250                               // Fill the filelist.
55914>>>>>>>>>>>>>>>>>>>>
55914>>>>>>>>>>>>>>>>>>>        set_attribute DF_FILE_ROOT_NAME    of liCount to ""   // Every slot must be
55917>>>>>>>>>>>>>>>>>>>        set_attribute DF_FILE_LOGICAL_NAME of liCount to ""   // emptied out. Otherwise
55920>>>>>>>>>>>>>>>>>>>        set_attribute DF_FILE_DISPLAY_NAME of liCount to ""   // the API thinks some of
55923>>>>>>>>>>>>>>>>>>>      loop                                                    // the slots are used.
55924>>>>>>>>>>>>>>>>>>>>
55924>>>>>>>>>>>>>>>>>>>    end
55924>>>>>>>>>>>>>>>>>>>>
55924>>>>>>>>>>>>>>>>>>>    send FLIST_PopCurrentFilelist   // Restore current filelist.
55925>>>>>>>>>>>>>>>>>>>    function_return (SEQ_FileExists(lsFileListPathAndName)=SEQIT_FILE)
55926>>>>>>>>>>>>>>>>>>>  end
55926>>>>>>>>>>>>>>>>>>>>
55926>>>>>>>>>>>>>>>>>>>  else function_return 0
55928>>>>>>>>>>>>>>>>>>>end_function
55929>>>>>>>>>>>>>>>>>>>
55929>>>>>>>>>>>>>>>>>>>enumeration_list
55929>>>>>>>>>>>>>>>>>>>  define FLINFO_SIZE_BYTES     // Filesize of filelist.cfg (bytes)
55929>>>>>>>>>>>>>>>>>>>  define FLINFO_SIZE_ENTRIES   // Max number of entries in filelist.cfg
55929>>>>>>>>>>>>>>>>>>>  define FLINFO_LT_256         // Is this a (lt) 256 version (bool)
55929>>>>>>>>>>>>>>>>>>>end_enumeration_list
55929>>>>>>>>>>>>>>>>>>>
55929>>>>>>>>>>>>>>>>>>>function FLIST_Information global integer liWhat returns integer
55931>>>>>>>>>>>>>>>>>>>  integer liRval
55931>>>>>>>>>>>>>>>>>>>  string lsPath lsFileList
55931>>>>>>>>>>>>>>>>>>>
55931>>>>>>>>>>>>>>>>>>>  move -1 to liRval
55932>>>>>>>>>>>>>>>>>>>
55932>>>>>>>>>>>>>>>>>>>  if (liWhat=FLINFO_SIZE_BYTES) begin
55934>>>>>>>>>>>>>>>>>>>    get FLIST_CurrentFilelist to lsFileList
55935>>>>>>>>>>>>>>>>>>>    get SEQ_FileSize lsFileList to liRval
55936>>>>>>>>>>>>>>>>>>>  end
55936>>>>>>>>>>>>>>>>>>>>
55936>>>>>>>>>>>>>>>>>>>  if (liWhat=FLINFO_LT_256) begin
55938>>>>>>>>>>>>>>>>>>>    get FLIST_Information FLINFO_SIZE_BYTES to liRval
55939>>>>>>>>>>>>>>>>>>>    move (liRval<=32768) to liRval
55940>>>>>>>>>>>>>>>>>>>  end
55940>>>>>>>>>>>>>>>>>>>>
55940>>>>>>>>>>>>>>>>>>>  if (liWhat=FLINFO_SIZE_ENTRIES) begin
55942>>>>>>>>>>>>>>>>>>>    get FLIST_Information FLINFO_SIZE_BYTES to liRval
55943>>>>>>>>>>>>>>>>>>>    move (liRval/128-1) to liRval
55944>>>>>>>>>>>>>>>>>>>  end
55944>>>>>>>>>>>>>>>>>>>>
55944>>>>>>>>>>>>>>>>>>>  function_return liRval
55945>>>>>>>>>>>>>>>>>>>end_function
55946>>>>>>>>>>>>>>>>>>>
55946>>>>>>>>>>>>>>>>>>>procedure FLIST_Make4095 global
55948>>>>>>>>>>>>>>>>>>>  if (FLIST_Information(FLINFO_LT_256)) begin
55950>>>>>>>>>>>>>>>>>>>    set_attribute DF_FILE_ROOT_NAME    of 4095 to "temp"
55953>>>>>>>>>>>>>>>>>>>    set_attribute DF_FILE_LOGICAL_NAME of 4095 to "temp"
55956>>>>>>>>>>>>>>>>>>>    set_attribute DF_FILE_DISPLAY_NAME of 4095 to "temp"
55959>>>>>>>>>>>>>>>>>>>    set_attribute DF_FILE_ROOT_NAME    of 4095 to ""
55962>>>>>>>>>>>>>>>>>>>    set_attribute DF_FILE_LOGICAL_NAME of 4095 to ""
55965>>>>>>>>>>>>>>>>>>>    set_attribute DF_FILE_DISPLAY_NAME of 4095 to ""
55968>>>>>>>>>>>>>>>>>>>  end
55968>>>>>>>>>>>>>>>>>>>>
55968>>>>>>>>>>>>>>>>>>>end_procedure
55969>>>>>>>>>>>>>>>>> Use Embedpre.vw
Including file: embedpre.vw    (C:\projects\BRS\VDFQuery\AppSrc\embedpre.vw)
55969>>>>>>>>>>>>>>>>>>>// Embedpre.vw
55969>>>>>>>>>>>>>>>>>>>// a DataFlex/VPE Preview view
55969>>>>>>>>>>>>>>>>>>>
55969>>>>>>>>>>>>>>>>>>>Use APS          // Auto Positioning and Sizing classes for VDF
55969>>>>>>>>>>>>>>>>>>>Use ObjGroup.utl // Defining groups of objects
55969>>>>>>>>>>>>>>>>>>>
55969>>>>>>>>>>>>>>>>>>> string gsVdfQuery_Icon#
55969>>>>>>>>>>>>>>>>>>> move "" to gsVdfQuery_Icon#
55970>>>>>>>>>>>>>>>>>>>
55970>>>>>>>>>>>>>>>>>>>use cWinControl.pkg
55970>>>>>>>>>>>>>>>>>>>
55970>>>>>>>>>>>>>>>>>>>Class VPE_Preview is a cWinControl
55971>>>>>>>>>>>>>>>>>>>  Procedure Construct_Object
55973>>>>>>>>>>>>>>>>>>>    Set External_Class_Name "VPE_Preview" to "Static"
55974>>>>>>>>>>>>>>>>>>>    forward send construct_object
55976>>>>>>>>>>>>>>>>>>>  End_Procedure // Construct_Object
55977>>>>>>>>>>>>>>>>>>>End_Class // VPE_Preview
55978>>>>>>>>>>>>>>>>>>>
55978>>>>>>>>>>>>>>>>>>>External_Function VPE_MoveWindow "MoveWindow" User32.DLL dword hwnd integer x integer y integer width integer height integer repaint returns integer
55979>>>>>>>>>>>>>>>>>>>
55979>>>>>>>>>>>>>>>>>>>DEFINE_OBJECT_GROUP OG_VpePreview
55980>>>>>>>>>>>>>>>>>>>  Object VPE_Embedded_Preview is a aps.View Label (OG_Param(0))
55983>>>>>>>>>>>>>>>>>>>    Set Border_Style to BORDER_THICK   // Make panel resizeable
55984>>>>>>>>>>>>>>>>>>>    Set pMinimumSize to 110 200 // Resize to no less than this!
55985>>>>>>>>>>>>>>>>>>>    Set p_Top_Margin to 0
55986>>>>>>>>>>>>>>>>>>>    Set p_Left_Margin to 0
55987>>>>>>>>>>>>>>>>>>>    Send Aps_Init
55988>>>>>>>>>>>>>>>>>>>    if gsVdfQuery_Icon# ne "" set icon to gsVdfQuery_Icon#
55991>>>>>>>>>>>>>>>>>>>
55991>>>>>>>>>>>>>>>>>>>    Property Integer phDoc Public 0
55993>>>>>>>>>>>>>>>>>>>    on_key kCancel send close_panel
55994>>>>>>>>>>>>>>>>>>>
55994>>>>>>>>>>>>>>>>>>>    Object oCont is a VPE_Preview //aps.Container3D
55996>>>>>>>>>>>>>>>>>>>      Set Size to 280 504
55997>>>>>>>>>>>>>>>>>>>      Send Aps_Auto_Locate_Control Self
55998>>>>>>>>>>>>>>>>>>>
55998>>>>>>>>>>>>>>>>>>>      Procedure Key Integer iKey
56001>>>>>>>>>>>>>>>>>>>        Integer hDoc iJunk
56001>>>>>>>>>>>>>>>>>>>
56001>>>>>>>>>>>>>>>>>>>        Forward Send Key iKey
56003>>>>>>>>>>>>>>>>>>>
56003>>>>>>>>>>>>>>>>>>>        Get phDoc to hDoc
56004>>>>>>>>>>>>>>>>>>>
56004>>>>>>>>>>>>>>>>>>>        If (iKey = KEY_LEFT_ARROW)              Move (VpeSendKey(hDoc,VKEY_SCROLL_LEFT)) to iJunk
56007>>>>>>>>>>>>>>>>>>>        If (iKey = (KEY_CTRL+KEY_LEFT_ARROW))   Move (VpeSendKey(hDoc,VKEY_SCROLL_PAGE_LEFT)) to iJunk
56010>>>>>>>>>>>>>>>>>>>        If (iKey = KEY_RIGHT_ARROW)             Move (VpeSendKey(hDoc,VKEY_SCROLL_RIGHT)) to iJunk
56013>>>>>>>>>>>>>>>>>>>        If (iKey = (KEY_CTRL+KEY_RIGHT_ARROW))  Move (VpeSendKey(hDoc,VKEY_SCROLL_PAGE_RIGHT)) to iJunk
56016>>>>>>>>>>>>>>>>>>>        If (iKey = KEY_UP_ARROW)                Move (VpeSendKey(hDoc,VKEY_SCROLL_UP)) to iJunk
56019>>>>>>>>>>>>>>>>>>>        If (iKey = (KEY_CTRL+KEY_UP_ARROW))     Move (VpeSendKey(hDoc,VKEY_SCROLL_PAGE_UP)) to iJunk
56022>>>>>>>>>>>>>>>>>>>        If (iKey = KEY_DOWN_ARROW)              Move (VpeSendKey(hDoc,VKEY_SCROLL_DOWN)) to iJunk
56025>>>>>>>>>>>>>>>>>>>        If (iKey = (KEY_CTRL+KEY_DOWN_ARROW))   Move (VpeSendKey(hDoc,VKEY_SCROLL_PAGE_DOWN)) to iJunk
56028>>>>>>>>>>>>>>>>>>>        If (iKey = KEY_HOME)                    Move (VpeSendKey(hDoc,VKEY_SCROLL_TOP)) to iJunk
56031>>>>>>>>>>>>>>>>>>>        If (iKey = KEY_END)                     Move (VpeSendKey(hDoc,VKEY_SCROLL_BOTTOM)) to iJunk
56034>>>>>>>>>>>>>>>>>>>        If (iKey = KEY_F2)                      Move (VpeSendKey(hDoc,VKEY_PRINT)) to iJunk
56037>>>>>>>>>>>>>>>>>>>        If (iKey = KEY_F3)                      Move (VpeSendKey(hDoc,VKEY_MAIL)) to iJunk
56040>>>>>>>>>>>>>>>>>>>        If (iKey = (KEY_CTRL+KEY_INSERT))       Move (VpeSendKey(hDoc,VKEY_1_1)) to iJunk
56043>>>>>>>>>>>>>>>>>>>        If (iKey = (KEY_CTRL+KEY_DELETE))       Move (VpeSendKey(hDoc,VKEY_FULL_PAGE)) to iJunk
56046>>>>>>>>>>>>>>>>>>>        If (iKey = KEY_INSERT)                  Move (VpeSendKey(hDoc,VKEY_ZOOM_IN)) to iJunk
56049>>>>>>>>>>>>>>>>>>>        If (iKey = KEY_DELETE)                  Move (VpeSendKey(hDoc,VKEY_ZOOM_OUT)) to iJunk
56052>>>>>>>>>>>>>>>>>>>        If (iKey = KEY_G)                       Move (VpeSendKey(hDoc,VKEY_GRID)) to iJunk
56055>>>>>>>>>>>>>>>>>>>        If (iKey = (KEY_CTRL+KEY_PGUP))         Move (VpeSendKey(hDoc,VKEY_PAGE_FIRST)) to iJunk
56058>>>>>>>>>>>>>>>>>>>        If (iKey = KEY_PGUP)                    Move (VpeSendKey(hDoc,VKEY_PAGE_LEFT)) to iJunk
56061>>>>>>>>>>>>>>>>>>>        If (iKey = KEY_PGDN)                    Move (VpeSendKey(hDoc,VKEY_PAGE_RIGHT)) to iJunk
56064>>>>>>>>>>>>>>>>>>>        If (iKey = (KEY_CTRL+KEY_PGDN))         Move (VpeSendKey(hDoc,VKEY_PAGE_LAST)) to iJunk
56067>>>>>>>>>>>>>>>>>>>        If (iKey = KEY_F1)                      Move (VpeSendKey(hDoc,VKEY_HELP)) to iJunk
56070>>>>>>>>>>>>>>>>>>>        If (iKey = KEY_I)                       Move (VpeSendKey(hDoc,VKEY_INFO)) to iJunk
56073>>>>>>>>>>>>>>>>>>>        If (iKey = KEY_ENTER)                   Move (VpeSendKey(hDoc,VKEY_GOTO_PAGE)) to iJunk
56076>>>>>>>>>>>>>>>>>>>      End_Procedure // Key
56077>>>>>>>>>>>>>>>>>>>
56077>>>>>>>>>>>>>>>>>>>      Procedure KeyEnter
56080>>>>>>>>>>>>>>>>>>>        Integer hDoc iJunk
56080>>>>>>>>>>>>>>>>>>>        Get phDoc to hDoc
56081>>>>>>>>>>>>>>>>>>>        Move (VpeSendKey(hDoc,VKEY_GOTO_PAGE)) to iJunk
56082>>>>>>>>>>>>>>>>>>>      End_Procedure // KeyEnter
56083>>>>>>>>>>>>>>>>>>>
56083>>>>>>>>>>>>>>>>>>>      On_Key kEnter Send KeyEnter
56084>>>>>>>>>>>>>>>>>>>    End_Object // Cont
56085>>>>>>>>>>>>>>>>>>>
56085>>>>>>>>>>>>>>>>>>>    Function Target returns Integer
56088>>>>>>>>>>>>>>>>>>>      Function_Return (Window_Handle(oCont(Self)))
56089>>>>>>>>>>>>>>>>>>>    End_Function // Target
56090>>>>>>>>>>>>>>>>>>>
56090>>>>>>>>>>>>>>>>>>>    Procedure Make_Visible
56093>>>>>>>>>>>>>>>>>>>      integer hWnd iVoid
56093>>>>>>>>>>>>>>>>>>>      Set Visible_State to True
56094>>>>>>>>>>>>>>>>>>>      // This piece of code does not work unfortunately. It makes sure
56094>>>>>>>>>>>>>>>>>>>      // that the view starts up in maximazed mode, but the initial paint
56094>>>>>>>>>>>>>>>>>>>      // does not look good.
56094>>>>>>>>>>>>>>>>>>>//    Set View_Mode to viewmode_zoom
56094>>>>>>>>>>>>>>>>>>>//    Get Window_Handle of (oCont(self)) To hWnd
56094>>>>>>>>>>>>>>>>>>>//    If hWnd Move (InvalidateRect(hWnd, 0, True)) To iVoid
56094>>>>>>>>>>>>>>>>>>>    End_Procedure // Make_Visible
56095>>>>>>>>>>>>>>>>>>>
56095>>>>>>>>>>>>>>>>>>>    Procedure Make_Invisible
56098>>>>>>>>>>>>>>>>>>>      Set Visible_State to False
56099>>>>>>>>>>>>>>>>>>>    End_Procedure // Make_Invisible
56100>>>>>>>>>>>>>>>>>>>    send Make_Invisible
56101>>>>>>>>>>>>>>>>>>>
56101>>>>>>>>>>>>>>>>>>>    Procedure Aps_OnResize integer delta_rw# integer delta_cl#
56104>>>>>>>>>>>>>>>>>>>      Integer hwnd# junk# size#
56104>>>>>>>>>>>>>>>>>>>
56104>>>>>>>>>>>>>>>>>>>      send aps_resize (oCont(Self)) delta_rw# delta_cl#
56105>>>>>>>>>>>>>>>>>>>      send aps_auto_size_container
56106>>>>>>>>>>>>>>>>>>>
56106>>>>>>>>>>>>>>>>>>>      Move (VpeGetWindowHandle(phDoc(Self))) to hwnd#
56107>>>>>>>>>>>>>>>>>>>      Get GuiSize of (oCont(self)) to size#
56108>>>>>>>>>>>>>>>>>>>      Move (VPE_MoveWindow(hwnd#,0,0,Low(size#),Hi(Size#),true)) to junk#
56109>>>>>>>>>>>>>>>>>>>    End_Procedure
56110>>>>>>>>>>>>>>>>>>>
56110>>>>>>>>>>>>>>>>>>>    Procedure Popup
56113>>>>>>>>>>>>>>>>>>>      Set Window_Style to WS_MAXIMIZEBOX 1
56114>>>>>>>>>>>>>>>>>>>      Forward Send Popup
56116>>>>>>>>>>>>>>>>>>>    End_Procedure // Popup
56117>>>>>>>>>>>>>>>>>>>
56117>>>>>>>>>>>>>>>>>>>    Procedure Close_Panel // Release when closed!
56120>>>>>>>>>>>>>>>>>>>      Forward Send Close_Panel
56122>>>>>>>>>>>>>>>>>>>      //send Deferred_Request_Destroy_Object
56122>>>>>>>>>>>>>>>>>>>      send Request_Destroy_Object
56123>>>>>>>>>>>>>>>>>>>    End_Procedure
56124>>>>>>>>>>>>>>>>>>>    Move self to OG_Current_Object# // global integer
56125>>>>>>>>>>>>>>>>>>>  End_Object // VPE_Embedded_Preview
56126>>>>>>>>>>>>>>>>>>>END_DEFINE_OBJECT_GROUP
56127>>>>>>>>>>>>>>>>> Use ErrorHnd.nui // cErrorHandlerRedirector class and oErrorHandlerQuiet object (No User Interface)
56127>>>>>>>>>>>>>>>>> Use Macros.utl   // Various macros (FOR_EX...)
56127>>>>>>>>>>>>>>>>> desktop_section
56132>>>>>>>>>>>>>>>>>   Integer glMainClientId#
56132>>>>>>>>>>>>>>>>>   Move 0 to glMainClientId#
56133>>>>>>>>>>>>>>>>>   Procedure Set iGlobal_MainClient_Id Integer obj#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
56135>>>>>>>>>>>>>>>>>     Move obj# to glMainClientId#
56136>>>>>>>>>>>>>>>>>   End_Procedure
56137>>>>>>>>>>>>>>>>>   Function iGlobal_MainClient_Id Returns Integer
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
56139>>>>>>>>>>>>>>>>>     Integer self#
56139>>>>>>>>>>>>>>>>>     ifnot glMainClientId# Begin
56141>>>>>>>>>>>>>>>>>       Move Self to self#
56142>>>>>>>>>>>>>>>>>       Move (client_id(self#)) to glMainClientId#
56143>>>>>>>>>>>>>>>>>     End
56143>>>>>>>>>>>>>>>>>>
56143>>>>>>>>>>>>>>>>>     Function_Return glMainClientId#
56144>>>>>>>>>>>>>>>>>   End_Function
56145>>>>>>>>>>>>>>>>> end_desktop_section
56150>>>>>>>>>>>>>>>>> Class cVPE is an Array
56151>>>>>>>>>>>>>>>>>  Procedure construct_object
56153>>>>>>>>>>>>>>>>>    Forward Send construct_object
56155>>>>>>>>>>>>>>>>>    Set delegation_mode to delegate_to_parent
56156>>>>>>>>>>>>>>>>>    Property DWord   phDoc            Public 0         // Document handle
56157>>>>>>>>>>>>>>>>>    Property String  pTitle           Public "Preview"
56158>>>>>>>>>>>>>>>>>     property string  pCurFont         public "Arial"
56159>>>>>>>>>>>>>>>>>    Property Integer pCurFontSize     public 12
56160>>>>>>>>>>>>>>>>>    Property Integer pCurTopMargin    public 200
56161>>>>>>>>>>>>>>>>>    Property Integer pCurBottomMargin public 200
56162>>>>>>>>>>>>>>>>>    Property Integer pCurLeftMargin   public 200
56163>>>>>>>>>>>>>>>>>    Property Integer pCurRightMargin  public 200
56164>>>>>>>>>>>>>>>>>     property string  pFont            public "Arial"
56165>>>>>>>>>>>>>>>>>    Property Integer pFontSize        public 12
56166>>>>>>>>>>>>>>>>>    Property Integer pLeftMargin      public 200
56167>>>>>>>>>>>>>>>>>    Property Integer pRightMargin     public 200
56168>>>>>>>>>>>>>>>>>    Property Integer pTopMargin       public 200
56169>>>>>>>>>>>>>>>>>    Property Integer pBottomMargin    public 200
56170>>>>>>>>>>>>>>>>>     property integer pPageWidth       public VPAPER_A4 // VPAPER_LETTER
56171>>>>>>>>>>>>>>>>>    Property Integer pPageLength      public 0
56172>>>>>>>>>>>>>>>>>    Property DWord   pOpenOptions     public 0
56173>>>>>>>>>>>>>>>>>     property integer pBold            public 0
56174>>>>>>>>>>>>>>>>>    Property Integer pUnderLine       public 0
56175>>>>>>>>>>>>>>>>>    Property Integer pItalics         public 0
56176>>>>>>>>>>>>>>>>>     property integer pLandscape       public 0
56177>>>>>>>>>>>>>>>>>     // The property pNewPageOnNextLine is tested and set by the following
56177>>>>>>>>>>>>>>>>>    // three procedure: NewPage, Write and WriteLn. It was introduced to
56177>>>>>>>>>>>>>>>>>    // handle continuos Write/WriteLn across more pages.
56177>>>>>>>>>>>>>>>>>    Property Integer pNewPageOnNextLine public 0
56178>>>>>>>>>>>>>>>>>   End_Procedure
56179>>>>>>>>>>>>>>>>> // VpeSetAutoBreak - parameters :
56179>>>>>>>>>>>>>>>>>  //  AUTO_BREAK_ON              // auto break
56179>>>>>>>>>>>>>>>>>  //  AUTO_BREAK_OFF             // limited positioning, rendering
56179>>>>>>>>>>>>>>>>>  //  AUTO_BREAK_NO_LIMITS       // none of above
56179>>>>>>>>>>>>>>>>>  //  AUTO_BREAK_FULL
56179>>>>>>>>>>>>>>>>>  Procedure Vpe_SetAutoBreak Integer liValue
56181>>>>>>>>>>>>>>>>>    Integer liGrb
56181>>>>>>>>>>>>>>>>>    DWord lhDoc
56181>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56182>>>>>>>>>>>>>>>>>    Move (VpeSetAutoBreak(lhDoc,liValue)) to liGrb
56183>>>>>>>>>>>>>>>>>  End_Procedure
56184>>>>>>>>>>>>>>>>>   function sDefaultSetupFileName returns string
56186>>>>>>>>>>>>>>>>>    Integer lbCreateError liChannel
56186>>>>>>>>>>>>>>>>>    String lsUserName lsFolder
56186>>>>>>>>>>>>>>>>>    Get User_Windows_User_Name to lsUserName
56187>>>>>>>>>>>>>>>>>    Get FLIST_CurrentFileListFolder to lsFolder
56188>>>>>>>>>>>>>>>>>    Get Files_AppendPath lsFolder "VpeSetup" to lsFolder
56189>>>>>>>>>>>>>>>>>    If (SEQ_FileExists(lsFolder)=SEQIT_NONE) Begin
56191>>>>>>>>>>>>>>>>>      Get wvaWin32_CreateDirectory (ToAnsi(lsFolder)) to lbCreateError
56192>>>>>>>>>>>>>>>>>      If lbCreateError Function_Return "c:\vpe3.set"
56195>>>>>>>>>>>>>>>>>      Get SEQ_DirectOutput (Files_AppendPath(lsFolder,"readme.txt")) to liChannel
56196>>>>>>>>>>>>>>>>>      If (liChannel>=0) Begin
56198>>>>>>>>>>>>>>>>>        Writeln channel liChannel "This folder was created automatically to store setup files for the"
56201>>>>>>>>>>>>>>>>>        Writeln "Virtual Print Engine (VPE)."
56203>>>>>>>>>>>>>>>>>        Writeln ""
56205>>>>>>>>>>>>>>>>>        Writeln "These files contain information about the currently selected printer."
56207>>>>>>>>>>>>>>>>>        Send SEQ_CloseOutput liChannel
56208>>>>>>>>>>>>>>>>>      End
56208>>>>>>>>>>>>>>>>>>
56208>>>>>>>>>>>>>>>>>    End
56208>>>>>>>>>>>>>>>>>>
56208>>>>>>>>>>>>>>>>>    Get Files_AppendPath lsFolder (lsUserName+".set") to lsUserName // overload
56209>>>>>>>>>>>>>>>>>    Function_Return lsUserName
56210>>>>>>>>>>>>>>>>>  End_Function
56211>>>>>>>>>>>>>>>>>   function Vpe_GetDevice returns string
56213>>>>>>>>>>>>>>>>>    DWord lhDoc
56213>>>>>>>>>>>>>>>>>    Pointer lpDevice
56213>>>>>>>>>>>>>>>>>    String lsDevice
56213>>>>>>>>>>>>>>>>>    Integer liGrb
56213>>>>>>>>>>>>>>>>>    Move (pad("",255)) to lsDevice
56214>>>>>>>>>>>>>>>>>    GetAddress of lsDevice to lpDevice
56215>>>>>>>>>>>>>>>>>     send OpenDoc
56216>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56217>>>>>>>>>>>>>>>>>    Move (VpeGetDevice(lhDoc,lpDevice,255)) to liGrb
56218>>>>>>>>>>>>>>>>>     send vpe_CloseDoc
56219>>>>>>>>>>>>>>>>>    Function_Return (CString(lsDevice))
56220>>>>>>>>>>>>>>>>>  End_Function
56221>>>>>>>>>>>>>>>>>   Function IsLandscape returns dword
56223>>>>>>>>>>>>>>>>>    Integer rval#
56223>>>>>>>>>>>>>>>>>    Get Vpe_GetPageOrientation to rval#
56224>>>>>>>>>>>>>>>>>    Function_Return (rval# = VORIENTATION_LANDSCAPE)
56225>>>>>>>>>>>>>>>>>  End_Function
56226>>>>>>>>>>>>>>>>>   Procedure vpe_SelectFont string Font# integer FontSize#
56228>>>>>>>>>>>>>>>>>    DWord lhDoc
56228>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56229>>>>>>>>>>>>>>>>>    Move (VpeSetFont(lhDoc,Font#,FontSize#)) to Vpe$ReturnGrb#
56230>>>>>>>>>>>>>>>>>    Set pCurFont to Font#
56231>>>>>>>>>>>>>>>>>    Set pCurFontSize to FontSize#
56232>>>>>>>>>>>>>>>>>  End_Procedure
56233>>>>>>>>>>>>>>>>>   Procedure ExportCurMargins
56235>>>>>>>>>>>>>>>>>    Integer left# right# top# bottom# Width# Length#
56235>>>>>>>>>>>>>>>>>    DWord lhDoc
56235>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56236>>>>>>>>>>>>>>>>>    Get pPageWidth  to Width#
56237>>>>>>>>>>>>>>>>>    Get pPageLength to Length#
56238>>>>>>>>>>>>>>>>>     // If landscape: switch length and width:
56238>>>>>>>>>>>>>>>>>    If (IsLandscape(Self)) Begin
56240>>>>>>>>>>>>>>>>>      Move Width# to Left#  // Overload!
56241>>>>>>>>>>>>>>>>>      Move Length# to Width#
56242>>>>>>>>>>>>>>>>>      Move Left# to Length# // End overload!
56243>>>>>>>>>>>>>>>>>    End
56243>>>>>>>>>>>>>>>>>>
56243>>>>>>>>>>>>>>>>>     get pCurLeftMargin   to Left#
56244>>>>>>>>>>>>>>>>>    Get pCurRightMargin  to Right#
56245>>>>>>>>>>>>>>>>>    Get pCurTopMargin    to Top#
56246>>>>>>>>>>>>>>>>>    Get pCurBottomMargin to Bottom#
56247>>>>>>>>>>>>>>>>>     Move (VpeSet(lhDoc,VLEFTMARGIN,  Left#))           to Vpe$ReturnGrb#
56248>>>>>>>>>>>>>>>>>    Move (VpeSet(lhDoc,VRIGHTMARGIN, Width#-Right#))   to Vpe$ReturnGrb#
56249>>>>>>>>>>>>>>>>>    Move (VpeSet(lhDoc,VTOPMARGIN,   Top#))            to Vpe$ReturnGrb#
56250>>>>>>>>>>>>>>>>>    Move (VpeSet(lhDoc,VBOTTOMMARGIN,Length#-Bottom#)) to Vpe$ReturnGrb#
56251>>>>>>>>>>>>>>>>>  End_Procedure
56252>>>>>>>>>>>>>>>>>   Procedure SetMargins integer left# integer right# integer top# integer bottom#
56254>>>>>>>>>>>>>>>>>    Set pCurLeftMargin   to Left#
56255>>>>>>>>>>>>>>>>>    Set pCurRightMargin  to Right#
56256>>>>>>>>>>>>>>>>>    Set pCurTopMargin    to Top#
56257>>>>>>>>>>>>>>>>>    Set pCurBottomMargin to Bottom#
56258>>>>>>>>>>>>>>>>>    Send ExportCurMargins
56259>>>>>>>>>>>>>>>>>  End_Procedure
56260>>>>>>>>>>>>>>>>>   Procedure vpe_Set Integer what# Integer val# // Same as SetCoord
56262>>>>>>>>>>>>>>>>>    DWord lhDoc
56262>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56263>>>>>>>>>>>>>>>>>    Move (VpeSet(lhDoc,what#,val#)) to Vpe$ReturnGrb#
56264>>>>>>>>>>>>>>>>>  End_Procedure
56265>>>>>>>>>>>>>>>>>   Procedure SetCoord Integer what# Integer val#
56267>>>>>>>>>>>>>>>>>    DWord lhDoc
56267>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56268>>>>>>>>>>>>>>>>>    Move (VpeSet(lhDoc,what#,val#)) to Vpe$ReturnGrb#
56269>>>>>>>>>>>>>>>>>  End_Procedure
56270>>>>>>>>>>>>>>>>>   Function GetCoord Integer what# Returns integer
56272>>>>>>>>>>>>>>>>>    DWord lhDoc
56272>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56273>>>>>>>>>>>>>>>>>    Function_Return (VpeGet(lhDoc,what#))
56274>>>>>>>>>>>>>>>>>  End_Function
56275>>>>>>>>>>>>>>>>>   Function vpe_Get Integer what# Returns integer // Same as GetCoord
56277>>>>>>>>>>>>>>>>>    DWord lhDoc
56277>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56278>>>>>>>>>>>>>>>>>    Function_Return (VpeGet(lhDoc,what#))
56279>>>>>>>>>>>>>>>>>  End_Function
56280>>>>>>>>>>>>>>>>>   Procedure vpe_OpenDoc handle parent# string title# dword flags#
56282>>>>>>>>>>>>>>>>>    DWord lhDoc
56282>>>>>>>>>>>>>>>>>    Integer target# main_client#
56282>>>>>>>>>>>>>>>>>    String bypass#
56282>>>>>>>>>>>>>>>>>    Get VPE_OemToChar title# to title#
56283>>>>>>>>>>>>>>>>>
56283>>>>>>>>>>>>>>>>>     Get iGlobal_MainClient_Id to main_client#
56284>>>>>>>>>>>>>>>>>     Move "" to bypass#
56285>>>>>>>>>>>>>>>>>     Get_Profile_String "VEJMAN_SETUP" "OLD_PREVIEW" to bypass#
56288>>>>>>>>>>>>>>>>>     If (bypass# = "") Begin
56290>>>>>>>>>>>>>>>>>       Create_Object_Group OG_VpePreview PARENT main_client# (pTitle(Self))
56300>>>>>>>>>>>>>>>>>       Send ErrorHnd_Quiet_Activate
56301>>>>>>>>>>>>>>>>>       Send Popup to OG_Current_Object#
56302>>>>>>>>>>>>>>>>>       Send ErrorHnd_Quiet_Deactivate
56303>>>>>>>>>>>>>>>>>       Send Make_Invisible to OG_Current_Object#
56304>>>>>>>>>>>>>>>>>       Get Target of OG_Current_Object# to target#
56305>>>>>>>>>>>>>>>>>       Move (VpeOpenDoc(target#,title#,flags# ior VPE_EMBEDDED ior VPE_NO_USER_CLOSE)) to lhDoc
56306>>>>>>>>>>>>>>>>>       Set phDoc of OG_Current_Object# to lhDoc
56307>>>>>>>>>>>>>>>>>     End
56307>>>>>>>>>>>>>>>>>>
56307>>>>>>>>>>>>>>>>>     Else Move (VpeOpenDoc(parent#,title#,flags#)) to lhDoc
56309>>>>>>>>>>>>>>>>>    Move (VpeLicense(lhDoc,VPE_SERIAL_CODE1,VPE_SERIAL_CODE2)) to Vpe$ReturnGrb#
56310>>>>>>>>>>>>>>>>>    Set phDoc to lhDoc
56311>>>>>>>>>>>>>>>>>    If (pLandscape(Self)) Begin
56313>>>>>>>>>>>>>>>>>      Send Vpe_SetDevOrientation VORIENTATION_LANDSCAPE
56314>>>>>>>>>>>>>>>>>      Send Vpe_SetPageOrientation VORIENTATION_LANDSCAPE
56315>>>>>>>>>>>>>>>>>    End
56315>>>>>>>>>>>>>>>>>>
56315>>>>>>>>>>>>>>>>>  End_Procedure
56316>>>>>>>>>>>>>>>>>   Procedure OpenDoc string tmpTitle# string tmpSetupFile#
56318>>>>>>>>>>>>>>>>>    DWord lhDoc
56318>>>>>>>>>>>>>>>>>    String title# SetupFile#
56318>>>>>>>>>>>>>>>>>    Integer length# width#
56318>>>>>>>>>>>>>>>>>    Integer target# main_client#
56318>>>>>>>>>>>>>>>>>    String bypass#
56318>>>>>>>>>>>>>>>>>     if num_arguments gt 0 move tmpTitle# to title#
56321>>>>>>>>>>>>>>>>>    Else Get pTitle to title#
56323>>>>>>>>>>>>>>>>>    If num_arguments gt 1 Move tmpSetupFile# to SetupFile#
56326>>>>>>>>>>>>>>>>>    Else Get sDefaultSetupFileName to SetupFile# // "c:\vpe3.set"
56328>>>>>>>>>>>>>>>>>    If (SetupFile# = "") Get sDefaultSetupFileName  to SetupFile# // "c:\vpe3.set"
56331>>>>>>>>>>>>>>>>>     get VPE_OemToChar title# To title#
56332>>>>>>>>>>>>>>>>>     get pPageWidth  to Width#
56333>>>>>>>>>>>>>>>>>    Get pPageLength to Length#
56334>>>>>>>>>>>>>>>>>     if (width# = VPAPER_A4) begin
56336>>>>>>>>>>>>>>>>>      Move 2100 to Width#
56337>>>>>>>>>>>>>>>>>      Move 2970 to Length#
56338>>>>>>>>>>>>>>>>>    End
56338>>>>>>>>>>>>>>>>>>
56338>>>>>>>>>>>>>>>>>    If (width# = VPAPER_LETTER) Begin
56340>>>>>>>>>>>>>>>>>      Move 2159 to Width#
56341>>>>>>>>>>>>>>>>>      Move 2794 to Length#
56342>>>>>>>>>>>>>>>>>    End
56342>>>>>>>>>>>>>>>>>>
56342>>>>>>>>>>>>>>>>>    Set pPageWidth  to Width#
56343>>>>>>>>>>>>>>>>>    Set pPageLength to Length#
56344>>>>>>>>>>>>>>>>>    // width and length are no longer passed as params to opendoc
56344>>>>>>>>>>>>>>>>>    // we might have to set paper size diffently
56344>>>>>>>>>>>>>>>>>     Get iGlobal_MainClient_Id to main_client#
56345>>>>>>>>>>>>>>>>>     Move "" to bypass#
56346>>>>>>>>>>>>>>>>>     Get_Profile_String "VEJMAN_SETUP" "OLD_PREVIEW" to bypass#
56349>>>>>>>>>>>>>>>>>     If (bypass# = "") Begin
56351>>>>>>>>>>>>>>>>>       Create_Object_Group OG_VpePreview PARENT main_client# (pTitle(Self))
56361>>>>>>>>>>>>>>>>>       Send ErrorHnd_Quiet_Activate
56362>>>>>>>>>>>>>>>>>       Send Popup to OG_Current_Object#
56363>>>>>>>>>>>>>>>>>       Send ErrorHnd_Quiet_Deactivate
56364>>>>>>>>>>>>>>>>>       Send Make_Invisible to OG_Current_Object#
56365>>>>>>>>>>>>>>>>>       Get Target of OG_Current_Object# to target#
56366>>>>>>>>>>>>>>>>>       Move (VpeOpenDoc(target#,title#,pOpenOptions(Self) ior VPE_EMBEDDED ior VPE_NO_USER_CLOSE)) to lhDoc
56367>>>>>>>>>>>>>>>>>       Set phDoc of OG_Current_Object# to lhDoc
56368>>>>>>>>>>>>>>>>>     End
56368>>>>>>>>>>>>>>>>>>
56368>>>>>>>>>>>>>>>>>     Else Move (VpeOpenDoc(0,title#,pOpenOptions(Self))) to lhDoc
56370>>>>>>>>>>>>>>>>>    Move (VpeLicense(lhDoc,VPE_SERIAL_CODE1,VPE_SERIAL_CODE2)) to Vpe$ReturnGrb#
56371>>>>>>>>>>>>>>>>>    Set phDoc to lhDoc
56372>>>>>>>>>>>>>>>>>    If (pLandscape(Self)) Begin
56374>>>>>>>>>>>>>>>>>      Send Vpe_SetDevOrientation VORIENTATION_LANDSCAPE
56375>>>>>>>>>>>>>>>>>      Send Vpe_SetPageOrientation VORIENTATION_LANDSCAPE
56376>>>>>>>>>>>>>>>>>    End
56376>>>>>>>>>>>>>>>>>>
56376>>>>>>>>>>>>>>>>>     move (VpeSetupPrinter(lhDoc,SetupFile#,PRINTDLG_ONFAIL)) to Vpe$ReturnGrb#
56377>>>>>>>>>>>>>>>>>    If (Vpe$ReturnGrb# = 1) Begin // User pressed cancel
56379>>>>>>>>>>>>>>>>>      Send vpe_CloseDoc
56380>>>>>>>>>>>>>>>>>    End
56380>>>>>>>>>>>>>>>>>>
56380>>>>>>>>>>>>>>>>>    Else Begin
56381>>>>>>>>>>>>>>>>>      Send SetMargins (pLeftMargin(Self)) (pRightMargin(Self)) (pTopMargin(Self)) (pBottomMargin(Self))
56382>>>>>>>>>>>>>>>>>      Send vpe_SelectFont (pFont(Self)) (pFontSize(Self))
56383>>>>>>>>>>>>>>>>>      Set pBold      to False
56384>>>>>>>>>>>>>>>>>      Set pUnderLine to False
56385>>>>>>>>>>>>>>>>>      Set pItalics   to False
56386>>>>>>>>>>>>>>>>>      Set pNewPageOnNextLine to 0
56387>>>>>>>>>>>>>>>>>    End
56387>>>>>>>>>>>>>>>>>>
56387>>>>>>>>>>>>>>>>>  End_Procedure
56388>>>>>>>>>>>>>>>>>   Procedure vpe_CloseDoc
56390>>>>>>>>>>>>>>>>>    DWord lhDoc
56390>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56391>>>>>>>>>>>>>>>>>    Move (VpeCloseDoc(lhDoc)) to Vpe$ReturnGrb#
56392>>>>>>>>>>>>>>>>>  End_Procedure
56393>>>>>>>>>>>>>>>>>   Procedure vpe_PreviewDoc
56395>>>>>>>>>>>>>>>>>    DWord lhDoc
56395>>>>>>>>>>>>>>>>>    String bypass#
56395>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56396>>>>>>>>>>>>>>>>>    Move (VpeSetPaperView(lhDoc,1)) to Vpe$ReturnGrb# // Display paper size
56397>>>>>>>>>>>>>>>>>    Move (VpePreviewDoc(lhDoc, VPE_NULL, VPE_SHOW_MAXIMIZED)) to Vpe$ReturnGrb#
56398>>>>>>>>>>>>>>>>>     Move "" to bypass#
56399>>>>>>>>>>>>>>>>>     Get_Profile_String "VEJMAN_SETUP" "OLD_PREVIEW" to bypass#
56402>>>>>>>>>>>>>>>>>     If (bypass# = "") Send Make_Visible to OG_Current_Object#
56405>>>>>>>>>>>>>>>>>  End_Procedure
56406>>>>>>>>>>>>>>>>>   Procedure PreviewDoc
56408>>>>>>>>>>>>>>>>>    DWord lhDoc
56408>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56409>>>>>>>>>>>>>>>>>    //JK (2000.04.11): VpeGotoPage replaced with VpeGotoVisualPage
56409>>>>>>>>>>>>>>>>>    //Move (VpeGotoPage(lhDoc,1)) to Vpe$ReturnGrb#
56409>>>>>>>>>>>>>>>>>    Move (VpeGotoVisualPage(lhDoc,1)) to Vpe$ReturnGrb#
56410>>>>>>>>>>>>>>>>>    Send vpe_PreviewDoc
56411>>>>>>>>>>>>>>>>>  End_Procedure
56412>>>>>>>>>>>>>>>>>   //JK (2000.04.11): Updates an open preview when the document has changed
56412>>>>>>>>>>>>>>>>>  // Warning: if the user closes the preview, the document will also be closed,
56412>>>>>>>>>>>>>>>>>  // and DispatchAllMessages will then return true.
56412>>>>>>>>>>>>>>>>>  // At that point you immediately have to end all printing activites or
56412>>>>>>>>>>>>>>>>>  // the program will crash!!!
56412>>>>>>>>>>>>>>>>>  Function DispatchAllMessages Returns Integer
56414>>>>>>>>>>>>>>>>>    DWord lhDoc
56414>>>>>>>>>>>>>>>>>    Integer bClosed
56414>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56415>>>>>>>>>>>>>>>>>    Move (VpeDispatchAllMessages(lhDoc)) to bClosed
56416>>>>>>>>>>>>>>>>>    Function_Return bClosed
56417>>>>>>>>>>>>>>>>>  End_Function
56418>>>>>>>>>>>>>>>>>   Procedure vpe_PrintDoc
56420>>>>>>>>>>>>>>>>>    DWord lhDoc
56420>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56421>>>>>>>>>>>>>>>>>    Move (VpePrintDoc(lhDoc, VPE_FALSE)) to Vpe$ReturnGrb#
56422>>>>>>>>>>>>>>>>>  End_Procedure
56423>>>>>>>>>>>>>>>>>   Procedure PrintDoc
56425>>>>>>>>>>>>>>>>>    DWord lhDoc
56425>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56426>>>>>>>>>>>>>>>>>    Move (VpePrintDoc(lhDoc, VPE_FALSE)) to Vpe$ReturnGrb#
56427>>>>>>>>>>>>>>>>>  End_Procedure
56428>>>>>>>>>>>>>>>>>   Procedure vpe_SetupPrinter string file# integer mode#
56430>>>>>>>>>>>>>>>>>    DWord lhDoc
56430>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56431>>>>>>>>>>>>>>>>>    Move (VpeSetupPrinter(lhDoc,file#,mode#)) to Vpe$ReturnGrb#
56432>>>>>>>>>>>>>>>>>  End_Procedure
56433>>>>>>>>>>>>>>>>>   //JK: Writes current document to specified file
56433>>>>>>>>>>>>>>>>>  Procedure vpe_WriteDoc String file#
56435>>>>>>>>>>>>>>>>>    DWord lhDoc
56435>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56436>>>>>>>>>>>>>>>>>    Move (VpeWriteDoc(lhDoc,file#)) to Vpe$ReturnGrb#
56437>>>>>>>>>>>>>>>>>  End_Procedure
56438>>>>>>>>>>>>>>>>>   //JK: Reads specified file into current document
56438>>>>>>>>>>>>>>>>>  Procedure vpe_ReadDoc String file#
56440>>>>>>>>>>>>>>>>>    DWord lhDoc
56440>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56441>>>>>>>>>>>>>>>>>    Move (VpeReadDoc(lhDoc,file#)) to Vpe$ReturnGrb#
56442>>>>>>>>>>>>>>>>>  End_Procedure
56443>>>>>>>>>>>>>>>>>   Function iTextHeight.is integer width# string str# returns integer
56445>>>>>>>>>>>>>>>>>    DWord lhDoc
56445>>>>>>>>>>>>>>>>>    Integer rval#
56445>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56446>>>>>>>>>>>>>>>>>    Get VPE_OemToChar str# to str#
56447>>>>>>>>>>>>>>>>>    Move (VpeRenderWrite(lhDoc,100,100,(100+width#),VFREE,str#)) to Vpe$ReturnGrb#
56448>>>>>>>>>>>>>>>>>    // Vpe$ReturnGrb# now contains info on whether autobreak occured
56448>>>>>>>>>>>>>>>>>    Move (VpeGet(lhDoc,VRENDERHEIGHT)) to rval#
56449>>>>>>>>>>>>>>>>>    Function_Return rval#
56450>>>>>>>>>>>>>>>>>  End_Function
56451>>>>>>>>>>>>>>>>>   Procedure Vpe_SetDevOrientation integer orient#
56453>>>>>>>>>>>>>>>>>    DWord lhDoc
56453>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56454>>>>>>>>>>>>>>>>>    Move (VpeSetDevOrientation(lhDoc,orient#)) to Vpe$ReturnGrb#
56455>>>>>>>>>>>>>>>>>  End_Procedure
56456>>>>>>>>>>>>>>>>>   Function Vpe_GetDevOrientation returns integer
56458>>>>>>>>>>>>>>>>>    DWord lhDoc
56458>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56459>>>>>>>>>>>>>>>>>    Function_Return (VpeGetDevOrientation(lhDoc))
56460>>>>>>>>>>>>>>>>>  End_Function
56461>>>>>>>>>>>>>>>>>   Procedure Vpe_SetPageOrientation integer orient#
56463>>>>>>>>>>>>>>>>>    DWord lhDoc
56463>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56464>>>>>>>>>>>>>>>>>    Move (VpeSetPageOrientation(lhDoc,orient#)) to Vpe$ReturnGrb#
56465>>>>>>>>>>>>>>>>>  End_Procedure
56466>>>>>>>>>>>>>>>>>   Function Vpe_GetPageOrientation returns integer
56468>>>>>>>>>>>>>>>>>    DWord lhDoc
56468>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56469>>>>>>>>>>>>>>>>>    Function_Return (VpeGetPageOrientation(lhDoc))
56470>>>>>>>>>>>>>>>>>  End_Function
56471>>>>>>>>>>>>>>>>>   Procedure SetupPrinter string tmpSetupFile#
56473>>>>>>>>>>>>>>>>>    DWord lhDoc
56473>>>>>>>>>>>>>>>>>    String SetupFile#
56473>>>>>>>>>>>>>>>>>    If num_arguments gt 0 Move tmpSetupFile# to SetupFile#
56476>>>>>>>>>>>>>>>>>    Else Get sDefaultSetupFileName to SetupFile#
56478>>>>>>>>>>>>>>>>>    If SetupFile# eq "" Get sDefaultSetupFileName to SetupFile#
56481>>>>>>>>>>>>>>>>>     send OpenDoc
56482>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56483>>>>>>>>>>>>>>>>>    Move (VpeSetupPrinter(lhDoc,SetupFile#,PRINTDLG_ALWAYS)) to Vpe$ReturnGrb#
56484>>>>>>>>>>>>>>>>>    Send vpe_CloseDoc
56485>>>>>>>>>>>>>>>>>  End_Procedure
56486>>>>>>>>>>>>>>>>>   // The procedures Write and WriteLn simulates the good old way of
56486>>>>>>>>>>>>>>>>>  // outputting to the printer.
56486>>>>>>>>>>>>>>>>>  Function AttributeString Returns String
56488>>>>>>>>>>>>>>>>>    Function_Return ("["+If(pBold(Self),"B ","BO ")+If(pUnderLine(Self),"U ","UO ")+If(pItalics(Self),"I ","IO ")+"]")
56489>>>>>>>>>>>>>>>>>  End_Function
56490>>>>>>>>>>>>>>>>>   Function AttributeString.iii integer lbBold integer lbItalics integer lbUnderline returns string
56492>>>>>>>>>>>>>>>>>    Function_Return ("["+If(lbBold,"B ","BO ")+If(lbUnderline,"U ","UO ")+If(lbItalics,"I","IO")+"]")
56493>>>>>>>>>>>>>>>>>  End_Function
56494>>>>>>>>>>>>>>>>>
56494>>>>>>>>>>>>>>>>>  // When something has been printed that is known to be one line, this
56494>>>>>>>>>>>>>>>>>  // function will tell you how many more lines may printed on the current
56494>>>>>>>>>>>>>>>>>  // page. In general the function will tell you how many more of the
56494>>>>>>>>>>>>>>>>>  // previous objects may be printed on the current page.
56494>>>>>>>>>>>>>>>>>   Function RemainingLines Returns integer
56496>>>>>>>>>>>>>>>>>    Integer wy1 wy2 wy3
56496>>>>>>>>>>>>>>>>>    DWord lhDoc
56496>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56497>>>>>>>>>>>>>>>>>    Move (VpeGet(lhDoc,VTOP))          to wy1
56498>>>>>>>>>>>>>>>>>    Move (VpeGet(lhDoc,VBOTTOM))       to wy2
56499>>>>>>>>>>>>>>>>>    Move (VpeGet(lhDoc,VBOTTOMMARGIN)) to wy3
56500>>>>>>>>>>>>>>>>>    If (wy1=wy2) Function_Return 999 // No lines have been written yet
56503>>>>>>>>>>>>>>>>>    Function_Return (wy3-wy2/Number(wy2-wy1))
56504>>>>>>>>>>>>>>>>>  End_Function
56505>>>>>>>>>>>>>>>>>   Function LinesPerPage Returns integer
56507>>>>>>>>>>>>>>>>>    Integer wy1 wy2 wy3 wy4
56507>>>>>>>>>>>>>>>>>    DWord lhDoc
56507>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56508>>>>>>>>>>>>>>>>>    Move (VpeGet(lhDoc,VTOP))          to wy1
56509>>>>>>>>>>>>>>>>>    Move (VpeGet(lhDoc,VBOTTOM))       to wy2
56510>>>>>>>>>>>>>>>>>    Move (VpeGet(lhDoc,VBOTTOMMARGIN)) to wy3
56511>>>>>>>>>>>>>>>>>    Move (VpeGet(lhDoc,VTOPMARGIN))    to wy4
56512>>>>>>>>>>>>>>>>>    If (wy1=wy2) Function_Return 999 // No lines have been written yet
56515>>>>>>>>>>>>>>>>>    Function_Return (wy3-wy4/Number(wy2-wy1)-1)
56516>>>>>>>>>>>>>>>>>  End_Function
56517>>>>>>>>>>>>>>>>>   Function CheckPage Integer Lins# Returns Integer
56519>>>>>>>>>>>>>>>>>    Function_Return (Lins#>RemainingLines(Self))
56520>>>>>>>>>>>>>>>>>  End_Function
56521>>>>>>>>>>>>>>>>>   Procedure vpe_PageBreak
56523>>>>>>>>>>>>>>>>>    DWord lhDoc
56523>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56524>>>>>>>>>>>>>>>>>    Move (VpePageBreak(lhDoc)) to Vpe$ReturnGrb#
56525>>>>>>>>>>>>>>>>>  End_Procedure
56526>>>>>>>>>>>>>>>>>   Procedure NewPage
56528>>>>>>>>>>>>>>>>>    DWord lhDoc
56528>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56529>>>>>>>>>>>>>>>>>    Move (VpePageBreak(lhDoc)) to Vpe$ReturnGrb#
56530>>>>>>>>>>>>>>>>>    Send ExportCurMargins
56531>>>>>>>>>>>>>>>>>    Set pNewPageOnNextLine to 0
56532>>>>>>>>>>>>>>>>>  End_Procedure
56533>>>>>>>>>>>>>>>>>   Procedure Write string str#
56535>>>>>>>>>>>>>>>>>    DWord lhDoc
56535>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56536>>>>>>>>>>>>>>>>>    Get VPE_OemToChar str# to str#
56537>>>>>>>>>>>>>>>>>    If (pNewPageOnNextLine(Self)=2) Send NewPage
56540>>>>>>>>>>>>>>>>>    If (CheckPage(Self,1)) Set pNewPageOnNextLine to 1
56543>>>>>>>>>>>>>>>>>    If (VpeGet(lhDoc,VBOTTOM)=VpeGet(lhDoc,VTOP)) ;        Move (VpePrint(lhDoc,pCurLeftMargin(Self),pCurTopMargin(Self),AttributeString(Self)+str#)) to Vpe$ReturnGrb#
56546>>>>>>>>>>>>>>>>>    //JK: hmm... shouldn't it be VpeGet(VRIGHT) and VpeGet(VTOP) ?!?
56546>>>>>>>>>>>>>>>>>    Else Move (VpePrint(lhDoc,VRIGHT,VTOP,AttributeString(Self)+str#)) to Vpe$ReturnGrb#
56548>>>>>>>>>>>>>>>>>  End_Procedure
56549>>>>>>>>>>>>>>>>>   Procedure WriteLn string str#
56551>>>>>>>>>>>>>>>>>    DWord lhDoc
56551>>>>>>>>>>>>>>>>>    Integer VTOP# VBOTTOM#
56551>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56552>>>>>>>>>>>>>>>>>    Send Write str#
56553>>>>>>>>>>>>>>>>>    Move (VpeGet(lhDoc,VTOP)) to VTOP#
56554>>>>>>>>>>>>>>>>>    Move (VpeGet(lhDoc,VBOTTOM)) to VBOTTOM#
56555>>>>>>>>>>>>>>>>>    Move (VpeSet(lhDoc,VTOP,VTOP#+VBOTTOM#-VTOP#)) to Vpe$ReturnGrb#
56556>>>>>>>>>>>>>>>>>    // These two lines are not equivalent ???
56556>>>>>>>>>>>>>>>>>  //Move (VpeSet(lhDoc,VTOP,      VBOTTOM#      )) To Vpe$ReturnGrb#
56556>>>>>>>>>>>>>>>>>    Move (VpeSet(lhDoc,VBOTTOM,VBOTTOM#+VBOTTOM#-VTOP#)) to Vpe$ReturnGrb#
56557>>>>>>>>>>>>>>>>>    Move (VpeSet(lhDoc,VRIGHT,pCurLeftMargin(Self))) to Vpe$ReturnGrb#
56558>>>>>>>>>>>>>>>>>    If (pNewPageOnNextLine(Self)=1) Set pNewPageOnNextLine to 2
56561>>>>>>>>>>>>>>>>>  End_Procedure
56562>>>>>>>>>>>>>>>>>   Procedure vpe_Write integer x1# integer y1# integer x2# integer y2# string str#
56564>>>>>>>>>>>>>>>>>    Integer lhDoc
56564>>>>>>>>>>>>>>>>>    Move str# to str#
56565>>>>>>>>>>>>>>>>>    If (str#<>"") Begin
56567>>>>>>>>>>>>>>>>>      //showln x1# ":" y1# ":" x2# ":" y2# ":" str#
56567>>>>>>>>>>>>>>>>>      Get phDoc to lhDoc
56568>>>>>>>>>>>>>>>>>      Get VPE_OemToChar str# to str#
56569>>>>>>>>>>>>>>>>>      Move (VpeWrite(lhDoc,x1#,y1#,x2#,y2#,str#)) to Vpe$ReturnGrb#
56570>>>>>>>>>>>>>>>>>    End
56570>>>>>>>>>>>>>>>>>>
56570>>>>>>>>>>>>>>>>>  End_Procedure
56571>>>>>>>>>>>>>>>>>   Procedure vpe_WriteRTF integer x1# integer y1# integer x2# integer y2# string str#
56573>>>>>>>>>>>>>>>>>     DWord lhDoc
56573>>>>>>>>>>>>>>>>>     Get phDoc to lhDoc
56574>>>>>>>>>>>>>>>>>     //Get VPE_OemToChar str# To str#
56574>>>>>>>>>>>>>>>>>     Move (VpeWriteRTF(lhDoc,x1#,y1#,x2#,y2#,str#)) to Vpe$ReturnGrb#
56575>>>>>>>>>>>>>>>>>  End_Procedure
56576>>>>>>>>>>>>>>>>>   Procedure GenericWrite integer x1# integer y1# integer x2# integer y2# string str#
56578>>>>>>>>>>>>>>>>>    Showln "GenericWrite should be vpe_Write"
56580>>>>>>>>>>>>>>>>>  End_Procedure
56581>>>>>>>>>>>>>>>>>   Procedure vpe_Line integer x1# integer y1# integer x2# integer y2#
56583>>>>>>>>>>>>>>>>>    DWord lhDoc
56583>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56584>>>>>>>>>>>>>>>>>    Move (VpeLine(lhDoc,x1#,y1#,x2#,y2#)) to Vpe$ReturnGrb#
56585>>>>>>>>>>>>>>>>>  End_Procedure
56586>>>>>>>>>>>>>>>>>  Procedure vpe_HorizontalLineKeepPos Integer tmpleft# Integer tmpright#
56588>>>>>>>>>>>>>>>>>    Integer left# right#
56588>>>>>>>>>>>>>>>>>    DWord lhDoc
56588>>>>>>>>>>>>>>>>>    If num_arguments gt 0 Move tmpleft# to left#
56591>>>>>>>>>>>>>>>>>    Else Move VLEFTMARGIN to left#
56593>>>>>>>>>>>>>>>>>    If num_arguments gt 1 Move tmpright# to right#
56596>>>>>>>>>>>>>>>>>    Else Move VRIGHTMARGIN to right#
56598>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56599>>>>>>>>>>>>>>>>>    Move (VpeStorePos(lhDoc)) to Vpe$ReturnGrb#
56600>>>>>>>>>>>>>>>>>    Send vpe_Line left# VBOTTOM right# VBOTTOM
56601>>>>>>>>>>>>>>>>>    Move (VpeRestorePos(lhDoc)) to Vpe$ReturnGrb#
56602>>>>>>>>>>>>>>>>>  End_Procedure
56603>>>>>>>>>>>>>>>>>   Procedure WriteLine integer tmpleft# integer tmpright#
56605>>>>>>>>>>>>>>>>>    Integer left# right#
56605>>>>>>>>>>>>>>>>>    DWord lhDoc
56605>>>>>>>>>>>>>>>>>    If num_arguments gt 0 Move tmpleft# to left#
56608>>>>>>>>>>>>>>>>>    Else Move VLEFTMARGIN to left#
56610>>>>>>>>>>>>>>>>>    If num_arguments gt 1 Move tmpright# to right#
56613>>>>>>>>>>>>>>>>>    Else Move VRIGHTMARGIN to right#
56615>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56616>>>>>>>>>>>>>>>>>    Move (VpeStorePos(lhDoc)) to Vpe$ReturnGrb#
56617>>>>>>>>>>>>>>>>>    Send vpe_Line left# VTOP right# VTOP
56618>>>>>>>>>>>>>>>>>    Move (VpeRestorePos(lhDoc)) to Vpe$ReturnGrb#
56619>>>>>>>>>>>>>>>>>  End_Procedure
56620>>>>>>>>>>>>>>>>>   Procedure vpe_Box integer x1# integer y1# integer x2# integer y2#
56622>>>>>>>>>>>>>>>>>    DWord lhDoc
56622>>>>>>>>>>>>>>>>>    If (x1# > x2#) Begin // Coordinates MUST be upper left, lower right.
56624>>>>>>>>>>>>>>>>>      Move x1# to lhDoc // Otherwise errors in pre-viewer.
56625>>>>>>>>>>>>>>>>>      Move x2# to x1#
56626>>>>>>>>>>>>>>>>>      Move lhDoc to x2#
56627>>>>>>>>>>>>>>>>>    End
56627>>>>>>>>>>>>>>>>>>
56627>>>>>>>>>>>>>>>>>    If (y1# > y2#) Begin
56629>>>>>>>>>>>>>>>>>      Move y1# to lhDoc
56630>>>>>>>>>>>>>>>>>      Move y2# to y1#
56631>>>>>>>>>>>>>>>>>      Move lhDoc to y2#
56632>>>>>>>>>>>>>>>>>    End
56632>>>>>>>>>>>>>>>>>>
56632>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56633>>>>>>>>>>>>>>>>>    Move (VpeBox(lhDoc,x1#,y1#,x2#,y2#)) to Vpe$ReturnGrb#
56634>>>>>>>>>>>>>>>>>  End_Procedure
56635>>>>>>>>>>>>>>>>>  Procedure vpe_Ellipse Integer x1# Integer y1# Integer x2# Integer y2#
56637>>>>>>>>>>>>>>>>>    DWord lhDoc
56637>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56638>>>>>>>>>>>>>>>>>    Move (VpeEllipse(lhDoc,x1#,y1#,x2#,y2#)) to Vpe$ReturnGrb#
56639>>>>>>>>>>>>>>>>>  End_Procedure
56640>>>>>>>>>>>>>>>>>  Procedure vpe_SetTransparentMode Integer onoff#
56642>>>>>>>>>>>>>>>>>    DWord lhDoc
56642>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56643>>>>>>>>>>>>>>>>>    Move (VpeSetTransparentMode(lhDoc,onoff#)) to Vpe$ReturnGrb#
56644>>>>>>>>>>>>>>>>>  End_Procedure
56645>>>>>>>>>>>>>>>>>  Procedure vpe_SetBkgColor Integer color#
56647>>>>>>>>>>>>>>>>>    DWord lhDoc
56647>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56648>>>>>>>>>>>>>>>>>    Move (VpeSetBkgColor(lhDoc,color#)) to Vpe$ReturnGrb#
56649>>>>>>>>>>>>>>>>>  End_Procedure
56650>>>>>>>>>>>>>>>>>  Procedure vpe_SetHatchStyle Integer hatch#
56652>>>>>>>>>>>>>>>>>    DWord lhDoc
56652>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56653>>>>>>>>>>>>>>>>>    Move (VpeSetHatchStyle(lhDoc,hatch#)) to Vpe$ReturnGrb#
56654>>>>>>>>>>>>>>>>>  End_Procedure
56655>>>>>>>>>>>>>>>>>  Procedure vpe_SetHatchColor Integer color#
56657>>>>>>>>>>>>>>>>>    DWord lhDoc
56657>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56658>>>>>>>>>>>>>>>>>    Move (VpeSetHatchColor(lhDoc,color#)) to Vpe$ReturnGrb#
56659>>>>>>>>>>>>>>>>>  End_Procedure
56660>>>>>>>>>>>>>>>>>   Procedure vpe_Print_Print integer x1# integer y1# string str#
56662>>>>>>>>>>>>>>>>>    DWord lhDoc
56662>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56663>>>>>>>>>>>>>>>>>    Get VPE_OemToChar str# to str#
56664>>>>>>>>>>>>>>>>>    Move (VpePrint(lhDoc,x1#,y1#,str#)) to Vpe$ReturnGrb#
56665>>>>>>>>>>>>>>>>>  End_Procedure
56666>>>>>>>>>>>>>>>>>   Procedure vpe_PrintBox integer x1# integer y1# string str#
56668>>>>>>>>>>>>>>>>>    DWord lhDoc
56668>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56669>>>>>>>>>>>>>>>>>    Get VPE_OemToChar str# to str#
56670>>>>>>>>>>>>>>>>>    Move (VpePrintBox(lhDoc,x1#,y1#,str#)) to Vpe$ReturnGrb#
56671>>>>>>>>>>>>>>>>>  End_Procedure
56672>>>>>>>>>>>>>>>>>  Procedure vpe_WriteBox Integer x1# Integer y1# Integer x2# Integer y2# String str#
56674>>>>>>>>>>>>>>>>>    DWord lhDoc
56674>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56675>>>>>>>>>>>>>>>>>    Get VPE_OemToChar str# to str#
56676>>>>>>>>>>>>>>>>>    Move (VpeWriteBox(lhDoc,x1#,y1#,x2#,y2#,str#)) to Vpe$ReturnGrb#
56677>>>>>>>>>>>>>>>>>  End_Procedure
56678>>>>>>>>>>>>>>>>>   Procedure Vpe_Polygon integer arrayhandle# integer length#
56680>>>>>>>>>>>>>>>>>    DWord lhDoc
56680>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56681>>>>>>>>>>>>>>>>>    Move (VpePolygon(lhDoc,arrayhandle#,length#)) to Vpe$ReturnGrb#
56682>>>>>>>>>>>>>>>>>  End_Procedure
56683>>>>>>>>>>>>>>>>>  Procedure Vpe_Polyline Integer arrayhandle# Integer length#
56685>>>>>>>>>>>>>>>>>    DWord lhDoc
56685>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56686>>>>>>>>>>>>>>>>>    Move (VpePolyline(lhDoc,arrayhandle#,length#)) to Vpe$ReturnGrb#
56687>>>>>>>>>>>>>>>>>  End_Procedure
56688>>>>>>>>>>>>>>>>> //External_Function32 VpePolyLine "VpePolyLine" Dword lhDoc Dword array# integer size# returns dword#
56688>>>>>>>>>>>>>>>>>//// long EXPO VpePolygon(long hDoc, POINT *pt, unsigned int size);
56688>>>>>>>>>>>>>>>>>//External_Function32 VpePolyLine "VpePolyLine" Dword lhDoc Dword array# integer size# returns dword#
56688>>>>>>>>>>>>>>>>>   Procedure vpe_SetAlign integer attr#
56690>>>>>>>>>>>>>>>>>    DWord lhDoc
56690>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56691>>>>>>>>>>>>>>>>>    Move (VpeSetAlign(lhDoc,attr#)) to Vpe$ReturnGrb#
56692>>>>>>>>>>>>>>>>>  End_Procedure
56693>>>>>>>>>>>>>>>>>  Procedure vpe_SetPen Integer size# Integer style# Integer color#
56695>>>>>>>>>>>>>>>>>    DWord lhDoc
56695>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56696>>>>>>>>>>>>>>>>>    Move (VpeSetPen(lhDoc,size#,style#,color#)) to Vpe$ReturnGrb#
56697>>>>>>>>>>>>>>>>>  End_Procedure
56698>>>>>>>>>>>>>>>>>  Procedure vpe_Picture Integer x1# Integer y1# Integer x2# Integer y2# String bmpstr# Integer flags#
56700>>>>>>>>>>>>>>>>>    DWord lhDoc
56700>>>>>>>>>>>>>>>>>    String path#
56700>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56701>>>>>>>>>>>>>>>>>     //JK - 2000.06.26:
56701>>>>>>>>>>>>>>>>>    // Check if bitmap really exists
56701>>>>>>>>>>>>>>>>>    // If it doesn't, don't try top print it.
56701>>>>>>>>>>>>>>>>>    // If it does, convert to full path/filename.
56701>>>>>>>>>>>>>>>>>    If (pos(sysconf(SYSCONF_DIR_SEPARATOR),bmpstr#) > 0) Begin
56703>>>>>>>>>>>>>>>>>      // File has path already
56703>>>>>>>>>>>>>>>>>      If (not(SEQ_FileExists(bmpstr#))) Procedure_Return
56706>>>>>>>>>>>>>>>>>    End
56706>>>>>>>>>>>>>>>>>>
56706>>>>>>>>>>>>>>>>>    Else Begin
56707>>>>>>>>>>>>>>>>>      // File has no path, so we search along dfpath
56707>>>>>>>>>>>>>>>>>      Move (SEQ_FindFileAlongDFPath(bmpstr#)) to path#
56708>>>>>>>>>>>>>>>>>      If (path# = "") Procedure_Return
56711>>>>>>>>>>>>>>>>>      Move (path# + sysconf(SYSCONF_DIR_SEPARATOR) + bmpstr#) to bmpstr#
56712>>>>>>>>>>>>>>>>>    End
56712>>>>>>>>>>>>>>>>>>
56712>>>>>>>>>>>>>>>>>     //JK - 2000.06.08:
56712>>>>>>>>>>>>>>>>>    // Dirty hack to always save bitmaps in the generated document
56712>>>>>>>>>>>>>>>>>    Move (flags# ior PIC_IN_FILE) to flags#
56713>>>>>>>>>>>>>>>>>    Move (VpePicture(lhDoc,x1#,y1#,x2#,y2#,bmpstr#,flags#)) to Vpe$ReturnGrb#
56714>>>>>>>>>>>>>>>>>  End_Procedure
56715>>>>>>>>>>>>>>>>>  Procedure vpe_PictureKeepPos Integer x1# Integer y1# Integer x2# Integer y2# String bmpstr# Integer flags#
56717>>>>>>>>>>>>>>>>>    DWord lhDoc
56717>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56718>>>>>>>>>>>>>>>>>    Move (VpeStorePos(lhDoc)) to Vpe$ReturnGrb#
56719>>>>>>>>>>>>>>>>>    Send vpe_Picture x1# y1# x2# y2# bmpstr# flags#
56720>>>>>>>>>>>>>>>>>    Move (VpeRestorePos(lhDoc)) to Vpe$ReturnGrb#
56721>>>>>>>>>>>>>>>>>  End_Procedure
56722>>>>>>>>>>>>>>>>>  Procedure vpe_StorePos
56724>>>>>>>>>>>>>>>>>    DWord lhDoc
56724>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56725>>>>>>>>>>>>>>>>>    Move (VpeStorePos(lhDoc)) to Vpe$ReturnGrb#
56726>>>>>>>>>>>>>>>>>  End_Procedure
56727>>>>>>>>>>>>>>>>>  Procedure vpe_RestorePos
56729>>>>>>>>>>>>>>>>>    DWord lhDoc
56729>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56730>>>>>>>>>>>>>>>>>    Move (VpeRestorePos(lhDoc)) to Vpe$ReturnGrb#
56731>>>>>>>>>>>>>>>>>  End_Procedure
56732>>>>>>>>>>>>>>>>>  Procedure vpe_DefineHeader Integer x1# Integer y1# Integer x2# Integer y2# String text#
56734>>>>>>>>>>>>>>>>>    DWord lhDoc
56734>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56735>>>>>>>>>>>>>>>>>    Move (VpeDefineHeader(lhDoc,x1#,y1#,x2#,y2#,text#)) to Vpe$ReturnGrb#
56736>>>>>>>>>>>>>>>>>  End_Procedure
56737>>>>>>>>>>>>>>>>>  Procedure vpe_DefineFooter Integer x1# Integer y1# Integer x2# Integer y2# String text#
56739>>>>>>>>>>>>>>>>>    DWord lhDoc
56739>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56740>>>>>>>>>>>>>>>>>    Move (VpeDefineFooter(lhDoc,x1#,y1#,x2#,y2#,text#)) to Vpe$ReturnGrb#
56741>>>>>>>>>>>>>>>>>  End_Procedure
56742>>>>>>>>>>>>>>>>>  Procedure vpe_SetTextColor DWord color#
56744>>>>>>>>>>>>>>>>>    DWord lhDoc
56744>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56745>>>>>>>>>>>>>>>>>    Move (VpeSetTextColor(lhDoc,color#)) to Vpe$ReturnGrb#
56746>>>>>>>>>>>>>>>>>  End_Procedure
56747>>>>>>>>>>>>>>>>>  Procedure vpe_SetDefOutRectSP Integer left# Integer top# Integer right# Integer bottom#
56749>>>>>>>>>>>>>>>>>    DWord lhDoc
56749>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56750>>>>>>>>>>>>>>>>>    Move (VpeSetDefOutRectSP(lhDoc,left#,top#,right#,bottom#)) to Vpe$ReturnGrb#
56751>>>>>>>>>>>>>>>>>  End_Procedure
56752>>>>>>>>>>>>>>>>>  Function vpe_GetCurrentPage Returns Integer
56754>>>>>>>>>>>>>>>>>    DWord lhDoc
56754>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56755>>>>>>>>>>>>>>>>>    Function_Return (VpeGetCurrentPage(lhDoc))
56756>>>>>>>>>>>>>>>>>  End_Function
56757>>>>>>>>>>>>>>>>>   Function vpe_GetPageCount returns integer
56759>>>>>>>>>>>>>>>>>    DWord lhDoc
56759>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56760>>>>>>>>>>>>>>>>>    Function_Return (VpeGetPageCount(lhDoc))
56761>>>>>>>>>>>>>>>>>  End_Function
56762>>>>>>>>>>>>>>>>>   Procedure vpe_GotoPage integer page#
56764>>>>>>>>>>>>>>>>>    DWord lhDoc
56764>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56765>>>>>>>>>>>>>>>>>    Move (VpeGotoPage(lhDoc,page#)) to Vpe$ReturnGrb#
56766>>>>>>>>>>>>>>>>>  End_Procedure
56767>>>>>>>>>>>>>>>>>  Procedure vpe_Addbookmark Integer parent# String title#
56769>>>>>>>>>>>>>>>>>    DWord lhDoc
56769>>>>>>>>>>>>>>>>>    Get phDoc to lhDoc
56770>>>>>>>>>>>>>>>>>//     Move (VpeAddBookmark(lhDoc,parent#,title#)) to Vpe$ReturnGrb#
56770>>>>>>>>>>>>>>>>>  End_Procedure
56771>>>>>>>>>>>>>>>>>   Function Vpe_DevEnumPaperBins Returns Integer
56773>>>>>>>>>>>>>>>>>    DWord hDoc#
56773>>>>>>>>>>>>>>>>>    Integer iVal
56773>>>>>>>>>>>>>>>>>    Get phDoc to hDoc#
56774>>>>>>>>>>>>>>>>>    Move (vpeDevEnumPaperBins(hDoc#)) to iVal
56775>>>>>>>>>>>>>>>>>    Function_Return iVal
56776>>>>>>>>>>>>>>>>>  End_Function
56777>>>>>>>>>>>>>>>>>   Function Vpe_GetDevPaperBinName Integer iIndex Returns String
56779>>>>>>>>>>>>>>>>>    DWord hDoc#
56779>>>>>>>>>>>>>>>>>    Integer iVal p2BinName
56779>>>>>>>>>>>>>>>>>    String sBinName
56779>>>>>>>>>>>>>>>>>    ZeroString 65 to sBinName
56780>>>>>>>>>>>>>>>>>    GetAddress of sBinName to p2BinName
56781>>>>>>>>>>>>>>>>>    Get phDoc to hDoc#
56782>>>>>>>>>>>>>>>>>    Move (vpeGetDevPaperBinName(hDoc#,iIndex,p2BinName,64)) to iVal
56783>>>>>>>>>>>>>>>>>    Function_Return sBinName
56784>>>>>>>>>>>>>>>>>  End_Function
56785>>>>>>>>>>>>>>>>>
56785>>>>>>>>>>>>>>>>> End_Class // cVPE
56786>>>>>>>>>>>>>>>>> 
56786>>>>>>>>>>>>>>>>>Integer oVPE#
56786>>>>>>>>>>>>>>>>>
56786>>>>>>>>>>>>>>>>>Object oVPE is a cVPE
56788>>>>>>>>>>>>>>>>>  Procedure display_previous_object
56791>>>>>>>>>>>>>>>>>    Showln ("Left/Right/Top/Bottom:"+String(GetCoord(oVPE#,VLeft))*String(GetCoord(oVPE#,VRight))*String(GetCoord(oVPE#,VTop))*String(GetCoord(oVPE#,VBottom)))
56793>>>>>>>>>>>>>>>>>  End_Procedure
56794>>>>>>>>>>>>>>>>>  Procedure display_stuff
56797>>>>>>>>>>>>>>>>>    Showln "****vpe_get*******************************************"
56799>>>>>>>>>>>>>>>>>    Showln ("Text: Left/Right/Top/Bottom:"+String(GetCoord(oVPE#,VLeft))*String(GetCoord(oVPE#,VRight))*String(GetCoord(oVPE#,VTop))*String(GetCoord(oVPE#,VBottom)))
56801>>>>>>>>>>>>>>>>>    Showln ("Marg: Left/Right/Top/Bottom:"+String(GetCoord(oVPE#,VLeftMargin))*String(GetCoord(oVPE#,VRightMargin))*String(GetCoord(oVPE#,VTopMargin))*String(GetCoord(oVPE#,VBottomMargin)))
56803>>>>>>>>>>>>>>>>>  End_Procedure
56804>>>>>>>>>>>>>>>>>  Move Self to oVPE#
56805>>>>>>>>>>>>>>>>>End_Object
56806>>>>>>>>>>>>>>> Object oOutputVPE is a cVPE
56808>>>>>>>>>>>>>>> End_Object
56809>>>>>>>>>>>>>>>
56809>>>>>>>>>>>>>>>
56809>>>>>>>>>>>>>>>Use Dates.utl    // Date manipulation for VDF
Including file: dates.utl    (C:\projects\BRS\VDFQuery\AppSrc\dates.utl)
56809>>>>>>>>>>>>>>>>>// **********************************************************************
56809>>>>>>>>>>>>>>>>>// Use Dates.utl    // Date manipulation for VDF and DF3.2
56809>>>>>>>>>>>>>>>>>//
56809>>>>>>>>>>>>>>>>>// by Sture Andersen (sa1@vd.dk)
56809>>>>>>>>>>>>>>>>>//
56809>>>>>>>>>>>>>>>>>// The file contains a number of global functions for manipulating
56809>>>>>>>>>>>>>>>>>// dates. The package may be used with DataFlex 3.1 and Visual DataFlex.
56809>>>>>>>>>>>>>>>>>// This package is public domain.
56809>>>>>>>>>>>>>>>>>//
56809>>>>>>>>>>>>>>>>>// The package file is accompanied by a Word document (dfutil.doc)
56809>>>>>>>>>>>>>>>>>// listing the functions and their use.
56809>>>>>>>>>>>>>>>>>//
56809>>>>>>>>>>>>>>>>>//
56809>>>>>>>>>>>>>>>>>// Create: Fri  06-06-1997 - Merger of s_utl020, 021, 022, 023, 024, 025.
56809>>>>>>>>>>>>>>>>>// Update: Thu  26-06-1997 - Fixes for strange behavior when date4_state is set.
56809>>>>>>>>>>>>>>>>>//                         - Addition of popup_calendar to VDF.
56809>>>>>>>>>>>>>>>>>//         Sun  29-06-1997 - Character mode popup calender.
56809>>>>>>>>>>>>>>>>>//         Fri  04-07-1997 - Function WeekToDate added.
56809>>>>>>>>>>>>>>>>>//         Thu  10-07-1997 - Fixes.
56809>>>>>>>>>>>>>>>>>//         Mon  11-08-1997 - WeekToDate fixed.
56809>>>>>>>>>>>>>>>>>//         Sun  24-08-1997 - Character mode popup calender finished.
56809>>>>>>>>>>>>>>>>>//         Mon  15-12-1997 - Procedure Request_Popup_Calendar added.
56809>>>>>>>>>>>>>>>>>//         Mon  29-12-1997 - Procedures ItemYear2to4, ItemDate2to4 and
56809>>>>>>>>>>>>>>>>>//                           ItemSysdate added.
56809>>>>>>>>>>>>>>>>>//         Mon  29-12-1997 - Procedures FieldYear2to4, FieldDate2to4 and
56809>>>>>>>>>>>>>>>>>//                           FieldSysdate added.
56809>>>>>>>>>>>>>>>>>//         Sun  01-02-1998 - Functions Module_Compile_Date and
56809>>>>>>>>>>>>>>>>>//                           Module_Compile_Time added.
56809>>>>>>>>>>>>>>>>>//         Wed  25-02-1998 - Request_Popup in calendar object now only
56809>>>>>>>>>>>>>>>>>//                           responds if entry_state of the calling object
56809>>>>>>>>>>>>>>>>>//                           is true (VDF version). (No apparent effect)
56809>>>>>>>>>>>>>>>>>//         Sat  28-03-1998 - Added the following functions:
56809>>>>>>>>>>>>>>>>>//                             TS_SysTime      TS_ExtractDate
56809>>>>>>>>>>>>>>>>>//                             TS_ExtractTime  TS_ConvertToString
56809>>>>>>>>>>>>>>>>>//         Tue  26-05-1998 - Procedure TS_UI_Update added
56809>>>>>>>>>>>>>>>>>//         Sat  01-08-1998 - mask_date_window taken into account
56809>>>>>>>>>>>>>>>>>//         Mon  10-08-1998 - Functions Module_Start_Date and
56809>>>>>>>>>>>>>>>>>//                           Module_Start_Time added.
56809>>>>>>>>>>>>>>>>>//         Wed  02-09-1998 - Parameter for Module_Start_Date removed
56809>>>>>>>>>>>>>>>>>//         Mon  12-10-1998 - Portuguese added
56809>>>>>>>>>>>>>>>>>//         Wed  04-11-1998 - TS_TimeEstimator class added
56809>>>>>>>>>>>>>>>>>//         Tue  29-12-1998 - Function DateAsString added
56809>>>>>>>>>>>>>>>>>//         Wed  13-01-1999 - Function DateWeekNumber changed according to
56809>>>>>>>>>>>>>>>>>//                           Kjetil Johanson
56809>>>>>>>>>>>>>>>>>//         Mon  18-01-1999 - Function DateWeekNumber changed according to
56809>>>>>>>>>>>>>>>>>//                           Kjetil Johanson (again)
56809>>>>>>>>>>>>>>>>>//         Tue  19-01-1999 - Changed procedure names in TS_TimeEstimator
56809>>>>>>>>>>>>>>>>>//                           class (Continue->TS_Continue and Pause->
56809>>>>>>>>>>>>>>>>>//                           TS_Pause)
56809>>>>>>>>>>>>>>>>>//         Thu  21-01-1999 - Procedures DateFormatAsString and DateFormatName
56809>>>>>>>>>>>>>>>>>//                           added.
56809>>>>>>>>>>>>>>>>>//                         - Procedures DateCurrentSeparator and
56809>>>>>>>>>>>>>>>>>//                           DateCurrentFormat added.
56809>>>>>>>>>>>>>>>>>//         Tue  13-04-1999 - Julian constants added: Jan1st1900, Jan1st2000
56809>>>>>>>>>>>>>>>>>//                           Jan1st1000 and Jan1st100
56809>>>>>>>>>>>>>>>>>//         Mon  26-04-1999 - Changed procedure FieldYear2to4 and ItemYear2to4
56809>>>>>>>>>>>>>>>>>//                           to trap 3 digit years.
56809>>>>>>>>>>>>>>>>>//         Wed  27-04-1999 - Changed Dutch abbriviated day names (to 2 characters)
56809>>>>>>>>>>>>>>>>>//         Sun  02-05-1999 - Added function TS_Compose2
56809>>>>>>>>>>>>>>>>>//                         - Fixed error in TS_ConvertToString
56809>>>>>>>>>>>>>>>>>//         Tue  01-06-1999 - Added procedure popup_no_export to calendar.
56809>>>>>>>>>>>>>>>>>//         Thu  15-06-1999 - Fixed Date4to2 function and exporting dates
56809>>>>>>>>>>>>>>>>>//                           from the calendar to forms with no form_margin.
56809>>>>>>>>>>>>>>>>>//         Tue  07-09-1999 - Added function DateAsText
56809>>>>>>>>>>>>>>>>>//         Wed  27-10-1999 - Temporary fix for Module_Compile_Date function
56809>>>>>>>>>>>>>>>>>//                           in combination with y2k.
56809>>>>>>>>>>>>>>>>>//         Wed  19-12-1999 - Function StringToDate added.
56809>>>>>>>>>>>>>>>>>//                         - Existing function DateAsString renamed to
56809>>>>>>>>>>>>>>>>>//                           DateToString.
56809>>>>>>>>>>>>>>>>>//         Mon  03-01-2000 - Fix for VDF4. Popup calendar on empty date field
56809>>>>>>>>>>>>>>>>>//                           would result in seeding the calendar on year 100.
56809>>>>>>>>>>>>>>>>>//                           This error was caused by the fact that VDF 4
56809>>>>>>>>>>>>>>>>>//                           ignores SYSDATE4_STATE such that the sysdate
56809>>>>>>>>>>>>>>>>>//                           command returns 03-01-100
56809>>>>>>>>>>>>>>>>>//         Wed  01-02-2000 - Define instead of #REPLACE
56809>>>>>>>>>>>>>>>>>//         Wed  23-08-2000 - Function TS_Module_Compile_Time added
56809>>>>>>>>>>>>>>>>>//         Sat  04-08-2001 - Function StringToDate in Dates.nui fixed by Paul
56809>>>>>>>>>>>>>>>>>//                           Cooling
56809>>>>>>>>>>>>>>>>>//         Sat  30-08-2003 - Odd date thing fixed by Wil van Antwherpen. (Search: **WvA:)
56809>>>>>>>>>>>>>>>>>//
56809>>>>>>>>>>>>>>>>>// NOTE:  There is language dependent string constants in this file.
56809>>>>>>>>>>>>>>>>>//        Currently there are sections for dutch, english, danish, swedish,
56809>>>>>>>>>>>>>>>>>//        norwegian, spanish, german and portuguese
56809>>>>>>>>>>>>>>>>>//
56809>>>>>>>>>>>>>>>>>//        These sections may be identified by searching the symbol LNG_DEFAULT
56809>>>>>>>>>>>>>>>>>//
56809>>>>>>>>>>>>>>>>>// ***********************************************************************
56809>>>>>>>>>>>>>>>>>Use Dates.nui    // Date routines (No User Interface)
56809>>>>>>>>>>>>>>>>>Use ErrorHnd.nui // cErrorHandlerRedirector class and oErrorHandlerQuiet object (No User Interface)
56809>>>>>>>>>>>>>>>>>
56809>>>>>>>>>>>>>>>>>define DATES_INCLUDE_POPUP for 1   // If set to 0 the popup calendar will not be included
56809>>>>>>>>>>>>>>>>>
56809>>>>>>>>>>>>>>>>>procedure ItemSysdate for desktop integer liItm
56811>>>>>>>>>>>>>>>>>  date ldDate
56811>>>>>>>>>>>>>>>>>  get value item liItm to ldDate
56812>>>>>>>>>>>>>>>>>  if ldDate eq 0 begin
56814>>>>>>>>>>>>>>>>>    sysdate4 ldDate
56815>>>>>>>>>>>>>>>>>    set changed_value item liItm to ldDate
56816>>>>>>>>>>>>>>>>>  end
56816>>>>>>>>>>>>>>>>>>
56816>>>>>>>>>>>>>>>>>end_procedure
56817>>>>>>>>>>>>>>>>>
56817>>>>>>>>>>>>>>>>>procedure ItemDate2to4 for desktop integer liItm
56819>>>>>>>>>>>>>>>>>  integer liYear
56819>>>>>>>>>>>>>>>>>  date ldDate ldNewDate
56819>>>>>>>>>>>>>>>>>  send ErrorHnd_Quiet_Activate
56820>>>>>>>>>>>>>>>>>  get value item liItm to ldDate
56821>>>>>>>>>>>>>>>>>  send ErrorHnd_Quiet_Deactivate
56822>>>>>>>>>>>>>>>>>
56822>>>>>>>>>>>>>>>>>  move (DateSegment(ldDate,DS_YEAR)) to liYear
56823>>>>>>>>>>>>>>>>>  if (liYear=0 and ldDate<>0) move (DateIncrement(ldDate,3,iSysYear())) to ldNewDate
56826>>>>>>>>>>>>>>>>>  else move ldDate to ldNewDate
56828>>>>>>>>>>>>>>>>>
56828>>>>>>>>>>>>>>>>>  move (Date2to4(ldNewDate)) to ldNewDate
56829>>>>>>>>>>>>>>>>>  move (DateSegment(ldNewDate,3)) to liYear
56830>>>>>>>>>>>>>>>>>  if (liYear>99 and liYear<1000) begin
56832>>>>>>>>>>>>>>>>>    error 15 // Illegal entry in this window
56833>>>>>>>>>>>>>>>>>>
56833>>>>>>>>>>>>>>>>>    procedure_return 1
56834>>>>>>>>>>>>>>>>>  end
56834>>>>>>>>>>>>>>>>>>
56834>>>>>>>>>>>>>>>>>  if ldNewDate ne ldDate set value item liItm to ldNewDate
56837>>>>>>>>>>>>>>>>>end_procedure
56838>>>>>>>>>>>>>>>>>
56838>>>>>>>>>>>>>>>>>procedure ItemYear2to4 for desktop integer liItm
56840>>>>>>>>>>>>>>>>>  integer liYear liNewYear
56840>>>>>>>>>>>>>>>>>  get value item liItm to liYear
56841>>>>>>>>>>>>>>>>>  if (liYear>99 and liYear<1000) begin
56843>>>>>>>>>>>>>>>>>    error 15 // Illegal entry in this window
56844>>>>>>>>>>>>>>>>>>
56844>>>>>>>>>>>>>>>>>    procedure_return 1
56845>>>>>>>>>>>>>>>>>  end
56845>>>>>>>>>>>>>>>>>>
56845>>>>>>>>>>>>>>>>>  move (Year2to4(liYear)) to liNewYear
56846>>>>>>>>>>>>>>>>>  if liNewYear ne liYear set value item liItm to liNewYear
56849>>>>>>>>>>>>>>>>>end_procedure
56850>>>>>>>>>>>>>>>>>
56850>>>>>>>>>>>>>>>>>
56850>>>>>>>>>>>>>>>>> register_procedure NotifyPopupCalendarChange date ldDate
56850>>>>>>>>>>>>>>>>> register_procedure NotifyPopupCalendarSelect date ldDate
56850>>>>>>>>>>>>>>>>>
56850>>>>>>>>>>>>>>>>>  use DFAllent
56850>>>>>>>>>>>>>>>>>  class calendar.textbox is a textbox
56851>>>>>>>>>>>>>>>>>    procedure construct_object
56853>>>>>>>>>>>>>>>>>      forward send construct_object
56855>>>>>>>>>>>>>>>>>      Set Auto_Size_State To DFFALSE
56856>>>>>>>>>>>>>>>>>      Set Justification_Mode To (JMODE_VCENTER+JMODE_CENTER)
56857>>>>>>>>>>>>>>>>>    end_procedure
56858>>>>>>>>>>>>>>>>>  end_class
56859>>>>>>>>>>>>>>>>>
56859>>>>>>>>>>>>>>>>>  register_object oBtn1
56859>>>>>>>>>>>>>>>>>  register_object oBtn6
56859>>>>>>>>>>>>>>>>>
56859>>>>>>>>>>>>>>>>>  class calendar.button is a button
56860>>>>>>>>>>>>>>>>>
56860>>>>>>>>>>>>>>>>>    procedure construct_object
56862>>>>>>>>>>>>>>>>>      forward send construct_object
56864>>>>>>>>>>>>>>>>>      set size to 15 18
56865>>>>>>>>>>>>>>>>>      on_key kleftarrow   send prev_day
56866>>>>>>>>>>>>>>>>>      on_key krightarrow  send next_day
56867>>>>>>>>>>>>>>>>>      on_key kuparrow     send prev_week
56868>>>>>>>>>>>>>>>>>      on_key kdownarrow   send next_week
56869>>>>>>>>>>>>>>>>>      property date pdAssignedDate public 0
56870>>>>>>>>>>>>>>>>>    end_procedure
56871>>>>>>>>>>>>>>>>>
56871>>>>>>>>>>>>>>>>>    procedure switch // This makes all 42 buttons act as if they are one focus
56873>>>>>>>>>>>>>>>>>      send activate to (oBtn1(self))
56874>>>>>>>>>>>>>>>>>    end_procedure
56875>>>>>>>>>>>>>>>>>    procedure switch_back
56877>>>>>>>>>>>>>>>>>      send activate to (oBtn6(self))
56878>>>>>>>>>>>>>>>>>    end_procedure
56879>>>>>>>>>>>>>>>>>
56879>>>>>>>>>>>>>>>>>    procedure mouse_down
56881>>>>>>>>>>>>>>>>>      integer lhSelf
56881>>>>>>>>>>>>>>>>>      forward send mouse_down
56883>>>>>>>>>>>>>>>>>      move self to lhSelf
56884>>>>>>>>>>>>>>>>>      delegate set pdCurrentDate to (pdAssignedDate(lhSelf))
56886>>>>>>>>>>>>>>>>>    end_procedure
56887>>>>>>>>>>>>>>>>>  end_class
56888>>>>>>>>>>>>>>>>>
56888>>>>>>>>>>>>>>>>>  desktop_section
56893>>>>>>>>>>>>>>>>>    object popup_calendar is a ModalPanel
56895>>>>>>>>>>>>>>>>>      set size to 160 250
56896>>>>>>>>>>>>>>>>>      property date    pdCurrentDate  public 0
56898>>>>>>>>>>>>>>>>>      property integer p_current_year  public -1
56900>>>>>>>>>>>>>>>>>      property integer p_current_month public -1
56902>>>>>>>>>>>>>>>>>      property integer pExportState    public 1
56904>>>>>>>>>>>>>>>>>
56904>>>>>>>>>>>>>>>>>      on_key key_ctrl+key_pgup send prev_year
56905>>>>>>>>>>>>>>>>>      on_key key_ctrl+key_pgdn send next_year
56906>>>>>>>>>>>>>>>>>      on_key          key_pgup send prev_month
56907>>>>>>>>>>>>>>>>>      on_key          key_pgdn send next_month
56908>>>>>>>>>>>>>>>>>      on_key key_ctrl+key_d    send go_today
56909>>>>>>>>>>>>>>>>>      on_key kcancel           send cancel
56910>>>>>>>>>>>>>>>>>
56910>>>>>>>>>>>>>>>>>      object oCont3d is a container3d
56912>>>>>>>>>>>>>>>>>        set location to 5 5
56913>>>>>>>>>>>>>>>>>        set size to 120 237
56914>>>>>>>>>>>>>>>>>        object oTextboxYear is a calendar.textbox
56916>>>>>>>>>>>>>>>>>          set location to 5 5
56917>>>>>>>>>>>>>>>>>          set size to 15 30
56918>>>>>>>>>>>>>>>>>          set border_style to BORDER_STATICEDGE
56919>>>>>>>>>>>>>>>>>          procedure display
56922>>>>>>>>>>>>>>>>>            set value to (p_current_year(self))
56923>>>>>>>>>>>>>>>>>          end_procedure
56924>>>>>>>>>>>>>>>>>        end_object
56925>>>>>>>>>>>>>>>>>        object oDaynameHeader is a container3d
56927>>>>>>>>>>>>>>>>>          set location to 5 39
56928>>>>>>>>>>>>>>>>>          set size to 15 126
56929>>>>>>>>>>>>>>>>>          set border_style to BORDER_STATICEDGE
56930>>>>>>>>>>>>>>>>>          procedure initialize
56933>>>>>>>>>>>>>>>>>            integer liItm
56933>>>>>>>>>>>>>>>>>            for liItm from 0 to 6
56939>>>>>>>>>>>>>>>>>>
56939>>>>>>>>>>>>>>>>>              object oTxt is a calendar.textbox
56941>>>>>>>>>>>>>>>>>                set size to 12 17
56942>>>>>>>>>>>>>>>>>                set location to 0 (liItm*17.6+1)
56943>>>>>>>>>>>>>>>>>                 set value to (left(DayName(liItm+1),3))
56944>>>>>>>>>>>>>>>>>              end_object
56945>>>>>>>>>>>>>>>>>            loop
56946>>>>>>>>>>>>>>>>>>
56946>>>>>>>>>>>>>>>>>          end_procedure
56947>>>>>>>>>>>>>>>>>          send initialize
56948>>>>>>>>>>>>>>>>>        end_object
56949>>>>>>>>>>>>>>>>>        object oWeekNumberHeader is a container3d
56951>>>>>>>>>>>>>>>>>          set location to 24 5
56952>>>>>>>>>>>>>>>>>          set size     to 89 30
56953>>>>>>>>>>>>>>>>>          set border_style to BORDER_STATICEDGE
56954>>>>>>>>>>>>>>>>>          object oObjIdArray is an array
56956>>>>>>>>>>>>>>>>>          end_object
56957>>>>>>>>>>>>>>>>>          procedure initialize
56960>>>>>>>>>>>>>>>>>            integer liItm lhObj
56960>>>>>>>>>>>>>>>>>            move (oObjIdArray(self)) to lhObj
56961>>>>>>>>>>>>>>>>>            for liItm from 0 to 5
56967>>>>>>>>>>>>>>>>>>
56967>>>>>>>>>>>>>>>>>              object oTxt is a textbox
56969>>>>>>>>>>>>>>>>>                set size to 15 30
56970>>>>>>>>>>>>>>>>>                set location to (liItm*15+1) 1
56971>>>>>>>>>>>>>>>>>                set value of lhObj item (item_count(lhObj)) to self
56972>>>>>>>>>>>>>>>>>              end_object
56973>>>>>>>>>>>>>>>>>            loop
56974>>>>>>>>>>>>>>>>>>
56974>>>>>>>>>>>>>>>>>          end_procedure
56975>>>>>>>>>>>>>>>>>          procedure display
56978>>>>>>>>>>>>>>>>>            integer liItm lhObj
56978>>>>>>>>>>>>>>>>>            date ldDate ldLastDate
56978>>>>>>>>>>>>>>>>>            move (oObjIdArray(self)) to lhObj
56979>>>>>>>>>>>>>>>>>            get pdCurrentDate to ldDate
56980>>>>>>>>>>>>>>>>>            move (FirstDayInMonth(ldDate)) to ldDate
56981>>>>>>>>>>>>>>>>>            move (LastDayInMonth(ldDate)) to ldLastDate
56982>>>>>>>>>>>>>>>>>            move (ldDate-DateDayNumber(ldDate)+1) to ldDate
56983>>>>>>>>>>>>>>>>>            for liItm from 0 to 5
56989>>>>>>>>>>>>>>>>>>
56989>>>>>>>>>>>>>>>>>              if (liItm*7+ldDate) le ldLastDate ;                set value of (integer(value(lhObj,liItm))) to (t.calendar.week*string(DateWeekNumber(liItm*7+ldDate)))
56992>>>>>>>>>>>>>>>>>              else set value of (integer(value(lhObj,liItm))) to ""
56994>>>>>>>>>>>>>>>>>            loop
56995>>>>>>>>>>>>>>>>>>
56995>>>>>>>>>>>>>>>>>          end_procedure
56996>>>>>>>>>>>>>>>>>          send initialize
56997>>>>>>>>>>>>>>>>>        end_object
56998>>>>>>>>>>>>>>>>>        object oDaysGrid is a container3d
57000>>>>>>>>>>>>>>>>>          set location to 23 39
57001>>>>>>>>>>>>>>>>>          set size     to 100 127
57002>>>>>>>>>>>>>>>>>          set border_style to BORDER_NONE
57003>>>>>>>>>>>>>>>>>          object oBtnArray is an array
57005>>>>>>>>>>>>>>>>>          end_object
57006>>>>>>>>>>>>>>>>>          procedure initialize
57009>>>>>>>>>>>>>>>>>            integer liRow liCol lhBtnArray
57009>>>>>>>>>>>>>>>>>            move (oBtnArray(self)) to lhBtnArray
57010>>>>>>>>>>>>>>>>>            for liRow from 0 to 5
57016>>>>>>>>>>>>>>>>>>
57016>>>>>>>>>>>>>>>>>              for liCol from 0 to 6
57022>>>>>>>>>>>>>>>>>>
57022>>>>>>>>>>>>>>>>>                object oBtn is a calendar.button
57024>>>>>>>>>>>>>>>>>                  set location to (liRow*15) (liCol*18)
57025>>>>>>>>>>>>>>>>>                  set value of lhBtnArray item (item_count(lhBtnArray)) to self
57026>>>>>>>>>>>>>>>>>                  on_item "" send move_value_out_ok
57027>>>>>>>>>>>>>>>>>                end_object
57028>>>>>>>>>>>>>>>>>              loop
57029>>>>>>>>>>>>>>>>>>
57029>>>>>>>>>>>>>>>>>            loop
57030>>>>>>>>>>>>>>>>>>
57030>>>>>>>>>>>>>>>>>          end_procedure
57031>>>>>>>>>>>>>>>>>          send initialize
57032>>>>>>>>>>>>>>>>>
57032>>>>>>>>>>>>>>>>>          procedure display.iii integer liItm integer liDay integer lbActivate
57035>>>>>>>>>>>>>>>>>            integer lhObj liCurrentDay
57035>>>>>>>>>>>>>>>>>            move (integer(value(oBtnArray(self),liItm))) to lhObj
57036>>>>>>>>>>>>>>>>>            move (DateSegment(pdCurrentDate(self),DS_DAY)) to liCurrentDay
57037>>>>>>>>>>>>>>>>>            if lbActivate begin
57039>>>>>>>>>>>>>>>>>              if liDay eq liCurrentDay send activate to lhObj
57042>>>>>>>>>>>>>>>>>            end
57042>>>>>>>>>>>>>>>>>>
57042>>>>>>>>>>>>>>>>>            else begin
57043>>>>>>>>>>>>>>>>>              if liDay begin
57045>>>>>>>>>>>>>>>>>                set value of lhObj to liDay
57046>>>>>>>>>>>>>>>>>                set visible_state of lhObj to DFTRUE
57047>>>>>>>>>>>>>>>>>                set pdAssignedDate of lhObj to (DateCompose(liDay,p_current_month(self),p_current_year(self)))
57048>>>>>>>>>>>>>>>>>              end
57048>>>>>>>>>>>>>>>>>>
57048>>>>>>>>>>>>>>>>>              else set visible_state of lhObj to DFFALSE
57050>>>>>>>>>>>>>>>>>            end
57050>>>>>>>>>>>>>>>>>>
57050>>>>>>>>>>>>>>>>>          end_procedure
57051>>>>>>>>>>>>>>>>>
57051>>>>>>>>>>>>>>>>>          procedure display integer lbActivate
57054>>>>>>>>>>>>>>>>>            integer liFirstItem liLastItem liItm liDay liDate
57054>>>>>>>>>>>>>>>>>            get pdCurrentDate to liDate
57055>>>>>>>>>>>>>>>>>            move (FirstDayInMonth(liDate)) to liDate
57056>>>>>>>>>>>>>>>>>            move (DateDayNumber(liDate)-1) to liFirstItem
57057>>>>>>>>>>>>>>>>>            // **WvA: 27-08-2003 VDF9.1 Needs the integer datevalue to be casted to
57057>>>>>>>>>>>>>>>>>            // a date before the expression can be evaluated.
57057>>>>>>>>>>>>>>>>>            move (LastDayInMonth(liDate)-date(liDate)+liFirstItem) to liLastItem
57058>>>>>>>>>>>>>>>>>            // **
57058>>>>>>>>>>>>>>>>>            ifnot lbActivate begin
57060>>>>>>>>>>>>>>>>>              for liItm from 0 to (liFirstItem-1)
57066>>>>>>>>>>>>>>>>>>
57066>>>>>>>>>>>>>>>>>                send display.iii liItm 0 0
57067>>>>>>>>>>>>>>>>>              loop
57068>>>>>>>>>>>>>>>>>>
57068>>>>>>>>>>>>>>>>>            end
57068>>>>>>>>>>>>>>>>>>
57068>>>>>>>>>>>>>>>>>            move 1 to liDay
57069>>>>>>>>>>>>>>>>>            for liItm from liFirstItem to liLastItem
57075>>>>>>>>>>>>>>>>>>
57075>>>>>>>>>>>>>>>>>              send display.iii liItm liDay lbActivate
57076>>>>>>>>>>>>>>>>>              increment liDay
57077>>>>>>>>>>>>>>>>>            loop
57078>>>>>>>>>>>>>>>>>>
57078>>>>>>>>>>>>>>>>>            ifnot lbActivate begin
57080>>>>>>>>>>>>>>>>>              for liItm from (liLastItem+1) to 41
57086>>>>>>>>>>>>>>>>>>
57086>>>>>>>>>>>>>>>>>                send display.iii liItm 0 0
57087>>>>>>>>>>>>>>>>>              loop
57088>>>>>>>>>>>>>>>>>>
57088>>>>>>>>>>>>>>>>>            end
57088>>>>>>>>>>>>>>>>>>
57088>>>>>>>>>>>>>>>>>          end_procedure
57089>>>>>>>>>>>>>>>>>        end_object
57090>>>>>>>>>>>>>>>>>        object oTxtMonth is a calendar.textbox
57092>>>>>>>>>>>>>>>>>          set size to 12 27
57093>>>>>>>>>>>>>>>>>          set location to 25 185
57094>>>>>>>>>>>>>>>>>          set value to t.calendar.month
57095>>>>>>>>>>>>>>>>>        end_object
57096>>>>>>>>>>>>>>>>>        object oBtn1 is a button
57098>>>>>>>>>>>>>>>>>          set size to 12 12
57099>>>>>>>>>>>>>>>>>          set location to 40 185
57100>>>>>>>>>>>>>>>>>          on_item "" send prev_month
57101>>>>>>>>>>>>>>>>>          set bitmap to "prev.bmp"
57102>>>>>>>>>>>>>>>>>          procedure switch_back
57105>>>>>>>>>>>>>>>>>            send display_main
57106>>>>>>>>>>>>>>>>>          end_procedure
57107>>>>>>>>>>>>>>>>>        end_object
57108>>>>>>>>>>>>>>>>>        object oBtn2 is a button
57110>>>>>>>>>>>>>>>>>          set size to 12 12
57111>>>>>>>>>>>>>>>>>          set location to 40 200
57112>>>>>>>>>>>>>>>>>          on_item "" send next_month
57113>>>>>>>>>>>>>>>>>          set bitmap to "next.bmp"
57114>>>>>>>>>>>>>>>>>        end_object
57115>>>>>>>>>>>>>>>>>        object oTxtYear is a calendar.textbox
57117>>>>>>>>>>>>>>>>>          set size to 12 27
57118>>>>>>>>>>>>>>>>>          set location to 70 185
57119>>>>>>>>>>>>>>>>>          set value to t.calendar.year
57120>>>>>>>>>>>>>>>>>        end_object
57121>>>>>>>>>>>>>>>>>        object oBtn3 is a button
57123>>>>>>>>>>>>>>>>>          set size to 12 12
57124>>>>>>>>>>>>>>>>>          set location to 85 185
57125>>>>>>>>>>>>>>>>>          on_item "" send prev_year
57126>>>>>>>>>>>>>>>>>          set bitmap to "prev.bmp"
57127>>>>>>>>>>>>>>>>>        end_object
57128>>>>>>>>>>>>>>>>>        object oBtn4 is a button
57130>>>>>>>>>>>>>>>>>          set size to 12 12
57131>>>>>>>>>>>>>>>>>          set location to 85 200
57132>>>>>>>>>>>>>>>>>          on_item "" send next_year
57133>>>>>>>>>>>>>>>>>          set bitmap to "next.bmp"
57134>>>>>>>>>>>>>>>>>        end_object
57135>>>>>>>>>>>>>>>>>      end_object
57136>>>>>>>>>>>>>>>>>      object oBtn5 is a button
57138>>>>>>>>>>>>>>>>>        set size to 14 60
57139>>>>>>>>>>>>>>>>>        set location to 129 115
57140>>>>>>>>>>>>>>>>>        on_item t.calendar.ok send move_value_out_ok
57141>>>>>>>>>>>>>>>>>      end_object
57142>>>>>>>>>>>>>>>>>      object oBtn6 is a button
57144>>>>>>>>>>>>>>>>>        set size to 14 60
57145>>>>>>>>>>>>>>>>>        set location to 129 182
57146>>>>>>>>>>>>>>>>>        on_item t.calendar.cancel send cancel
57147>>>>>>>>>>>>>>>>>        procedure switch
57150>>>>>>>>>>>>>>>>>          send display_main
57151>>>>>>>>>>>>>>>>>        end_procedure
57152>>>>>>>>>>>>>>>>>      end_object
57153>>>>>>>>>>>>>>>>>      procedure next_year
57156>>>>>>>>>>>>>>>>>        set pdCurrentDate to (DateIncrement(pdCurrentDate(self),DS_YEAR,1))
57157>>>>>>>>>>>>>>>>>        send display_main
57158>>>>>>>>>>>>>>>>>      end_procedure
57159>>>>>>>>>>>>>>>>>      procedure prev_year
57162>>>>>>>>>>>>>>>>>        set pdCurrentDate to (DateIncrement(pdCurrentDate(self),DS_YEAR,-1))
57163>>>>>>>>>>>>>>>>>        send display_main
57164>>>>>>>>>>>>>>>>>      end_procedure
57165>>>>>>>>>>>>>>>>>      procedure next_month
57168>>>>>>>>>>>>>>>>>        set pdCurrentDate to (DateIncrement(pdCurrentDate(self),DS_MONTH,1))
57169>>>>>>>>>>>>>>>>>        send display_main
57170>>>>>>>>>>>>>>>>>      end_procedure
57171>>>>>>>>>>>>>>>>>      procedure prev_month
57174>>>>>>>>>>>>>>>>>        set pdCurrentDate to (DateIncrement(pdCurrentDate(self),DS_MONTH,-1))
57175>>>>>>>>>>>>>>>>>        send display_main
57176>>>>>>>>>>>>>>>>>      end_procedure
57177>>>>>>>>>>>>>>>>>      procedure next_week
57180>>>>>>>>>>>>>>>>>        set pdCurrentDate to (DateIncrement(pdCurrentDate(self),DS_WEEK,1))
57181>>>>>>>>>>>>>>>>>        send display_main
57182>>>>>>>>>>>>>>>>>      end_procedure
57183>>>>>>>>>>>>>>>>>      procedure prev_week
57186>>>>>>>>>>>>>>>>>        set pdCurrentDate to (DateIncrement(pdCurrentDate(self),DS_WEEK,-1))
57187>>>>>>>>>>>>>>>>>        send display_main
57188>>>>>>>>>>>>>>>>>      end_procedure
57189>>>>>>>>>>>>>>>>>      procedure next_day
57192>>>>>>>>>>>>>>>>>        set pdCurrentDate to (DateIncrement(pdCurrentDate(self),DS_DAY,1))
57193>>>>>>>>>>>>>>>>>        send display_main
57194>>>>>>>>>>>>>>>>>      end_procedure
57195>>>>>>>>>>>>>>>>>      procedure prev_day
57198>>>>>>>>>>>>>>>>>        set pdCurrentDate to (DateIncrement(pdCurrentDate(self),DS_DAY,-1))
57199>>>>>>>>>>>>>>>>>        send display_main
57200>>>>>>>>>>>>>>>>>      end_procedure
57201>>>>>>>>>>>>>>>>>      procedure go_today
57204>>>>>>>>>>>>>>>>>        date ldDate
57204>>>>>>>>>>>>>>>>>        sysdate4 ldDate
57205>>>>>>>>>>>>>>>>>        set pdCurrentDate to ldDate
57206>>>>>>>>>>>>>>>>>        send display_main
57207>>>>>>>>>>>>>>>>>      end_procedure
57208>>>>>>>>>>>>>>>>>      property integer invoking_object_id public 0
57210>>>>>>>>>>>>>>>>>      procedure OnChange date ldDate
57213>>>>>>>>>>>>>>>>>        integer lhFocus lbDelegationMode
57213>>>>>>>>>>>>>>>>>        get invoking_object_id to lhFocus
57214>>>>>>>>>>>>>>>>>        if lhFocus gt desktop begin
57216>>>>>>>>>>>>>>>>>          get delegation_mode of lhFocus to lbDelegationMode
57217>>>>>>>>>>>>>>>>>          set delegation_mode of lhFocus to no_delegate_or_error
57218>>>>>>>>>>>>>>>>>          send NotifyPopupCalendarChange to lhFocus ldDate
57219>>>>>>>>>>>>>>>>>          set delegation_mode of lhFocus to lbDelegationMode
57220>>>>>>>>>>>>>>>>>        end
57220>>>>>>>>>>>>>>>>>>
57220>>>>>>>>>>>>>>>>>      end_procedure
57221>>>>>>>>>>>>>>>>>      procedure display
57224>>>>>>>>>>>>>>>>>        integer liDate liMonth liYear
57224>>>>>>>>>>>>>>>>>        get pdCurrentDate to liDate
57225>>>>>>>>>>>>>>>>>        send OnChange liDate
57226>>>>>>>>>>>>>>>>>        move (DateSegment(liDate,DS_YEAR)) to liYear
57227>>>>>>>>>>>>>>>>>        move (DateSegment(liDate,DS_MONTH)) to liMonth
57228>>>>>>>>>>>>>>>>>        if (p_current_year(self)<>liYear or p_current_month(self)<>liMonth) begin
57230>>>>>>>>>>>>>>>>>          set p_current_year to liYear
57231>>>>>>>>>>>>>>>>>          set p_current_month to liMonth
57232>>>>>>>>>>>>>>>>>          set value to (t.calendar.calendar_popup+", "+MonthName(liMonth))
57233>>>>>>>>>>>>>>>>>          send display to (oTextboxYear(oCont3d(self)))
57234>>>>>>>>>>>>>>>>>          send display to (oWeekNumberHeader(oCont3d(self)))
57235>>>>>>>>>>>>>>>>>          send display to (oDaysGrid(oCont3d(self))) 0
57236>>>>>>>>>>>>>>>>>        end
57236>>>>>>>>>>>>>>>>>>
57236>>>>>>>>>>>>>>>>>      end_procedure
57237>>>>>>>>>>>>>>>>>      procedure display_main
57240>>>>>>>>>>>>>>>>>        send display
57241>>>>>>>>>>>>>>>>>        send display to (oDaysGrid(oCont3d(self))) 1
57242>>>>>>>>>>>>>>>>>      end_procedure
57243>>>>>>>>>>>>>>>>>      procedure popup_no_export
57246>>>>>>>>>>>>>>>>>        set pExportState to DFFALSE
57247>>>>>>>>>>>>>>>>>        send popup
57248>>>>>>>>>>>>>>>>>        set pExportState to DFTRUE
57249>>>>>>>>>>>>>>>>>      end_procedure
57250>>>>>>>>>>>>>>>>>
57250>>>>>>>>>>>>>>>>>      procedure popup_group
57253>>>>>>>>>>>>>>>>>        integer lhFocus
57253>>>>>>>>>>>>>>>>>        date ldDate
57253>>>>>>>>>>>>>>>>>        move (focus(desktop)) to lhFocus
57254>>>>>>>>>>>>>>>>>        set invoking_object_id to lhFocus
57255>>>>>>>>>>>>>>>>>        get value of lhFocus item current to ldDate
57256>>>>>>>>>>>>>>>>>        ifnot (integer(ldDate)) move (dSysdate()) to ldDate
57259>>>>>>>>>>>>>>>>>        move (Date2to4(ldDate)) to ldDate
57260>>>>>>>>>>>>>>>>>        set pdCurrentDate to ldDate
57261>>>>>>>>>>>>>>>>>        send display
57262>>>>>>>>>>>>>>>>>        forward send popup_group
57264>>>>>>>>>>>>>>>>>        send display to (oDaysGrid(oCont3d(self))) 1
57265>>>>>>>>>>>>>>>>>      end_procedure
57266>>>>>>>>>>>>>>>>>
57266>>>>>>>>>>>>>>>>>      procedure move_value_out
57269>>>>>>>>>>>>>>>>>        integer lhFocus lbDelegationMode liMargin liDataType
57269>>>>>>>>>>>>>>>>>//      if (pExportState(self)) begin
57269>>>>>>>>>>>>>>>>>          get invoking_object_id to lhFocus
57270>>>>>>>>>>>>>>>>>          if lhFocus gt desktop begin
57272>>>>>>>>>>>>>>>>>            get delegation_mode of lhFocus to lbDelegationMode
57273>>>>>>>>>>>>>>>>>            set delegation_mode of lhFocus to no_delegate_or_error
57274>>>>>>>>>>>>>>>>>            send NotifyPopupCalendarSelect to lhFocus (pdCurrentDate(self))
57275>>>>>>>>>>>>>>>>>            get form_margin of lhFocus item current to liMargin
57276>>>>>>>>>>>>>>>>>            get form_datatype of lhFocus item current to liDataType
57277>>>>>>>>>>>>>>>>>            set delegation_mode of lhFocus to lbDelegationMode
57278>>>>>>>>>>>>>>>>>            if (pExportState(self)) begin
57280>>>>>>>>>>>>>>>>>              if (liMargin>=10 or liDataType=mask_date_window or liDataType=date_window) set value of lhFocus item current to (pdCurrentDate(self))
57283>>>>>>>>>>>>>>>>>              else             set value of lhFocus item current to (Date4to2(pdCurrentDate(self)))
57285>>>>>>>>>>>>>>>>>              set item_changed_state of lhFocus item current to DFTRUE
57286>>>>>>>>>>>>>>>>>            end
57286>>>>>>>>>>>>>>>>>>
57286>>>>>>>>>>>>>>>>>          end
57286>>>>>>>>>>>>>>>>>>
57286>>>>>>>>>>>>>>>>>//      end
57286>>>>>>>>>>>>>>>>>      end_procedure
57287>>>>>>>>>>>>>>>>>
57287>>>>>>>>>>>>>>>>>      procedure move_value_out_ok
57290>>>>>>>>>>>>>>>>>        send move_value_out
57291>>>>>>>>>>>>>>>>>        send deactivate
57292>>>>>>>>>>>>>>>>>      end_procedure
57293>>>>>>>>>>>>>>>>>
57293>>>>>>>>>>>>>>>>>      procedure request_popup
57296>>>>>>>>>>>>>>>>>        integer lhFocus liType lbDelegationMode
57296>>>>>>>>>>>>>>>>>        move (focus(desktop)) to lhFocus
57297>>>>>>>>>>>>>>>>>        if lhFocus gt desktop begin
57299>>>>>>>>>>>>>>>>>          get delegation_mode of lhFocus to lbDelegationMode
57300>>>>>>>>>>>>>>>>>          set delegation_mode of lhFocus to no_delegate_or_error
57301>>>>>>>>>>>>>>>>>          get form_datatype of lhFocus item current to liType
57302>>>>>>>>>>>>>>>>>          if (liType=date_window or liType=mask_date_window) send popup
57305>>>>>>>>>>>>>>>>>          set delegation_mode of lhFocus to lbDelegationMode
57306>>>>>>>>>>>>>>>>>        end
57306>>>>>>>>>>>>>>>>>>
57306>>>>>>>>>>>>>>>>>      end_procedure
57307>>>>>>>>>>>>>>>>>    end_object
57308>>>>>>>>>>>>>>>>>  end_desktop_section
57313>>>>>>>>>>>>>>>>>  // If the procedure below was not defined "for BaseClass" its symbolic
57313>>>>>>>>>>>>>>>>>  // substitute would become negative (because located on the desktop). This
57313>>>>>>>>>>>>>>>>>  // would result in the toolbar object not being able to handle it. Therefore:
57313>>>>>>>>>>>>>>>>>  procedure request_popup_calendar for BaseClass
57315>>>>>>>>>>>>>>>>>    send request_popup to (popup_calendar(self))
57316>>>>>>>>>>>>>>>>>  end_procedure
57317>>>>>>>>>>>>>>>>>  procedure popup_calendar_no_export
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
57319>>>>>>>>>>>>>>>>>    send popup_no_export to (popup_calendar(self))
57320>>>>>>>>>>>>>>>>>  end_procedure
57321>>>>>>>>>>>>>>>>>  register_procedure Add_Toolbar_Button_Bitmap string lsBmp string lsTip string lsStatusHelp integer liMsg integer lhObj
57321>>>>>>>>>>>>>>>>>  procedure Add_Calendar_tbButton integer lhToolButton
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
57323>>>>>>>>>>>>>>>>>    send Add_Toolbar_Button_Bitmap to lhToolButton "DfCalend.bmp" t.calendar.calendar_popup t.calendar.Activate msg_request_popup_calendar
57324>>>>>>>>>>>>>>>>>  end_procedure
57325>>>>>>>>>>>>>>>>> function s.calendar returns integer // Backwards compatible!!
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
57327>>>>>>>>>>>>>>>>>   function_return (popup_calendar(self))
57328>>>>>>>>>>>>>>>>> end_function
57329>>>>>>>>>>>>>>>>>
57329>>>>>>>>>>>>>>>>>// Karl,
57329>>>>>>>>>>>>>>>>>// Structure is as follows,
57329>>>>>>>>>>>>>>>>>//
57329>>>>>>>>>>>>>>>>>// //put this code in the top portion of the view code or in the program
57329>>>>>>>>>>>>>>>>>// code.
57329>>>>>>>>>>>>>>>>>//
57329>>>>>>>>>>>>>>>>>// Type SystemTime
57329>>>>>>>>>>>>>>>>>//   field SystemTime.iYear As Word
57329>>>>>>>>>>>>>>>>>//   field SystemTime.iMonth As Word
57329>>>>>>>>>>>>>>>>>//   field SystemTime.iDayOfWeek As Word
57329>>>>>>>>>>>>>>>>>//   field SystemTime.iDay As Word
57329>>>>>>>>>>>>>>>>>//   field SystemTime.iHour As Word
57329>>>>>>>>>>>>>>>>>//   field SystemTime.iMinute As Word
57329>>>>>>>>>>>>>>>>>//   field SystemTime.iSecond As Word
57329>>>>>>>>>>>>>>>>>//   field SystemTime.iMilliseconds As Word
57329>>>>>>>>>>>>>>>>>// End_Type
57329>>>>>>>>>>>>>>>>>//
57329>>>>>>>>>>>>>>>>>// external_function GetSystemTime "GetSystemTime" kernel32.dll Pointer lpGST Returns VOID_TYPE
57329>>>>>>>>>>>>>>>>>//
57329>>>>>>>>>>>>>>>>>// //put this code in an onClick or wherever
57329>>>>>>>>>>>>>>>>>// procedure onclick
57329>>>>>>>>>>>>>>>>>//   integer iRetVal
57329>>>>>>>>>>>>>>>>>//   string TimeData
57329>>>>>>>>>>>>>>>>>//   pointer GST
57329>>>>>>>>>>>>>>>>>//
57329>>>>>>>>>>>>>>>>>//   ZeroType SystemTime to TimeData
57329>>>>>>>>>>>>>>>>>//   getAddress from TimeData to GST
57329>>>>>>>>>>>>>>>>>//
57329>>>>>>>>>>>>>>>>>//   move (GetSystemTime(GST)) to iRetVal
57329>>>>>>>>>>>>>>>>>// end_procedure
57329>>>>>>>>>>>>>>>>>//
57329>>>>>>>>>>>>>>>>>// To extract the data from the Structure after calling the function use
57329>>>>>>>>>>>>>>>>>// the getbuff command as follows:
57329>>>>>>>>>>>>>>>>>//
57329>>>>>>>>>>>>>>>>>// getbuff from TimeData as SystemTime.IVAL to var
57329>>>>>>>>>>>>>>>>>//
57329>>>>>>>>>>>>>>>>>// where IVAL is one of the vars such as iYear or iDay, etc.
57329>>>>>>>>>>>>>>>>>//
57329>>>>>>>>>>>>>>>>>// OLIVER NELSON
57329>>>>>>>>>>>>>>>>>//
57329>>>>>>>>>>>>>>>>>//
57329>>>>>>>>>>>>>>>Use Files.utl    // Utilities for handling file related stuff
57329>>>>>>>>>>>>>>>Use MsgBox.utl   // obs procedure
57329>>>>>>>>>>>>>>>Use Seq_Chnl     // Defines global sequential device management operations (DAC)
57329>>>>>>>>>>>>>>>Use Language.pkg // Default language setup
57329>>>>>>>>>>>>>>>Use API_Attr.nui // Functions for querying API attributes (No User Interface)
57329>>>>>>>>>>>>>>>Use Strings.nui  // String manipulation for VDF (No User Interface)
57329>>>>>>>>>>>>>>>
57329>>>>>>>>>>>>>>>// ===========================================================================
57329>>>>>>>>>>>>>>>//          LANGUAGE DEPENDANT TEXT CONSTANTS
57329>>>>>>>>>>>>>>>// ===========================================================================
57329>>>>>>>>>>>>>>>
57329>>>>>>>>>>>>>>> define t.output.GoPg_Label     for "Go to page"
57329>>>>>>>>>>>>>>> define t.output.Find           for "Find"
57329>>>>>>>>>>>>>>> define t.output.Search_string  for "Search string"
57329>>>>>>>>>>>>>>> define t.output.Case_sensitive for "Case sensitive"
57329>>>>>>>>>>>>>>> define t.output.Searching      for "Searching for string..."
57329>>>>>>>>>>>>>>> define t.output.PressAnyKey    for "Press any key to interrupt"
57329>>>>>>>>>>>>>>> define t.output.CancelSearch   for "Cancel search?"
57329>>>>>>>>>>>>>>> define t.output.TextNotFound   for "' not found!"
57329>>>>>>>>>>>>>>> define t.output.NotToScreen    for "Not screen!"
57329>>>>>>>>>>>>>>> define t.output.Main1          for " &Exit"
57329>>>>>>>>>>>>>>> define t.output.Main1_1        for "&Exit\aEsc"
57329>>>>>>>>>>>>>>> define t.output.Main2          for " &Navigate"
57329>>>>>>>>>>>>>>> define t.output.Main2_1        for "&Prev. page \aPgUp"
57329>>>>>>>>>>>>>>> define t.output.Main2_2        for "&Next page \aPgDn"
57329>>>>>>>>>>>>>>> define t.output.Main2_3        for "16 lines &Up\a-"
57329>>>>>>>>>>>>>>> define t.output.Main2_4        for "16 lines &Down\a+"
57329>>>>>>>>>>>>>>> define t.output.Main2_5        for "First page \aCtrl+PgUp"
57329>>>>>>>>>>>>>>> define t.output.Main2_6        for "Last page \aCtrl+PgDn"
57329>>>>>>>>>>>>>>> define t.output.Main2_7        for "&Go to page\aAlt-G"
57329>>>>>>>>>>>>>>> define t.output.Main2_8        for "Line start\aHome"
57329>>>>>>>>>>>>>>> define t.output.Main2_9        for "Left"
57329>>>>>>>>>>>>>>> define t.output.Main2_10       for "Right"
57329>>>>>>>>>>>>>>> define t.output.Main2_11       for "Linie end\aEnd"
57329>>>>>>>>>>>>>>> define t.output.Main3          for " &Search"
57329>>>>>>>>>>>>>>> define t.output.Main3_1        for "&Search\aF2"
57329>>>>>>>>>>>>>>> define t.output.Main3_2        for "&Find next\aSF2"
57329>>>>>>>>>>>>>>> define t.output.Main4          for " &Print"
57329>>>>>>>>>>>>>>> define t.output.Main4_1        for "&Print report"
57329>>>>>>>>>>>>>>>
57329>>>>>>>>>>>>>>>// ===========================================================================
57329>>>>>>>>>>>>>>>//          CONSTANTS DECLARATIONS
57329>>>>>>>>>>>>>>>// ===========================================================================
57329>>>>>>>>>>>>>>>
57329>>>>>>>>>>>>>>>define DEST_NONE    for 0
57329>>>>>>>>>>>>>>>define DEST_PRINTER for 1
57329>>>>>>>>>>>>>>>define DEST_SCREEN  for 2
57329>>>>>>>>>>>>>>>define DEST_FILE    for 3
57329>>>>>>>>>>>>>>>define DEST_HTML    for 4
57329>>>>>>>>>>>>>>>define DEST_EDITOR  for 5
57329>>>>>>>>>>>>>>>define DEST_EMAIL   for 6
57329>>>>>>>>>>>>>>>
57329>>>>>>>>>>>>>>>define FILEEXISTS_CANCEL    for 0
57329>>>>>>>>>>>>>>>define FILEEXISTS_APPEND    for 1
57329>>>>>>>>>>>>>>>define FILEEXISTS_OVERWRITE for 2
57329>>>>>>>>>>>>>>>define FILEEXISTS_PROMPT    for 3 // Ask the operator
57329>>>>>>>>>>>>>>>
57329>>>>>>>>>>>>>>>// ===========================================================================
57329>>>>>>>>>>>>>>>//          BASIC OUTPUT CLASS
57329>>>>>>>>>>>>>>>// ===========================================================================
57329>>>>>>>>>>>>>>>
57329>>>>>>>>>>>>>>>indicator output$move_up?
57329>>>>>>>>>>>>>>>string    output$code
57329>>>>>>>>>>>>>>>string    output$symbollist 255
57329>>>>>>>>>>>>>>>integer   output$idx
57329>>>>>>>>>>>>>>>integer   seq.object#
57329>>>>>>>>>>>>>>>
57329>>>>>>>>>>>>>>>
57329>>>>>>>>>>>>>>>goto output$skip_definition
57330>>>>>>>>>>>>>>>>
57330>>>>>>>>>>>>>>>output$code_move:
57330>>>>>>>>>>>>>>>  Enumeration_List
57330>>>>>>>>>>>>>>>    output.define_code _nop             ""
57336>>>>>>>>>>>>>>>    output.define_code _initialize      ""
57342>>>>>>>>>>>>>>>    output.define_code _reset           ""
57348>>>>>>>>>>>>>>>    output.define_code _bold_on         ""
57354>>>>>>>>>>>>>>>    output.define_code _bold_off        ""
57360>>>>>>>>>>>>>>>    output.define_code _italics_on      ""
57366>>>>>>>>>>>>>>>    output.define_code _italics_off     ""
57372>>>>>>>>>>>>>>>    output.define_code _underline_on    ""
57378>>>>>>>>>>>>>>>    output.define_code _underline_off   ""
57384>>>>>>>>>>>>>>>    output.define_code _user_on         ""
57390>>>>>>>>>>>>>>>    output.define_code _user_off        ""
57396>>>>>>>>>>>>>>>    output.define_code _cpi10           ""
57402>>>>>>>>>>>>>>>    output.define_code _cpi12           ""
57408>>>>>>>>>>>>>>>    output.define_code _cpi17           ""
57414>>>>>>>>>>>>>>>    output.define_code _lpi03           ""
57420>>>>>>>>>>>>>>>    output.define_code _lpi06           ""
57426>>>>>>>>>>>>>>>    output.define_code _lpi08           ""
57432>>>>>>>>>>>>>>>    output.define_code _lpi12           ""
57438>>>>>>>>>>>>>>>    output.define_code _lpi72           ""
57444>>>>>>>>>>>>>>>    output.define_code _macro_def_pre   ""
57450>>>>>>>>>>>>>>>    output.define_code _macro_def_post  ""
57456>>>>>>>>>>>>>>>    output.define_code _macro_call_pre  ""
57462>>>>>>>>>>>>>>>    output.define_code _macro_call_post ""
57468>>>>>>>>>>>>>>>    output.define_code _macro_kill_pre  ""
57474>>>>>>>>>>>>>>>    output.define_code _macro_kill_post ""
57480>>>>>>>>>>>>>>>    output.define_code _paper_tray_1    ""
57486>>>>>>>>>>>>>>>    output.define_code _paper_tray_2    ""
57492>>>>>>>>>>>>>>>    output.define_code _paper_tray_3    ""
57498>>>>>>>>>>>>>>>    output.define_code _paper_tray_4    ""
57504>>>>>>>>>>>>>>>    output.define_code _pos_push        ""
57510>>>>>>>>>>>>>>>    output.define_code _pos_pop         ""
57516>>>>>>>>>>>>>>>  End_Enumeration_List
57516>>>>>>>>>>>>>>>return
57517>>>>>>>>>>>>>>>output$skip_definition:
57517>>>>>>>>>>>>>>>
57517>>>>>>>>>>>>>>>
57517>>>>>>>>>>>>>>>move "" to OUTPUT$SYMBOLLIST
57518>>>>>>>>>>>>>>>BUILD_CODE_SYMBOLS
57549>>>>>>>>>>>>>>>
57549>>>>>>>>>>>>>>>procedure output.get_code integer code#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
57551>>>>>>>>>>>>>>>  indicate output$move_up? true
57552>>>>>>>>>>>>>>>  move code# to output$idx
57553>>>>>>>>>>>>>>>  gosub output$code_move
57554>>>>>>>>>>>>>>>>
57554>>>>>>>>>>>>>>>end_procedure
57555>>>>>>>>>>>>>>>procedure output.set_code integer code#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
57557>>>>>>>>>>>>>>>  indicate output$move_up? false
57558>>>>>>>>>>>>>>>  move code# to output$idx
57559>>>>>>>>>>>>>>>  gosub output$code_move
57560>>>>>>>>>>>>>>>>
57560>>>>>>>>>>>>>>>end_procedure
57561>>>>>>>>>>>>>>>procedure output.zero_codes
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
57563>>>>>>>>>>>>>>>  integer code#
57563>>>>>>>>>>>>>>>  move "" to output$code
57564>>>>>>>>>>>>>>>  for code# from 0 to output$max_code
57570>>>>>>>>>>>>>>>>
57570>>>>>>>>>>>>>>>    send output.set_code code#
57571>>>>>>>>>>>>>>>  loop
57572>>>>>>>>>>>>>>>>
57572>>>>>>>>>>>>>>>end_procedure
57573>>>>>>>>>>>>>>>send output.zero_codes
57574>>>>>>>>>>>>>>>function output.replace_codes global string str# returns string
57576>>>>>>>>>>>>>>>  integer code#
57576>>>>>>>>>>>>>>>  string symb#
57576>>>>>>>>>>>>>>>  if "<" in str# begin
57578>>>>>>>>>>>>>>>    for code# from 0 to output$max_code
57584>>>>>>>>>>>>>>>>
57584>>>>>>>>>>>>>>>      send output.get_code code#
57585>>>>>>>>>>>>>>>      move (replaces(mid(output$symbollist,5,code#*5+1),str#,output$code)) to str#
57586>>>>>>>>>>>>>>>    loop
57587>>>>>>>>>>>>>>>>
57587>>>>>>>>>>>>>>>  end
57587>>>>>>>>>>>>>>>>
57587>>>>>>>>>>>>>>>  function_return str#
57588>>>>>>>>>>>>>>>end_function
57589>>>>>>>>>>>>>>>function output.remove_codes global string str# returns string
57591>>>>>>>>>>>>>>>  integer code#
57591>>>>>>>>>>>>>>>  string symb#
57591>>>>>>>>>>>>>>>  if "<" in str# begin
57593>>>>>>>>>>>>>>>    for code# from 0 to output$max_code
57599>>>>>>>>>>>>>>>>
57599>>>>>>>>>>>>>>>      move (replaces(mid(output$symbollist,5,code#*5+1),str#,"")) to str#
57600>>>>>>>>>>>>>>>    loop
57601>>>>>>>>>>>>>>>>
57601>>>>>>>>>>>>>>>  end
57601>>>>>>>>>>>>>>>>
57601>>>>>>>>>>>>>>>  function_return str#
57602>>>>>>>>>>>>>>>end_function
57603>>>>>>>>>>>>>>>
57603>>>>>>>>>>>>>>>class cBasicSequentialOutputEMailRecipients is a cArray
57604>>>>>>>>>>>>>>>  item_property_list
57604>>>>>>>>>>>>>>>    item_property string psName.i
57604>>>>>>>>>>>>>>>    item_property string psAddress.i
57604>>>>>>>>>>>>>>>  end_item_property_list cBasicSequentialOutputEMailRecipients
#REM 57636 DEFINE FUNCTION PSADDRESS.I INTEGER LIROW RETURNS STRING
#REM 57640 DEFINE PROCEDURE SET PSADDRESS.I INTEGER LIROW STRING VALUE
#REM 57644 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 57648 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
57653>>>>>>>>>>>>>>>  procedure add_recipient string lsName string lsAddress
57655>>>>>>>>>>>>>>>    integer liRow
57655>>>>>>>>>>>>>>>    get row_count to liRow
57656>>>>>>>>>>>>>>>    set psName.i    liRow to lsName
57657>>>>>>>>>>>>>>>    set psAddress.i liRow to lsAddress
57658>>>>>>>>>>>>>>>  end_procedure
57659>>>>>>>>>>>>>>>end_class // cBasicSequentialOutputEMailRecipients
57660>>>>>>>>>>>>>>>
57660>>>>>>>>>>>>>>>class cBasicSequentialOutput is a cArray
57661>>>>>>>>>>>>>>>  procedure construct_object integer img#
57663>>>>>>>>>>>>>>>    forward send construct_object img#
57665>>>>>>>>>>>>>>>    set delegation_mode to delegate_to_parent
57666>>>>>>>>>>>>>>>    move self to seq.object#
57667>>>>>>>>>>>>>>>    property string  pTitle            public "Un-titled"
57668>>>>>>>>>>>>>>>    property date    pInitDate         public 0
57669>>>>>>>>>>>>>>>    property string  pInitTime         public ""
57670>>>>>>>>>>>>>>>    property integer pDestination      public DEST_SCREEN
57671>>>>>>>>>>>>>>>
57671>>>>>>>>>>>>>>>    property integer pOutputChannel    public -1
57672>>>>>>>>>>>>>>>
57672>>>>>>>>>>>>>>>     property string  pPrinterPort     public "LPT1:"
57673>>>>>>>>>>>>>>>    property string  pOutFileName      public "dataflex.txt"
57674>>>>>>>>>>>>>>>    property string  pScreenTmpFile    public "" // Used when printing to screen AND *email*
57675>>>>>>>>>>>>>>>    property integer pFileExistsAction public FILEEXISTS_OVERWRITE // If set to FILEEXISTS_CANCEL the report will refuse to print to an existing file!
57676>>>>>>>>>>>>>>>    property integer pOmitFormFeed     public 0
57677>>>>>>>>>>>>>>>
57677>>>>>>>>>>>>>>>    property integer pLineCount        public 0
57678>>>>>>>>>>>>>>>    property integer pPageCount        public 0
57679>>>>>>>>>>>>>>>    property integer pPageLength       public 50 // 0 means continous
57680>>>>>>>>>>>>>>>    property integer pBytesWritten     public 0
57681>>>>>>>>>>>>>>>
57681>>>>>>>>>>>>>>>    property integer phMsg_Object      public 0
57682>>>>>>>>>>>>>>>
57682>>>>>>>>>>>>>>>    property integer pHeader_image     public 0
57683>>>>>>>>>>>>>>>    property integer pHeader_height    public 0 // number of lines in header.
57684>>>>>>>>>>>>>>>    property integer pHeader_msg       public 0
57685>>>>>>>>>>>>>>>
57685>>>>>>>>>>>>>>>    property integer pSubHeader_image  public 0
57686>>>>>>>>>>>>>>>    property integer pSubHeader_height public 0 // number of lines in subheader.
57687>>>>>>>>>>>>>>>    property integer pSubHeader_msg    public 0
57688>>>>>>>>>>>>>>>
57688>>>>>>>>>>>>>>>    property integer pFooter_image     public 0
57689>>>>>>>>>>>>>>>    property integer pFooter_height    public 0 // number of lines in footer.
57690>>>>>>>>>>>>>>>    property integer pFooter_msg       public 0
57691>>>>>>>>>>>>>>>    property integer pFooterFill_image public 0
57692>>>>>>>>>>>>>>>
57692>>>>>>>>>>>>>>>    property integer pOnceOnly_image   public 0
57693>>>>>>>>>>>>>>>    property integer pOnceOnly_height  public 0
57694>>>>>>>>>>>>>>>    property integer pOnceOnly_msg     public 0
57695>>>>>>>>>>>>>>>
57695>>>>>>>>>>>>>>>    property integer pInUseState       public false
57696>>>>>>>>>>>>>>>    property integer pWidth            public 77
57697>>>>>>>>>>>>>>>    property integer pbOemToAnsi       public 0
57698>>>>>>>>>>>>>>>
57698>>>>>>>>>>>>>>>    object oPageOffSets is an array no_image
57700>>>>>>>>>>>>>>>    end_object
57701>>>>>>>>>>>>>>>    object oChannelAdmin is a cChannelAdmin no_image
57703>>>>>>>>>>>>>>>    end_object
57704>>>>>>>>>>>>>>>     property integer pOriginalVPE_Object public 0
57705>>>>>>>>>>>>>>>    object oEmailRecipients is a cBasicSequentialOutputEMailRecipients
57707>>>>>>>>>>>>>>>    end_object
57708>>>>>>>>>>>>>>>    // ". /dfds01/appl/scripts/sendfile #F# #A#"
57708>>>>>>>>>>>>>>>    property string psSendMailProgramPath public ""
57709>>>>>>>>>>>>>>>  end_procedure
57710>>>>>>>>>>>>>>>
57710>>>>>>>>>>>>>>>  procedure add_recipient string lsName string lsAddress
57712>>>>>>>>>>>>>>>    send add_recipient to (oEmailRecipients(self)) lsName lsAddress
57713>>>>>>>>>>>>>>>  end_procedure
57714>>>>>>>>>>>>>>>
57714>>>>>>>>>>>>>>>  procedure reset_recipients
57716>>>>>>>>>>>>>>>    send delete_data to (oEmailRecipients(self))
57717>>>>>>>>>>>>>>>  end_procedure
57718>>>>>>>>>>>>>>>
57718>>>>>>>>>>>>>>>  function iUseSequentialChannel returns integer
57720>>>>>>>>>>>>>>>    integer destination#
57720>>>>>>>>>>>>>>>    get pDestination to destination#
57721>>>>>>>>>>>>>>>    function_return (destination#=DEST_FILE or destination#=DEST_HTML or destination#=DEST_EDITOR)
57722>>>>>>>>>>>>>>>  end_function // iUseSequentialChannel
57723>>>>>>>>>>>>>>>
57723>>>>>>>>>>>>>>>  function iPageBreakNeeded integer lines# returns integer
57725>>>>>>>>>>>>>>>    integer pageend#
57725>>>>>>>>>>>>>>>    get pPageLength to pageend#
57726>>>>>>>>>>>>>>>    if pageend# eq 0 function_return 0
57729>>>>>>>>>>>>>>>    function_return (lines#>(pageend#-pLineCount(self)-pFooter_height(self)))
57730>>>>>>>>>>>>>>>  end_function
57731>>>>>>>>>>>>>>>
57731>>>>>>>>>>>>>>>  function iAvailablePageLength returns integer
57733>>>>>>>>>>>>>>>    integer pageend# headerlines# subheaderlines# footerlines#
57733>>>>>>>>>>>>>>>    get pPageLength to pageend#
57734>>>>>>>>>>>>>>>    get pHeader_height to headerlines#
57735>>>>>>>>>>>>>>>    get pSubHeader_height to subheaderlines#
57736>>>>>>>>>>>>>>>    get pFooter_height to footerlines#
57737>>>>>>>>>>>>>>>    function_return (pageend#-headerlines#-subheaderlines#-footerlines#)
57738>>>>>>>>>>>>>>>  end_function
57739>>>>>>>>>>>>>>>
57739>>>>>>>>>>>>>>>  function Remaining_Lines returns integer
57741>>>>>>>>>>>>>>>    integer pageend# linecount# footerlines#
57741>>>>>>>>>>>>>>>    get pPageLength to pageend#
57742>>>>>>>>>>>>>>>    get pLineCount to linecount#
57743>>>>>>>>>>>>>>>    get pFooter_height to footerlines#
57744>>>>>>>>>>>>>>>    function_return (pageend#-linecount#-footerlines#)
57745>>>>>>>>>>>>>>>  end_function
57746>>>>>>>>>>>>>>>
57746>>>>>>>>>>>>>>>  function iResource_Reserve returns integer
57748>>>>>>>>>>>>>>>    integer ch1# ch2# rval# UseSequentialChannel#
57748>>>>>>>>>>>>>>>    get iUseSequentialChannel to UseSequentialChannel# // Do we need a channel?
57749>>>>>>>>>>>>>>>    if UseSequentialChannel# get Seq_New_Channel to ch1#
57752>>>>>>>>>>>>>>>    else move 0 to ch1#
57754>>>>>>>>>>>>>>>    get Seq_New_Channel to ch2#
57755>>>>>>>>>>>>>>>    move (ch1#>=0 and ch2#>=0) to rval#
57756>>>>>>>>>>>>>>>    if rval# begin
57758>>>>>>>>>>>>>>>      if UseSequentialChannel# set pOutputChannel to ch1#
57761>>>>>>>>>>>>>>>      set pChannel of (oChannelAdmin(self)) to ch2#
57762>>>>>>>>>>>>>>>    end
57762>>>>>>>>>>>>>>>>
57762>>>>>>>>>>>>>>>    else begin
57763>>>>>>>>>>>>>>>      if UseSequentialChannel# if ch1# ge 0 send Seq_Release_Channel ch1#
57768>>>>>>>>>>>>>>>      if ch2# ge 0 send Seq_Release_Channel ch2#
57771>>>>>>>>>>>>>>>    end
57771>>>>>>>>>>>>>>>>
57771>>>>>>>>>>>>>>>     set pOriginalVPE_Object to oVPE#
57772>>>>>>>>>>>>>>>     move (oOutputVPE(self)) to oVPE#
57773>>>>>>>>>>>>>>>    function_return rval#
57774>>>>>>>>>>>>>>>  end_function
57775>>>>>>>>>>>>>>>
57775>>>>>>>>>>>>>>>  procedure Resource_Release
57777>>>>>>>>>>>>>>>    if (iUseSequentialChannel(self)) ;        send Seq_Release_Channel (pOutputChannel(self))
57780>>>>>>>>>>>>>>>    send Seq_Release_Channel (pChannel(oChannelAdmin(self)))
57781>>>>>>>>>>>>>>>     get pOriginalVPE_Object to oVPE#
57782>>>>>>>>>>>>>>>  end_procedure
57783>>>>>>>>>>>>>>>
57783>>>>>>>>>>>>>>>  procedure Page_Eject_No_Footer.i integer ff#
57785>>>>>>>>>>>>>>>    integer obj# ch# Destination#
57785>>>>>>>>>>>>>>>    integer pos# UseSequentialChannel#
57785>>>>>>>>>>>>>>>    if (pLineCount(self)) begin
57787>>>>>>>>>>>>>>>      get iUseSequentialChannel to UseSequentialChannel#
57788>>>>>>>>>>>>>>>      if UseSequentialChannel# begin
57790>>>>>>>>>>>>>>>        get pOutputChannel to ch#
57791>>>>>>>>>>>>>>>        get_channel_position ch# to pos#
57792>>>>>>>>>>>>>>>>
57792>>>>>>>>>>>>>>>        set pBytesWritten to pos#
57793>>>>>>>>>>>>>>>      end
57793>>>>>>>>>>>>>>>>
57793>>>>>>>>>>>>>>>      get pDestination to Destination#
57794>>>>>>>>>>>>>>>      if Destination# eq DEST_SCREEN begin //screen
57796>>>>>>>>>>>>>>>          if ff# send vpe_PageBreak to oVPE#
57799>>>>>>>>>>>>>>>      end
57799>>>>>>>>>>>>>>>>
57799>>>>>>>>>>>>>>>      else begin
57800>>>>>>>>>>>>>>>        if UseSequentialChannel# begin
57802>>>>>>>>>>>>>>>          if ff# begin
57804>>>>>>>>>>>>>>>            if Destination# eq DEST_HTML write channel ch# (replace("#",'

',string(pPageCount(self))))
57808>>>>>>>>>>>>>>>            else write channel ch# (character(12))
57811>>>>>>>>>>>>>>>          end
57811>>>>>>>>>>>>>>>>
57811>>>>>>>>>>>>>>>        end
57811>>>>>>>>>>>>>>>>
57811>>>>>>>>>>>>>>>      end
57811>>>>>>>>>>>>>>>>
57811>>>>>>>>>>>>>>>      set pPageCount to (pPageCount(self)+1)
57812>>>>>>>>>>>>>>>      set pLineCount to 0
57813>>>>>>>>>>>>>>>      move 0 to linecount
57814>>>>>>>>>>>>>>>    end
57814>>>>>>>>>>>>>>>>
57814>>>>>>>>>>>>>>>  end_procedure
57815>>>>>>>>>>>>>>>
57815>>>>>>>>>>>>>>>  procedure page_eject.i integer ff#
57817>>>>>>>>>>>>>>>    integer line# linecount# pageend# footerlines# footer_img# footerfill_img#
57817>>>>>>>>>>>>>>>    get pLineCount to linecount#
57818>>>>>>>>>>>>>>>    if linecount# begin // only if something has been written
57820>>>>>>>>>>>>>>>      get pFooter_image to footer_img#
57821>>>>>>>>>>>>>>>      if footer_img# begin // If 'footer' has been set
57823>>>>>>>>>>>>>>>        get pPageLength to pageend#
57824>>>>>>>>>>>>>>>        get pFooter_height to footerlines#
57825>>>>>>>>>>>>>>>        get pFooterFill_image to footerfill_img#
57826>>>>>>>>>>>>>>>        for line# from linecount# to (pageend#-1-footerlines#)
57832>>>>>>>>>>>>>>>>
57832>>>>>>>>>>>>>>>          if footerfill_img# send output_image_aux footerfill_img#
57835>>>>>>>>>>>>>>>          else send writeln_no_headers ""
57837>>>>>>>>>>>>>>>        loop
57838>>>>>>>>>>>>>>>>
57838>>>>>>>>>>>>>>>        send message.i (pFooter_msg(self))
57839>>>>>>>>>>>>>>>        send output_image_aux footer_img#
57840>>>>>>>>>>>>>>>      end
57840>>>>>>>>>>>>>>>>
57840>>>>>>>>>>>>>>>      send page_eject_no_footer.i ff#
57841>>>>>>>>>>>>>>>    end
57841>>>>>>>>>>>>>>>>
57841>>>>>>>>>>>>>>>  end_procedure
57842>>>>>>>>>>>>>>>
57842>>>>>>>>>>>>>>>  procedure new_page
57844>>>>>>>>>>>>>>>    send page_eject.i 1
57845>>>>>>>>>>>>>>>  end_procedure
57846>>>>>>>>>>>>>>>
57846>>>>>>>>>>>>>>>  procedure cmdline_start
57848>>>>>>>>>>>>>>>  end_procedure
57849>>>>>>>>>>>>>>>  procedure cmdline_stop
57851>>>>>>>>>>>>>>>  end_procedure
57852>>>>>>>>>>>>>>>
57852>>>>>>>>>>>>>>>  function iPreconditions_Direct_Output returns integer
57854>>>>>>>>>>>>>>>    integer rval#
57854>>>>>>>>>>>>>>>    get iResource_Reserve to rval#
57855>>>>>>>>>>>>>>>    function_return rval#
57856>>>>>>>>>>>>>>>  end_function
57857>>>>>>>>>>>>>>>
57857>>>>>>>>>>>>>>>  function iDirect_Output returns integer
57859>>>>>>>>>>>>>>>    integer rval# dest# exists_action#
57859>>>>>>>>>>>>>>>    string tmp_fn# fn#
57859>>>>>>>>>>>>>>>    move 1 to rval#
57860>>>>>>>>>>>>>>>    if (iPreconditions_Direct_Output(self)) begin
57862>>>>>>>>>>>>>>>      get pDestination to dest#
57863>>>>>>>>>>>>>>>      set pInitDate to (dSysDate())
57864>>>>>>>>>>>>>>>      set pInitTime to (sSysTime())
57865>>>>>>>>>>>>>>>      if dest# eq DEST_PRINTER begin // Printer
57867>>>>>>>>>>>>>>>         set pOmitFormFeed to true
57868>>>>>>>>>>>>>>>          set pTitle of oVPE# to (pTitle(self))
57869>>>>>>>>>>>>>>>          send OpenDoc to oVPE#
57870>>>>>>>>>>>>>>>          send obs "Hello (test)"
57871>>>>>>>>>>>>>>>      end
57871>>>>>>>>>>>>>>>>
57871>>>>>>>>>>>>>>>      if dest# eq DEST_SCREEN begin // Screen
57873>>>>>>>>>>>>>>>         set pOmitFormFeed to true
57874>>>>>>>>>>>>>>>          set pTitle of oVPE# to (pTitle(self))
57875>>>>>>>>>>>>>>>          send OpenDoc to oVPE#
57876>>>>>>>>>>>>>>>      end
57876>>>>>>>>>>>>>>>>
57876>>>>>>>>>>>>>>>      if dest# eq DEST_FILE begin // File
57878>>>>>>>>>>>>>>>        get pOutFileName to fn#
57879>>>>>>>>>>>>>>>        move 2 to exists_action# // 0=cancel 1=append, 2=overwrite
57880>>>>>>>>>>>>>>>        if (SEQ_FileExists(fn#)) begin
57882>>>>>>>>>>>>>>>          get pFileExistsAction to exists_action#
57883>>>>>>>>>>>>>>>          // if exists_action# eq FILEEXISTS_PROMPT move (SEQ_FileExistsAction(fn#,1)) to exists_action#
57883>>>>>>>>>>>>>>>        end
57883>>>>>>>>>>>>>>>>
57883>>>>>>>>>>>>>>>        if exists_action# begin
57885>>>>>>>>>>>>>>>          if exists_action# eq 1 append_output channel (pOutputChannel(self)) ("cr: 13 eol: 10 "+fn#) //append
57889>>>>>>>>>>>>>>>          if exists_action# eq 2 direct_output channel (pOutputChannel(self)) ("cr: 13 eol: 10 "+fn#) //overwrite
57893>>>>>>>>>>>>>>>        end
57893>>>>>>>>>>>>>>>>
57893>>>>>>>>>>>>>>>        else move 0 to rval#
57895>>>>>>>>>>>>>>>      end
57895>>>>>>>>>>>>>>>>
57895>>>>>>>>>>>>>>>      if dest# eq DEST_EMAIL begin // EMAIL
57897>>>>>>>>>>>>>>>
57897>>>>>>>>>>>>>>>//        get SEQ_UniqueFileName "mail" to fn#
57897>>>>>>>>>>>>>>>        get SEQ_UniqueFileNamePathAndExt "" "mail" "txt" to fn#
57898>>>>>>>>>>>>>>>        if fn# ne "" begin
57900>>>>>>>>>>>>>>>          set pScreenTmpFile to fn#
57901>>>>>>>>>>>>>>>          if (API_OtherAttr_Value(OA_OS_SHORT_NAME)="WIN32CM") begin
57903>>>>>>>>>>>>>>>            direct_output channel (pOutputChannel(self)) fn#
57905>>>>>>>>>>>>>>>          end
57905>>>>>>>>>>>>>>>>
57905>>>>>>>>>>>>>>>          else begin
57906>>>>>>>>>>>>>>>            direct_output channel (pOutputChannel(self)) ("pc-text: "+fn#)
57908>>>>>>>>>>>>>>>          end
57908>>>>>>>>>>>>>>>>
57908>>>>>>>>>>>>>>>        end
57908>>>>>>>>>>>>>>>>
57908>>>>>>>>>>>>>>>        else begin
57909>>>>>>>>>>>>>>>          send obs "Outfile failure (source: output.utl)" "(E-mail)"
57910>>>>>>>>>>>>>>>          move 0 to rval#
57911>>>>>>>>>>>>>>>        end
57911>>>>>>>>>>>>>>>>
57911>>>>>>>>>>>>>>>      end
57911>>>>>>>>>>>>>>>>
57911>>>>>>>>>>>>>>>      if dest# eq DEST_HTML begin // HTML
57913>>>>>>>>>>>>>>>      end
57913>>>>>>>>>>>>>>>>
57913>>>>>>>>>>>>>>>      set pPageCount    to 0
57914>>>>>>>>>>>>>>>      set pBytesWritten to 0
57915>>>>>>>>>>>>>>>      set pLineCount    to 0
57916>>>>>>>>>>>>>>>    end
57916>>>>>>>>>>>>>>>>
57916>>>>>>>>>>>>>>>    else move 0 to rval#
57918>>>>>>>>>>>>>>>    if rval# begin
57920>>>>>>>>>>>>>>>      set pInUseState to true
57921>>>>>>>>>>>>>>>      send Report_Wait_On
57922>>>>>>>>>>>>>>>      send Initialize_Output
57923>>>>>>>>>>>>>>>    end
57923>>>>>>>>>>>>>>>>
57923>>>>>>>>>>>>>>>    else begin
57924>>>>>>>>>>>>>>>      set pInUseState to false
57925>>>>>>>>>>>>>>>      send Resource_Release
57926>>>>>>>>>>>>>>>    end
57926>>>>>>>>>>>>>>>>
57926>>>>>>>>>>>>>>>    function_return rval#
57927>>>>>>>>>>>>>>>  end_function
57928>>>>>>>>>>>>>>>  function iDirect_Output_Title string title# returns integer
57930>>>>>>>>>>>>>>>    integer rval#
57930>>>>>>>>>>>>>>>    set pTitle to title#
57931>>>>>>>>>>>>>>>    get iDirect_Output to rval#
57932>>>>>>>>>>>>>>>    if rval# begin
57934>>>>>>>>>>>>>>>      set pHeader_image to 0
57935>>>>>>>>>>>>>>>      set pHeader_height to 0
57936>>>>>>>>>>>>>>>      set pHeader_msg to 0
57937>>>>>>>>>>>>>>>      set pSubHeader_image to 0
57938>>>>>>>>>>>>>>>      set pSubHeader_height to 0
57939>>>>>>>>>>>>>>>      set pSubHeader_msg to 0
57940>>>>>>>>>>>>>>>      set pFooter_image to 0
57941>>>>>>>>>>>>>>>      set pFooter_height to 0
57942>>>>>>>>>>>>>>>      set pFooter_msg to 0
57943>>>>>>>>>>>>>>>      set pFooterFill_image to 0
57944>>>>>>>>>>>>>>>      set pOnceOnly_image to 0
57945>>>>>>>>>>>>>>>      set pOnceOnly_height to 0
57946>>>>>>>>>>>>>>>      set pOnceOnly_msg to 0
57947>>>>>>>>>>>>>>>    end
57947>>>>>>>>>>>>>>>>
57947>>>>>>>>>>>>>>>    function_return rval#
57948>>>>>>>>>>>>>>>  end_function
57949>>>>>>>>>>>>>>>  procedure Initialize_Output
57951>>>>>>>>>>>>>>>  end_procedure
57952>>>>>>>>>>>>>>>
57952>>>>>>>>>>>>>>>            procedure DoSendEmails string lsFile
57954>>>>>>>>>>>>>>>              integer lhEmailRecipients liMax liRow
57954>>>>>>>>>>>>>>>              string lsName lsAddress lsSendMailProgramPath
57954>>>>>>>>>>>>>>>
57954>>>>>>>>>>>>>>>              get psSendMailProgramPath to lsSendMailProgramPath
57955>>>>>>>>>>>>>>>              if (lsSendMailProgramPath<>"") begin
57957>>>>>>>>>>>>>>>
57957>>>>>>>>>>>>>>>                move (oEmailRecipients(self)) to lhEmailRecipients
57958>>>>>>>>>>>>>>>                get row_count of lhEmailRecipients to liMax
57959>>>>>>>>>>>>>>>                decrement liMax
57960>>>>>>>>>>>>>>>                for liRow from 0 to liMax
57966>>>>>>>>>>>>>>>>
57966>>>>>>>>>>>>>>>                  get psSendMailProgramPath to lsSendMailProgramPath
57967>>>>>>>>>>>>>>>                  move (replace("#A#",lsSendMailProgramPath,psAddress.i(lhEmailRecipients,liRow))) to lsSendMailProgramPath
57968>>>>>>>>>>>>>>>                  move (replace("#F#",lsSendMailProgramPath,lsFile)) to lsSendMailProgramPath
57969>>>>>>>>>>>>>>>                  //send obs lsSendMailProgramPath
57969>>>>>>>>>>>>>>>                  runprogram wait lsSendMailProgramPath
57970>>>>>>>>>>>>>>>                loop
57971>>>>>>>>>>>>>>>>
57971>>>>>>>>>>>>>>>              end
57971>>>>>>>>>>>>>>>>
57971>>>>>>>>>>>>>>>              else send obs "E-mail program path not specified."
57973>>>>>>>>>>>>>>>            end_procedure
57974>>>>>>>>>>>>>>>
57974>>>>>>>>>>>>>>>  procedure Close_Output
57976>>>>>>>>>>>>>>>    integer ch# dest# pos#
57976>>>>>>>>>>>>>>>    string lsFileName
57976>>>>>>>>>>>>>>>    if (pInUseState(self)) begin
57978>>>>>>>>>>>>>>>      if (pLineCount(self)) send page_eject.i (not(pOmitFormFeed(self)))
57981>>>>>>>>>>>>>>>
57981>>>>>>>>>>>>>>>      if (iUseSequentialChannel(self)) begin
57983>>>>>>>>>>>>>>>        send write_no_headers ""
57984>>>>>>>>>>>>>>>        get pOutputChannel to ch#
57985>>>>>>>>>>>>>>>        get_channel_position ch# to pos#
57986>>>>>>>>>>>>>>>>
57986>>>>>>>>>>>>>>>        set pBytesWritten to pos#
57987>>>>>>>>>>>>>>>        despool
57988>>>>>>>>>>>>>>>>
57988>>>>>>>>>>>>>>>        close_output channel ch#
57990>>>>>>>>>>>>>>>      end
57990>>>>>>>>>>>>>>>>
57990>>>>>>>>>>>>>>>
57990>>>>>>>>>>>>>>>      get pDestination to dest#
57991>>>>>>>>>>>>>>>      if dest# eq DEST_PRINTER begin
57993>>>>>>>>>>>>>>>        send cmdline_stop
57994>>>>>>>>>>>>>>>          send PrintDoc to oVPE#
57995>>>>>>>>>>>>>>>      end
57995>>>>>>>>>>>>>>>>
57995>>>>>>>>>>>>>>>      if dest# eq DEST_EMAIL begin
57997>>>>>>>>>>>>>>>        //send obs "Haps, min fine ven"
57997>>>>>>>>>>>>>>>        send report_wait_update "Sending e-mails..."
57998>>>>>>>>>>>>>>>        get pScreenTmpFile to lsFileName
57999>>>>>>>>>>>>>>>        get SEQ_ConvertToAbsoluteFileName lsFileName to lsFileName
58000>>>>>>>>>>>>>>>        send DoSendEmails lsFileName
58001>>>>>>>>>>>>>>>        erasefile lsFileName
58002>>>>>>>>>>>>>>>>
58002>>>>>>>>>>>>>>>      end
58002>>>>>>>>>>>>>>>>
58002>>>>>>>>>>>>>>>      send report_wait_off
58003>>>>>>>>>>>>>>>      if dest# eq DEST_SCREEN begin
58005>>>>>>>>>>>>>>>          send PreviewDoc to oVPE#
58006>>>>>>>>>>>>>>>      end
58006>>>>>>>>>>>>>>>>
58006>>>>>>>>>>>>>>>      else send report_done
58008>>>>>>>>>>>>>>>      set pInUseState to false
58009>>>>>>>>>>>>>>>      send Resource_Release
58010>>>>>>>>>>>>>>>    end
58010>>>>>>>>>>>>>>>>
58010>>>>>>>>>>>>>>>
58010>>>>>>>>>>>>>>>  end_procedure
58011>>>>>>>>>>>>>>>
58011>>>>>>>>>>>>>>>  procedure message.i integer msg#
58013>>>>>>>>>>>>>>>    integer lhObj
58013>>>>>>>>>>>>>>>    if msg# begin
58015>>>>>>>>>>>>>>>      get phMsg_Object to lhObj
58016>>>>>>>>>>>>>>>      if lhObj send msg# to lhObj
58019>>>>>>>>>>>>>>>      else send msg#
58021>>>>>>>>>>>>>>>    end
58021>>>>>>>>>>>>>>>>
58021>>>>>>>>>>>>>>>  end_procedure
58022>>>>>>>>>>>>>>>
58022>>>>>>>>>>>>>>>  function replace_header_codes string str# returns string
58024>>>>>>>>>>>>>>>    integer pagecount#
58024>>>>>>>>>>>>>>>    date date#
58024>>>>>>>>>>>>>>>    string page#
58024>>>>>>>>>>>>>>>    get pInitDate to date#
58025>>>>>>>>>>>>>>>    move (pPageCount(self)+1) to pagecount#
58026>>>>>>>>>>>>>>>    move (replaces("",str#,string(date#))) to str#
58027>>>>>>>>>>>>>>>    move (replaces("",str#,pInitTime(self))) to str# //time
58028>>>>>>>>>>>>>>>    if "" in str# begin // page number
58030>>>>>>>>>>>>>>>      move pagecount# to page#
58031>>>>>>>>>>>>>>>      if pagecount# le 999 insert " " in page# at 1
58035>>>>>>>>>>>>>>>      pad page# to page# 4
58037>>>>>>>>>>>>>>>>
58037>>>>>>>>>>>>>>>      move (replaces("",str#,page#)) to str# //time
58038>>>>>>>>>>>>>>>    end
58038>>>>>>>>>>>>>>>>
58038>>>>>>>>>>>>>>>    if "
" in str# begin // page number
58040>>>>>>>>>>>>>>>      move pagecount# to page#
58041>>>>>>>>>>>>>>>      if pagecount# le 99 insert " " in page# at 1
58045>>>>>>>>>>>>>>>      if pagecount# le  9 insert " " in page# at 1
58049>>>>>>>>>>>>>>>      move (replaces("
",str#,page#)) to str#
58050>>>>>>>>>>>>>>>    end
58050>>>>>>>>>>>>>>>>
58050>>>>>>>>>>>>>>>    function_return str#
58051>>>>>>>>>>>>>>>  end_function
58052>>>>>>>>>>>>>>>
58052>>>>>>>>>>>>>>>  function replace_codes string str# returns string
58054>>>>>>>>>>>>>>>    // If e-mail remove codes, else insert code values
58054>>>>>>>>>>>>>>>    if (pDestination(self)=DEST_EMAIL) function_return (output.replace_codes(str#))
58057>>>>>>>>>>>>>>>    function_return (output.remove_codes(str#))
58058>>>>>>>>>>>>>>>  end_function
58059>>>>>>>>>>>>>>>
58059>>>>>>>>>>>>>>>  procedure output_image_help integer img# integer header_codes#
58061>>>>>>>>>>>>>>>    integer seqeof# obj# ch#
58061>>>>>>>>>>>>>>>    string str#
58061>>>>>>>>>>>>>>>    move (seqeof) to seqeof#
58062>>>>>>>>>>>>>>>    move (oChannelAdmin(self)) to obj#
58063>>>>>>>>>>>>>>>    get pChannel of obj# to ch#
58064>>>>>>>>>>>>>>>    send direct_xput to obj# 1 ("image: "+string(img#))
58065>>>>>>>>>>>>>>>    repeat
58065>>>>>>>>>>>>>>>>
58065>>>>>>>>>>>>>>>      readln channel ch# str#
58067>>>>>>>>>>>>>>>      [~seqeof] begin
58069>>>>>>>>>>>>>>>>
58069>>>>>>>>>>>>>>>        if header_codes# send writeln_no_headers (replace_header_codes(self,str#))
58072>>>>>>>>>>>>>>>        else send writeln str#
58074>>>>>>>>>>>>>>>      end
58074>>>>>>>>>>>>>>>>
58074>>>>>>>>>>>>>>>    [~seqeof] loop
58075>>>>>>>>>>>>>>>>
58075>>>>>>>>>>>>>>>    send close_xput to obj#
58076>>>>>>>>>>>>>>>    indicate seqeof as seqeof#
58077>>>>>>>>>>>>>>>  end_procedure
58078>>>>>>>>>>>>>>>
58078>>>>>>>>>>>>>>>  procedure output_image_aux integer img#
58080>>>>>>>>>>>>>>>    send output_image_help img# 1
58081>>>>>>>>>>>>>>>  end_procedure
58082>>>>>>>>>>>>>>>
58082>>>>>>>>>>>>>>>  procedure output_image integer img# integer check_space_tmp#
58084>>>>>>>>>>>>>>>    integer check_space#
58084>>>>>>>>>>>>>>>    if num_arguments gt 1 move check_space_tmp# to check_space#
58087>>>>>>>>>>>>>>>    else move 0 to check_space#
58089>>>>>>>>>>>>>>>    if (iPageBreakNeeded(self,check_space#)) send page_eject.i 0
58092>>>>>>>>>>>>>>>    send output_image_help img# 0
58093>>>>>>>>>>>>>>>  end_procedure
58094>>>>>>>>>>>>>>>
58094>>>>>>>>>>>>>>>  procedure output_image_wrap integer img# // Won't work! (BLANKFORM img#)
58096>>>>>>>>>>>>>>>    send output_image_help img# 0
58098>>>>>>>>>>>>>>>    indicate copy_122 as [ |122]
58099>>>>>>>>>>>>>>>    send output_image img#
58102>>>>>>>>>>>>>>>    indicate copy_122 as [ |122]
58103>>>>>>>>>>>>>>>    [not copy_122] repeat
58105>>>>>>>>>>>>>>>>
58105>>>>>>>>>>>>>>>      send output_image img#
58107>>>>>>>>>>>>>>>      indicate copy_122 as [ |122]
58108>>>>>>>>>>>>>>>    [not copy_122] loop
58109>>>>>>>>>>>>>>>>
58109>>>>>>>>>>>>>>>  end_procedure
58110>>>>>>>>>>>>>>>
58110>>>>>>>>>>>>>>>  procedure write.i string str# integer do_headers#
58112>>>>>>>>>>>>>>>    integer header_img# subheader_img# onceonly_img# pagecount# pageend#
58112>>>>>>>>>>>>>>>    string page_init#
58112>>>>>>>>>>>>>>>    if do_headers# begin
58114>>>>>>>>>>>>>>>      get pHeader_image    to header_img#
58115>>>>>>>>>>>>>>>      get pSubHeader_image to subheader_img#
58116>>>>>>>>>>>>>>>      get pOnceOnly_image  to onceonly_img#
58117>>>>>>>>>>>>>>>      get pPageCount       to pagecount#
58118>>>>>>>>>>>>>>>      get pPageLength      to pageend#
58119>>>>>>>>>>>>>>>
58119>>>>>>>>>>>>>>>      if (iPageBreakNeeded(self,1)) send page_eject.i 0
58122>>>>>>>>>>>>>>>
58122>>>>>>>>>>>>>>>      // if we are at the top of a new page print header and subheader:
58122>>>>>>>>>>>>>>>      if (pLineCount(self)) eq 0 begin
58124>>>>>>>>>>>>>>>
58124>>>>>>>>>>>>>>>        send message.i (pHeader_msg(self))
58125>>>>>>>>>>>>>>>        if header_img# send output_image_aux header_img#
58128>>>>>>>>>>>>>>>
58128>>>>>>>>>>>>>>>        send message.i (pSubHeader_msg(self))
58129>>>>>>>>>>>>>>>        if subheader_img# send output_image_aux subheader_img#
58132>>>>>>>>>>>>>>>      end
58132>>>>>>>>>>>>>>>>
58132>>>>>>>>>>>>>>>      if onceonly_img# begin
58134>>>>>>>>>>>>>>>        send message.i (pOnceOnly_msg(self))
58135>>>>>>>>>>>>>>>        set pOnceOnly_image to 0
58136>>>>>>>>>>>>>>>        send output_image onceonly_img#
58137>>>>>>>>>>>>>>>      end
58137>>>>>>>>>>>>>>>>
58137>>>>>>>>>>>>>>>    end
58137>>>>>>>>>>>>>>>>
58137>>>>>>>>>>>>>>>    move (replace_codes(self,str#)) to str#
58138>>>>>>>>>>>>>>>    if (iUseSequentialChannel(self)) write channel (pOutputChannel(self)) str#
58142>>>>>>>>>>>>>>>    else begin
58143>>>>>>>>>>>>>>>        send Write to oVPE# str#
58144>>>>>>>>>>>>>>>    end
58144>>>>>>>>>>>>>>>>
58144>>>>>>>>>>>>>>>  end_procedure
58145>>>>>>>>>>>>>>>
58145>>>>>>>>>>>>>>>  procedure write_no_headers string str#
58147>>>>>>>>>>>>>>>    send write.i str# 0
58148>>>>>>>>>>>>>>>  end_procedure
58149>>>>>>>>>>>>>>>
58149>>>>>>>>>>>>>>>  procedure write string str#
58151>>>>>>>>>>>>>>>    send write.i str# 1
58152>>>>>>>>>>>>>>>  end_procedure
58153>>>>>>>>>>>>>>>
58153>>>>>>>>>>>>>>>  procedure writeln string str#
58155>>>>>>>>>>>>>>>    send write.i str# 1
58156>>>>>>>>>>>>>>>    if (iUseSequentialChannel(self)) writeln channel (pOutputChannel(self)) (if(pDestination(self)=DEST_HTML,"
",""))
58161>>>>>>>>>>>>>>>    else begin
58162>>>>>>>>>>>>>>>        send WriteLn to oVPE# " "
58163>>>>>>>>>>>>>>>    end
58163>>>>>>>>>>>>>>>>
58163>>>>>>>>>>>>>>>    set pLineCount to (pLineCount(self)+1)
58164>>>>>>>>>>>>>>>  end_procedure
58165>>>>>>>>>>>>>>>
58165>>>>>>>>>>>>>>>  procedure writeln_no_headers string str#
58167>>>>>>>>>>>>>>>    send write.i str# 0
58168>>>>>>>>>>>>>>>    writeln channel (pOutputChannel(self))
58170>>>>>>>>>>>>>>>    set pLineCount to (pLineCount(self)+1)
58171>>>>>>>>>>>>>>>  end_procedure
58172>>>>>>>>>>>>>>>
58172>>>>>>>>>>>>>>>  procedure make_horizontal_line
58174>>>>>>>>>>>>>>>    integer destination#
58174>>>>>>>>>>>>>>>    get pDestination to Destination#
58175>>>>>>>>>>>>>>>
58175>>>>>>>>>>>>>>>      if (destination#=DEST_PRINTER or destination#=DEST_SCREEN) send WriteLine to oVPE#
58178>>>>>>>>>>>>>>>//    send writeln to oVPE# " "
58178>>>>>>>>>>>>>>>    else begin
58179>>>>>>>>>>>>>>>      if destination# eq DEST_HTML send writeln "
" // Horizontal ruler
58182>>>>>>>>>>>>>>>      else send writeln (repeat(" ",pWidth(self)))
58184>>>>>>>>>>>>>>>    end
58184>>>>>>>>>>>>>>>>
58184>>>>>>>>>>>>>>>  end_procedure
58185>>>>>>>>>>>>>>>
58185>>>>>>>>>>>>>>>  procedure call_viewer
58187>>>>>>>>>>>>>>>    integer self#
58187>>>>>>>>>>>>>>>    move self to self#
58188>>>>>>>>>>>>>>>    send output.CallViewer (pScreenTmpFile(self)) self#
58189>>>>>>>>>>>>>>>  end_procedure
58190>>>>>>>>>>>>>>>
58190>>>>>>>>>>>>>>>  procedure Report_Wait_On
58192>>>>>>>>>>>>>>>  end_procedure
58193>>>>>>>>>>>>>>>  procedure Report_Wait_Off
58195>>>>>>>>>>>>>>>  end_procedure
58196>>>>>>>>>>>>>>>  procedure Report_Wait_Update string str#
58198>>>>>>>>>>>>>>>  end_procedure
58199>>>>>>>>>>>>>>>  procedure Report_Wait_Update2 string str#
58201>>>>>>>>>>>>>>>  end_procedure
58202>>>>>>>>>>>>>>>  function iReport_Cancel returns integer
58204>>>>>>>>>>>>>>>  end_function
58205>>>>>>>>>>>>>>>  procedure Report_Done
58207>>>>>>>>>>>>>>>    send obs "Done"
58208>>>>>>>>>>>>>>>  end_procedure
58209>>>>>>>>>>>>>>>end_class // cBasicSequentialOutput
58210>>>>>>>>>>>>>>>
58210>>>>>>>>>>>>>>>object oBasicSequentialOutput is a cBasicSequentialOutput NO_IMAGE
58212>>>>>>>>>>>>>>>end_object
58213>>>>>>>>>>>>>>>
58213>>>>>>>>>>>>>>>
58213>>>>>>>>>>>>>>>// seq.output  [lines]
58213>>>>>>>>>>>>>>>
58213>>>>>>>>>>>>>>>
58213>>>>>>>>>>>>>>>
58213>>>>>>>>>>>>>>>
58213>>>>>>>>>>>>>>>
58213>>>>>>>>>>>>>>>
58213>>>>>>>>>>>>>>>
58213>>>>>>>>>>>>>>>// ===========================================================================
58213>>>>>>>>>>>>>>>//  ********************* CHARACTER MODE PREVIEW OBJECT *********************
58213>>>>>>>>>>>>>>>// ===========================================================================
58213>>>>>>>>>>>>>>>
58213>>>>>>>>>>>>>>>use Aps      // Auto Position and Sizing classes for Visual DataFlex 4.0
58213>>>>>>>>>>>>>>>use file_dlg // OpenDialog class
58213>>>>>>>>>>>>>>>register_abstract_field_type aft_AppLinkPath50 50 ascii_window
58215>>>>>>>>>>>>>>>
58215>>>>>>>>>>>>>>>object WordPadLinkSetup is a aps.ModalPanel label "WordPad kommunikation"
58218>>>>>>>>>>>>>>>  object FlDlg is a OpenDialog
58220>>>>>>>>>>>>>>>    set NoChangeDir_State to true
58221>>>>>>>>>>>>>>>  end_object
58222>>>>>>>>>>>>>>>  object cont is a aps.container3D
58224>>>>>>>>>>>>>>>    object frm1 is a aps.Form label "WordPadPath:" abstract aft_AppLinkPath50
58228>>>>>>>>>>>>>>>      set p_extra_internal_width to -100
58229>>>>>>>>>>>>>>>      set form_button item 0 to 1
58230>>>>>>>>>>>>>>>      set form_button_value item 0 to "..."
58231>>>>>>>>>>>>>>>      procedure form_button_notification integer itm#
58234>>>>>>>>>>>>>>>        integer obj#
58234>>>>>>>>>>>>>>>        move (FlDlg(self)) to obj#
58235>>>>>>>>>>>>>>>        set Dialog_Caption of obj# to "Locate WORDPAD.EXE"
58236>>>>>>>>>>>>>>>        Set Filter_String  of obj# to ;         "Standard (WORDPAD.EXE)|WORDPAD.EXE|EXE files|*.exe|All files|*.*"
58237>>>>>>>>>>>>>>>        if (Show_Dialog(obj#)) set value item 0 to (File_Name(obj#))
58240>>>>>>>>>>>>>>>      end_procedure
58241>>>>>>>>>>>>>>>    end_object
58242>>>>>>>>>>>>>>>  end_object
58243>>>>>>>>>>>>>>>  procedure activate
58246>>>>>>>>>>>>>>>    ifnot (active_state(self)) send retrieve_values
58249>>>>>>>>>>>>>>>    forward send activate
58251>>>>>>>>>>>>>>>  end_procedure
58252>>>>>>>>>>>>>>>  procedure retrieve_values
58255>>>>>>>>>>>>>>>    string str#
58255>>>>>>>>>>>>>>>    get_profile_string "APPLICATION_LINKS" "WordPadPath"  to str#
58258>>>>>>>>>>>>>>>    set value of (frm1(cont(self))) item 0 to str#
58259>>>>>>>>>>>>>>>  end_procedure
58260>>>>>>>>>>>>>>>  procedure store_values
58263>>>>>>>>>>>>>>>    set_profile_string "APPLICATION_LINKS" "WordPadPath"  to (value(frm1(cont(self)),0))
58266>>>>>>>>>>>>>>>    send close_panel
58267>>>>>>>>>>>>>>>  end_procedure
58268>>>>>>>>>>>>>>>  object btn1 is a aps.multi_button
58270>>>>>>>>>>>>>>>    on_item "OK" send store_values
58271>>>>>>>>>>>>>>>  end_object
58272>>>>>>>>>>>>>>>  object btn2 is a aps.multi_button
58274>>>>>>>>>>>>>>>    on_item "Cancel" send close_panel
58275>>>>>>>>>>>>>>>  end_object
58276>>>>>>>>>>>>>>>  send aps_locate_multi_buttons
58277>>>>>>>>>>>>>>>end_object
58278>>>>>>>>>>>>>>>procedure activate_wordpad_setup
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
58280>>>>>>>>>>>>>>>  send popup to (WordPadLinkSetup(self))
58281>>>>>>>>>>>>>>>end_procedure
58282>>>>>>>>>>>>>>>
58282>>>>>>>>>>>>>>>procedure output.CallViewer global string fn# integer obj#
58284>>>>>>>>>>>>>>>   string str#
58284>>>>>>>>>>>>>>>   get_profile_string "APPLICATION_LINKS" "WordPadPath" to str#
58287>>>>>>>>>>>>>>>   move (str#*fn#) to str#
58288>>>>>>>>>>>>>>>   runprogram wait str#
58289>>>>>>>>>>>>>>>end_procedure
58290>>>>>>>>>>>>>>>
58290>>>>>>>>>>>>>>>procedure output.display_file global string fn#
58292>>>>>>>>>>>>>>>  integer ch# fin# liPos
58292>>>>>>>>>>>>>>>  integer liSearchPrnLine // Find this line (in .PRN file)
58292>>>>>>>>>>>>>>>  integer liFileLine      // Line number currently being loaded
58292>>>>>>>>>>>>>>>  integer liResultLine    // desired item found in this line in the file
58292>>>>>>>>>>>>>>>  string  lsTmpPrnLine    //
58292>>>>>>>>>>>>>>>  string str# dir#
58292>>>>>>>>>>>>>>>  get Seq_New_Channel to ch#
58293>>>>>>>>>>>>>>>  direct_input channel ch# fn#
58295>>>>>>>>>>>>>>>  if [seqeof] send obs ("File not found ("+fn#+")")
58298>>>>>>>>>>>>>>>  else begin
58299>>>>>>>>>>>>>>>    get SEQ_ExtractPathFromFileName fn# to dir#
58300>>>>>>>>>>>>>>>    if (dir#="") move (SEQ_FindFileAlongDFPath(fn#)) to dir#
58303>>>>>>>>>>>>>>>    if (dir#=".") get_current_directory to dir#
58306>>>>>>>>>>>>>>>    set pDestination of seq.object# to DEST_SCREEN
58307>>>>>>>>>>>>>>>    if (iDirect_Output_Title(seq.object#,fn#+" "+"("+dir#+")")) begin
58309>>>>>>>>>>>>>>>      move 0 to fin#
58310>>>>>>>>>>>>>>>      move 0 to liFileLine
58311>>>>>>>>>>>>>>>      move 0 to liResultLine
58312>>>>>>>>>>>>>>>      repeat
58312>>>>>>>>>>>>>>>>
58312>>>>>>>>>>>>>>>        readln channel ch# str#
58314>>>>>>>>>>>>>>>        move (seqeof) to fin#
58315>>>>>>>>>>>>>>>        ifnot fin# begin
58317>>>>>>>>>>>>>>>
58317>>>>>>>>>>>>>>>          increment liFileLine
58318>>>>>>>>>>>>>>>
58318>>>>>>>>>>>>>>>          // *** PRN file search ***
58318>>>>>>>>>>>>>>>          if liSearchPrnLine begin // If we're searching for a PRN line
58320>>>>>>>>>>>>>>>            ifnot liResultLine begin // If we didn't find it yet
58322>>>>>>>>>>>>>>>              if ("0123456789" contains left(str#,1)) begin
58324>>>>>>>>>>>>>>>                move (pos(">",str#)) to liPos
58325>>>>>>>>>>>>>>>                if (liPos>0 and liPos<8) begin
58327>>>>>>>>>>>>>>>                  move (left(str#,liPos-1)) to lsTmpPrnLine
58328>>>>>>>>>>>>>>>                  if (StringIsInteger(lsTmpPrnLine) and integer(lsTmpPrnLine)>=liSearchPrnLine) begin
58330>>>>>>>>>>>>>>>                    move liFileLine to liResultLine
58331>>>>>>>>>>>>>>>                    move 0 to liSearchPrnLine
58332>>>>>>>>>>>>>>>                  end
58332>>>>>>>>>>>>>>>>
58332>>>>>>>>>>>>>>>                end
58332>>>>>>>>>>>>>>>>
58332>>>>>>>>>>>>>>>              end
58332>>>>>>>>>>>>>>>>
58332>>>>>>>>>>>>>>>            end
58332>>>>>>>>>>>>>>>>
58332>>>>>>>>>>>>>>>          end
58332>>>>>>>>>>>>>>>>
58332>>>>>>>>>>>>>>>
58332>>>>>>>>>>>>>>>          seq.writeln str#
58334>>>>>>>>>>>>>>>        end
58334>>>>>>>>>>>>>>>>
58334>>>>>>>>>>>>>>>      until fin#
58336>>>>>>>>>>>>>>>      seq.close_output
58337>>>>>>>>>>>>>>>    end
58337>>>>>>>>>>>>>>>>
58337>>>>>>>>>>>>>>>  end
58337>>>>>>>>>>>>>>>>
58337>>>>>>>>>>>>>>>  send Seq_Release_Channel ch#
58338>>>>>>>>>>>>>>>end_procedure
58339>>>>>>>>>>>>>>>
58339>>>>>>>>>>>>>>>procedure output.run_dfindex_all global
58341>>>>>>>>>>>>>>>  send output.display_file "dfsort.log"
58342>>>>>>>>>>>>>>>end_procedure
58343>>>>>>>>>>>>>Use ErrorHnd.nui // cErrorHandlerRedirector class and oErrorHandlerQuiet object (No User Interface)
58343>>>>>>>>>>>>>//  Use LogFile.nui  // Class for handling a log file (No User Interface)
58343>>>>>>>>>>>>>//
58343>>>>>>>>>>>>>//  object oVMLogFile is a cLogFile
58343>>>>>>>>>>>>>//    set psFileName to "vmachine.log"
58343>>>>>>>>>>>>>//    set piCloseOnWrite to DFTRUE
58343>>>>>>>>>>>>>//    set psPurpose to "Expression evaluation log"
58343>>>>>>>>>>>>>//    send DirectOutput
58343>>>>>>>>>>>>>//  end_object
58343>>>>>>>>>>>>>
58343>>>>>>>>>>>>>
58343>>>>>>>>>>>>>Enumeration_List // Operation codes for Virtual Machine
58343>>>>>>>>>>>>>  define OP_NOP             // Do nothing!
58343>>>>>>>>>>>>>  define OP_ABORT           // Stop program execution
58343>>>>>>>>>>>>>  define OP_CLEARSCREEN     // Clear the screen
58343>>>>>>>>>>>>>  define OP_GOSUB           // Call subrutine
58343>>>>>>>>>>>>>  define OP_GOTO            // Goto label
58343>>>>>>>>>>>>>  define OP_RETURN          // Return from subrutine
58343>>>>>>>>>>>>>  define OP_PAUSE           // Pauses program execution
58343>>>>>>>>>>>>>  define OP_GOTOXY          // Positions the cursor on a character mode screen
58343>>>>>>>>>>>>>  define OP_INPUT           // Input from the keyboard
58343>>>>>>>>>>>>>  define OP_SHOW            // Display on virtual console
58343>>>>>>>>>>>>>  define OP_SHOWLN          // Display on virtual console
58343>>>>>>>>>>>>>  define OP_SEQFILE         // Open/close/append sequential file
58343>>>>>>>>>>>>>  define OP_WRITE           // Write to currently open sequential out file
58343>>>>>>>>>>>>>  define OP_WRITELN         // Write to currently open sequential out file
58343>>>>>>>>>>>>>  define OP_READ            // Read from currently open sequential in file
58343>>>>>>>>>>>>>  define OP_READLN          // Read from currently open sequential in file
58343>>>>>>>>>>>>>  define OP_MSGBOX          // Display a message box
58343>>>>>>>>>>>>>  define OP_ASSIGN          // Assign value to variable or a field
58343>>>>>>>>>>>>>  define OP_GVAR_INCR       // Increment integer variable by amount
58343>>>>>>>>>>>>>  define OP_GVAR_DISPLAY    // Display global variable (debug purposes)
58343>>>>>>>>>>>>>  define OP_IF_GOTO         // Conditioned jump (x<>0)
58343>>>>>>>>>>>>>  define OP_IF_GOSUB        // Conditioned gosub (x<>0)
58343>>>>>>>>>>>>>  define OP_IFTEST_GOTO     // Conditioned jump (x comp y)
58343>>>>>>>>>>>>>  define OP_IFTEST_GOSUB    // Conditioned gosub (x comp y)
58343>>>>>>>>>>>>>  define OP_DEBUG           // Turn debug on and off
58343>>>>>>>>>>>>>  define OP_LOG_OPEN        // Open file for logging
58343>>>>>>>>>>>>>  define OP_LOG_CLOSE       // Close log file
58343>>>>>>>>>>>>>  define OP_LOG_DISPLAY     // Display log file
58343>>>>>>>>>>>>>  define OP_LOG_FLUSH       // Flush log file (momentarily close/open)
58343>>>>>>>>>>>>>  define OP_LOG_WRITE       // Write something to log file
58343>>>>>>>>>>>>>  define OP_LOG_WRITELN     // WriteLn something to log file
58343>>>>>>>>>>>>>  define OP_API_FILELIST    // Set_Attribute (filelist)
58343>>>>>>>>>>>>>  define OP_API_FILE        // Set_Attribute (file)
58343>>>>>>>>>>>>>  define OP_API_FIELD       // Set_Attribute (field)
58343>>>>>>>>>>>>>  define OP_API_INDEX       // Set_Attribute (index)
58343>>>>>>>>>>>>>  define OP_API_IDXSEG      // Set_Attribute (idxseg)
58343>>>>>>>>>>>>>  define OP_API_STRUCTURE_ABORT // Structure abort
58343>>>>>>>>>>>>>  define OP_API_STRUCTURE_END   // Structure end
58343>>>>>>>>>>>>>  define OP_API_PROBE_END       // Probe end
58343>>>>>>>>>>>>>  define OP_API_DELETEINDEX     // Delete index
58343>>>>>>>>>>>>>  define OP_API_DELETEFIELD     // Delete field
58343>>>>>>>>>>>>>  define OP_API_APPENDFIELD     // Append field
58343>>>>>>>>>>>>>  define OP_API_CREATEFIELD     // Create field
58343>>>>>>>>>>>>>  define OP_API_SETFIELDNUMBER  // Set implicit field number
58343>>>>>>>>>>>>>  define cBasicVirtualMachine.NEXT_OP // Augmentation codes starts here
58343>>>>>>>>>>>>>End_Enumeration_List
58343>>>>>>>>>>>>>
58343>>>>>>>>>>>>>Enumeration_List // Variable types
58343>>>>>>>>>>>>>  define VARTYP_VOID     // Return type for procedures
58343>>>>>>>>>>>>>  define VARTYP_INTEGER
58343>>>>>>>>>>>>>  define VARTYP_DATE
58343>>>>>>>>>>>>>  define VARTYP_NUMBER
58343>>>>>>>>>>>>>  define VARTYP_STRING
58343>>>>>>>>>>>>>End_Enumeration_List
58343>>>>>>>>>>>>>
58343>>>>>>>>>>>>>Enumeration_List // Field types
58343>>>>>>>>>>>>>  define FLDTYP_DATE
58343>>>>>>>>>>>>>  define FLDTYP_NUMBER
58343>>>>>>>>>>>>>  define FLDTYP_STRING
58343>>>>>>>>>>>>>  define FLDTYP_BINARY
58343>>>>>>>>>>>>>  define FLDTYP_OVERLAP
58343>>>>>>>>>>>>>  define FLDTYP_TEXT
58343>>>>>>>>>>>>>End_Enumeration_List
58343>>>>>>>>>>>>>
58343>>>>>>>>>>>>>Enumeration_List // Comparison modes
58343>>>>>>>>>>>>>  define COMP_LT
58343>>>>>>>>>>>>>  define COMP_LE
58343>>>>>>>>>>>>>  define COMP_EQ
58343>>>>>>>>>>>>>  define COMP_GE
58343>>>>>>>>>>>>>  define COMP_GT
58343>>>>>>>>>>>>>  define COMP_NE
58343>>>>>>>>>>>>>End_Enumeration_List
58343>>>>>>>>>>>>>
58343>>>>>>>>>>>>>Enumeration_List // Argument types
58343>>>>>>>>>>>>>  define AT_NOT_VALID
58343>>>>>>>>>>>>>  define AT_CINT
58343>>>>>>>>>>>>>  define AT_CSTR
58343>>>>>>>>>>>>>  define AT_CNUM
58343>>>>>>>>>>>>>  define AT_CDAT
58343>>>>>>>>>>>>>  define AT_VAR
58343>>>>>>>>>>>>>  define AT_VARNO
58343>>>>>>>>>>>>>  define AT_EXPR
58343>>>>>>>>>>>>>  define AT_LBL
58343>>>>>>>>>>>>>  define AT_FIELD
58343>>>>>>>>>>>>>  define AT_FIELDNO
58343>>>>>>>>>>>>>  define AT_ARRAY_ID
58343>>>>>>>>>>>>>  define AT_ARRAY_ELEM
58343>>>>>>>>>>>>>End_Enumeration_List
58343>>>>>>>>>>>>>
58343>>>>>>>>>>>>>function iCompStringToInt.s global string lsComp returns integer
58345>>>>>>>>>>>>>  move (uppercase(lsComp)) to lsComp
58346>>>>>>>>>>>>>  if lsComp eq "LT" function_return COMP_LT
58349>>>>>>>>>>>>>  if lsComp eq "LE" function_return COMP_LE
58352>>>>>>>>>>>>>  if lsComp eq "EQ" function_return COMP_EQ
58355>>>>>>>>>>>>>  if lsComp eq "GE" function_return COMP_GE
58358>>>>>>>>>>>>>  if lsComp eq "GT" function_return COMP_GT
58361>>>>>>>>>>>>>  if lsComp eq "NE" function_return COMP_NE
58364>>>>>>>>>>>>>  function_return -1
58365>>>>>>>>>>>>>end_function
58366>>>>>>>>>>>>>
58366>>>>>>>>>>>>>function iArgType_Const.i global integer liType returns integer
58368>>>>>>>>>>>>>  if liType eq AT_CINT function_return 1
58371>>>>>>>>>>>>>  if liType eq AT_CSTR function_return 1
58374>>>>>>>>>>>>>  if liType eq AT_CNUM function_return 1
58377>>>>>>>>>>>>>  if liType eq AT_CDAT function_return 1
58380>>>>>>>>>>>>>  function_return 0
58381>>>>>>>>>>>>>end_function
58382>>>>>>>>>>>>>
58382>>>>>>>>>>>>>function sArgtype_Name.i global integer liType returns string
58384>>>>>>>>>>>>>  if liType eq AT_CINT  function_return "CnstInt"
58387>>>>>>>>>>>>>  if liType eq AT_CSTR  function_return "CnstStr"
58390>>>>>>>>>>>>>  if liType eq AT_CNUM  function_return "CnstNum"
58393>>>>>>>>>>>>>  if liType eq AT_CDAT  function_return "CnstDat"
58396>>>>>>>>>>>>>  if liType eq AT_VAR   function_return "VarName"
58399>>>>>>>>>>>>>  if liType eq AT_VARNO function_return "VarNo"
58402>>>>>>>>>>>>>  if liType eq AT_EXPR  function_return "Expr"
58405>>>>>>>>>>>>>  if liType eq AT_LBL   function_return "Lbl"
58408>>>>>>>>>>>>>  if liType eq AT_FIELD function_return "Field"
58411>>>>>>>>>>>>>  if liType eq AT_FIELDNO function_return "FieldNo"
58414>>>>>>>>>>>>>  if liType eq AT_ARRAY_ID function_return "Array ID"
58417>>>>>>>>>>>>>  if liType eq AT_ARRAY_ELEM function_return "Array Index"
58420>>>>>>>>>>>>>  function_return "Unknown argtype"
58421>>>>>>>>>>>>>end_function
58422>>>>>>>>>>>>>
58422>>>>>>>>>>>>>class cOpCodes is a cArray
58423>>>>>>>>>>>>>  item_property_list
58423>>>>>>>>>>>>>    item_property string  psName.i
58423>>>>>>>>>>>>>    item_property integer piMessage.i
58423>>>>>>>>>>>>>    item_property integer piParameters.i // Number of parameters
58423>>>>>>>>>>>>>    item_property integer psFormat.i     // Format of parameters
58423>>>>>>>>>>>>>    item_property integer piSpecialAddMsg.i
58423>>>>>>>>>>>>>  end_item_property_list cOpCodes
#REM 58464 DEFINE FUNCTION PISPECIALADDMSG.I INTEGER LIROW RETURNS INTEGER
#REM 58468 DEFINE PROCEDURE SET PISPECIALADDMSG.I INTEGER LIROW INTEGER VALUE
#REM 58472 DEFINE FUNCTION PSFORMAT.I INTEGER LIROW RETURNS INTEGER
#REM 58476 DEFINE PROCEDURE SET PSFORMAT.I INTEGER LIROW INTEGER VALUE
#REM 58480 DEFINE FUNCTION PIPARAMETERS.I INTEGER LIROW RETURNS INTEGER
#REM 58484 DEFINE PROCEDURE SET PIPARAMETERS.I INTEGER LIROW INTEGER VALUE
#REM 58488 DEFINE FUNCTION PIMESSAGE.I INTEGER LIROW RETURNS INTEGER
#REM 58492 DEFINE PROCEDURE SET PIMESSAGE.I INTEGER LIROW INTEGER VALUE
#REM 58496 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 58500 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
58505>>>>>>>>>>>>>  procedure add_opcode integer liOpCode string lsName integer lhMsg integer liParams integer lhSpecial_add_msg
58507>>>>>>>>>>>>>    set psName.i          liOpCode to lsName
58508>>>>>>>>>>>>>    set piMessage.i       liOpCode to lhMsg
58509>>>>>>>>>>>>>    set piParameters.i    liOpCode to liParams
58510>>>>>>>>>>>>>    set piSpecialAddMsg.i liOpCode to lhSpecial_add_msg
58511>>>>>>>>>>>>>  end_procedure
58512>>>>>>>>>>>>>end_class // cOpCodes
58513>>>>>>>>>>>>>
58513>>>>>>>>>>>>>function VmIntIf global integer lbCondition integer liTrue integer liFalse returns integer
58515>>>>>>>>>>>>>  if lbCondition function_return liTrue
58518>>>>>>>>>>>>>  function_return liFalse
58519>>>>>>>>>>>>>end_function
58520>>>>>>>>>>>>>function VmNumIf global integer lbCondition number lnTrue number lnFalse returns number
58522>>>>>>>>>>>>>  if lbCondition function_return lnTrue
58525>>>>>>>>>>>>>  function_return lnFalse
58526>>>>>>>>>>>>>end_function
58527>>>>>>>>>>>>>function VmStrIf global integer lbCondition string lsTrue string lsFalse returns string
58529>>>>>>>>>>>>>  if lbCondition function_return lsTrue
58532>>>>>>>>>>>>>  function_return lsFalse
58533>>>>>>>>>>>>>end_function
58534>>>>>>>>>>>>>function VmDatIf global integer lbCondition date ldTrue date ldFalse returns date
58536>>>>>>>>>>>>>  if lbCondition function_return ldTrue
58539>>>>>>>>>>>>>  function_return ldFalse
58540>>>>>>>>>>>>>end_function
58541>>>>>>>>>>>>>
58541>>>>>>>>>>>>>class cDeclaredArrays is a cArray
58542>>>>>>>>>>>>>  item_property_list
58542>>>>>>>>>>>>>    item_property string  psName.i
58542>>>>>>>>>>>>>    item_property integer piObject.i
58542>>>>>>>>>>>>>    item_property integer piType.i // VARTYP_INTEGER, VARTYP_NUMBER, VARTYP_DATE or VARTYP_STRING
58542>>>>>>>>>>>>>  end_item_property_list cDeclaredArrays
#REM 58577 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 58581 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 58585 DEFINE FUNCTION PIOBJECT.I INTEGER LIROW RETURNS INTEGER
#REM 58589 DEFINE PROCEDURE SET PIOBJECT.I INTEGER LIROW INTEGER VALUE
#REM 58593 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 58597 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
58602>>>>>>>>>>>>>  procedure reset
58604>>>>>>>>>>>>>    integer liRow max# obj#
58604>>>>>>>>>>>>>    get row_count to max#
58605>>>>>>>>>>>>>    for liRow from 0 to (max#-1)
58611>>>>>>>>>>>>>>
58611>>>>>>>>>>>>>      get piObject.i liRow to obj#
58612>>>>>>>>>>>>>      if obj# send request_destroy_object to obj#
58615>>>>>>>>>>>>>    loop
58616>>>>>>>>>>>>>>
58616>>>>>>>>>>>>>    send delete_data
58617>>>>>>>>>>>>>  end_procedure
58618>>>>>>>>>>>>>  function iRowToObjectID.i integer liRow returns integer
58620>>>>>>>>>>>>>    integer obj#
58620>>>>>>>>>>>>>    get piObject.i liRow to obj#
58621>>>>>>>>>>>>>    ifnot obj# begin
58623>>>>>>>>>>>>>      object oArray is an cArray
58625>>>>>>>>>>>>>        move self to obj#
58626>>>>>>>>>>>>>      end_object
58627>>>>>>>>>>>>>    end
58627>>>>>>>>>>>>>>
58627>>>>>>>>>>>>>    function_return obj#
58628>>>>>>>>>>>>>  end_function
58629>>>>>>>>>>>>>  procedure Array_Reset integer liRow
58631>>>>>>>>>>>>>    send delete_data to (iRowToObjectID.i(self,liRow))
58632>>>>>>>>>>>>>  end_procedure
58633>>>>>>>>>>>>>  function iNameToNumber.s string lsName returns integer
58635>>>>>>>>>>>>>    integer liRow liMax
58635>>>>>>>>>>>>>    move (uppercase(lsName)) to lsName
58636>>>>>>>>>>>>>    get row_count to liMax
58637>>>>>>>>>>>>>    for liRow from 0 to (liMax-1)
58643>>>>>>>>>>>>>>
58643>>>>>>>>>>>>>      if lsName eq (psName.i(self,liRow)) function_return liRow
58646>>>>>>>>>>>>>    loop
58647>>>>>>>>>>>>>>
58647>>>>>>>>>>>>>    function_return -1
58648>>>>>>>>>>>>>  end_function
58649>>>>>>>>>>>>>  procedure declare_array string lsName integer liType
58651>>>>>>>>>>>>>    integer liRow
58651>>>>>>>>>>>>>    get row_count to liRow
58652>>>>>>>>>>>>>    set psName.i   liRow to (uppercase(lsName))
58653>>>>>>>>>>>>>    set piObject.i liRow to 0
58654>>>>>>>>>>>>>    set piType.i   liRow to liType
58655>>>>>>>>>>>>>  end_procedure
58656>>>>>>>>>>>>>  procedure Assign_Value integer liRow integer liItem string lsValue
58658>>>>>>>>>>>>>    integer liType lhObj
58658>>>>>>>>>>>>>    get piObject.i liRow to lhObj
58659>>>>>>>>>>>>>    get piType.i   liRow to liType
58660>>>>>>>>>>>>>    if liType eq VARTYP_INTEGER set value of lhObj item liItem to (integer(lsValue))
58663>>>>>>>>>>>>>    if liType eq VARTYP_NUMBER  set value of lhObj item liItem to (number(lsValue))
58666>>>>>>>>>>>>>    if liType eq VARTYP_DATE    set value of lhObj item liItem to (date(lsValue))
58669>>>>>>>>>>>>>    if liType eq VARTYP_STRING  set value of lhObj item liItem to (string(lsValue))
58672>>>>>>>>>>>>>  end_procedure
58673>>>>>>>>>>>>>  function sAssigned_Value.ii integer liRow integer liItem returns string
58675>>>>>>>>>>>>>    function_return (value(piObject.i(self,liRow),liItem))
58676>>>>>>>>>>>>>  end_function
58677>>>>>>>>>>>>>  procedure sort_array integer liRow
58679>>>>>>>>>>>>>    send sort_items to (piObject.i(self,liRow))
58680>>>>>>>>>>>>>  end_procedure
58681>>>>>>>>>>>>>  function iItem_Count.i integer liRow returns integer
58683>>>>>>>>>>>>>    function_return (item_count(piObject.i(self,liRow)))
58684>>>>>>>>>>>>>  end_function
58685>>>>>>>>>>>>>end_class // cDeclaredArrays
58686>>>>>>>>>>>>>
58686>>>>>>>>>>>>>//  Move MyArray(2) to YourArray(4)
58686>>>>>>>>>>>>>//  Move MyArray.Item_Count to WhatEver#
58686>>>>>>>>>>>>>//
58686>>>>>>>>>>>>>//
58686>>>>>>>>>>>>>enumeration_list // Function classes
58686>>>>>>>>>>>>>  define FTYPE.SCRIPT  // Functions declared in the script
58686>>>>>>>>>>>>>  define FTYPE.GET     // Globally declared functions
58686>>>>>>>>>>>>>  define FTYPE.BUILTIN // Predefined DF functions that are called automatically by the eval function
58686>>>>>>>>>>>>>end_enumeration_list
58686>>>>>>>>>>>>>
58686>>>>>>>>>>>>>register_object oParameterStack
58686>>>>>>>>>>>>>class cDeclaredFunctions is a cArray
58687>>>>>>>>>>>>>  procedure construct_object integer liImg
58689>>>>>>>>>>>>>    forward send construct_object liImg
58691>>>>>>>>>>>>>    object oParameterReverse is a cStack NO_IMAGE
58693>>>>>>>>>>>>>    end_object
58694>>>>>>>>>>>>>    object oParameterStack is a cStack NO_IMAGE
58696>>>>>>>>>>>>>    end_object
58697>>>>>>>>>>>>>  end_procedure
58698>>>>>>>>>>>>>  item_property_list
58698>>>>>>>>>>>>>    item_property string  psName.i
58698>>>>>>>>>>>>>    item_property string  psDisplayName.i
58698>>>>>>>>>>>>>    item_property integer piReturnType.i    // VT_Something
58698>>>>>>>>>>>>>    item_property string  psParameterList.i //
58698>>>>>>>>>>>>>    item_property string  psDisplayParameterList.i //
58698>>>>>>>>>>>>>    item_property integer piFuncClass.i     // FTYPE.SCRIPT/FTYPE.GET/FTYPE.EXPR
58698>>>>>>>>>>>>>    item_property integer piLineDeclared.i  // when FTYPE.SCRIPT
58698>>>>>>>>>>>>>    item_property integer piMessage.i       // when FTYPE.GET or FTYPE.EXPR
58698>>>>>>>>>>>>>  end_item_property_list cDeclaredFunctions
#REM 58748 DEFINE FUNCTION PIMESSAGE.I INTEGER LIROW RETURNS INTEGER
#REM 58752 DEFINE PROCEDURE SET PIMESSAGE.I INTEGER LIROW INTEGER VALUE
#REM 58756 DEFINE FUNCTION PILINEDECLARED.I INTEGER LIROW RETURNS INTEGER
#REM 58760 DEFINE PROCEDURE SET PILINEDECLARED.I INTEGER LIROW INTEGER VALUE
#REM 58764 DEFINE FUNCTION PIFUNCCLASS.I INTEGER LIROW RETURNS INTEGER
#REM 58768 DEFINE PROCEDURE SET PIFUNCCLASS.I INTEGER LIROW INTEGER VALUE
#REM 58772 DEFINE FUNCTION PSDISPLAYPARAMETERLIST.I INTEGER LIROW RETURNS STRING
#REM 58776 DEFINE PROCEDURE SET PSDISPLAYPARAMETERLIST.I INTEGER LIROW STRING VALUE
#REM 58780 DEFINE FUNCTION PSPARAMETERLIST.I INTEGER LIROW RETURNS STRING
#REM 58784 DEFINE PROCEDURE SET PSPARAMETERLIST.I INTEGER LIROW STRING VALUE
#REM 58788 DEFINE FUNCTION PIRETURNTYPE.I INTEGER LIROW RETURNS INTEGER
#REM 58792 DEFINE PROCEDURE SET PIRETURNTYPE.I INTEGER LIROW INTEGER VALUE
#REM 58796 DEFINE FUNCTION PSDISPLAYNAME.I INTEGER LIROW RETURNS STRING
#REM 58800 DEFINE PROCEDURE SET PSDISPLAYNAME.I INTEGER LIROW STRING VALUE
#REM 58804 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 58808 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
58813>>>>>>>>>>>>>
58813>>>>>>>>>>>>>  procedure declare_function string lsName integer liRtnType string lsParamList integer liFuncClass integer liLine integer lhMsg
58815>>>>>>>>>>>>>    integer liRow
58815>>>>>>>>>>>>>    get row_count to liRow
58816>>>>>>>>>>>>>    set psName.i          liRow to (uppercase(lsName))
58817>>>>>>>>>>>>>    set psDisplayName.i   liRow to lsName
58818>>>>>>>>>>>>>    set piReturnType.i    liRow to liRtnType
58819>>>>>>>>>>>>>    set psParameterList.i liRow to lsParamList
58820>>>>>>>>>>>>>    set piFuncClass.i     liRow to liFuncClass
58821>>>>>>>>>>>>>    set piLineDeclared.i  liRow to liLine
58822>>>>>>>>>>>>>    set piMessage.i       liRow to lhMsg
58823>>>>>>>>>>>>>  end_function
58824>>>>>>>>>>>>>
58824>>>>>>>>>>>>>  function MidFunction string lsValue integer liLen integer liPos returns string
58826>>>>>>>>>>>>>    function_return (mid(lsValue,liLen,liPos))
58827>>>>>>>>>>>>>  end_function
58828>>>>>>>>>>>>>
58828>>>>>>>>>>>>>  // procedure Handle_Function string lsName integer liReturnType string lsParamList string lsLongParamList
58828>>>>>>>>>>>>>  procedure CallBack_AllFunctions integer lhMsg integer lhObj
58830>>>>>>>>>>>>>    integer liRow liMax lhSelf
58830>>>>>>>>>>>>>    move self to lhSelf
58831>>>>>>>>>>>>>    get row_count to liMax
58832>>>>>>>>>>>>>    decrement liMax
58833>>>>>>>>>>>>>    for liRow from 0 to liMax
58839>>>>>>>>>>>>>>
58839>>>>>>>>>>>>>      send lhMsg to lhObj (psDisplayName.i(lhSelf,liRow)) (piReturnType.i(lhSelf,liRow)) (psParameterList.i(lhSelf,liRow)) (psDisplayParameterList.i(lhSelf,liRow))
58840>>>>>>>>>>>>>    loop
58841>>>>>>>>>>>>>>
58841>>>>>>>>>>>>>  end_procedure
58842>>>>>>>>>>>>>
58842>>>>>>>>>>>>>  enumeration_list // Function groups
58842>>>>>>>>>>>>>    define FG_BEYOND_DESCRIPTION
58842>>>>>>>>>>>>>    define FG_STRING
58842>>>>>>>>>>>>>    define FG_DATETIME
58842>>>>>>>>>>>>>    define FG_LOGIC
58842>>>>>>>>>>>>>    define FG_TYPECONV
58842>>>>>>>>>>>>>    define FG_TRIG
58842>>>>>>>>>>>>>  end_enumeration_list
58842>>>>>>>>>>>>>
58842>>>>>>>>>>>>>  procedure reset
58844>>>>>>>>>>>>>    send delete_data
58845>>>>>>>>>>>>>    // STRINGS
58845>>>>>>>>>>>>>    send declare_function "Mid"             VARTYP_STRING "SII"   FTYPE.GET     0 get_MidFunction FG_STRING
58846>>>>>>>>>>>>>    send declare_function "Left"            VARTYP_STRING "SI"    FTYPE.BUILTIN 0 0               FG_STRING
58847>>>>>>>>>>>>>    send declare_function "Right"           VARTYP_STRING "SI"    FTYPE.BUILTIN 0 0               FG_STRING
58848>>>>>>>>>>>>>    send declare_function "Uppercase"       VARTYP_STRING "S"     FTYPE.BUILTIN 0 0               FG_STRING
58849>>>>>>>>>>>>>    send declare_function "Lowercase"       VARTYP_STRING "S"     FTYPE.BUILTIN 0 0               FG_STRING
58850>>>>>>>>>>>>>    send declare_function "Length"          VARTYP_INTEGER "S"    FTYPE.BUILTIN 0 0               FG_STRING
58851>>>>>>>>>>>>>    send declare_function "Trim"            VARTYP_STRING  "S"    FTYPE.BUILTIN 0 0               FG_STRING
58852>>>>>>>>>>>>>    if DFFALSE begin
58854>>>>>>>>>>>>>      send declare_function "Pad"             VARTYP_STRING "SI"    FTYPE.BUILTIN 0 0               FG_STRING
58855>>>>>>>>>>>>>      send declare_function "NumToStr"        VARTYP_STRING "NI"    FTYPE.GET     0 get_NumToStr    FG_STRING
58856>>>>>>>>>>>>>      send declare_function "NumToStrR"       VARTYP_STRING "NII"   FTYPE.GET     0 get_NumToStrR   FG_STRING
58857>>>>>>>>>>>>>      send declare_function "IntToStrR"       VARTYP_STRING "NI"    FTYPE.GET     0 get_IntToStrR   FG_STRING
58858>>>>>>>>>>>>>      send declare_function "IntToStrRzf"     VARTYP_STRING "NI"    FTYPE.GET     0 get_IntToStrRzf FG_STRING
58859>>>>>>>>>>>>>    end
58859>>>>>>>>>>>>>>
58859>>>>>>>>>>>>>    // DATES
58859>>>>>>>>>>>>>    send declare_function "SysDate"         VARTYP_DATE    ""     FTYPE.GET     0 get_dSysDate        FG_DATETIME
58860>>>>>>>>>>>>>    send declare_function "DateIncrement"   VARTYP_DATE    "DII"  FTYPE.GET     0 get_DateIncrement   FG_DATETIME
58861>>>>>>>>>>>>>    send declare_function "FirstDayInMonth" VARTYP_DATE    "D"    FTYPE.GET     0 get_FirstDayInMonth FG_DATETIME
58862>>>>>>>>>>>>>    if DFFALSE begin
58864>>>>>>>>>>>>>      send declare_function "SysYear"         VARTYP_INTEGER ""     FTYPE.GET     0 get_iSysYear        FG_DATETIME
58865>>>>>>>>>>>>>      send declare_function "SysTime"         VARTYP_STRING  ""     FTYPE.GET     0 get_sSysTime        FG_DATETIME
58866>>>>>>>>>>>>>      send declare_function "DateCompose"     VARTYP_DATE    "III"  FTYPE.GET     0 get_DateCompose     FG_DATETIME
58867>>>>>>>>>>>>>      send declare_function "StringToDate"    VARTYP_DATE    "SIIS" FTYPE.GET     0 get_StringToDate    FG_DATETIME
58868>>>>>>>>>>>>>      send declare_function "DateToString"    VARTYP_STRING  "DIIS" FTYPE.GET     0 get_DateToString    FG_DATETIME
58869>>>>>>>>>>>>>      send declare_function "DateSegment"     VARTYP_INTEGER "DI"   FTYPE.GET     0 get_DateSegment     FG_DATETIME
58870>>>>>>>>>>>>>      send declare_function "LastDayInMonth"  VARTYP_DATE    "D"    FTYPE.GET     0 get_LastDayInMonth  FG_DATETIME
58871>>>>>>>>>>>>>      send declare_function "FirstDayInYear"  VARTYP_DATE    "D"    FTYPE.GET     0 get_FirstDayInYear  FG_DATETIME
58872>>>>>>>>>>>>>      send declare_function "LastDayInYear"   VARTYP_DATE    "D"    FTYPE.GET     0 get_LastDayInYear   FG_DATETIME
58873>>>>>>>>>>>>>    end
58873>>>>>>>>>>>>>>
58873>>>>>>>>>>>>>    send declare_function "DateWeekNumber"  VARTYP_INTEGER "D"    FTYPE.GET     0 get_DateWeekNumber  FG_DATETIME
58874>>>>>>>>>>>>>    send declare_function "DateDayName"     VARTYP_STRING  "D"    FTYPE.GET     0 get_DateDayName     FG_DATETIME
58875>>>>>>>>>>>>>    send declare_function "DateMonthName"   VARTYP_STRING  "D"    FTYPE.GET     0 get_DateMonthName   FG_DATETIME
58876>>>>>>>>>>>>>    send declare_function "DateAsText"      VARTYP_STRING  "DS"   FTYPE.GET     0 get_DateAsText      FG_DATETIME
58877>>>>>>>>>>>>>    if DFFALSE begin
58879>>>>>>>>>>>>>      send declare_function "DayName"         VARTYP_STRING  "I"    FTYPE.GET     0 get_DayName         FG_DATETIME
58880>>>>>>>>>>>>>      send declare_function "DateDayNumber"   VARTYP_INTEGER "D"    FTYPE.GET     0 get_DateDayNumber   FG_DATETIME
58881>>>>>>>>>>>>>      send declare_function "WeekToDate"      VARTYP_DATE    "II"   FTYPE.GET     0 get_WeekToDate      FG_DATETIME
58882>>>>>>>>>>>>>      send declare_function "MonthName"       VARTYP_STRING  "I"    FTYPE.GET     0 get_MonthName       FG_DATETIME
58883>>>>>>>>>>>>>    end
58883>>>>>>>>>>>>>>
58883>>>>>>>>>>>>>//    if DFFALSE begin
58883>>>>>>>>>>>>>      // If
58883>>>>>>>>>>>>>      send declare_function "If_Int"      VARTYP_INTEGER "III" FTYPE.GET     0 get_VmIntIf     FG_LOGIC
58884>>>>>>>>>>>>>      send declare_function "If_Num"      VARTYP_NUMBER  "INN" FTYPE.GET     0 get_VmNumIf     FG_LOGIC
58885>>>>>>>>>>>>>      send declare_function "If_Str"      VARTYP_STRING  "ISS" FTYPE.GET     0 get_VmStrIf     FG_LOGIC
58886>>>>>>>>>>>>>      send declare_function "If_Dat"      VARTYP_DATE    "IDD" FTYPE.GET     0 get_VmDatIf     FG_LOGIC
58887>>>>>>>>>>>>>//    end
58887>>>>>>>>>>>>>    // TYPE CONVERSION
58887>>>>>>>>>>>>>    send declare_function "Integer"     VARTYP_INTEGER "I"   FTYPE.BUILTIN 0 0               FG_TYPECONV
58888>>>>>>>>>>>>>    send declare_function "String"      VARTYP_STRING  "S"   FTYPE.BUILTIN 0 0               FG_TYPECONV
58889>>>>>>>>>>>>>    send declare_function "Number"      VARTYP_NUMBER  "N"   FTYPE.BUILTIN 0 0               FG_TYPECONV
58890>>>>>>>>>>>>>    send declare_function "Date"        VARTYP_DATE    "D"   FTYPE.BUILTIN 0 0               FG_TYPECONV
58891>>>>>>>>>>>>>    // GEOMETRY (just for fun, shouldn't be here really)
58891>>>>>>>>>>>>>    if DFFALSE begin
58893>>>>>>>>>>>>>      send declare_function "sin"         VARTYP_NUMBER  "N"   FTYPE.BUILTIN 0 0               FG_TRIG
58894>>>>>>>>>>>>>      send declare_function "cos"         VARTYP_NUMBER  "N"   FTYPE.BUILTIN 0 0               FG_TRIG
58895>>>>>>>>>>>>>      send declare_function "tan"         VARTYP_NUMBER  "N"   FTYPE.BUILTIN 0 0               FG_TRIG
58896>>>>>>>>>>>>>    end
58896>>>>>>>>>>>>>>
58896>>>>>>>>>>>>>    // LOGICAL
58896>>>>>>>>>>>>>    send declare_function "not"         VARTYP_INTEGER "I"   FTYPE.BUILTIN 0 0               FG_LOGIC
58897>>>>>>>>>>>>>
58897>>>>>>>>>>>>>    if DFFALSE begin
58899>>>>>>>>>>>>>      // DBMS
58899>>>>>>>>>>>>>      send declare_function "OpenFile" VARTYP_INTEGER "III" FTYPE.GET 0 get_DBMS_OpenFile FG_BEYOND_DESCRIPTION
58900>>>>>>>>>>>>>      // Restructuring
58900>>>>>>>>>>>>>      send declare_function "RS_TableOpenNumber"      VARTYP_INTEGER "I"    FTYPE.GET 0 get_RS_TableOpenNumber      FG_BEYOND_DESCRIPTION
58901>>>>>>>>>>>>>      send declare_function "RS_TableProbeNumber"     VARTYP_INTEGER "I"    FTYPE.GET 0 get_RS_TableProbeNumber     FG_BEYOND_DESCRIPTION
58902>>>>>>>>>>>>>      send declare_function "RS_TableCreateName"      VARTYP_INTEGER "S"    FTYPE.GET 0 get_RS_TableCreateName      FG_BEYOND_DESCRIPTION
58903>>>>>>>>>>>>>      send declare_function "RS_TableDropName"        VARTYP_INTEGER "S"    FTYPE.GET 0 get_RS_TableDropName        FG_BEYOND_DESCRIPTION
58904>>>>>>>>>>>>>      send declare_function "RS_TableExistsName"      VARTYP_INTEGER "S"    FTYPE.GET 0 get_RS_TableExistsName      FG_BEYOND_DESCRIPTION
58905>>>>>>>>>>>>>      send declare_function "RS_CurrentFieldCount"    VARTYP_INTEGER ""     FTYPE.GET 0 get_RS_CurrentFieldCount    FG_BEYOND_DESCRIPTION
58906>>>>>>>>>>>>>      send declare_function "RS_GetFileAttr"          VARTYP_STRING  "I"    FTYPE.GET 0 get_RS_GetFileAttr          FG_BEYOND_DESCRIPTION
58907>>>>>>>>>>>>>      send declare_function "RS_GetFieldAttr"         VARTYP_STRING  "II"   FTYPE.GET 0 get_RS_GetFieldAttr         FG_BEYOND_DESCRIPTION
58908>>>>>>>>>>>>>      send declare_function "RS_GetIndexAttr"         VARTYP_STRING  "II"   FTYPE.GET 0 get_RS_GetIndexAttr         FG_BEYOND_DESCRIPTION
58909>>>>>>>>>>>>>      send declare_function "RS_GetIndexSegAttr"      VARTYP_STRING  "III"  FTYPE.GET 0 get_RS_GetIndexSegAttr      FG_BEYOND_DESCRIPTION
58910>>>>>>>>>>>>>      send declare_function "RS_GetFileListAttr"      VARTYP_STRING  "I"    FTYPE.GET 0 get_RS_GetFileListAttr      FG_BEYOND_DESCRIPTION
58911>>>>>>>>>>>>>
58911>>>>>>>>>>>>>      send declare_function "API_AttrValue_GLOBAL"    VARTYP_STRING  "I"    FTYPE.GET 0 get_API_AttrValue_GLOBAL    FG_BEYOND_DESCRIPTION
58912>>>>>>>>>>>>>      send declare_function "API_AttrValue_FILELIST"  VARTYP_STRING  "II"   FTYPE.GET 0 get_API_AttrValue_FILELIST  FG_BEYOND_DESCRIPTION
58913>>>>>>>>>>>>>      send declare_function "API_AttrValue_FILE"      VARTYP_STRING  "II"   FTYPE.GET 0 get_API_AttrValue_FILE      FG_BEYOND_DESCRIPTION
58914>>>>>>>>>>>>>      send declare_function "API_AttrValue_FIELD"     VARTYP_STRING  "III"  FTYPE.GET 0 get_API_AttrValue_FIELD     FG_BEYOND_DESCRIPTION
58915>>>>>>>>>>>>>      send declare_function "API_AttrValue_INDEX"     VARTYP_STRING  "III"  FTYPE.GET 0 get_API_AttrValue_INDEX     FG_BEYOND_DESCRIPTION
58916>>>>>>>>>>>>>      send declare_function "API_AttrValue_IDXSEG"    VARTYP_STRING  "IIII" FTYPE.GET 0 get_API_AttrValue_IDXSEG    FG_BEYOND_DESCRIPTION
58917>>>>>>>>>>>>>      send declare_function "API_AttrValue_SPECIAL1"  VARTYP_STRING  "IIII" FTYPE.GET 0 get_API_AttrValue_SPECIAL1  FG_BEYOND_DESCRIPTION
58918>>>>>>>>>>>>>      send declare_function "API_AttrValue_FLSTNAV"   VARTYP_STRING  "II"   FTYPE.GET 0 get_API_AttrValue_FLSTNAV   FG_BEYOND_DESCRIPTION
58919>>>>>>>>>>>>>      send declare_function "API_AttrValue_DRIVER"    VARTYP_STRING  "II"   FTYPE.GET 0 get_API_AttrValue_DRIVER    FG_BEYOND_DESCRIPTION
58920>>>>>>>>>>>>>      send declare_function "API_AttrValue_DRVSRV"    VARTYP_STRING  "III"  FTYPE.GET 0 get_API_AttrValue_DRVSRV    FG_BEYOND_DESCRIPTION
58921>>>>>>>>>>>>>
58921>>>>>>>>>>>>>      send declare_function "API_Attr_ValueName"      VARTYP_STRING  "IS"   FTYPE.GET 0 get_API_Attr_ValueName      FG_BEYOND_DESCRIPTION
58922>>>>>>>>>>>>>    end
58922>>>>>>>>>>>>>>
58922>>>>>>>>>>>>>    send delete_data to (oParameterStack(self))
58923>>>>>>>>>>>>>  end_procedure
58924>>>>>>>>>>>>>  procedure reverse_stack integer how_many#
58926>>>>>>>>>>>>>    integer obj1# obj2# itm#
58926>>>>>>>>>>>>>    move (oParameterStack(self))   to obj1#
58927>>>>>>>>>>>>>    move (oParameterReverse(self)) to obj2#
58928>>>>>>>>>>>>>    for itm# from 1 to how_many#
58934>>>>>>>>>>>>>>
58934>>>>>>>>>>>>>      send push.s to obj2# (sPop(obj1#))
58935>>>>>>>>>>>>>    loop
58936>>>>>>>>>>>>>>
58936>>>>>>>>>>>>>  end_procedure
58937>>>>>>>>>>>>>  function sExec_Function.i integer liRow returns string
58939>>>>>>>>>>>>>    integer msg# params# obj#
58939>>>>>>>>>>>>>    string rval#
58939>>>>>>>>>>>>>    get piMessage.i liRow to msg#
58940>>>>>>>>>>>>>    // Apparently the parameters to the get command are evaluated
58940>>>>>>>>>>>>>    // in reverse order, thus eliminating the need for me to reverse
58940>>>>>>>>>>>>>    // the parameters. What luck.
58940>>>>>>>>>>>>>  //move (oParameterReverse(self)) to obj#
58940>>>>>>>>>>>>>  //move (length(psParameterList.i(self,liRow))) to params#
58940>>>>>>>>>>>>>  //send reverse_stack params#
58940>>>>>>>>>>>>>    move (oParameterStack(self)) to obj#
58941>>>>>>>>>>>>>    move (length(psParameterList.i(self,liRow))) to params#
58942>>>>>>>>>>>>>    //send reverse_stack params#
58942>>>>>>>>>>>>>    if msg# begin //
58944>>>>>>>>>>>>>      if params# eq 0 get msg# to rval#
58947>>>>>>>>>>>>>      if params# eq 1 get msg# (sPop(obj#)) to rval#
58950>>>>>>>>>>>>>      if params# eq 2 get msg# (sPop(obj#)) (sPop(obj#)) to rval#
58953>>>>>>>>>>>>>      if params# eq 3 get msg# (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) to rval#
58956>>>>>>>>>>>>>      if params# eq 4 get msg# (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) to rval#
58959>>>>>>>>>>>>>      if params# eq 5 get msg# (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) to rval#
58962>>>>>>>>>>>>>      if params# eq 6 get msg# (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) to rval#
58965>>>>>>>>>>>>>      if (piReturnType.i(self,liRow)=VARTYP_DATE) begin
58967>>>>>>>>>>>>>//      showln "XXX: " rval#
58967>>>>>>>>>>>>>        function_return (date(rval#))
58968>>>>>>>>>>>>>      end
58968>>>>>>>>>>>>>>
58968>>>>>>>>>>>>>    end
58968>>>>>>>>>>>>>>
58968>>>>>>>>>>>>>    else begin // Script defined function
58969>>>>>>>>>>>>>    end
58969>>>>>>>>>>>>>>
58969>>>>>>>>>>>>>    function_return rval#
58970>>>>>>>>>>>>>  end_function
58971>>>>>>>>>>>>>  function iNameToNumber.s string name# returns integer
58973>>>>>>>>>>>>>    integer liRow max#
58973>>>>>>>>>>>>>    move (uppercase(name#)) to name#
58974>>>>>>>>>>>>>    get row_count to max#
58975>>>>>>>>>>>>>    for liRow from 0 to (max#-1)
58981>>>>>>>>>>>>>>
58981>>>>>>>>>>>>>      if name# eq (psName.i(self,liRow)) function_return liRow
58984>>>>>>>>>>>>>    loop
58985>>>>>>>>>>>>>>
58985>>>>>>>>>>>>>    function_return -1
58986>>>>>>>>>>>>>  end_function
58987>>>>>>>>>>>>>  procedure push_param string param#
58989>>>>>>>>>>>>>    send Push.s to (oParameterStack(self)) param#
58990>>>>>>>>>>>>>  end_procedure
58991>>>>>>>>>>>>>end_class // cDeclaredFunctions
58992>>>>>>>>>>>>>
58992>>>>>>>>>>>>>class cResolvedLabels is a cArray // Help class for cLabels class below
58993>>>>>>>>>>>>>  item_property_list
58993>>>>>>>>>>>>>    item_property string  psLabelName.i
58993>>>>>>>>>>>>>    item_property integer piLabelLine.i
58993>>>>>>>>>>>>>  end_item_property_list cResolvedLabels
#REM 59025 DEFINE FUNCTION PILABELLINE.I INTEGER LIROW RETURNS INTEGER
#REM 59029 DEFINE PROCEDURE SET PILABELLINE.I INTEGER LIROW INTEGER VALUE
#REM 59033 DEFINE FUNCTION PSLABELNAME.I INTEGER LIROW RETURNS STRING
#REM 59037 DEFINE PROCEDURE SET PSLABELNAME.I INTEGER LIROW STRING VALUE
59042>>>>>>>>>>>>>  function iFindLabel.s string labelid# returns integer // Has label already been defined?
59044>>>>>>>>>>>>>    integer max# liRow
59044>>>>>>>>>>>>>    get row_count to max#
59045>>>>>>>>>>>>>    move 0 to liRow
59046>>>>>>>>>>>>>    while liRow lt max#
59050>>>>>>>>>>>>>      if labelid# eq (psLabelName.i(self,liRow)) function_return liRow
59053>>>>>>>>>>>>>      increment liRow
59054>>>>>>>>>>>>>    end
59055>>>>>>>>>>>>>>
59055>>>>>>>>>>>>>    function_return -1 // Not found
59056>>>>>>>>>>>>>  end_function
59057>>>>>>>>>>>>>  function iLabelidToLine.s string labelid# returns integer
59059>>>>>>>>>>>>>    integer liRow line#
59059>>>>>>>>>>>>>    get iFindLabel.s labelid# to liRow
59060>>>>>>>>>>>>>    move -1 to line#
59061>>>>>>>>>>>>>    if liRow ne -1 get piLabelLine.i liRow to line#
59064>>>>>>>>>>>>>    function_return line#
59065>>>>>>>>>>>>>  end_function
59066>>>>>>>>>>>>>  procedure add_resolved_label string labelid# integer line#
59068>>>>>>>>>>>>>    integer liRow
59068>>>>>>>>>>>>>    if (iFindLabel.s(self,labelid#)=-1) begin
59070>>>>>>>>>>>>>      get row_count to liRow
59071>>>>>>>>>>>>>      set psLabelName.i liRow to labelid#
59072>>>>>>>>>>>>>      set piLabelLine.i liRow to line#
59073>>>>>>>>>>>>>    end
59073>>>>>>>>>>>>>>
59073>>>>>>>>>>>>>    else send add_ct_error line# ("ERROR! Label already defined: "+labelid#)
59075>>>>>>>>>>>>>  end_procedure
59076>>>>>>>>>>>>>  procedure add_resolved_label_no_error string labelid# integer line#
59078>>>>>>>>>>>>>    integer liRow
59078>>>>>>>>>>>>>    if (iFindLabel.s(self,labelid#)=-1) begin
59080>>>>>>>>>>>>>      get row_count to liRow
59081>>>>>>>>>>>>>      set psLabelName.i liRow to labelid#
59082>>>>>>>>>>>>>      set piLabelLine.i liRow to line#
59083>>>>>>>>>>>>>    end
59083>>>>>>>>>>>>>>
59083>>>>>>>>>>>>>  end_procedure
59084>>>>>>>>>>>>>end_class // cResolvedLabels
59085>>>>>>>>>>>>>
59085>>>>>>>>>>>>>class cLabels is a cArray
59086>>>>>>>>>>>>>  procedure construct_object integer img#
59088>>>>>>>>>>>>>    forward send construct_object img#
59090>>>>>>>>>>>>>    object oResolvedLabels is a cResolvedLabels
59092>>>>>>>>>>>>>    end_object
59093>>>>>>>>>>>>>    object oReferredLabels is a cSet
59095>>>>>>>>>>>>>    end_object
59096>>>>>>>>>>>>>  end_procedure
59097>>>>>>>>>>>>>  procedure reset
59099>>>>>>>>>>>>>    send delete_data
59100>>>>>>>>>>>>>    send delete_data to (oResolvedLabels(self))
59101>>>>>>>>>>>>>    send delete_data to (oReferredLabels(self))
59102>>>>>>>>>>>>>  end_procedure
59103>>>>>>>>>>>>>  procedure add_resolved_label string labelid# integer line#
59105>>>>>>>>>>>>>    send add_resolved_label to (oResolvedLabels(self)) labelid# line#
59106>>>>>>>>>>>>>  end_procedure
59107>>>>>>>>>>>>>  procedure add_resolved_label_no_error string labelid# integer line#
59109>>>>>>>>>>>>>    send add_resolved_label_no_error to (oResolvedLabels(self)) labelid# line#
59110>>>>>>>>>>>>>  end_procedure
59111>>>>>>>>>>>>>  procedure add_label_reference string labelid# integer obj# integer line#
59113>>>>>>>>>>>>>    integer labelno#
59113>>>>>>>>>>>>>    set value item (item_count(self)) to line#
59114>>>>>>>>>>>>>    get iAddOrFind_Element of (oReferredLabels(self)) labelid# to labelno#
59115>>>>>>>>>>>>>    set value of obj# item line# to labelno#
59116>>>>>>>>>>>>>  end_procedure
59117>>>>>>>>>>>>>  function sResolve_Labels.i integer obj# returns string // Obj# is the program array
59119>>>>>>>>>>>>>    integer itm# max# line# labelno# reflabels# reslabels# labelline#
59119>>>>>>>>>>>>>    string labelid# rval#
59119>>>>>>>>>>>>>    move "" to rval# // All is OK!
59120>>>>>>>>>>>>>    move (oResolvedLabels(self)) to reslabels#
59121>>>>>>>>>>>>>    move (oReferredLabels(self)) to reflabels#
59122>>>>>>>>>>>>>    get item_count to max#
59123>>>>>>>>>>>>>    for itm# from 0 to (max#-1)
59129>>>>>>>>>>>>>>
59129>>>>>>>>>>>>>      get value item itm# to line#
59130>>>>>>>>>>>>>      get value of obj# item line# to labelno#
59131>>>>>>>>>>>>>      get value of reflabels# item labelno# to labelid#
59132>>>>>>>>>>>>>      get iLabelidToLine.s of reslabels# labelid# to labelline#
59133>>>>>>>>>>>>>      set value of obj# item line# to labelline#
59134>>>>>>>>>>>>>      if labelline# eq -1 move labelid# to rval#
59137>>>>>>>>>>>>>    loop
59138>>>>>>>>>>>>>>
59138>>>>>>>>>>>>>    function_return rval#
59139>>>>>>>>>>>>>  end_function
59140>>>>>>>>>>>>>  function iIsLabelNameUsed.s string label# returns integer
59142>>>>>>>>>>>>>    integer rval#
59142>>>>>>>>>>>>>    get element_find of (oReferredLabels(self)) label# to rval#
59143>>>>>>>>>>>>>    if rval# eq -1 get iFindLabel.s of (oResolvedLabels(self)) label# to rval#
59146>>>>>>>>>>>>>    if rval# eq -1 function_return 0
59149>>>>>>>>>>>>>    function_return 1
59150>>>>>>>>>>>>>  end_function
59151>>>>>>>>>>>>>end_class // cLabels
59152>>>>>>>>>>>>>
59152>>>>>>>>>>>>>class cVariables is a cArray
59153>>>>>>>>>>>>>  item_property_list
59153>>>>>>>>>>>>>    item_property string  psName.i
59153>>>>>>>>>>>>>    item_property string  psValue.i
59153>>>>>>>>>>>>>    item_property integer piType.i
59153>>>>>>>>>>>>>  end_item_property_list cVariables
#REM 59188 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 59192 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 59196 DEFINE FUNCTION PSVALUE.I INTEGER LIROW RETURNS STRING
#REM 59200 DEFINE PROCEDURE SET PSVALUE.I INTEGER LIROW STRING VALUE
#REM 59204 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 59208 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
59213>>>>>>>>>>>>>  function iVarNameToVarNo string name# returns integer
59215>>>>>>>>>>>>>    integer liRow max# rval#
59215>>>>>>>>>>>>>    move (uppercase(name#)) to name#
59216>>>>>>>>>>>>>    get row_count to max#
59217>>>>>>>>>>>>>    move -1 to rval#
59218>>>>>>>>>>>>>    move 0 to liRow
59219>>>>>>>>>>>>>    while (liRow>>>>>>>>>>>>      if name# eq (psName.i(self,liRow)) move liRow to rval#
59226>>>>>>>>>>>>>      increment liRow
59227>>>>>>>>>>>>>    end
59228>>>>>>>>>>>>>>
59228>>>>>>>>>>>>>    function_return rval#
59229>>>>>>>>>>>>>  end_function
59230>>>>>>>>>>>>>  register_function piProgramCounter returns integer
59230>>>>>>>>>>>>>  procedure VarNameDeclare string name# integer type#
59232>>>>>>>>>>>>>    integer liRow
59232>>>>>>>>>>>>>    move (uppercase(name#)) to name#
59233>>>>>>>>>>>>>    get iVarNameToVarNo name# to liRow
59234>>>>>>>>>>>>>    if liRow eq -1 begin
59236>>>>>>>>>>>>>      get row_count to liRow
59237>>>>>>>>>>>>>      set psName.i  liRow to name#
59238>>>>>>>>>>>>>      set psValue.i liRow to ""
59239>>>>>>>>>>>>>      set piType.i  liRow to type#
59240>>>>>>>>>>>>>    end
59240>>>>>>>>>>>>>>
59240>>>>>>>>>>>>>    else send add_ct_error (piProgramCounter(self)) ("Variable already defined ("+name#+")")
59242>>>>>>>>>>>>>  end_procedure
59243>>>>>>>>>>>>>  function sVarValue integer varno# returns string
59245>>>>>>>>>>>>>    function_return (psValue.i(self,varno#))
59246>>>>>>>>>>>>>  end_function
59247>>>>>>>>>>>>>  procedure VarIncrement integer varno# integer amount#
59249>>>>>>>>>>>>>    set psValue.i varno# to (psValue.i(self,varno#)+amount#)
59250>>>>>>>>>>>>>  end_procedure
59251>>>>>>>>>>>>>  procedure VarAssign integer varno# string value#
59253>>>>>>>>>>>>>    integer type#
59253>>>>>>>>>>>>>    get piType.i varno# to type#
59254>>>>>>>>>>>>>    if type# eq VARTYP_INTEGER set psValue.i varno# to (integer(value#))
59257>>>>>>>>>>>>>    if type# eq VARTYP_NUMBER  set psValue.i varno# to (number(value#))
59260>>>>>>>>>>>>>    if type# eq VARTYP_DATE    set psValue.i varno# to (date(value#))
59263>>>>>>>>>>>>>    if type# eq VARTYP_STRING  set psValue.i varno# to (string(value#))
59266>>>>>>>>>>>>>  end_procedure
59267>>>>>>>>>>>>>  procedure VarDisplay
59269>>>>>>>>>>>>>    integer liRow max#
59269>>>>>>>>>>>>>    string str#
59269>>>>>>>>>>>>>    move "" to str#
59270>>>>>>>>>>>>>    get row_count to max#
59271>>>>>>>>>>>>>    for liRow from 0 to (max#-1)
59277>>>>>>>>>>>>>>
59277>>>>>>>>>>>>>      move (str#+psName.i(self,liRow)+": "+psValue.i(self,liRow)) to str#
59278>>>>>>>>>>>>>      if liRow ne (max#-1) move (str#+character(10)) to str#
59281>>>>>>>>>>>>>    loop
59282>>>>>>>>>>>>>>
59282>>>>>>>>>>>>>    send obs str#
59283>>>>>>>>>>>>>  end_procedure
59284>>>>>>>>>>>>>end_class // cVariables
59285>>>>>>>>>>>>>
59285>>>>>>>>>>>>>
59285>>>>>>>>>>>>>function sExprOp_Text.i global integer op# returns string
59287>>>>>>>>>>>>>  enumeration_list
59287>>>>>>>>>>>>>    define_exprop EXPROP.ERROR           "Error"            //  0
59290>>>>>>>>>>>>>    define_exprop EXPROP.TYPE            "TypeDef"          //  1
59293>>>>>>>>>>>>>    define_exprop EXPROP.APPEND          "Append"           //  2
59296>>>>>>>>>>>>>    define_exprop EXPROP.PUSH_EXPRESSION "PushExpr"         //  3
59299>>>>>>>>>>>>>    define_exprop EXPROP.PUSH_PARAM      "PushParam"        //  4
59302>>>>>>>>>>>>>    define_exprop EXPROP.EXEC_FUNCTION   "Exec&Pop&Append"  //  5
59305>>>>>>>>>>>>>    define_exprop EXPROP.EXEC_SFUNCTION  "Exec&sPop&Append" //  6
59308>>>>>>>>>>>>>    define_exprop EXPROP.GET_IVAR        "Get iVar"         //  7
59311>>>>>>>>>>>>>    define_exprop EXPROP.GET_DVAR        "Get dVar"         //  8
59314>>>>>>>>>>>>>    define_exprop EXPROP.GET_NVAR        "Get nVar"         //  9
59317>>>>>>>>>>>>>    define_exprop EXPROP.GET_SVAR        "Get sVar"         // 10
59320>>>>>>>>>>>>>    define_exprop EXPROP.GET_IFIELD      "Get iField"       // 11
59323>>>>>>>>>>>>>    define_exprop EXPROP.GET_DFIELD      "Get dField"       // 12
59326>>>>>>>>>>>>>    define_exprop EXPROP.GET_NFIELD      "Get nField"       // 13
59329>>>>>>>>>>>>>    define_exprop EXPROP.GET_SFIELD      "Get sField"       // 14
59332>>>>>>>>>>>>>    define_exprop EXPROP.END             "ExprEnd"          // 15
59335>>>>>>>>>>>>>  end_enumeration_list
59335>>>>>>>>>>>>>  function_return "Error"
59336>>>>>>>>>>>>>end_function
59337>>>>>>>>>>>>>
59337>>>>>>>>>>>>>desktop_section
59342>>>>>>>>>>>>>  integer ghExpressionErrorHandler
59342>>>>>>>>>>>>>  object oExpressionErrorHandler is a cErrorHandlerRedirector NO_IMAGE
59344>>>>>>>>>>>>>    item_property_list
59344>>>>>>>>>>>>>      item_property integer piError.i
59344>>>>>>>>>>>>>      item_property string  psErrorText.i
59344>>>>>>>>>>>>>      item_property integer piErrorLine.i
59344>>>>>>>>>>>>>    end_item_property_list
#REM 59384 DEFINE FUNCTION PIERRORLINE.I INTEGER LIROW RETURNS INTEGER
#REM 59389 DEFINE PROCEDURE SET PIERRORLINE.I INTEGER LIROW INTEGER VALUE
#REM 59394 DEFINE FUNCTION PSERRORTEXT.I INTEGER LIROW RETURNS STRING
#REM 59399 DEFINE PROCEDURE SET PSERRORTEXT.I INTEGER LIROW STRING VALUE
#REM 59404 DEFINE FUNCTION PIERROR.I INTEGER LIROW RETURNS INTEGER
#REM 59409 DEFINE PROCEDURE SET PIERROR.I INTEGER LIROW INTEGER VALUE
59415>>>>>>>>>>>>>    procedure OnError integer liError string lsErrorText integer liErrorLine
59418>>>>>>>>>>>>>      integer liRow
59418>>>>>>>>>>>>>//    showln "Error: "  liError " " lsErrorText " " liErrorLine
59418>>>>>>>>>>>>>      get row_count to liRow
59419>>>>>>>>>>>>>      set piError.i     liRow to liError
59420>>>>>>>>>>>>>      set psErrorText.i liRow to lsErrorText
59421>>>>>>>>>>>>>      set piErrorLine.i liRow to liErrorLine
59422>>>>>>>>>>>>>    end_procedure
59423>>>>>>>>>>>>>    move self to ghExpressionErrorHandler
59424>>>>>>>>>>>>>  end_object
59425>>>>>>>>>>>>>end_desktop_section
59430>>>>>>>>>>>>>
59430>>>>>>>>>>>>>class cEvalSequence is a cArray
59431>>>>>>>>>>>>>  procedure construct_object integer img#
59433>>>>>>>>>>>>>    forward send construct_object img#
59435>>>>>>>>>>>>>    object oStack is a cStack no_image
59437>>>>>>>>>>>>>    end_object
59438>>>>>>>>>>>>>    property integer piFunctionObject public 0
59439>>>>>>>>>>>>>  end_procedure
59440>>>>>>>>>>>>>  item_property_list
59440>>>>>>>>>>>>>    item_property integer piOpCode.i
59440>>>>>>>>>>>>>    item_property string  psVar.i
59440>>>>>>>>>>>>>  end_item_property_list cEvalSequence
#REM 59472 DEFINE FUNCTION PSVAR.I INTEGER LIROW RETURNS STRING
#REM 59476 DEFINE PROCEDURE SET PSVAR.I INTEGER LIROW STRING VALUE
#REM 59480 DEFINE FUNCTION PIOPCODE.I INTEGER LIROW RETURNS INTEGER
#REM 59484 DEFINE PROCEDURE SET PIOPCODE.I INTEGER LIROW INTEGER VALUE
59489>>>>>>>>>>>>>  function insert_and_append_quotes string str# returns string
59491>>>>>>>>>>>>>    function_return (MakeStringConstantMax255(str#))
59492>>>>>>>>>>>>>  end_function
59493>>>>>>>>>>>>>  register_function iVarValue integer varno# returns integer
59493>>>>>>>>>>>>>  register_function dVarValue integer varno# returns integer // date
59493>>>>>>>>>>>>>  register_function nVarValue integer varno# returns number
59493>>>>>>>>>>>>>  register_function sVarValue integer varno# returns string
59493>>>>>>>>>>>>>  function iFieldValue integer liFileField returns integer
59495>>>>>>>>>>>>>    integer liRval
59495>>>>>>>>>>>>>    get_field_value (liFileField/65536) (mod(liFileField,65536)) to liRval
59498>>>>>>>>>>>>>    function_return liRval
59499>>>>>>>>>>>>>  end_function
59500>>>>>>>>>>>>>  function dFieldValue integer liFileField returns integer //date
59502>>>>>>>>>>>>>    date ldRval
59502>>>>>>>>>>>>>    get_field_value (liFileField/65536) (mod(liFileField,65536)) to ldRval
59505>>>>>>>>>>>>>    function_return ldRval
59506>>>>>>>>>>>>>  end_function
59507>>>>>>>>>>>>>  function nFieldValue integer liFileField returns number
59509>>>>>>>>>>>>>    number lnRval
59509>>>>>>>>>>>>>    get_field_value (liFileField/65536) (mod(liFileField,65536)) to lnRval
59512>>>>>>>>>>>>>    function_return lnRval
59513>>>>>>>>>>>>>  end_function
59514>>>>>>>>>>>>>  function sFieldValue integer liFileField returns string
59516>>>>>>>>>>>>>    string lsRval
59516>>>>>>>>>>>>>    get_field_value (liFileField/65536) (mod(liFileField,65536)) to lsRval
59519>>>>>>>>>>>>>    function_return (rtrim(lsRval))
59520>>>>>>>>>>>>>  end_function
59521>>>>>>>>>>>>>  procedure Handle_ExprEvalError integer liExprId string lsExpr
59523>>>>>>>>>>>>>    integer liMax liRow
59523>>>>>>>>>>>>>    string lsValue
59523>>>>>>>>>>>>>    get row_count of ghExpressionErrorHandler to liMax
59524>>>>>>>>>>>>>    decrement liMax
59525>>>>>>>>>>>>>    showln ""
59527>>>>>>>>>>>>>    showln "DataFlex reported this error:"
59529>>>>>>>>>>>>>    for liRow from 0 to liMax
59535>>>>>>>>>>>>>>
59535>>>>>>>>>>>>>      show (piError.i(ghExpressionErrorHandler,liRow)) ", "
59537>>>>>>>>>>>>>      get psErrorText.i of ghExpressionErrorHandler liRow to lsValue
59538>>>>>>>>>>>>>      show lsValue " on line "
59540>>>>>>>>>>>>>      showln (piErrorLine.i(ghExpressionErrorHandler,liRow))
59542>>>>>>>>>>>>>    loop
59543>>>>>>>>>>>>>>
59543>>>>>>>>>>>>>    showln "while executing this expression:"
59545>>>>>>>>>>>>>    showln lsExpr
59547>>>>>>>>>>>>>  end_procedure
59548>>>>>>>>>>>>>  function sExec_Expression.i integer liExprId returns string
59550>>>>>>>>>>>>>    integer op# stack# funcobj# liDec liType liRow
59550>>>>>>>>>>>>>    string expression# lsRval
59550>>>>>>>>>>>>>    send DoReset to ghExpressionErrorHandler
59551>>>>>>>>>>>>>    send DoActivate to ghExpressionErrorHandler
59552>>>>>>>>>>>>>    move liExprId to liRow
59553>>>>>>>>>>>>>    get_attribute DF_DECIMAL_SEPARATOR to liDec
59556>>>>>>>>>>>>>    set_attribute DF_DECIMAL_SEPARATOR to 46 // "."
59559>>>>>>>>>>>>>    move (oStack(self)) to stack#
59560>>>>>>>>>>>>>    move (piFunctionObject(self)) to funcobj#
59561>>>>>>>>>>>>> // showln "Hello "  liRow " " (value(self,liRow-1))
59561>>>>>>>>>>>>> //
59561>>>>>>>>>>>>> // direct_output channel 1 "c:\cc.ccc"
59561>>>>>>>>>>>>> // for windowindex from 0 to (item_count(self)-1)
59561>>>>>>>>>>>>> //   writeln channel 1 (value(self,windowindex))
59561>>>>>>>>>>>>> // loop
59561>>>>>>>>>>>>> // close_output channel 1
59561>>>>>>>>>>>>> // send obs "OK!"
59561>>>>>>>>>>>>>
59561>>>>>>>>>>>>>    move "" to expression#
59562>>>>>>>>>>>>>    get psVar.i (liRow-1) to liType
59563>>>>>>>>>>>>>    repeat
59563>>>>>>>>>>>>>>
59563>>>>>>>>>>>>>      get piOpCode.i liRow to op#
59564>>>>>>>>>>>>>      //showln (sExprOp_Text.i(op#)) " " (psVar.i(self,liRow)) " Expr: " expression#
59564>>>>>>>>>>>>>      if op# ne EXPROP.END begin
59566>>>>>>>>>>>>>        if op# eq EXPROP.GET_IVAR move (expression#+string(iVarValue(self,psVar.i(self,liRow)))) to expression#
59569>>>>>>>>>>>>>        if op# eq EXPROP.GET_DVAR move (expression#+string(dVarValue(self,psVar.i(self,liRow)))) to expression#
59572>>>>>>>>>>>>>        if op# eq EXPROP.GET_NVAR move (expression#+string(nVarValue(self,psVar.i(self,liRow)))) to expression#
59575>>>>>>>>>>>>>        if op# eq EXPROP.GET_SVAR move (expression#+MakeStringConstantMax255(sVarValue(self,psVar.i(self,liRow)))) to expression#
59578>>>>>>>>>>>>>        if op# eq EXPROP.GET_IFIELD move (expression#+string(iFieldValue(self,psVar.i(self,liRow)))) to expression#
59581>>>>>>>>>>>>>        if op# eq EXPROP.GET_DFIELD move (expression#+string(dFieldValue(self,psVar.i(self,liRow)))) to expression#
59584>>>>>>>>>>>>>        if op# eq EXPROP.GET_NFIELD move (expression#+string(nFieldValue(self,psVar.i(self,liRow)))) to expression#
59587>>>>>>>>>>>>>        if op# eq EXPROP.GET_SFIELD move (expression#+MakeStringConstantMax255(sFieldValue(self,psVar.i(self,liRow)))) to expression#
59590>>>>>>>>>>>>>        if op# eq EXPROP.APPEND move (expression#+psVar.i(self,liRow)) to expression#
59593>>>>>>>>>>>>>        if op# eq EXPROP.PUSH_EXPRESSION begin
59595>>>>>>>>>>>>>          send push.s to stack# expression#
59596>>>>>>>>>>>>>          move "" to expression#
59597>>>>>>>>>>>>>        end
59597>>>>>>>>>>>>>>
59597>>>>>>>>>>>>>        if op# eq EXPROP.PUSH_PARAM begin
59599>>>>>>>>>>>>>          send push_param to funcobj# (eval(expression#))
59600>>>>>>>>>>>>>          move "" to expression#
59601>>>>>>>>>>>>>        end
59601>>>>>>>>>>>>>>
59601>>>>>>>>>>>>>        if op# eq EXPROP.EXEC_FUNCTION begin // Exec, Pop Expr and Append
59603>>>>>>>>>>>>>          get sExec_Function.i of funcobj# (integer(psVar.i(self,liRow))) to expression#
59604>>>>>>>>>>>>>          move (sPop(stack#)+expression#) to expression#
59605>>>>>>>>>>>>>        end
59605>>>>>>>>>>>>>>
59605>>>>>>>>>>>>>        if op# eq EXPROP.EXEC_SFUNCTION begin // Exec, Pop Expr and Append
59607>>>>>>>>>>>>>          // In this case we have to insert and append quotes
59607>>>>>>>>>>>>>          get sExec_Function.i of funcobj# (integer(psVar.i(self,liRow))) to expression#
59608>>>>>>>>>>>>>          get insert_and_append_quotes expression# to expression#
59609>>>>>>>>>>>>>          move (sPop(stack#)+expression#) to expression#
59610>>>>>>>>>>>>>        end
59610>>>>>>>>>>>>>>
59610>>>>>>>>>>>>>      end
59610>>>>>>>>>>>>>>
59610>>>>>>>>>>>>>      increment liRow
59611>>>>>>>>>>>>>//      showln ": " expression#
59611>>>>>>>>>>>>>    until op# eq EXPROP.END
59613>>>>>>>>>>>>>    if (expression#="()") move "" to lsRval
59616>>>>>>>>>>>>>    else move (eval(expression#)) to lsRval
59618>>>>>>>>>>>>>//  showln expression#
59618>>>>>>>>>>>>>    set_attribute DF_DECIMAL_SEPARATOR to liDec
59621>>>>>>>>>>>>>//  showln "After expr1: " liDec " " liType " Value: " lsRval
59621>>>>>>>>>>>>>
59621>>>>>>>>>>>>>    if (liType=VARTYP_DATE) begin
59623>>>>>>>>>>>>>      move (date(lsRval)) to lsRval
59624>>>>>>>>>>>>>    end
59624>>>>>>>>>>>>>>
59624>>>>>>>>>>>>>    if (liType=VARTYP_NUMBER or liType=VARTYP_INTEGER) begin
59626>>>>>>>>>>>>>//    showln "Was number or integer " lsRval
59626>>>>>>>>>>>>>      if (liDec<>46) move (replace(".",lsRval,",")) to lsRval
59629>>>>>>>>>>>>>    end
59629>>>>>>>>>>>>>>
59629>>>>>>>>>>>>>//    showln "After expr2: " liDec " " liType " Value: " lsRval
59629>>>>>>>>>>>>>    send DoDeactivate to ghExpressionErrorHandler
59630>>>>>>>>>>>>>    if (row_count(ghExpressionErrorHandler)) begin
59632>>>>>>>>>>>>>      // Af this point we know that there was an error while evaluating
59632>>>>>>>>>>>>>      // the expression.
59632>>>>>>>>>>>>>      send Handle_ExprEvalError liExprId expression#
59633>>>>>>>>>>>>>    end
59633>>>>>>>>>>>>>>
59633>>>>>>>>>>>>>    function_return lsRval
59634>>>>>>>>>>>>>  end_function
59635>>>>>>>>>>>>>  procedure add_expr_instruction integer op# string item#
59637>>>>>>>>>>>>>    integer liRow
59637>>>>>>>>>>>>>    get row_count to liRow
59638>>>>>>>>>>>>>    set piOpCode.i liRow to op#
59639>>>>>>>>>>>>>    set psVar.i    liRow to item#
59640>>>>>>>>>>>>>  end_procedure
59641>>>>>>>>>>>>>  procedure RemoveSuperfluosPar
59643>>>>>>>>>>>>>//  integer max#
59643>>>>>>>>>>>>>//  get row_count to max#
59643>>>>>>>>>>>>>//  decrement max#
59643>>>>>>>>>>>>>//  decrement max#
59643>>>>>>>>>>>>>//  if (piOpCode.i(self,1)=EXPROP.APPEND and psVar.i(self,1)="(" and piOpCode.i(self,max#)=EXPROP.APPEND and psVar.i(self,max#)=")") begin
59643>>>>>>>>>>>>>//    send delete_row max#
59643>>>>>>>>>>>>>//    send delete_row 1
59643>>>>>>>>>>>>>//    send RemoveSuperfluosPar
59643>>>>>>>>>>>>>//  end
59643>>>>>>>>>>>>>  end_procedure
59644>>>>>>>>>>>>>  procedure Optimize
59646>>>>>>>>>>>>>    integer liRow
59646>>>>>>>>>>>>>    send RemoveSuperfluosPar
59647>>>>>>>>>>>>>    move 0 to liRow
59648>>>>>>>>>>>>>    while (liRow>>>>>>>>>>>>      if (piOpCode.i(self,liRow)=EXPROP.APPEND and piOpCode.i(self,liRow+1)=EXPROP.APPEND) begin
59654>>>>>>>>>>>>>        set psVar.i liRow to (psVar.i(self,liRow)+psVar.i(self,liRow+1))
59655>>>>>>>>>>>>>        send delete_row (liRow+1)
59656>>>>>>>>>>>>>      end
59656>>>>>>>>>>>>>>
59656>>>>>>>>>>>>>      else increment liRow
59658>>>>>>>>>>>>>    end
59659>>>>>>>>>>>>>>
59659>>>>>>>>>>>>>  end_procedure
59660>>>>>>>>>>>>>  procedure reset
59662>>>>>>>>>>>>>    send delete_data
59663>>>>>>>>>>>>>    send delete_data to (oStack(self))
59664>>>>>>>>>>>>>  end_procedure
59665>>>>>>>>>>>>>  function iAppendToOtherSequence integer target_obj# returns integer
59667>>>>>>>>>>>>>    integer liRow remote_row# max#
59667>>>>>>>>>>>>>    get row_count of target_obj# to remote_row#
59668>>>>>>>>>>>>>    get row_count to max#
59669>>>>>>>>>>>>>    decrement max#
59670>>>>>>>>>>>>>    for liRow from 0 to max#
59676>>>>>>>>>>>>>>
59676>>>>>>>>>>>>>      send add_expr_instruction to target_obj# (piOpCode.i(self,liRow)) (psVar.i(self,liRow))
59677>>>>>>>>>>>>>    loop
59678>>>>>>>>>>>>>>
59678>>>>>>>>>>>>>    function_return remote_row#
59679>>>>>>>>>>>>>  end_function
59680>>>>>>>>>>>>>end_class // cEvalSequence
59681>>>>>>>>>>>>>
59681>>>>>>>>>>>>>register_procedure mthd_Nop
59681>>>>>>>>>>>>>register_procedure mthd_ClearScreen
59681>>>>>>>>>>>>>register_procedure mthd_Abort
59681>>>>>>>>>>>>>register_procedure mthd_Gosub
59681>>>>>>>>>>>>>register_procedure mthd_Goto
59681>>>>>>>>>>>>>register_procedure mthd_Return
59681>>>>>>>>>>>>>register_procedure mthd_ShowLn
59681>>>>>>>>>>>>>register_procedure mthd_Show
59681>>>>>>>>>>>>>register_procedure mthd_SeqFile
59681>>>>>>>>>>>>>register_procedure mthd_WriteLn
59681>>>>>>>>>>>>>register_procedure mthd_MsgBox
59681>>>>>>>>>>>>>register_procedure mthd_GotoXY
59681>>>>>>>>>>>>>register_procedure mthd_Input
59681>>>>>>>>>>>>>register_procedure mthd_Pause
59681>>>>>>>>>>>>>register_procedure mthd_Assign
59681>>>>>>>>>>>>>register_procedure mthd_gVar_Incr
59681>>>>>>>>>>>>>register_procedure mthd_gVar_Display
59681>>>>>>>>>>>>>register_procedure mthd_if_goto
59681>>>>>>>>>>>>>register_procedure mthd_if_gosub
59681>>>>>>>>>>>>>register_procedure mthd_iftest_goto
59681>>>>>>>>>>>>>register_procedure mthd_iftest_gosub
59681>>>>>>>>>>>>>register_procedure mthd_debug
59681>>>>>>>>>>>>>register_procedure mthd_log_open
59681>>>>>>>>>>>>>register_procedure mthd_log_close
59681>>>>>>>>>>>>>register_procedure mthd_log_display
59681>>>>>>>>>>>>>register_procedure mthd_log_flush
59681>>>>>>>>>>>>>register_procedure mthd_log_write
59681>>>>>>>>>>>>>register_procedure mthd_log_writeln
59681>>>>>>>>>>>>>register_procedure mthd_api_filelist
59681>>>>>>>>>>>>>register_procedure mthd_api_file
59681>>>>>>>>>>>>>register_procedure mthd_api_field
59681>>>>>>>>>>>>>register_procedure mthd_api_index
59681>>>>>>>>>>>>>register_procedure mthd_api_idxseg
59681>>>>>>>>>>>>>register_procedure mthd_api_structure_abort
59681>>>>>>>>>>>>>register_procedure mthd_api_structure_end
59681>>>>>>>>>>>>>register_procedure mthd_api_probe_end
59681>>>>>>>>>>>>>register_procedure mthd_api_deleteindex
59681>>>>>>>>>>>>>register_procedure mthd_api_deletefield
59681>>>>>>>>>>>>>register_procedure mthd_api_appendfield
59681>>>>>>>>>>>>>register_procedure mthd_api_createfield
59681>>>>>>>>>>>>>register_procedure mthd_api_setfieldnumber
59681>>>>>>>>>>>>>
59681>>>>>>>>>>>>>integer oVM_CurrentlyExecuting#
59681>>>>>>>>>>>>>class cBasicVirtualMachine is an cArray
59682>>>>>>>>>>>>>  procedure construct_object integer img#
59684>>>>>>>>>>>>>    forward send construct_object img#
59686>>>>>>>>>>>>>    property integer piProgramCounter      public 0
59687>>>>>>>>>>>>>    property integer piInvalidProgram      public 0
59688>>>>>>>>>>>>>    property integer piDebugState          public 0
59689>>>>>>>>>>>>>    property integer piDebugSingleStep     public 0
59690>>>>>>>>>>>>>    property string  psDebugLine           public ""
59691>>>>>>>>>>>>>    property integer pCurrentOpCodeLine    public 0
59692>>>>>>>>>>>>>    property integer pProgramEnded         public 0
59693>>>>>>>>>>>>>    property integer private.piLogChannel  public -1
59694>>>>>>>>>>>>>    property string  private.psLogFileName public ""
59695>>>>>>>>>>>>>    property integer phFDX_Server       public 0
59696>>>>>>>>>>>>>    object oOpcodes is a cOpCodes // OpCodes -> messages id's
59698>>>>>>>>>>>>>      send add_opcode OP_NOP                 "No operation"    msg_mthd_Nop                 0 0
59699>>>>>>>>>>>>>      send add_opcode OP_ABORT               "EndProgram."     msg_mthd_Abort               0 0
59700>>>>>>>>>>>>>      send add_opcode OP_CLEARSCREEN         "ClearScreen"     msg_mthd_ClearScreen         0 0
59701>>>>>>>>>>>>>      send add_opcode OP_GOSUB               "Gosub"           msg_mthd_Gosub               1 0
59702>>>>>>>>>>>>>      send add_opcode OP_GOTO                "Goto"            msg_mthd_Goto                1 0
59703>>>>>>>>>>>>>      send add_opcode OP_RETURN              "Return"          msg_mthd_Return              0 0
59704>>>>>>>>>>>>>      send add_opcode OP_SHOWLN              "ShowLn"          msg_mthd_ShowLn              1 0
59705>>>>>>>>>>>>>      send add_opcode OP_SHOW                "Show"            msg_mthd_Show                1 0
59706>>>>>>>>>>>>>      send add_opcode OP_SEQFILE             "SeqFile"         msg_mthd_SeqFile             2 0
59707>>>>>>>>>>>>>      send add_opcode OP_WRITELN             "WriteLn"         msg_mthd_WriteLn             1 0
59708>>>>>>>>>>>>>      send add_opcode OP_MSGBOX              "MsgBox"          msg_mthd_MsgBox              1 0
59709>>>>>>>>>>>>>      send add_opcode OP_INPUT               "Input"           msg_mthd_Input               2 0
59710>>>>>>>>>>>>>      send add_opcode OP_GOTOXY              "GotoXY"          msg_mthd_GotoXY              2 0
59711>>>>>>>>>>>>>      send add_opcode OP_PAUSE               "Pause"           msg_mthd_Pause               0 0
59712>>>>>>>>>>>>>      send add_opcode OP_ASSIGN              "Assign"          msg_mthd_Assign              2 0
59713>>>>>>>>>>>>>      send add_opcode OP_GVAR_INCR           "gVarIncrement"   msg_mthd_gVar_Incr           2 0
59714>>>>>>>>>>>>>      send add_opcode OP_GVAR_DISPLAY        "gVarDisplay"     msg_mthd_gVar_Display        0 0
59715>>>>>>>>>>>>>      send add_opcode OP_IF_GOTO             "IfGoto"          msg_mthd_if_goto             2 0
59716>>>>>>>>>>>>>      send add_opcode OP_IF_GOSUB            "IfGoSub"         msg_mthd_if_gosub            2 0
59717>>>>>>>>>>>>>      send add_opcode OP_IFTEST_GOTO         "IfTestGoto"      msg_mthd_iftest_goto         4 0
59718>>>>>>>>>>>>>      send add_opcode OP_IFTEST_GOSUB        "IfTestGoSub"     msg_mthd_iftest_gosub        4 0
59719>>>>>>>>>>>>>      send add_opcode OP_DEBUG               "Debug"           msg_mthd_debug               1 0
59720>>>>>>>>>>>>>      send add_opcode OP_LOG_OPEN            "LogOpen"         msg_mthd_log_open            2 0
59721>>>>>>>>>>>>>      send add_opcode OP_LOG_CLOSE           "LogClose"        msg_mthd_log_close           0 0
59722>>>>>>>>>>>>>      send add_opcode OP_LOG_DISPLAY         "LogDisplay"      msg_mthd_log_display         0 0
59723>>>>>>>>>>>>>      send add_opcode OP_LOG_FLUSH           "LogFlush"        msg_mthd_log_flush           0 0
59724>>>>>>>>>>>>>      send add_opcode OP_LOG_WRITE           "LogWrite"        msg_mthd_log_write           1 0
59725>>>>>>>>>>>>>      send add_opcode OP_LOG_WRITELN         "LogWriteLn"      msg_mthd_log_writeln         1 0
59726>>>>>>>>>>>>>      send add_opcode OP_API_FILELIST        "SetAttrFileList" msg_mthd_api_filelist        3 0
59727>>>>>>>>>>>>>      send add_opcode OP_API_FILE            "SetAttrFile"     msg_mthd_api_file            2 0
59728>>>>>>>>>>>>>      send add_opcode OP_API_FIELD           "SetAttrField"    msg_mthd_api_field           3 0
59729>>>>>>>>>>>>>      send add_opcode OP_API_INDEX           "SetAttrIndex"    msg_mthd_api_index           3 0
59730>>>>>>>>>>>>>      send add_opcode OP_API_IDXSEG          "SetAttrIdxSeg"   msg_mthd_api_idxseg          4 0
59731>>>>>>>>>>>>>      send add_opcode OP_API_STRUCTURE_ABORT "StructureAbort"  msg_mthd_api_structure_abort 0 0
59732>>>>>>>>>>>>>      send add_opcode OP_API_STRUCTURE_END   "StructureEnd"    msg_mthd_api_structure_end   0 0
59733>>>>>>>>>>>>>      send add_opcode OP_API_PROBE_END       "ProbeEnd"        msg_mthd_api_probe_end       0 0
59734>>>>>>>>>>>>>      send add_opcode OP_API_DELETEINDEX     "DeleteIndex"     msg_mthd_api_deleteindex     1 0
59735>>>>>>>>>>>>>      send add_opcode OP_API_DELETEFIELD     "DeleteField"     msg_mthd_api_deletefield     1 0
59736>>>>>>>>>>>>>      send add_opcode OP_API_APPENDFIELD     "AppendField"     msg_mthd_api_appendfield     2 0
59737>>>>>>>>>>>>>      send add_opcode OP_API_CREATEFIELD     "CreateField"     msg_mthd_api_createfield     3 0
59738>>>>>>>>>>>>>      send add_opcode OP_API_SETFIELDNUMBER  "SetFieldNumber"  msg_mthd_api_setfieldnumber  1 0
59739>>>>>>>>>>>>>    end_object
59740>>>>>>>>>>>>>    object oLabels is a cLabels no_image // Used during program entry
59742>>>>>>>>>>>>>    end_object
59743>>>>>>>>>>>>>    object oReturnAddressStack is a cStack no_image // Return addresses (Gosub's)
59745>>>>>>>>>>>>>    end_object
59746>>>>>>>>>>>>>    object oVariables is a cVariables no_image
59748>>>>>>>>>>>>>    end_object
59749>>>>>>>>>>>>>    object oDeclaredArrays is a cDeclaredArrays no_image
59751>>>>>>>>>>>>>    end_object
59752>>>>>>>>>>>>>    object oDeclaredFunctions is a cDeclaredFunctions no_image
59754>>>>>>>>>>>>>    end_object
59755>>>>>>>>>>>>>    object oExprEvalSequences is a cEvalSequence no_image
59757>>>>>>>>>>>>>      set piFunctionObject to (oDeclaredFunctions(self))
59758>>>>>>>>>>>>>    end_object
59759>>>>>>>>>>>>>  end_procedure
59760>>>>>>>>>>>>>
59760>>>>>>>>>>>>>  procedure add_opcode integer opcode# string name# integer msg# integer params# integer special_add_msg#
59762>>>>>>>>>>>>>    send add_opcode to (oOpcodes(self)) opcode# name# msg# params# special_add_msg#
59763>>>>>>>>>>>>>  end_procedure
59764>>>>>>>>>>>>>
59764>>>>>>>>>>>>>  function sEvalExpression integer id# returns string
59766>>>>>>>>>>>>>    function_return (sExec_Expression.i(oExprEvalSequences(self),id#))
59767>>>>>>>>>>>>>  end_function
59768>>>>>>>>>>>>>
59768>>>>>>>>>>>>>  function sArgValue.is integer type# string arg# returns string
59770>>>>>>>>>>>>>    if type# eq AT_VARNO get sVarValue arg# to arg#
59773>>>>>>>>>>>>>    if type# eq AT_EXPR  get sEvalExpression arg# to arg#
59776>>>>>>>>>>>>>    if type# eq AT_FIELDNO get_field_value (hi(integer(arg#))) (low(integer(arg#))) to arg#
59781>>>>>>>>>>>>>    if type# eq AT_ARRAY_ELEM get sAssigned_Value.ii of (oDeclaredArrays(self)) (hi(integer(arg#))) (low(integer(arg#))) to arg#
59784>>>>>>>>>>>>>    function_return arg#
59785>>>>>>>>>>>>>  end_function
59786>>>>>>>>>>>>>
59786>>>>>>>>>>>>>  function sArgType.is integer type# string arg# returns string
59788>>>>>>>>>>>>>    integer rval#
59788>>>>>>>>>>>>>    move -1 to rval# // Unknown type
59789>>>>>>>>>>>>>    if type# eq AT_CINT move VARTYP_INTEGER to rval#
59792>>>>>>>>>>>>>    if type# eq AT_CSTR move VARTYP_STRING to rval#
59795>>>>>>>>>>>>>    if type# eq AT_CNUM move VARTYP_NUMBER to rval#
59798>>>>>>>>>>>>>    if type# eq AT_CDAT move VARTYP_DATE to rval#
59801>>>>>>>>>>>>>    if type# eq AT_FIELDNO begin
59803>>>>>>>>>>>>>      get_attribute DF_FIELD_TYPE of (hi(integer(arg#))) (low(integer(arg#))) to type#
59806>>>>>>>>>>>>>      if type# eq DF_ASCII   move VARTYP_STRING to type#
59809>>>>>>>>>>>>>      if type# eq DF_BCD     move VARTYP_NUMBER to type#
59812>>>>>>>>>>>>>      if type# eq DF_DATE    move VARTYP_DATE   to type#
59815>>>>>>>>>>>>>      if type# eq DF_OVERLAP move VARTYP_STRING to type#
59818>>>>>>>>>>>>>      if type# eq DF_TEXT    move VARTYP_STRING to type#
59821>>>>>>>>>>>>>      if type# eq DF_BINARY  move VARTYP_STRING to type#
59824>>>>>>>>>>>>>    end
59824>>>>>>>>>>>>>>
59824>>>>>>>>>>>>>    if type# eq AT_VARNO begin
59826>>>>>>>>>>>>>      get piType.i of (oVariables(self)) arg# to rval#
59827>>>>>>>>>>>>>      function_return rval#
59828>>>>>>>>>>>>>    end
59828>>>>>>>>>>>>>>
59828>>>>>>>>>>>>>    if type# eq AT_EXPR function_return (psVar.i(oExprEvalSequences(self),integer(arg#)-1))
59831>>>>>>>>>>>>>    if type# eq AT_ARRAY_ELEM function_return (piType.i(oDeclaredArrays(self),hi(integer(arg#))))
59834>>>>>>>>>>>>>    function_return rval#
59835>>>>>>>>>>>>>  end_function
59836>>>>>>>>>>>>>
59836>>>>>>>>>>>>>  function iVarType.i integer varno# returns integer
59838>>>>>>>>>>>>>    function_return (piType.i(oVariables(self),varno#))
59839>>>>>>>>>>>>>  end_function
59840>>>>>>>>>>>>>  function iVarType.s string name# returns integer
59842>>>>>>>>>>>>>    integer varno#
59842>>>>>>>>>>>>>    get iVarNameToVarNo name# to varno#
59843>>>>>>>>>>>>>    if varno# eq -1 function_return -1
59846>>>>>>>>>>>>>    function_return (piType.i(oVariables(self),varno#))
59847>>>>>>>>>>>>>  end_function
59848>>>>>>>>>>>>>
59848>>>>>>>>>>>>>  // -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
59848>>>>>>>>>>>>>  // These procedures are used when EXECUTING each valid OP-code
59848>>>>>>>>>>>>>  procedure mthd_Nop
59850>>>>>>>>>>>>>  end_procedure
59851>>>>>>>>>>>>>  procedure mthd_ClearScreen
59853>>>>>>>>>>>>>    clearscreen
59854>>>>>>>>>>>>>>
59854>>>>>>>>>>>>>  end_procedure
59855>>>>>>>>>>>>>  procedure mthd_Abort
59857>>>>>>>>>>>>>    send reset // Clean up variables and arrays
59858>>>>>>>>>>>>>    set pProgramEnded to 1
59859>>>>>>>>>>>>>  end_procedure
59860>>>>>>>>>>>>>  procedure mthd_Gosub integer type# integer line#
59862>>>>>>>>>>>>>    get sArgValue.is type# line# to line#
59863>>>>>>>>>>>>>    integer pc#
59863>>>>>>>>>>>>>    get piProgramCounter to pc#
59864>>>>>>>>>>>>>    send Push.i to (oReturnAddressStack(self)) pc#
59865>>>>>>>>>>>>>    set piProgramCounter to line#
59866>>>>>>>>>>>>>  end_procedure
59867>>>>>>>>>>>>>  procedure mthd_Goto integer type# integer line#
59869>>>>>>>>>>>>>    get sArgValue.is type# line# to line#
59870>>>>>>>>>>>>>    set piProgramCounter to line#
59871>>>>>>>>>>>>>  end_procedure
59872>>>>>>>>>>>>>  procedure mthd_Return
59874>>>>>>>>>>>>>    set piProgramCounter to (iPop(oReturnAddressStack(self)))
59875>>>>>>>>>>>>>  end_procedure
59876>>>>>>>>>>>>>  procedure mthd_ShowLn integer type# string str#
59878>>>>>>>>>>>>>    get sArgValue.is type# str# to str#
59879>>>>>>>>>>>>>    showln str#
59881>>>>>>>>>>>>>  end_procedure
59882>>>>>>>>>>>>>  procedure mthd_Show integer type# string str#
59884>>>>>>>>>>>>>    get sArgValue.is type# str# to str#
59885>>>>>>>>>>>>>    show str#
59886>>>>>>>>>>>>>  end_procedure
59887>>>>>>>>>>>>>  procedure mthd_SeqFile integer type1# integer op# integer type2# string fn#
59889>>>>>>>>>>>>>  end_procedure
59890>>>>>>>>>>>>>  procedure mthd_WriteLn integer type# string str#
59892>>>>>>>>>>>>>  end_procedure
59893>>>>>>>>>>>>>  procedure mthd_MsgBox integer type# string str#
59895>>>>>>>>>>>>>    get sArgValue.is type# str# to str#
59896>>>>>>>>>>>>>    send obs str#
59897>>>>>>>>>>>>>  end_procedure
59898>>>>>>>>>>>>>  procedure mthd_GotoXY integer t1# integer v1# integer t2# integer v2#
59900>>>>>>>>>>>>>    get sArgValue.is t1# v1# to v1#
59901>>>>>>>>>>>>>    get sArgValue.is t2# v2# to v2#
59902>>>>>>>>>>>>>    gotoxy v1# v2#
59903>>>>>>>>>>>>>>
59903>>>>>>>>>>>>>  end_procedure
59904>>>>>>>>>>>>>  procedure mthd_Input integer type# integer varno# integer type2# string label#
59906>>>>>>>>>>>>>    string value#
59906>>>>>>>>>>>>>    get sArgValue.is type2# label# to label#
59907>>>>>>>>>>>>>    show label#
59908>>>>>>>>>>>>>    input value#
59909>>>>>>>>>>>>>>
59909>>>>>>>>>>>>>    send VarAssign to (oVariables(self)) varno# value#
59910>>>>>>>>>>>>>  end_procedure
59911>>>>>>>>>>>>>  procedure mthd_Pause
59913>>>>>>>>>>>>>    string grb#
59913>>>>>>>>>>>>>    inkey grb#
59914>>>>>>>>>>>>>>
59914>>>>>>>>>>>>>  end_procedure
59915>>>>>>>>>>>>>  procedure mthd_Assign integer type# string varno# integer type2# string value#
59917>>>>>>>>>>>>>//    send obs "mthd_Assign" type# varno# type2# value#
59917>>>>>>>>>>>>>    get sArgValue.is type2# value# to value# // Source value
59918>>>>>>>>>>>>>    if type# eq AT_FIELDNO set_field_value (hi(integer(varno#))) (low(integer(varno#))) to value#
59923>>>>>>>>>>>>>    else if type# eq AT_ARRAY_ELEM send Assign_Value to (oDeclaredArrays(self)) (hi(integer(varno#))) (low(integer(varno#))) value#
59927>>>>>>>>>>>>>    else send VarAssign to (oVariables(self)) varno# value#
59929>>>>>>>>>>>>>  end_procedure
59930>>>>>>>>>>>>>  procedure mthd_gVar_Incr integer type# integer varno# integer type2# integer amount#
59932>>>>>>>>>>>>>    get sArgValue.is type2# amount# to amount#
59933>>>>>>>>>>>>>    send VarIncrement to (oVariables(self)) varno# amount#
59934>>>>>>>>>>>>>  end_procedure
59935>>>>>>>>>>>>>  procedure mthd_gVar_Display
59937>>>>>>>>>>>>>    send VarDisplay to (oVariables(self))
59938>>>>>>>>>>>>>  end_procedure
59939>>>>>>>>>>>>>  procedure mthd_if_goto integer type# integer varno# integer type2# integer line#
59941>>>>>>>>>>>>>    integer bool#
59941>>>>>>>>>>>>>    get sArgValue.is type2# line# to line#
59942>>>>>>>>>>>>>    get psValue.i of (oVariables(self)) varno# to bool#
59943>>>>>>>>>>>>>    if bool# set piProgramCounter to line#
59946>>>>>>>>>>>>>  end_procedure
59947>>>>>>>>>>>>>  procedure mthd_if_gosub integer type# integer varno# integer type2# integer line#
59949>>>>>>>>>>>>>    integer bool# pc#
59949>>>>>>>>>>>>>    get sArgValue.is type2# line# to line#
59950>>>>>>>>>>>>>    get psValue.i of (oVariables(self)) varno# to bool#
59951>>>>>>>>>>>>>    if bool# begin
59953>>>>>>>>>>>>>      get piProgramCounter to pc#
59954>>>>>>>>>>>>>      send Push.i to (oReturnAddressStack(self)) pc#
59955>>>>>>>>>>>>>      set piProgramCounter to line#
59956>>>>>>>>>>>>>    end
59956>>>>>>>>>>>>>>
59956>>>>>>>>>>>>>  end_procedure
59957>>>>>>>>>>>>>  function iIfTest_Help.iiiiii integer t1# string arg1# ;                               integer t2# integer comp# ;                               integer t3# string arg2# returns integer
59959>>>>>>>>>>>>>    integer vcomp# type# i1# i2# bool#
59959>>>>>>>>>>>>>    number n1# n2#
59959>>>>>>>>>>>>>    date   d1# d2#
59959>>>>>>>>>>>>>    move -1 to bool#
59960>>>>>>>>>>>>>    get sArgType.is t1# arg1# to type#
59961>>>>>>>>>>>>>    get sArgValue.is t1# arg1# to arg1#
59962>>>>>>>>>>>>>    get sArgValue.is t3# arg2# to arg2#
59963>>>>>>>>>>>>>    if type# eq VARTYP_INTEGER begin
59965>>>>>>>>>>>>>      move 0 to bool#
59966>>>>>>>>>>>>>      move arg1# to i1#
59967>>>>>>>>>>>>>      move arg2# to i2#
59968>>>>>>>>>>>>>      if comp# eq COMP_LT move (i1#>>>>>>>>>>>>      if comp# eq COMP_LE move (i1#<=i2#) to bool#
59974>>>>>>>>>>>>>      if comp# eq COMP_EQ move (i1#=i2#)  to bool#
59977>>>>>>>>>>>>>      if comp# eq COMP_GE move (i1#>=i2#) to bool#
59980>>>>>>>>>>>>>      if comp# eq COMP_GT move (i1#>i2#)  to bool#
59983>>>>>>>>>>>>>      if comp# eq COMP_NE move (i1#<>i2#) to bool#
59986>>>>>>>>>>>>>    end
59986>>>>>>>>>>>>>>
59986>>>>>>>>>>>>>    if type# eq VARTYP_NUMBER begin
59988>>>>>>>>>>>>>      move 0 to bool#
59989>>>>>>>>>>>>>      move arg1# to n1#
59990>>>>>>>>>>>>>      move arg2# to n2#
59991>>>>>>>>>>>>>      if comp# eq COMP_LT move (n1#>>>>>>>>>>>>      if comp# eq COMP_LE move (n1#<=n2#) to bool#
59997>>>>>>>>>>>>>      if comp# eq COMP_EQ move (n1#=n2#)  to bool#
60000>>>>>>>>>>>>>      if comp# eq COMP_GE move (n1#>=n2#) to bool#
60003>>>>>>>>>>>>>      if comp# eq COMP_GT move (n1#>n2#)  to bool#
60006>>>>>>>>>>>>>      if comp# eq COMP_NE move (n1#<>n2#) to bool#
60009>>>>>>>>>>>>>    end
60009>>>>>>>>>>>>>>
60009>>>>>>>>>>>>>    if type# eq VARTYP_DATE begin
60011>>>>>>>>>>>>>      move 0 to bool#
60012>>>>>>>>>>>>>      move arg1# to d1#
60013>>>>>>>>>>>>>      move arg2# to d2#
60014>>>>>>>>>>>>>      if comp# eq COMP_LT move (d1#>>>>>>>>>>>>      if comp# eq COMP_LE move (d1#<=d2#) to bool#
60020>>>>>>>>>>>>>      if comp# eq COMP_EQ move (d1#=d2#)  to bool#
60023>>>>>>>>>>>>>      if comp# eq COMP_GE move (d1#>=d2#) to bool#
60026>>>>>>>>>>>>>      if comp# eq COMP_GT move (d1#>d2#)  to bool#
60029>>>>>>>>>>>>>      if comp# eq COMP_NE move (d1#<>d2#) to bool#
60032>>>>>>>>>>>>>    end
60032>>>>>>>>>>>>>>
60032>>>>>>>>>>>>>    if type# eq VARTYP_STRING begin
60034>>>>>>>>>>>>>      move 0 to bool#
60035>>>>>>>>>>>>>      if comp# eq COMP_LT if arg1# LT arg2# move 1 to bool#
60040>>>>>>>>>>>>>      if comp# eq COMP_LE if arg1# LE arg2# move 1 to bool#
60045>>>>>>>>>>>>>      if comp# eq COMP_EQ if arg1# EQ arg2# move 1 to bool#
60050>>>>>>>>>>>>>      if comp# eq COMP_GE if arg1# GE arg2# move 1 to bool#
60055>>>>>>>>>>>>>      if comp# eq COMP_GT if arg1# GT arg2# move 1 to bool#
60060>>>>>>>>>>>>>      if comp# eq COMP_NE if arg1# NE arg2# move 1 to bool#
60065>>>>>>>>>>>>>    end
60065>>>>>>>>>>>>>>
60065>>>>>>>>>>>>>    if bool# eq -1 send obs "Bad comparison, if-test failed"
60068>>>>>>>>>>>>>    function_return bool#
60069>>>>>>>>>>>>>  end_function
60070>>>>>>>>>>>>>  procedure mthd_iftest_goto integer t1# string varno1# integer t2# integer comp# integer t3# string varno2# integer t4# integer line#
60072>>>>>>>>>>>>>    integer bool# pc#
60072>>>>>>>>>>>>>    get sArgValue.is t4# line# to line#
60073>>>>>>>>>>>>>    get iIfTest_Help.iiiiii t1# varno1# t2# comp# t3# varno2# to bool#
60074>>>>>>>>>>>>>    if bool# set piProgramCounter to line#
60077>>>>>>>>>>>>>  end_procedure
60078>>>>>>>>>>>>>  procedure mthd_iftest_gosub integer t1# string varno1# integer t2# integer comp# integer t3# string varno2# integer t4# integer line#
60080>>>>>>>>>>>>>    integer bool# pc#
60080>>>>>>>>>>>>>    get sArgValue.is t4# line# to line#
60081>>>>>>>>>>>>>    get iIfTest_Help.iiiiii t1# varno1# t2# comp# t3# varno2# to bool#
60082>>>>>>>>>>>>>    if bool# begin
60084>>>>>>>>>>>>>      get piProgramCounter to pc#
60085>>>>>>>>>>>>>      send Push.i to (oReturnAddressStack(self)) pc#
60086>>>>>>>>>>>>>      set piProgramCounter to line#
60087>>>>>>>>>>>>>    end
60087>>>>>>>>>>>>>>
60087>>>>>>>>>>>>>  end_procedure
60088>>>>>>>>>>>>>  enumeration_list
60088>>>>>>>>>>>>>    define DBG.OFF
60088>>>>>>>>>>>>>    define DBG.ON
60088>>>>>>>>>>>>>    define DBG.SINGLESTEP
60088>>>>>>>>>>>>>    define DBG.VARDISPLAY
60088>>>>>>>>>>>>>  end_enumeration_list
60088>>>>>>>>>>>>>  procedure mthd_debug integer t1# string value#
60090>>>>>>>>>>>>>    get sArgValue.is t1# value# to value#
60091>>>>>>>>>>>>>    if (integer(value#)) eq DBG.OFF begin
60093>>>>>>>>>>>>>      set piDebugState to 0
60094>>>>>>>>>>>>>      set piDebugSingleStep to 0
60095>>>>>>>>>>>>>    end
60095>>>>>>>>>>>>>>
60095>>>>>>>>>>>>>    if (integer(value#)) eq DBG.ON begin
60097>>>>>>>>>>>>>      set piDebugState to 1
60098>>>>>>>>>>>>>      set piDebugSingleStep to 0
60099>>>>>>>>>>>>>    end
60099>>>>>>>>>>>>>>
60099>>>>>>>>>>>>>    if (integer(value#)) eq DBG.SINGLESTEP begin
60101>>>>>>>>>>>>>      set piDebugState to 1
60102>>>>>>>>>>>>>      set piDebugSingleStep to 1
60103>>>>>>>>>>>>>    end
60103>>>>>>>>>>>>>>
60103>>>>>>>>>>>>>    if (integer(value#)) eq DBG.VARDISPLAY send VarDisplay to (oVariables(self))
60106>>>>>>>>>>>>>  end_procedure
60107>>>>>>>>>>>>>  procedure mthd_log_open integer t1# string fn# integer t2# string append#
60109>>>>>>>>>>>>>    integer ch#
60109>>>>>>>>>>>>>    get sArgValue.is t1# fn# to fn#
60110>>>>>>>>>>>>>    get sArgValue.is t2# append# to append#
60111>>>>>>>>>>>>>    get private.piLogChannel to ch#
60112>>>>>>>>>>>>>    if ch# eq -1 begin
60114>>>>>>>>>>>>>      if (integer(append#)) move (SEQ_AppendOutput(fn#)) to ch#
60117>>>>>>>>>>>>>      else move (SEQ_DirectOutput(fn#)) to ch#
60119>>>>>>>>>>>>>      set private.piLogChannel  to ch#
60120>>>>>>>>>>>>>      set private.psLogFileName to fn#
60121>>>>>>>>>>>>>    end
60121>>>>>>>>>>>>>>
60121>>>>>>>>>>>>>    // else some kind of runtime error
60121>>>>>>>>>>>>>  end_procedure
60122>>>>>>>>>>>>>  procedure mthd_log_close
60124>>>>>>>>>>>>>    integer ch#
60124>>>>>>>>>>>>>    get private.piLogChannel to ch#
60125>>>>>>>>>>>>>    if (ch#>=0) begin
60127>>>>>>>>>>>>>      send SEQ_CloseOutput ch#
60128>>>>>>>>>>>>>      set private.piLogChannel to -1
60129>>>>>>>>>>>>>    end
60129>>>>>>>>>>>>>>
60129>>>>>>>>>>>>>    // else some kind of runtime error
60129>>>>>>>>>>>>>  end_procedure
60130>>>>>>>>>>>>>  procedure mthd_log_display
60132>>>>>>>>>>>>>    send output.display_file (private.psLogFileName(self))
60133>>>>>>>>>>>>>  end_procedure
60134>>>>>>>>>>>>>  procedure mthd_log_flush
60136>>>>>>>>>>>>>    integer ch#
60136>>>>>>>>>>>>>    get private.piLogChannel to ch#
60137>>>>>>>>>>>>>    if (ch#>=0) begin
60139>>>>>>>>>>>>>      close_output channel ch#
60141>>>>>>>>>>>>>      append_output channel ch# (private.psLogFileName(self))
60143>>>>>>>>>>>>>    end
60143>>>>>>>>>>>>>>
60143>>>>>>>>>>>>>    // else some kind of runtime error
60143>>>>>>>>>>>>>  end_procedure
60144>>>>>>>>>>>>>  procedure mthd_log_write integer type# string str#
60146>>>>>>>>>>>>>    integer ch#
60146>>>>>>>>>>>>>    get sArgValue.is type# str# to str#
60147>>>>>>>>>>>>>    get private.piLogChannel to ch#
60148>>>>>>>>>>>>>    if (ch#>=0) write channel ch# str#
60152>>>>>>>>>>>>>  end_procedure
60153>>>>>>>>>>>>>  procedure mthd_log_writeln integer type# string str#
60155>>>>>>>>>>>>>    integer ch#
60155>>>>>>>>>>>>>    get sArgValue.is type# str# to str#
60156>>>>>>>>>>>>>    get private.piLogChannel to ch#
60157>>>>>>>>>>>>>    if (ch#>=0) writeln channel ch# str#
60162>>>>>>>>>>>>>  end_procedure
60163>>>>>>>>>>>>>  procedure mthd_api_filelist integer t1# string a1# integer t2# string a2# integer t3# string a3#
60165>>>>>>>>>>>>>    get sArgValue.is t1# a1# to a1#
60166>>>>>>>>>>>>>    get sArgValue.is t2# a2# to a2#
60167>>>>>>>>>>>>>    get sArgValue.is t3# a3# to a3#
60168>>>>>>>>>>>>>    send RS_SetFileListAttr a1# a2# a3#
60169>>>>>>>>>>>>>  end_procedure
60170>>>>>>>>>>>>>  procedure mthd_api_file integer t1# string a1# integer t2# string a2#
60172>>>>>>>>>>>>>    get sArgValue.is t1# a1# to a1#
60173>>>>>>>>>>>>>    get sArgValue.is t2# a2# to a2#
60174>>>>>>>>>>>>>    send RS_SetFileAttr a1# a2#
60175>>>>>>>>>>>>>  end_procedure
60176>>>>>>>>>>>>>  procedure mthd_api_field integer t1# string a1# integer t2# string a2# integer t3# string a3#
60178>>>>>>>>>>>>>    get sArgValue.is t1# a1# to a1#
60179>>>>>>>>>>>>>    get sArgValue.is t2# a2# to a2#
60180>>>>>>>>>>>>>    get sArgValue.is t3# a3# to a3#
60181>>>>>>>>>>>>>    send RS_SetFieldAttr a1# a2# a3#
60182>>>>>>>>>>>>>  end_procedure
60183>>>>>>>>>>>>>  procedure mthd_api_index integer t1# string a1# integer t2# string a2# integer t3# string a3#
60185>>>>>>>>>>>>>    get sArgValue.is t1# a1# to a1#
60186>>>>>>>>>>>>>    get sArgValue.is t2# a2# to a2#
60187>>>>>>>>>>>>>    get sArgValue.is t3# a3# to a3#
60188>>>>>>>>>>>>>    send RS_SetIndexAttr a1# a2# a3#
60189>>>>>>>>>>>>>  end_procedure
60190>>>>>>>>>>>>>  procedure mthd_api_idxseg integer t1# string a1# integer t2# string a2# integer t3# string a3# integer t4# string a4#
60192>>>>>>>>>>>>>    get sArgValue.is t1# a1# to a1#
60193>>>>>>>>>>>>>    get sArgValue.is t2# a2# to a2#
60194>>>>>>>>>>>>>    get sArgValue.is t3# a3# to a3#
60195>>>>>>>>>>>>>    get sArgValue.is t4# a4# to a4#
60196>>>>>>>>>>>>>    send RS_SetIndexSegAttr a1# a2# a3# a4#
60197>>>>>>>>>>>>>  end_procedure
60198>>>>>>>>>>>>>  procedure mthd_api_structure_abort
60200>>>>>>>>>>>>>    send RS_Structure_Abort
60201>>>>>>>>>>>>>  end_procedure
60202>>>>>>>>>>>>>  procedure mthd_api_structure_end
60204>>>>>>>>>>>>>    send RS_Structure_End
60205>>>>>>>>>>>>>  end_procedure
60206>>>>>>>>>>>>>  procedure mthd_api_probe_end
60208>>>>>>>>>>>>>    send RS_Probe_End
60209>>>>>>>>>>>>>  end_procedure
60210>>>>>>>>>>>>>  procedure mthd_api_DeleteIndex integer t1# string a1#
60212>>>>>>>>>>>>>    get sArgValue.is t1# a1# to a1#
60213>>>>>>>>>>>>>    send RS_DeleteIndex a1#
60214>>>>>>>>>>>>>  end_procedure
60215>>>>>>>>>>>>>  procedure mthd_api_DeleteField integer t1# string a1#
60217>>>>>>>>>>>>>    get sArgValue.is t1# a1# to a1#
60218>>>>>>>>>>>>>    send RS_DeleteField a1#
60219>>>>>>>>>>>>>  end_procedure
60220>>>>>>>>>>>>>  procedure mthd_api_AppendField integer t1# string a1# integer t2# string a2#
60222>>>>>>>>>>>>>    get sArgValue.is t1# a1# to a1#
60223>>>>>>>>>>>>>    get sArgValue.is t2# a2# to a2#
60224>>>>>>>>>>>>>    send RS_AppendField a1# a2#
60225>>>>>>>>>>>>>  end_procedure
60226>>>>>>>>>>>>>  procedure mthd_api_CreateField integer t1# string a1# integer t2# string a2# integer t3# string a3#
60228>>>>>>>>>>>>>    get sArgValue.is t1# a1# to a1#
60229>>>>>>>>>>>>>    get sArgValue.is t2# a2# to a2#
60230>>>>>>>>>>>>>    get sArgValue.is t3# a3# to a3#
60231>>>>>>>>>>>>>    send RS_CreateField a1# a2# a3#
60232>>>>>>>>>>>>>  end_procedure
60233>>>>>>>>>>>>>  procedure mthd_api_SetFieldNumber integer t1# string a1#
60235>>>>>>>>>>>>>    get sArgValue.is t1# a1# to a1#
60236>>>>>>>>>>>>>    send RS_SetFieldNumber a1#
60237>>>>>>>>>>>>>  end_procedure
60238>>>>>>>>>>>>>  // -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
60238>>>>>>>>>>>>>  procedure add_ct_error integer line# string msg#
60240>>>>>>>>>>>>>    send obs ("Error in line "+string(line#)) msg#
60241>>>>>>>>>>>>>    set piInvalidProgram to true
60242>>>>>>>>>>>>>  end_procedure
60243>>>>>>>>>>>>>  procedure reset
60245>>>>>>>>>>>>>    send delete_data
60246>>>>>>>>>>>>>    send reset to (oLabels(self))
60247>>>>>>>>>>>>>    send reset to (oDeclaredArrays(self))
60248>>>>>>>>>>>>>    send reset to (oDeclaredFunctions(self))
60249>>>>>>>>>>>>>    send reset to (oExprEvalSequences(self))
60250>>>>>>>>>>>>>    send delete_data to (oReturnAddressStack(self))
60251>>>>>>>>>>>>>    send delete_data to (oVariables(self))
60252>>>>>>>>>>>>>    set piProgramCounter to 0
60253>>>>>>>>>>>>>    set piInvalidProgram to 0
60254>>>>>>>>>>>>>    set pCurrentOpCodeLine to 0
60255>>>>>>>>>>>>>    set pProgramEnded to 0
60256>>>>>>>>>>>>>    set private.piLogChannel  to -1
60257>>>>>>>>>>>>>    set private.psLogFileName to ""
60258>>>>>>>>>>>>>  end_procedure
60259>>>>>>>>>>>>>  procedure increment_pc integer tmp_amount#
60261>>>>>>>>>>>>>    integer amount#
60261>>>>>>>>>>>>>    if num_arguments move tmp_amount# to amount#
60264>>>>>>>>>>>>>    else move 1 to amount#
60266>>>>>>>>>>>>>    set piProgramCounter to (piProgramCounter(self)+amount#)
60267>>>>>>>>>>>>>  end_procedure
60268>>>>>>>>>>>>>  function sGetData returns string
60270>>>>>>>>>>>>>    string rval#
60270>>>>>>>>>>>>>    get value item (piProgramCounter(self)) to rval#
60271>>>>>>>>>>>>>    send increment_pc
60272>>>>>>>>>>>>>    function_return rval#
60273>>>>>>>>>>>>>  end_function
60274>>>>>>>>>>>>>  // -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
60274>>>>>>>>>>>>>  // These procedures are used for EXECUTING a program
60274>>>>>>>>>>>>>  procedure add_debug_line integer display# integer opcode# integer typ1# string arg1# integer typ2# string arg2# integer typ3# string arg3# integer typ4# string arg4# integer typ5# string arg5# integer typ6# string arg6#
60276>>>>>>>>>>>>>    integer num_arguments#
60276>>>>>>>>>>>>>    string grb# str#
60276>>>>>>>>>>>>>    get piParameters.i of (oOpcodes(self)) item opcode# to num_arguments#
60277>>>>>>>>>>>>>    move "Line #: #" to str#
60278>>>>>>>>>>>>>    replace "#" in str# with (IntToStrRzf(pCurrentOpCodeLine(self),length(string(item_count(self)-1))))
60280>>>>>>>>>>>>>    replace "#" in str# with (psName.i(oOpcodes(self),opcode#))
60282>>>>>>>>>>>>>    if num_arguments# ge 1 move (str#+" "+sArgtype_Name.i(typ1#)+"["+arg1#+"]") to str#
60285>>>>>>>>>>>>>    if num_arguments# ge 2 move (str#+" "+sArgtype_Name.i(typ2#)+"["+arg2#+"]") to str#
60288>>>>>>>>>>>>>    if num_arguments# ge 3 move (str#+" "+sArgtype_Name.i(typ3#)+"["+arg3#+"]") to str#
60291>>>>>>>>>>>>>    if num_arguments# ge 4 move (str#+" "+sArgtype_Name.i(typ4#)+"["+arg4#+"]") to str#
60294>>>>>>>>>>>>>    if num_arguments# ge 5 move (str#+" "+sArgtype_Name.i(typ5#)+"["+arg5#+"]") to str#
60297>>>>>>>>>>>>>    if num_arguments# ge 6 move (str#+" "+sArgtype_Name.i(typ6#)+"["+arg6#+"]") to str#
60300>>>>>>>>>>>>>    set psDebugLine to str#
60301>>>>>>>>>>>>>    if display# begin
60303>>>>>>>>>>>>>      showln str#
60305>>>>>>>>>>>>>      if (piDebugSingleStep(self)) inkey grb#
60308>>>>>>>>>>>>>    end
60308>>>>>>>>>>>>>>
60308>>>>>>>>>>>>>  end_procedure
60309>>>>>>>>>>>>>  procedure illegal_opcode integer opcode#
60311>>>>>>>>>>>>>    send add_ct_error (piProgramCounter(self)-1) ("Illegal OPCODE ("+string(opcode#)+")")
60312>>>>>>>>>>>>>  end_procedure
60313>>>>>>>>>>>>>  procedure exec_instruction integer opcode# integer exec#
60315>>>>>>>>>>>>>    integer msg# num_arguments# oOpCodes#
60315>>>>>>>>>>>>>    integer typ1# typ2# typ3# typ4# typ5# typ6#
60315>>>>>>>>>>>>>    string arg1# arg2# arg3# arg4# arg5# arg6#
60315>>>>>>>>>>>>>    //send obs (psName.i(oOpCodes(self),opcode#))
60315>>>>>>>>>>>>>    move (oOpCodes(self)) to oOpCodes#
60316>>>>>>>>>>>>>    get piMessage.i    of oOpCodes# opcode# to msg#
60317>>>>>>>>>>>>>    get piParameters.i of oOpCodes# opcode# to num_arguments#
60318>>>>>>>>>>>>>    if num_arguments# ge 1 get sGetData to typ1#
60321>>>>>>>>>>>>>    if num_arguments# ge 1 get sGetData to arg1#
60324>>>>>>>>>>>>>    if num_arguments# ge 2 get sGetData to typ2#
60327>>>>>>>>>>>>>    if num_arguments# ge 2 get sGetData to arg2#
60330>>>>>>>>>>>>>    if num_arguments# ge 3 get sGetData to typ3#
60333>>>>>>>>>>>>>    if num_arguments# ge 3 get sGetData to arg3#
60336>>>>>>>>>>>>>    if num_arguments# ge 4 get sGetData to typ4#
60339>>>>>>>>>>>>>    if num_arguments# ge 4 get sGetData to arg4#
60342>>>>>>>>>>>>>    if num_arguments# ge 5 get sGetData to typ5#
60345>>>>>>>>>>>>>    if num_arguments# ge 5 get sGetData to arg5#
60348>>>>>>>>>>>>>    if num_arguments# ge 6 get sGetData to typ6#
60351>>>>>>>>>>>>>    if num_arguments# ge 6 get sGetData to arg6#
60354>>>>>>>>>>>>>    if (piDebugState(self)) ;      send add_debug_line exec# opcode# typ1# arg1# typ2# arg2# typ3# arg3# typ4# arg4# typ5# arg5# typ6# arg6#
60357>>>>>>>>>>>>>    if exec# begin
60359>>>>>>>>>>>>>      if num_arguments# eq 0 send msg#
60362>>>>>>>>>>>>>      if num_arguments# eq 1 send msg# typ1# arg1#
60365>>>>>>>>>>>>>      if num_arguments# eq 2 send msg# typ1# arg1# typ2# arg2#
60368>>>>>>>>>>>>>      if num_arguments# eq 3 send msg# typ1# arg1# typ2# arg2# typ3# arg3#
60371>>>>>>>>>>>>>      if num_arguments# eq 4 send msg# typ1# arg1# typ2# arg2# typ3# arg3# typ4# arg4#
60374>>>>>>>>>>>>>      if num_arguments# eq 5 send msg# typ1# arg1# typ2# arg2# typ3# arg3# typ4# arg4# typ5# arg5#
60377>>>>>>>>>>>>>      if num_arguments# eq 6 send msg# typ1# arg1# typ2# arg2# typ3# arg3# typ4# arg4# typ5# arg5# typ6# arg6#
60380>>>>>>>>>>>>>    end
60380>>>>>>>>>>>>>>
60380>>>>>>>>>>>>>  end_procedure
60381>>>>>>>>>>>>>  function sExecutingLine returns string
60383>>>>>>>>>>>>>    integer opcode# st#
60383>>>>>>>>>>>>>    get piDebugState to st#
60384>>>>>>>>>>>>>    set piDebugState to true
60385>>>>>>>>>>>>>    set piProgramCounter to (pCurrentOpCodeLine(self))
60386>>>>>>>>>>>>>    get value item (pCurrentOpCodeLine(self)) to opcode#
60387>>>>>>>>>>>>>    send increment_pc
60388>>>>>>>>>>>>>    send exec_instruction opcode# 0
60389>>>>>>>>>>>>>    set piDebugState to st#
60390>>>>>>>>>>>>>    function_return (psDebugLine(self))
60391>>>>>>>>>>>>>  end_function
60392>>>>>>>>>>>>>  procedure run_script
60394>>>>>>>>>>>>>    integer pc# max# opcode# max_line#
60394>>>>>>>>>>>>>    ifnot (piInvalidProgram(self)) begin
60396>>>>>>>>>>>>>      set piProgramCounter to 0
60397>>>>>>>>>>>>>      set pProgramEnded to 0
60398>>>>>>>>>>>>>      move self to oVM_CurrentlyExecuting#
60399>>>>>>>>>>>>>      send delete_data to (oReturnAddressStack(self))
60400>>>>>>>>>>>>>      move 0 to max_line#
60401>>>>>>>>>>>>>      send DFScriptError_On
60402>>>>>>>>>>>>>      get piProgramCounter to pc#
60403>>>>>>>>>>>>>      get item_count to max#
60404>>>>>>>>>>>>>      screenmode 1
60405>>>>>>>>>>>>>      while (pc#>>>>>>>>>>>>        get value item pc# to opcode#
60410>>>>>>>>>>>>>        set pCurrentOpCodeLine to pc#
60411>>>>>>>>>>>>>        send increment_pc
60412>>>>>>>>>>>>>        send exec_instruction opcode# 1
60413>>>>>>>>>>>>>        get piProgramCounter to pc#
60414>>>>>>>>>>>>>        increment max_line#
60415>>>>>>>>>>>>>        if max_line# gt 10000 begin
60417>>>>>>>>>>>>>          if (MB_Verify4("","Max lines encountered!","Execute another "+string(10000)+" instructions?","",1)) move 0 to max_line#
60420>>>>>>>>>>>>>          else set pProgramEnded to true
60422>>>>>>>>>>>>>        end
60422>>>>>>>>>>>>>>
60422>>>>>>>>>>>>>      end
60423>>>>>>>>>>>>>>
60423>>>>>>>>>>>>>      if (private.piLogChannel(self)<>-1) begin // Close log file and release channel
60425>>>>>>>>>>>>>        send SEQ_CloseOutput (private.piLogChannel(self))
60426>>>>>>>>>>>>>        set private.piLogChannel to -1
60427>>>>>>>>>>>>>      end
60427>>>>>>>>>>>>>>
60427>>>>>>>>>>>>>      send DFScriptError_Off
60428>>>>>>>>>>>>>    end
60428>>>>>>>>>>>>>>
60428>>>>>>>>>>>>>    else send obs "Errors where found during" "script interpretation." "The program will not execute!"
60430>>>>>>>>>>>>>    move 0 to oVM_CurrentlyExecuting#
60431>>>>>>>>>>>>>  end_procedure
60432>>>>>>>>>>>>>
60432>>>>>>>>>>>>>  procedure program_init
60434>>>>>>>>>>>>>    set private.piLogChannel  to -1
60435>>>>>>>>>>>>>    //intended for augmentation (Define SCREENEND and the like)
60435>>>>>>>>>>>>>  end_procedure
60436>>>>>>>>>>>>>
60436>>>>>>>>>>>>>  procedure AddOpcode.i integer opcode#
60438>>>>>>>>>>>>>    set value item (piProgramCounter(self)) to opcode#
60439>>>>>>>>>>>>>    send increment_pc
60440>>>>>>>>>>>>>  end_procedure
60441>>>>>>>>>>>>>  procedure script_begin
60443>>>>>>>>>>>>>    send reset
60444>>>>>>>>>>>>>    send program_init
60445>>>>>>>>>>>>>  end_procedure
60446>>>>>>>>>>>>>  procedure private.resolve_labels
60448>>>>>>>>>>>>>    integer self#
60448>>>>>>>>>>>>>    string unresolved_label#
60448>>>>>>>>>>>>>    move self to self#
60449>>>>>>>>>>>>>    get sResolve_Labels.i of (oLabels(self)) self# to unresolved_label#
60450>>>>>>>>>>>>>    if unresolved_label# ne "" send add_ct_error (piProgramCounter(self)-1) ("Unresolved label ("+unresolved_label#+")")
60453>>>>>>>>>>>>>  end_procedure
60454>>>>>>>>>>>>>  procedure script_end
60456>>>>>>>>>>>>>    send private.resolve_labels
60457>>>>>>>>>>>>>  end_procedure
60458>>>>>>>>>>>>>  procedure declare_label string name#
60460>>>>>>>>>>>>>    integer self#
60460>>>>>>>>>>>>>    move self to self#
60461>>>>>>>>>>>>>    send add_resolved_label to (oLabels(self)) name# (piProgramCounter(self#))
60462>>>>>>>>>>>>>  end_procedure
60463>>>>>>>>>>>>>  procedure declare_label_no_error string name# // Makes no error if label is already defined
60465>>>>>>>>>>>>>    integer self#
60465>>>>>>>>>>>>>    move self to self#
60466>>>>>>>>>>>>>    send add_resolved_label_no_error to (oLabels(self)) name# (piProgramCounter(self#))
60467>>>>>>>>>>>>>  end_procedure
60468>>>>>>>>>>>>>  function iIsLabelNameUsed.s string name# returns integer
60470>>>>>>>>>>>>>    function_return (iIsLabelNameUsed.s(oLabels(self),name#))
60471>>>>>>>>>>>>>  end_function
60472>>>>>>>>>>>>>  // ====== Variable procedures =======================================
60472>>>>>>>>>>>>>  function iVarValue integer varno# returns integer
60474>>>>>>>>>>>>>    function_return (psValue.i(oVariables(self),varno#))
60475>>>>>>>>>>>>>  end_function
60476>>>>>>>>>>>>>  function dVarValue integer varno# returns integer
60478>>>>>>>>>>>>>    function_return (psValue.i(oVariables(self),varno#))
60479>>>>>>>>>>>>>  end_function
60480>>>>>>>>>>>>>  function nVarValue integer varno# returns number
60482>>>>>>>>>>>>>    function_return (psValue.i(oVariables(self),varno#))
60483>>>>>>>>>>>>>  end_function
60484>>>>>>>>>>>>>  function sVarValue integer varno# returns string
60486>>>>>>>>>>>>>    function_return (psValue.i(oVariables(self),varno#))
60487>>>>>>>>>>>>>  end_function
60488>>>>>>>>>>>>>  procedure declare_var string varid# integer type#
60490>>>>>>>>>>>>>    send VarNameDeclare to (oVariables(self)) varid# type#
60491>>>>>>>>>>>>>  end_procedure
60492>>>>>>>>>>>>>  function iIsVarDeclared.s string varid# returns integer
60494>>>>>>>>>>>>>    integer rval#
60494>>>>>>>>>>>>>    get iVarNameToVarNo of (oVariables(self)) varid# to rval#
60495>>>>>>>>>>>>>    function_return (rval#<>-1)
60496>>>>>>>>>>>>>  end_function
60497>>>>>>>>>>>>>  procedure declare_var_cond string varid# integer type# // Declare if not already declared
60499>>>>>>>>>>>>>    ifnot (iIsVarDeclared.s(self,varid#)) send declare_var varid# type#
60502>>>>>>>>>>>>>  end_procedure
60503>>>>>>>>>>>>>  function iVarNameToVarNo string varid# returns integer
60505>>>>>>>>>>>>>    integer rval#
60505>>>>>>>>>>>>>    get iVarNameToVarNo of (oVariables(self)) varid# to rval#
60506>>>>>>>>>>>>>    function_return rval#
60507>>>>>>>>>>>>>  end_function
60508>>>>>>>>>>>>>  // ====== Field stuff ============================================
60508>>>>>>>>>>>>>  function iFileField.s string lsSymbol returns integer
60510>>>>>>>>>>>>>    string lsFile lsField
60510>>>>>>>>>>>>>    integer liFile liField lhFdx
60510>>>>>>>>>>>>>    move (uppercase(ExtractWord(lsSymbol,".",1))) to lsFile
60511>>>>>>>>>>>>>    move (uppercase(ExtractWord(lsSymbol,".",2))) to lsField
60512>>>>>>>>>>>>>    get phFDX_Server to lhFdx
60513>>>>>>>>>>>>>    if (lsFile<>"" and lsField<>"") begin
60515>>>>>>>>>>>>>      get FDX_FindLogicalName lhFdx lsFile 0 to liFile
60516>>>>>>>>>>>>>      if (liFile>-1) get FDX_FindField lhFdx liFile lsField to liField
60519>>>>>>>>>>>>>      else move -1 to liField
60521>>>>>>>>>>>>>      if (liField>-1) function_return (liFile*65536+liField)
60524>>>>>>>>>>>>>    end
60524>>>>>>>>>>>>>>
60524>>>>>>>>>>>>>    function_return 0
60525>>>>>>>>>>>>>  end_function
60526>>>>>>>>>>>>>  function iFieldType.i integer liFileField returns integer
60528>>>>>>>>>>>>>    integer lhFdx liType
60528>>>>>>>>>>>>>    get phFDX_Server to lhFdx
60529>>>>>>>>>>>>>    get FDX_AttrValue_FIELD lhFdx DF_FIELD_TYPE (liFileField/65536) (mod(liFileField,65536)) to liType
60530>>>>>>>>>>>>>    if liType eq DF_ASCII   function_return FLDTYP_STRING
60533>>>>>>>>>>>>>    if liType eq DF_BCD     function_return FLDTYP_NUMBER
60536>>>>>>>>>>>>>    if liType eq DF_DATE    function_return FLDTYP_DATE
60539>>>>>>>>>>>>>    if liType eq DF_TEXT    function_return FLDTYP_STRING
60542>>>>>>>>>>>>>    if liType eq DF_BINARY  function_return FLDTYP_STRING
60545>>>>>>>>>>>>>    if liType eq DF_OVERLAP function_return FLDTYP_STRING
60548>>>>>>>>>>>>>  end_function
60549>>>>>>>>>>>>>
60549>>>>>>>>>>>>>  // ====== Function stuff ============================================
60549>>>>>>>>>>>>>  function iFuncNameToFuncNo.s string name# returns integer
60551>>>>>>>>>>>>>    function_return (iNameToNumber.s(oDeclaredFunctions(self),name#))
60552>>>>>>>>>>>>>  end_function
60553>>>>>>>>>>>>>  function iFuncType.i integer id# returns integer
60555>>>>>>>>>>>>>    function_return (piReturnType.i(oDeclaredFunctions(self),id#))
60556>>>>>>>>>>>>>  end_function
60557>>>>>>>>>>>>>  function sFuncParams.i integer id# returns string
60559>>>>>>>>>>>>>    function_return (psParameterList.i(oDeclaredFunctions(self),id#))
60560>>>>>>>>>>>>>  end_function
60561>>>>>>>>>>>>>  function sFuncClass.i integer id# returns string
60563>>>>>>>>>>>>>    function_return (piFuncClass.i(oDeclaredFunctions(self),id#))
60564>>>>>>>>>>>>>  end_function
60565>>>>>>>>>>>>>  // ====== Array stuff ===============================================
60565>>>>>>>>>>>>>  procedure declare_array string name# integer type#
60567>>>>>>>>>>>>>    send declare_array (oDeclaredArrays(self)) name# type#
60568>>>>>>>>>>>>>  end_procedure
60569>>>>>>>>>>>>>  // ====== Procedures used for entering a program ====================
60569>>>>>>>>>>>>>  procedure add_argument_label string labelid#
60571>>>>>>>>>>>>>    integer self# line#
60571>>>>>>>>>>>>>    move self to self#
60572>>>>>>>>>>>>>    send add_label_reference to (oLabels(self)) labelid# self# (piProgramCounter(self#))
60573>>>>>>>>>>>>>    send increment_pc
60574>>>>>>>>>>>>>  end_procedure
60575>>>>>>>>>>>>>  procedure add_argument_gvar string varid#
60577>>>>>>>>>>>>>    integer varno#
60577>>>>>>>>>>>>>    get iVarNameToVarNo of (oVariables(self)) varid# to varno#
60578>>>>>>>>>>>>>    if varno# eq -1 send add_ct_error (piProgramCounter(self)) ("Undefined variable name: "+varid#)
60581>>>>>>>>>>>>>    set value item (piProgramCounter(self)) to varno#
60582>>>>>>>>>>>>>    send increment_pc
60583>>>>>>>>>>>>>  end_procedure
60584>>>>>>>>>>>>>  procedure add_argument_field string lsFieldName
60586>>>>>>>>>>>>>    integer liFileField
60586>>>>>>>>>>>>>    get iFileField.s lsFieldName to liFileField
60587>>>>>>>>>>>>>    if liFileField eq 0 send add_ct_error (piProgramCounter(self)) ("Undefined field name: "+lsFieldName)
60590>>>>>>>>>>>>>    set value item (piProgramCounter(self)) to liFileField
60591>>>>>>>>>>>>>    send increment_pc
60592>>>>>>>>>>>>>  end_procedure
60593>>>>>>>>>>>>>  procedure AddData.s integer arg_type# string data#
60595>>>>>>>>>>>>>    if arg_type# eq AT_VAR begin
60597>>>>>>>>>>>>>      set value item (piProgramCounter(self)) to AT_VARNO
60598>>>>>>>>>>>>>      send increment_pc
60599>>>>>>>>>>>>>      send add_argument_gvar data#
60600>>>>>>>>>>>>>    end
60600>>>>>>>>>>>>>>
60600>>>>>>>>>>>>>    if arg_type# eq AT_LBL begin
60602>>>>>>>>>>>>>      set value item (piProgramCounter(self)) to AT_LBL
60603>>>>>>>>>>>>>      send increment_pc
60604>>>>>>>>>>>>>      send add_argument_label data#
60605>>>>>>>>>>>>>    end
60605>>>>>>>>>>>>>>
60605>>>>>>>>>>>>>    if (iArgType_Const.i(arg_type#)) begin
60607>>>>>>>>>>>>>      set value item (piProgramCounter(self)) to arg_type#
60608>>>>>>>>>>>>>      send increment_pc
60609>>>>>>>>>>>>>      set value item (piProgramCounter(self)) to data#
60610>>>>>>>>>>>>>      send increment_pc
60611>>>>>>>>>>>>>    end
60611>>>>>>>>>>>>>>
60611>>>>>>>>>>>>>    if arg_type# eq AT_EXPR begin
60613>>>>>>>>>>>>>      set value item (piProgramCounter(self)) to arg_type#
60614>>>>>>>>>>>>>      send increment_pc
60615>>>>>>>>>>>>>      set value item (piProgramCounter(self)) to data#
60616>>>>>>>>>>>>>      send increment_pc
60617>>>>>>>>>>>>>    end
60617>>>>>>>>>>>>>>
60617>>>>>>>>>>>>>    if arg_type# eq AT_FIELD begin
60619>>>>>>>>>>>>>      set value item (piProgramCounter(self)) to AT_FIELDNO
60620>>>>>>>>>>>>>      send increment_pc
60621>>>>>>>>>>>>>      send add_argument_field data#
60622>>>>>>>>>>>>>    end
60622>>>>>>>>>>>>>>
60622>>>>>>>>>>>>>    if arg_type# eq AT_ARRAY_ELEM begin
60624>>>>>>>>>>>>>      set value item (piProgramCounter(self)) to AT_ARRAY_ELEM
60625>>>>>>>>>>>>>    end
60625>>>>>>>>>>>>>>
60625>>>>>>>>>>>>>  end_procedure
60626>>>>>>>>>>>>>  procedure add_instruction integer opcode# string arg#
60628>>>>>>>>>>>>>    integer iArg num_arguments# special_add_msg# oOpCodes# argtype# count#
60628>>>>>>>>>>>>>    string data#
60628>>>>>>>>>>>>>    string arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#
60628>>>>>>>>>>>>>    move (oOpcodes(self)) to oOpCodes#
60629>>>>>>>>>>>>>    get piParameters.i of oOpCodes# item opcode# to num_arguments#
60630>>>>>>>>>>>>>    if num_arguments# ne (num_arguments-1/2) begin
60632>>>>>>>>>>>>>      send add_ct_error (piProgramCounter(self)) "Wrong number of arguments"
60633>>>>>>>>>>>>>      send add_ct_error (piProgramCounter(self)) ("Command: "+psName.i(oOpcodes#,opcode#)+"(Gets "+string(num_arguments-1/2)+", expects "+string(num_arguments#)+")")
60634>>>>>>>>>>>>>    end
60634>>>>>>>>>>>>>>
60634>>>>>>>>>>>>>    else begin
60635>>>>>>>>>>>>>      get piSpecialAddMsg.i of oOpCodes# item opcode# to special_add_msg#
60636>>>>>>>>>>>>>      if special_add_msg# begin
60638>>>>>>>>>>>>>        for iArg from 2 to num_arguments
60644>>>>>>>>>>>>>>
60644>>>>>>>>>>>>>          if iArg eq  2 MoveStr iArg& to arg1#
60647>>>>>>>>>>>>>          if iArg eq  3 MoveStr iArg& to arg2#
60650>>>>>>>>>>>>>          if iArg eq  4 MoveStr iArg& to arg3#
60653>>>>>>>>>>>>>          if iArg eq  5 MoveStr iArg& to arg4#
60656>>>>>>>>>>>>>          if iArg eq  6 MoveStr iArg& to arg5#
60659>>>>>>>>>>>>>          if iArg eq  7 MoveStr iArg& to arg6#
60662>>>>>>>>>>>>>          if iArg eq  8 MoveStr iArg& to arg7#
60665>>>>>>>>>>>>>          if iArg eq  9 MoveStr iArg& to arg8#
60668>>>>>>>>>>>>>          if iArg eq 10 MoveStr iArg& to arg9#
60671>>>>>>>>>>>>>          if iArg eq 11 MoveStr iArg& to arg10#
60674>>>>>>>>>>>>>          if iArg eq 12 MoveStr iArg& to arg11#
60677>>>>>>>>>>>>>          if iArg eq 13 MoveStr iArg& to arg12#
60680>>>>>>>>>>>>>        loop
60681>>>>>>>>>>>>>>
60681>>>>>>>>>>>>>        if num_arguments eq  1 send special_add_msg# opcode#
60684>>>>>>>>>>>>>        if num_arguments eq  2 send special_add_msg# opcode# arg1#
60687>>>>>>>>>>>>>        if num_arguments eq  3 send special_add_msg# opcode# arg1# arg2#
60690>>>>>>>>>>>>>        if num_arguments eq  4 send special_add_msg# opcode# arg1# arg2# arg3#
60693>>>>>>>>>>>>>        if num_arguments eq  5 send special_add_msg# opcode# arg1# arg2# arg3# arg4#
60696>>>>>>>>>>>>>        if num_arguments eq  6 send special_add_msg# opcode# arg1# arg2# arg3# arg4# arg5#
60699>>>>>>>>>>>>>        if num_arguments eq  7 send special_add_msg# opcode# arg1# arg2# arg3# arg4# arg5# arg6#
60702>>>>>>>>>>>>>        if num_arguments eq  8 send special_add_msg# opcode# arg1# arg2# arg3# arg4# arg5# arg6# arg7#
60705>>>>>>>>>>>>>        if num_arguments eq  9 send special_add_msg# opcode# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8#
60708>>>>>>>>>>>>>        if num_arguments eq 10 send special_add_msg# opcode# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9#
60711>>>>>>>>>>>>>        if num_arguments eq 11 send special_add_msg# opcode# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10#
60714>>>>>>>>>>>>>        if num_arguments eq 12 send special_add_msg# opcode# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11#
60717>>>>>>>>>>>>>        if num_arguments eq 13 send special_add_msg# opcode# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#
60720>>>>>>>>>>>>>      end
60720>>>>>>>>>>>>>>
60720>>>>>>>>>>>>>      else begin
60721>>>>>>>>>>>>>        send AddOpcode.i opcode#
60722>>>>>>>>>>>>>        for count# from 1 to num_arguments#
60728>>>>>>>>>>>>>>
60728>>>>>>>>>>>>>          move (count#-1*2+2) to iArg
60729>>>>>>>>>>>>>          MoveStr iArg& to argtype# // tricky way to parse passed arguments
60730>>>>>>>>>>>>>>
60730>>>>>>>>>>>>>          increment iArg
60731>>>>>>>>>>>>>          MoveStr iArg& to data# // tricky way to parse passed arguments
60732>>>>>>>>>>>>>>
60732>>>>>>>>>>>>>          send AddData.s argtype# data#
60733>>>>>>>>>>>>>        loop
60734>>>>>>>>>>>>>>
60734>>>>>>>>>>>>>      end
60734>>>>>>>>>>>>>>
60734>>>>>>>>>>>>>    end
60734>>>>>>>>>>>>>>
60734>>>>>>>>>>>>>    //send display_array
60734>>>>>>>>>>>>>  end_procedure
60735>>>>>>>>>>>>>  // ==================================================================
60735>>>>>>>>>>>>>  procedure display_array
60737>>>>>>>>>>>>>    integer max# itm#
60737>>>>>>>>>>>>>    get item_count to max#
60738>>>>>>>>>>>>>    showln
60739>>>>>>>>>>>>>    show ">> "
60740>>>>>>>>>>>>>    for itm# from 0 to (max#-1)
60746>>>>>>>>>>>>>>
60746>>>>>>>>>>>>>      show ("["+value(self,itm#)+"]")
60747>>>>>>>>>>>>>    loop
60748>>>>>>>>>>>>>>
60748>>>>>>>>>>>>>    inkey itm#
60749>>>>>>>>>>>>>>
60749>>>>>>>>>>>>>  end_procedure
60750>>>>>>>>>>>>>end_class // cBasicVirtualMachine
60751>>>>>>>>>>>>>
60751>>>>>>>>>>>>>// ========================================================================
60751>>>>>>>>>>>>>//  SEC2: =================================================================
60751>>>>>>>>>>>>>// ========================================================================
60751>>>>>>>>>>>>>
60751>>>>>>>>>>>>>Enumeration_List // Operation codes
60751>>>>>>>>>>>>>  Enumeration_List_Set_Enum_Value cBasicVirtualMachine.NEXT_OP
60751>>>>>>>>>>>>>  define OP_WHILE
60751>>>>>>>>>>>>>  define OP_FOR
60751>>>>>>>>>>>>>  define OP_LOOP
60751>>>>>>>>>>>>>  define OP_IF_BEGIN
60751>>>>>>>>>>>>>  define OP_ELSE
60751>>>>>>>>>>>>>  define OP_ENDIF
60751>>>>>>>>>>>>>  define OP_REPEAT
60751>>>>>>>>>>>>>  define OP_UNTIL
60751>>>>>>>>>>>>>  define cVirtualMachine.NEXT_OP // Augmentation codes starts here
60751>>>>>>>>>>>>>End_Enumeration_List
60751>>>>>>>>>>>>>
60751>>>>>>>>>>>>>register_procedure add_macro_while
60751>>>>>>>>>>>>>register_procedure add_macro_for
60751>>>>>>>>>>>>>register_procedure add_macro_loop
60751>>>>>>>>>>>>>register_procedure add_macro_if_begin
60751>>>>>>>>>>>>>register_procedure add_macro_else
60751>>>>>>>>>>>>>register_procedure add_macro_endif
60751>>>>>>>>>>>>>register_procedure add_macro_repeat
60751>>>>>>>>>>>>>register_procedure add_macro_until
60751>>>>>>>>>>>>>
60751>>>>>>>>>>>>>class cVirtualMachine is an cBasicVirtualMachine
60752>>>>>>>>>>>>>  procedure construct_object integer img#
60754>>>>>>>>>>>>>    forward send construct_object img#
60756>>>>>>>>>>>>>    send add_opcode OP_WHILE    "While"  0 3 msg_add_macro_while    //
60757>>>>>>>>>>>>>    send add_opcode OP_FOR      "For"    0 3 msg_add_macro_for      //
60758>>>>>>>>>>>>>    send add_opcode OP_LOOP     "Loop"   0 0 msg_add_macro_loop     //
60759>>>>>>>>>>>>>    send add_opcode OP_IF_BEGIN "If"     0 3 msg_add_macro_if_begin //
60760>>>>>>>>>>>>>    send add_opcode OP_ELSE     "Else"   0 0 msg_add_macro_else     //
60761>>>>>>>>>>>>>    send add_opcode OP_ENDIF    "End"    0 0 msg_add_macro_endif    //
60762>>>>>>>>>>>>>    send add_opcode OP_REPEAT   "Repeat" 0 0 msg_add_macro_repeat   //
60763>>>>>>>>>>>>>    send add_opcode OP_UNTIL    "Until"  0 3 msg_add_macro_until    //
60764>>>>>>>>>>>>>    object oIfStack is a cStack
60766>>>>>>>>>>>>>    end_object
60767>>>>>>>>>>>>>    property integer pUniqueLabelID public 0 // Used for generating unique labels
60768>>>>>>>>>>>>>  end_procedure
60769>>>>>>>>>>>>>  procedure reset
60771>>>>>>>>>>>>>    forward send reset
60773>>>>>>>>>>>>>    set pUniqueLabelID to 0
60774>>>>>>>>>>>>>    send delete_data to (oIfStack(self))
60775>>>>>>>>>>>>>  end_procedure
60776>>>>>>>>>>>>>  function sNextUniqueLabel returns string // Returns next unique label
60778>>>>>>>>>>>>>    integer UniqueLabelID#
60778>>>>>>>>>>>>>    string rval#
60778>>>>>>>>>>>>>    get pUniqueLabelID to UniqueLabelID#
60779>>>>>>>>>>>>>    move ("Label$"+string(UniqueLabelID#)) to rval#
60780>>>>>>>>>>>>>    set pUniqueLabelID to (UniqueLabelID#+1)
60781>>>>>>>>>>>>>    function_return rval#
60782>>>>>>>>>>>>>  end_function
60783>>>>>>>>>>>>>
60783>>>>>>>>>>>>>  // Repeat/Until structure:
60783>>>>>>>>>>>>>  //
60783>>>>>>>>>>>>>  // Repeat:      LoopStart:
60783>>>>>>>>>>>>>  //
60783>>>>>>>>>>>>>  // Until:       If Var1 Comp Var2 Goto Loopend:
60783>>>>>>>>>>>>>  //              Goto LoopStart:
60783>>>>>>>>>>>>>  //              LoopEnd:
60783>>>>>>>>>>>>>  //
60783>>>>>>>>>>>>>  procedure add_macro_repeat
60785>>>>>>>>>>>>>    string lbl_LoopStart#
60785>>>>>>>>>>>>>    get sNextUniqueLabel to lbl_LoopStart#
60786>>>>>>>>>>>>>    send declare_label lbl_LoopStart#
60787>>>>>>>>>>>>>    send push.s to (oIfStack(self)) lbl_LoopStart#
60788>>>>>>>>>>>>>  end_procedure
60789>>>>>>>>>>>>>
60789>>>>>>>>>>>>>  procedure add_macro_until integer opcode# integer t1# integer varno1# integer t2# integer comp# integer t3# integer varno2#
60791>>>>>>>>>>>>>    string lbl_LoopStart# lbl_LoopEnd#
60791>>>>>>>>>>>>>    get sNextUniqueLabel to lbl_LoopEnd#
60792>>>>>>>>>>>>>    get sPop of (oIfStack(self)) to lbl_LoopStart#
60793>>>>>>>>>>>>>    send add_instruction OP_IFTEST_GOTO t1# varno1# t2# comp# t3# varno2# AT_LBL lbl_LoopEnd#
60794>>>>>>>>>>>>>    send add_instruction OP_GOTO AT_LBL lbl_LoopStart#
60795>>>>>>>>>>>>>    send declare_label lbl_LoopEnd#
60796>>>>>>>>>>>>>  end_procedure
60797>>>>>>>>>>>>>
60797>>>>>>>>>>>>>  // For/Loop structure:
60797>>>>>>>>>>>>>  //
60797>>>>>>>>>>>>>  // For:         VarAssign CtrlId VarFrom
60797>>>>>>>>>>>>>  //              Goto LoopStart
60797>>>>>>>>>>>>>  //              CtrlIncrement:
60797>>>>>>>>>>>>>  //              VarIncr CtrlId 1
60797>>>>>>>>>>>>>  //              LoopStart:
60797>>>>>>>>>>>>>  //              If CtrlId gt VarTo goto LoopEnd
60797>>>>>>>>>>>>>  //
60797>>>>>>>>>>>>>  // Loop:        Goto CtrlIncrement
60797>>>>>>>>>>>>>  //              LoopEnd:
60797>>>>>>>>>>>>>  //
60797>>>>>>>>>>>>>  procedure add_macro_for integer opcode# integer t1# string ctrlid# integer t2# string varfrom# integer t3# string varto#
60799>>>>>>>>>>>>>    string lbl_LoopStart# lbl_CtrlIncrement# lbl_LoopEnd#
60799>>>>>>>>>>>>>    get sNextUniqueLabel to lbl_LoopStart#
60800>>>>>>>>>>>>>    get sNextUniqueLabel to lbl_CtrlIncrement#
60801>>>>>>>>>>>>>    get sNextUniqueLabel to lbl_LoopEnd#
60802>>>>>>>>>>>>>    send add_instruction OP_ASSIGN AT_VAR ctrlid# t2# varfrom#
60803>>>>>>>>>>>>>    send add_instruction OP_GOTO AT_LBL lbl_LoopStart#
60804>>>>>>>>>>>>>    send declare_label lbl_CtrlIncrement#
60805>>>>>>>>>>>>>    send add_instruction OP_GVAR_INCR AT_VAR ctrlid# AT_CINT 1
60806>>>>>>>>>>>>>    send declare_label lbl_LoopStart#
60807>>>>>>>>>>>>>    send add_instruction OP_IFTEST_GOTO AT_VAR ctrlid# AT_CINT COMP_GT t3# varto# AT_LBL lbl_LoopEnd#
60808>>>>>>>>>>>>>    send push.s to (oIfStack(self)) lbl_CtrlIncrement#
60809>>>>>>>>>>>>>    send push.s to (oIfStack(self)) lbl_LoopEnd#
60810>>>>>>>>>>>>>  end_procedure
60811>>>>>>>>>>>>>  procedure add_macro_loop
60813>>>>>>>>>>>>>    string lbl_CtrlIncrement# lbl_LoopEnd#
60813>>>>>>>>>>>>>    get sPop of (oIfStack(self)) to lbl_LoopEnd#
60814>>>>>>>>>>>>>    get sPop of (oIfStack(self)) to lbl_CtrlIncrement#
60815>>>>>>>>>>>>>    send add_instruction OP_GOTO AT_LBL lbl_CtrlIncrement#
60816>>>>>>>>>>>>>    send declare_label lbl_LoopEnd#
60817>>>>>>>>>>>>>  end_procedure
60818>>>>>>>>>>>>>
60818>>>>>>>>>>>>>  // While/Loop structure:
60818>>>>>>>>>>>>>  //
60818>>>>>>>>>>>>>  // While:       LoopStart:
60818>>>>>>>>>>>>>  //              If Var1 Comp Var2 Goto Continue
60818>>>>>>>>>>>>>  //              Goto LoopEnd
60818>>>>>>>>>>>>>  //              Continue:
60818>>>>>>>>>>>>>  //
60818>>>>>>>>>>>>>  // Loop:        Goto LoopStart
60818>>>>>>>>>>>>>  //              LoopEnd:
60818>>>>>>>>>>>>>  //
60818>>>>>>>>>>>>>  procedure add_macro_while integer opcode# integer t1# integer varno1# integer t2# integer comp# integer t3# integer varno2#
60820>>>>>>>>>>>>>    string lbl_LoopStart# lbl_Continue# lbl_LoopEnd#
60820>>>>>>>>>>>>>    get sNextUniqueLabel to lbl_LoopStart#
60821>>>>>>>>>>>>>    get sNextUniqueLabel to lbl_Continue#
60822>>>>>>>>>>>>>    get sNextUniqueLabel to lbl_LoopEnd#
60823>>>>>>>>>>>>>    send declare_label lbl_LoopStart#
60824>>>>>>>>>>>>>    send add_instruction OP_IFTEST_GOTO t1# varno1# t2# comp# t3# varno2# AT_LBL lbl_Continue#
60825>>>>>>>>>>>>>    send add_instruction OP_GOTO AT_LBL lbl_LoopEnd#
60826>>>>>>>>>>>>>    send declare_label lbl_Continue#
60827>>>>>>>>>>>>>    send push.s to (oIfStack(self)) lbl_LoopStart#
60828>>>>>>>>>>>>>    send push.s to (oIfStack(self)) lbl_LoopEnd#
60829>>>>>>>>>>>>>  end_procedure
60830>>>>>>>>>>>>>
60830>>>>>>>>>>>>>  // If/Else/Endif structure:
60830>>>>>>>>>>>>>  //
60830>>>>>>>>>>>>>  // If:          If Var1 Comp Var2 Goto IfBranch
60830>>>>>>>>>>>>>  //              Goto ElseBranch
60830>>>>>>>>>>>>>  //              IfBranch:
60830>>>>>>>>>>>>>  //
60830>>>>>>>>>>>>>  // Else:        Goto EndIf
60830>>>>>>>>>>>>>  //              ElseBranch:
60830>>>>>>>>>>>>>  //
60830>>>>>>>>>>>>>  // EndIf:       EndIf:
60830>>>>>>>>>>>>>  //             (ElseBranch:)
60830>>>>>>>>>>>>>  procedure add_macro_if_begin integer opcode# integer t1# integer varno1# integer t2# integer comp# integer t3# integer varno2#
60832>>>>>>>>>>>>>    string lbl_IfBranch# lbl_ElseBranch# lbl_EndIf#
60832>>>>>>>>>>>>>    get sNextUniqueLabel to lbl_IfBranch#
60833>>>>>>>>>>>>>    get sNextUniqueLabel to lbl_ElseBranch#
60834>>>>>>>>>>>>>    get sNextUniqueLabel to lbl_EndIf#
60835>>>>>>>>>>>>>    send add_instruction OP_IFTEST_GOTO t1# varno1# t2# comp# t3# varno2# AT_LBL lbl_IfBranch#
60836>>>>>>>>>>>>>    send add_instruction OP_GOTO AT_LBL lbl_ElseBranch#
60837>>>>>>>>>>>>>    send declare_label lbl_IfBranch#
60838>>>>>>>>>>>>>    send push.s to (oIfStack(self)) lbl_ElseBranch#
60839>>>>>>>>>>>>>    send push.s to (oIfStack(self)) lbl_EndIf#
60840>>>>>>>>>>>>>  end_procedure
60841>>>>>>>>>>>>>  procedure add_macro_else integer opcode#
60843>>>>>>>>>>>>>    string lbl_ElseBranch# lbl_EndIf#
60843>>>>>>>>>>>>>    get sPop of (oIfStack(self)) to lbl_EndIf#
60844>>>>>>>>>>>>>    get sPop of (oIfStack(self)) to lbl_ElseBranch#
60845>>>>>>>>>>>>>    send add_instruction OP_GOTO AT_LBL lbl_EndIf#
60846>>>>>>>>>>>>>    send declare_label lbl_ElseBranch#
60847>>>>>>>>>>>>>    send push.s to (oIfStack(self)) lbl_ElseBranch#
60848>>>>>>>>>>>>>    send push.s to (oIfStack(self)) lbl_EndIf#
60849>>>>>>>>>>>>>  end_procedure
60850>>>>>>>>>>>>>  procedure add_macro_endif integer opcode#
60852>>>>>>>>>>>>>    string lbl_ElseBranch# lbl_EndIf#
60852>>>>>>>>>>>>>    get sPop of (oIfStack(self)) to lbl_EndIf#
60853>>>>>>>>>>>>>    get sPop of (oIfStack(self)) to lbl_ElseBranch#
60854>>>>>>>>>>>>>    send declare_label lbl_EndIf#
60855>>>>>>>>>>>>>    send declare_label_no_error lbl_ElseBranch# // Only ifnot already declared!
60856>>>>>>>>>>>>>  end_procedure
60857>>>>>>>>>>>>>end_class // cVirtualMachine
60858>>>>>>>>>>>>>
60858>>>>>>>>>>>>>Use APS          // Auto Positioning and Sizing classes for VDF
60858>>>>>>>>>>>>>object oScriptError is a aps.ModalPanel label "DFScript runtime error"
60861>>>>>>>>>>>>>  set Locate_Mode to CENTER_ON_SCREEN
60862>>>>>>>>>>>>>  on_key kcancel send close_panel
60863>>>>>>>>>>>>>  property integer piOriginalErrorObject public 0
60865>>>>>>>>>>>>>
60865>>>>>>>>>>>>>  object oTb1 is a aps.TextBox label "DataFlex reported this error:"
60868>>>>>>>>>>>>>  end_object
60869>>>>>>>>>>>>>  object oFrm1 is a aps.Form abstract AFT_ASCII50 snap sl_down
60873>>>>>>>>>>>>>    set object_shadow_state to true
60874>>>>>>>>>>>>>  end_object
60875>>>>>>>>>>>>>  object oFrm2 is a aps.Form abstract AFT_ASCII50 snap sl_down
60879>>>>>>>>>>>>>    set object_shadow_state to true
60880>>>>>>>>>>>>>  end_object
60881>>>>>>>>>>>>>  object oTb2 is a aps.TextBox label "While executing this DFScript instruction:" snap sl_down
60885>>>>>>>>>>>>>  end_object
60886>>>>>>>>>>>>>  object oFrm3 is a aps.Form abstract AFT_ASCII50 snap sl_down
60890>>>>>>>>>>>>>    set object_shadow_state to true
60891>>>>>>>>>>>>>  end_object
60892>>>>>>>>>>>>>  object oFrm4 is a aps.Form abstract AFT_ASCII50 snap sl_down
60896>>>>>>>>>>>>>    set object_shadow_state to true
60897>>>>>>>>>>>>>  end_object
60898>>>>>>>>>>>>>  object oFrm5 is a aps.Form abstract AFT_ASCII50 snap sl_down
60902>>>>>>>>>>>>>    set object_shadow_state to true
60903>>>>>>>>>>>>>  end_object
60904>>>>>>>>>>>>>  object oBtn1 is a aps.Multi_Button
60906>>>>>>>>>>>>>      on_item "End script"  send end_script
60907>>>>>>>>>>>>>  end_object
60908>>>>>>>>>>>>>  object oBtn2 is a aps.Multi_Button
60910>>>>>>>>>>>>>      on_item "Display def" send display_definition
60911>>>>>>>>>>>>>  end_object
60912>>>>>>>>>>>>>  object oBtn3 is a aps.Multi_Button
60914>>>>>>>>>>>>>      on_item "Continue" send close_panel
60915>>>>>>>>>>>>>  end_object
60916>>>>>>>>>>>>>  send aps_locate_multi_buttons
60917>>>>>>>>>>>>>  procedure Error_Report integer ErrNum integer Err_Line string str#
60920>>>>>>>>>>>>>    integer grb#
60920>>>>>>>>>>>>>    string str1# str2#
60920>>>>>>>>>>>>>    set value of (oFrm1(self)) item 0 to (Error_Description(self,ErrNum,str#))
60921>>>>>>>>>>>>>    set value of (oFrm2(self)) item 0 to ("(Error "+string(ErrNum)+" on line "+string(Err_Line)+")")
60922>>>>>>>>>>>>>    move (sExecutingLine(oVM_CurrentlyExecuting#)) to str1#
60923>>>>>>>>>>>>>    move (StringRightBut(str1#,64)) to str2#
60924>>>>>>>>>>>>>    set value of (oFrm3(self)) item 0 to str1#
60925>>>>>>>>>>>>>    set value of (oFrm4(self)) item 0 to str2#
60926>>>>>>>>>>>>>    set value of (oFrm5(self)) item 0 to Struc$ErrDescr
60927>>>>>>>>>>>>>    send popup
60928>>>>>>>>>>>>>  end_procedure
60929>>>>>>>>>>>>>
60929>>>>>>>>>>>>>  // Stolen right out of error.pkg:
60929>>>>>>>>>>>>>  //*** Build complete error description from Flexerrs and user error message.
60929>>>>>>>>>>>>>  function Error_Description integer Error# string ErrMsg returns string
60932>>>>>>>>>>>>>    string Full_Error_Text
60932>>>>>>>>>>>>>    trim ErrMsg to ErrMsg
60933>>>>>>>>>>>>>>
60933>>>>>>>>>>>>>    move (trim(error_text(DESKTOP,Error#))) to Full_Error_Text
60934>>>>>>>>>>>>>    if ErrMsg ne "" begin
60936>>>>>>>>>>>>>      if ((Full_Error_Text ne "") AND error_text_available(DESKTOP,Error#)) append Full_Error_Text " " ErrMsg
60940>>>>>>>>>>>>>      else move ErrMsg to Full_Error_Text
60942>>>>>>>>>>>>>    end
60942>>>>>>>>>>>>>>
60942>>>>>>>>>>>>>    function_return Full_Error_Text
60943>>>>>>>>>>>>>  end_function
60944>>>>>>>>>>>>>
60944>>>>>>>>>>>>>  procedure end_script
60947>>>>>>>>>>>>>    set pProgramEnded of oVM_CurrentlyExecuting# to true
60948>>>>>>>>>>>>>    send close_panel
60949>>>>>>>>>>>>>  end_procedure
60950>>>>>>>>>>>>>
60950>>>>>>>>>>>>>  procedure display_definition
60953>>>>>>>>>>>>>    send RS_DisplayDef
60954>>>>>>>>>>>>>  end_procedure
60955>>>>>>>>>>>>>end_object
60956>>>>>>>>>>>>>
60956>>>>>>>>>>>>>procedure DFScriptError_On global // Set error trapping mode to DFScript
60958>>>>>>>>>>>>>  integer obj#
60958>>>>>>>>>>>>>  move (oScriptError(self)) to obj#
60959>>>>>>>>>>>>>  if Error_Object_Id ne obj# begin
60961>>>>>>>>>>>>>    set piOriginalErrorObject of obj# to Error_Object_Id
60962>>>>>>>>>>>>>    move obj# to Error_Object_Id
60963>>>>>>>>>>>>>  end
60963>>>>>>>>>>>>>>
60963>>>>>>>>>>>>>end_procedure
60964>>>>>>>>>>>>>procedure DFScriptError_Off global // Set error trapping mode back to normal
60966>>>>>>>>>>>>>  integer obj#
60966>>>>>>>>>>>>>  move (oScriptError(self)) to obj#
60967>>>>>>>>>>>>>  if Error_Object_Id eq obj# ;    get piOriginalErrorObject of obj# to Error_Object_Id
60970>>>>>>>>>>>>>end_procedure
60971>>>>>>>>>>>>>
60971>>>>>>>>>>>>>
60971>>>>>>>>>>>>>//
60971>>>>>>>>>>>>>//  This is what the interface looks like if you don't put an interpreter
60971>>>>>>>>>>>>>//  object in front of the Virtual Machine
60971>>>>>>>>>>>>>//
60971>>>>>>>>>>>>>//  object oVM is a cVirtualMachine
60971>>>>>>>>>>>>>//    set piDebugState      to DFFALSE
60971>>>>>>>>>>>>>//    set piDebugSingleStep to DFFALSE
60971>>>>>>>>>>>>>//    send script_begin // Optag program
60971>>>>>>>>>>>>>//    send declare_var "i" VARTYP_INTEGER
60971>>>>>>>>>>>>>//    send declare_var "j" VARTYP_INTEGER
60971>>>>>>>>>>>>>//    send add_instruction OP_FOR AT_VAR "i" AT_CINT 1 AT_CINT 2
60971>>>>>>>>>>>>>//      send add_instruction OP_FOR AT_VAR "j" AT_CINT 1 AT_CINT 10
60971>>>>>>>>>>>>>//      send add_instruction   OP_SHOWLN AT_VAR "j"
60971>>>>>>>>>>>>>//      send add_instruction OP_LOOP
60971>>>>>>>>>>>>>//    send add_instruction OP_LOOP
60971>>>>>>>>>>>>>//    send declare_var "A" VARTYP_INTEGER
60971>>>>>>>>>>>>>//    send declare_var "B" VARTYP_INTEGER
60971>>>>>>>>>>>>>//    send declare_var "C" VARTYP_INTEGER
60971>>>>>>>>>>>>>//    send declare_var "D" VARTYP_INTEGER
60971>>>>>>>>>>>>>//    send add_instruction OP_ASSIGN AT_VAR "A" AT_CINT 7878
60971>>>>>>>>>>>>>//    send add_instruction OP_ASSIGN AT_VAR "B" AT_VAR "A"
60971>>>>>>>>>>>>>//    send add_instruction OP_GVAR_DISPLAY
60971>>>>>>>>>>>>>//    send add_instruction OP_GVAR_INCR   AT_VAR "B" AT_CINT 1
60971>>>>>>>>>>>>>//    send add_instruction OP_ASSIGN AT_VAR "C" AT_VAR "B"
60971>>>>>>>>>>>>>//    send add_instruction OP_GVAR_INCR   AT_VAR "C" AT_CINT 1
60971>>>>>>>>>>>>>//    send add_instruction OP_ASSIGN AT_VAR "D" AT_VAR "C"
60971>>>>>>>>>>>>>//    send add_instruction OP_GVAR_INCR   AT_VAR "D" AT_CINT 1
60971>>>>>>>>>>>>>//    send add_instruction OP_GVAR_DISPLAY
60971>>>>>>>>>>>>>//    send add_instruction OP_INPUT AT_VAR "D" AT_CSTR "Enter something: "
60971>>>>>>>>>>>>>//    send add_instruction OP_NOP // NOP means No OPeration (= do nothing)
60971>>>>>>>>>>>>>//    send add_instruction OP_NOP
60971>>>>>>>>>>>>>//    send add_instruction OP_NOP
60971>>>>>>>>>>>>>//    send add_instruction OP_GOSUB AT_LBL "MyFirstLabel"
60971>>>>>>>>>>>>>//    send add_instruction OP_ABORT // End program!
60971>>>>>>>>>>>>>//    send declare_label "MyFirstLabel"
60971>>>>>>>>>>>>>//    send add_instruction OP_NOP
60971>>>>>>>>>>>>>//    send add_instruction OP_NOP
60971>>>>>>>>>>>>>//    send add_instruction OP_IF_GOTO AT_VAR "A" AT_LBL "MySecondLabel"
60971>>>>>>>>>>>>>//    send add_instruction OP_SHOWLN AT_CSTR "Didn't jump"
60971>>>>>>>>>>>>>//    send declare_label "MySecondLabel"
60971>>>>>>>>>>>>>//    send add_instruction OP_SHOWLN AT_CSTR "Jumped"
60971>>>>>>>>>>>>>//    send add_instruction OP_RETURN
60971>>>>>>>>>>>>>//    send script_end
60971>>>>>>>>>>>>>//  end_object
60971>>>>>>>>>>>>>//
60971>>>>>>>>>>>>>//  send obs "Begin"
60971>>>>>>>>>>>>>//  send run_script to (oVM(self))
60971>>>>>>>>>>>>>//  inkey windowindex
60971>>>>>>>>>>>Use Set.utl      // cArray, cSet and cStack classes
60971>>>>>>>>>>>Use Array.nui    // Item_Property command
60971>>>>>>>>>>>Use Strings.nui  // String manipulation for VDF
60971>>>>>>>>>>>Use Files.utl    // Utilities for handling file related stuff
60971>>>>>>>>>>>Use API_Attr.utl // Database API attributes characteristics
60971>>>>>>>>>>>
60971>>>>>>>>>>>//  /DFScript.RS_Program.hdr
60971>>>>>>>>>>>//  __ Program generated on __/__/____ ________ by ___________________
60971>>>>>>>>>>>//
60971>>>>>>>>>>>//  integer iFile     __
60971>>>>>>>>>>>//  integer iField    __
60971>>>>>>>>>>>//  integer iError    __
60971>>>>>>>>>>>//  integer iPrecond  __
60971>>>>>>>>>>>//  integer iWarning  __
60971>>>>>>>>>>>//  string  sFileName __
60971>>>>>>>>>>>//
60971>>>>>>>>>>>//  log_open "dfscript.log" 0
60971>>>>>>>>>>>//
60971>>>>>>>>>>>//  /DFScript.RS_Program.ftr
60971>>>>>>>>>>>//  log_close
60971>>>>>>>>>>>//  log_display
60971>>>>>>>>>>>//  system
60971>>>>>>>>>>>//  /*
60971>>>>>>>>>>>//
60971>>>>>>>>>>>//  object oScriptSource is an cArray
60971>>>>>>>>>>>//    property integer piRS_Header_Inserted public 0
60971>>>>>>>>>>>//    procedure reset
60971>>>>>>>>>>>//      send delete_data
60971>>>>>>>>>>>//      set piRS_Header_Inserted to false
60971>>>>>>>>>>>//    end_procedure
60971>>>>>>>>>>>//    procedure append_line string str#
60971>>>>>>>>>>>//      set value item (item_count(self)) to str#
60971>>>>>>>>>>>//    end_procedure
60971>>>>>>>>>>>//    procedure Insert_Image integer img#
60971>>>>>>>>>>>//      integer ch# seqeof#
60971>>>>>>>>>>>//      string str#
60971>>>>>>>>>>>//      move (SEQ_DirectInput("image:"+string(img#))) to ch#
60971>>>>>>>>>>>//      if (ch#>=0) begin
60971>>>>>>>>>>>//        repeat
60971>>>>>>>>>>>//          readln channel ch# str#
60971>>>>>>>>>>>//          move (seqeof) to seqeof#
60971>>>>>>>>>>>//          ifnot seqeof# send append_line str#
60971>>>>>>>>>>>//        until seqeof#
60971>>>>>>>>>>>//        send SEQ_CloseInput ch#
60971>>>>>>>>>>>//      end
60971>>>>>>>>>>>//    end_procedure
60971>>>>>>>>>>>//    procedure Insert_RS_Header string author#
60971>>>>>>>>>>>//      ifnot (piRS_Header_Inserted(self)) begin
60971>>>>>>>>>>>//        autopage DFScript.RS_Program.hdr
60971>>>>>>>>>>>//        print ("/"+"/")
60971>>>>>>>>>>>//        print (dSysDate())
60971>>>>>>>>>>>//        print (sSysTime())
60971>>>>>>>>>>>//        print author#
60971>>>>>>>>>>>//        print ("/"+"/")
60971>>>>>>>>>>>//        print ("/"+"/")
60971>>>>>>>>>>>//        print ("/"+"/")
60971>>>>>>>>>>>//        print ("/"+"/")
60971>>>>>>>>>>>//        print ("/"+"/")
60971>>>>>>>>>>>//        send Insert_Image DFScript.RS_Program.hdr.N
60971>>>>>>>>>>>//        set piRS_Header_Inserted to true
60971>>>>>>>>>>>//      end
60971>>>>>>>>>>>//    end_procedure
60971>>>>>>>>>>>//  end_object
60971>>>>>>>>>>>
60971>>>>>>>>>>>
60971>>>>>>>>>>>function ScriptError_Text global integer error# returns string
60973>>>>>>>>>>>  enumeration_list
60973>>>>>>>>>>>    define_script_error ERR.SCRIPT.NO_ERROR           "No error"
60976>>>>>>>>>>>    define_script_error ERR.SCRIPT.ERROR_ILLEGAL_CHAR "Illegal character"
60979>>>>>>>>>>>    define_script_error ERR.SCRIPT.COMMAND_NOT_FOUND  "Command not found"
60982>>>>>>>>>>>    define_script_error ERR.SCRIPT.ILLEGAL_VARNAME    "Illegal variable name"
60985>>>>>>>>>>>    define_script_error ERR.SCRIPT.SYMBOL_ALREADY_DEF "Symbol already defined"
60988>>>>>>>>>>>    define_script_error ERR.SCRIPT.TOO_MANY_ARGUMENTS "Too many arguments for command"
60991>>>>>>>>>>>    define_script_error ERR.SCRIPT.MISSING_ARGUMENT   "Missing argument(s)"
60994>>>>>>>>>>>    define_script_error ERR.SCRIPT.UNDEFINED_SYMBOL   "Undefined symbol"
60997>>>>>>>>>>>    define_script_error ERR.SCRIPT.CIRCULAR_REFERENCE "Circular reference in symbol replace"
61000>>>>>>>>>>>    define_script_error ERR.SCRIPT.ARGUMENT_TYPED     "Argument may not be typed"
61003>>>>>>>>>>>    define_script_error ERR.SCRIPT.CLASS_CHECK_ERROR  "Unknown symbol" //"Class check error"
61006>>>>>>>>>>>    define_script_error ERR.SCRIPT.TYPE_CHECK_ERROR   "Type check error"
61009>>>>>>>>>>>    define_script_error ERR.SCRIPT.KEYWORD_EXPECTED   "Keyword expected"
61012>>>>>>>>>>>    define_script_error ERR.SCRIPT.KEYWORD_DEBUG      "Keyword must be ON, OFF, SINGLE_STEP or DISPLAY_VAR"
61015>>>>>>>>>>>    define_script_error ERR.SCRIPT.SHOULD_BE_END      "END command expected"
61018>>>>>>>>>>>    define_script_error ERR.SCRIPT.SHOULD_BE_ENDIF    "ENDIF command expected"
61021>>>>>>>>>>>    define_script_error ERR.SCRIPT.SHOULD_BE_LOOP     "LOOP command expected"
61024>>>>>>>>>>>    define_script_error ERR.SCRIPT.SHOULD_BE_UNTIL    "UNTIL command expected"
61027>>>>>>>>>>>    define_script_error ERR.SCRIPT.UNINITIATED_END    "Un-initiated END command"
61030>>>>>>>>>>>    define_script_error ERR.SCRIPT.UNINITIATED_ELSE   "Un-initiated ELSE command"
61033>>>>>>>>>>>    define_script_error ERR.SCRIPT.UNINITIATED_ENDIF  "Un-initiated ENDIF command"
61036>>>>>>>>>>>    define_script_error ERR.SCRIPT.UNINITIATED_LOOP   "Un-initiated LOOP command"
61039>>>>>>>>>>>    define_script_error ERR.SCRIPT.UNINITIATED_UNTIL  "Un-initiated UNTIL command"
61042>>>>>>>>>>>    define_script_error ERR.SCRIPT.UNFINISHED_STRUCT  "Missing END/UNTIL or LOOP"
61045>>>>>>>>>>>    define_script_error ERR.SCRIPT.ILLEGAL_SYMBNAME   "Illegal symbol name"
61048>>>>>>>>>>>    define_script_error ERR.SCRIPT.MISSING_END_QUOTE  "Missing end quote"
61051>>>>>>>>>>>    define_script_error ERR.SCRIPT.BAD_PARAM_COUNT    "Wrong number of parameters for function"
61054>>>>>>>>>>>    define_script_error ERR.SCRIPT.FUNC_MISSING_PAR   "Function name must be followed by left parenthesis"
61057>>>>>>>>>>>    define_script_error ERR.SCRIPT.UNMOTIVATED_PARAM  "Unmotivated parameter"
61060>>>>>>>>>>>    define_script_error ERR.SCRIPT.MISSING_CONTENTS   "No contents in ()"
61063>>>>>>>>>>>    define_script_error ERR.SCRIPT.UNMOTIVATED_SYMBOL "Unmotivated symbol"
61066>>>>>>>>>>>    define_script_error ERR.SCRIPT.MISSING_OPERATOR   "Missing operator or comma"
61069>>>>>>>>>>>    define_script_error ERR.SCRIPT.ONE_OPERATOR_TO_M  "One operator too many"
61072>>>>>>>>>>>    define_script_error ERR.SCRIPT.OPERATOR_NEEDS_OPE "Operator must be followed by operand"
61075>>>>>>>>>>>    define_script_error ERR.SCRIPT.ATTR_NO_CHANGING   "Changing of API attribute not supported"
61078>>>>>>>>>>>    define_script_error ERR.SCRIPT.ATTR_IMPLICIT      "Setting of implicit API attributes not supported yet"
61081>>>>>>>>>>>    define_script_error ERR.SCRIPT.ATTR_NO_SET        "This attribute can only be read, not set"
61084>>>>>>>>>>>  end_enumeration_list
61084>>>>>>>>>>>end_function
61085>>>>>>>>>>>
61085>>>>>>>>>>>
61085>>>>>>>>>>>function ExprItemType_Text global integer liType returns string
61087>>>>>>>>>>>  enumeration_list
61087>>>>>>>>>>>    define_expr_item_type EIT.ERROR    "Error"
61090>>>>>>>>>>>    define_expr_item_type EIT.LEFT     "LftP"
61093>>>>>>>>>>>    define_expr_item_type EIT.RIGHT    "RgtP"
61096>>>>>>>>>>>    define_expr_item_type EIT.OPERATOR "Oper"
61099>>>>>>>>>>>    define_expr_item_type EIT.SYMBOL   "Symbol"
61102>>>>>>>>>>>    define_expr_item_type EIT.COMMA    "Comma"
61105>>>>>>>>>>>  end_enumeration_list
61105>>>>>>>>>>>end_function
61106>>>>>>>>>>>
61106>>>>>>>>>>>
61106>>>>>>>>>>>define TYPE.UNKNOWN for  0   // Argument types (UNKNOWN *must* be 0)
61106>>>>>>>>>>>define TYPE.UNTYPED for  1
61106>>>>>>>>>>>define TYPE.INTEGER for  2
61106>>>>>>>>>>>define TYPE.DATE    for  4
61106>>>>>>>>>>>define TYPE.NUMBER  for  8
61106>>>>>>>>>>>define TYPE.STRING  for 16
61106>>>>>>>>>>>
61106>>>>>>>>>>>function iTypeToVT.i global integer liType returns integer
61108>>>>>>>>>>>  if liType eq TYPE.INTEGER function_return VARTYP_INTEGER
61111>>>>>>>>>>>  if liType eq TYPE.DATE    function_return VARTYP_DATE
61114>>>>>>>>>>>  if liType eq TYPE.NUMBER  function_return VARTYP_NUMBER
61117>>>>>>>>>>>  if liType eq TYPE.STRING  function_return VARTYP_STRING
61120>>>>>>>>>>>  function_return VARTYP_VOID
61121>>>>>>>>>>>end_function
61122>>>>>>>>>>>
61122>>>>>>>>>>>define CLASS.UNKNOWN        for   0   // Argument classes (UNKNOWN *must* be 0)
61122>>>>>>>>>>>define CLASS.LABEL          for   1
61122>>>>>>>>>>>define CLASS.VAR            for   2
61122>>>>>>>>>>>define CLASS.CONST          for   4
61122>>>>>>>>>>>define CLASS.EXPR           for   8
61122>>>>>>>>>>>define CLASS.KEYWORD        for  16
61122>>>>>>>>>>>define CLASS.COMMAND        for  32
61122>>>>>>>>>>>define CLASS.REPLACE_SYMBOL for  64
61122>>>>>>>>>>>define CLASS.FIELD          for 128
61122>>>>>>>>>>>define CLASS.FUNCTION       for 256
61122>>>>>>>>>>>
61122>>>>>>>>>>>string charlist.all.legal 100
61122>>>>>>>>>>>move ('!"#$%&'+"'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~") to charlist.all.legal
61123>>>>>>>>>>>
61123>>>>>>>>>>>
61123>>>>>>>>>>>function iOperatorNameToID.s global string lsName returns integer
61125>>>>>>>>>>>  enumeration_list
61125>>>>>>>>>>>    define_operator OPERATOR.NONE     ""
61128>>>>>>>>>>>    define_operator OPERATOR.PLUS     "+"
61131>>>>>>>>>>>    define_operator OPERATOR.MINUS    "-"
61134>>>>>>>>>>>    define_operator OPERATOR.MULTIPLY "*"
61137>>>>>>>>>>>    define_operator OPERATOR.DIVIDE   "/"
61140>>>>>>>>>>>    define_operator OPERATOR.LT       "<"
61143>>>>>>>>>>>    define_operator OPERATOR.LE       "<="
61146>>>>>>>>>>>    define_operator OPERATOR.EQ       "="
61149>>>>>>>>>>>    define_operator OPERATOR.NE       "<>"
61152>>>>>>>>>>>    define_operator OPERATOR.GE       ">="
61155>>>>>>>>>>>    define_operator OPERATOR.GT       ">"
61158>>>>>>>>>>>    define_operator OPERATOR.MIN      "MIN"
61161>>>>>>>>>>>    define_operator OPERATOR.MAX      "MAX"
61164>>>>>>>>>>>    define_operator OPERATOR.AND      "AND"
61167>>>>>>>>>>>    define_operator OPERATOR.OR       "OR"
61170>>>>>>>>>>>  end_enumeration_list
61170>>>>>>>>>>>end_function
61171>>>>>>>>>>>function sOperatorSymbol.i global integer op# returns string
61173>>>>>>>>>>>  if op# eq OPERATOR.NONE     function_return ""
61176>>>>>>>>>>>  if op# eq OPERATOR.PLUS     function_return "+"
61179>>>>>>>>>>>  if op# eq OPERATOR.MINUS    function_return "-"
61182>>>>>>>>>>>  if op# eq OPERATOR.MULTIPLY function_return "*"
61185>>>>>>>>>>>  if op# eq OPERATOR.DIVIDE   function_return "/"
61188>>>>>>>>>>>  if op# eq OPERATOR.LT       function_return "<"
61191>>>>>>>>>>>  if op# eq OPERATOR.LE       function_return "<="
61194>>>>>>>>>>>  if op# eq OPERATOR.EQ       function_return "="
61197>>>>>>>>>>>  if op# eq OPERATOR.NE       function_return "<>"
61200>>>>>>>>>>>  if op# eq OPERATOR.GE       function_return ">="
61203>>>>>>>>>>>  if op# eq OPERATOR.GT       function_return ">"
61206>>>>>>>>>>>  if op# eq OPERATOR.MIN      function_return "MIN"
61209>>>>>>>>>>>  if op# eq OPERATOR.MAX      function_return "MAX"
61212>>>>>>>>>>>  if op# eq OPERATOR.AND      function_return "AND"
61215>>>>>>>>>>>  if op# eq OPERATOR.OR       function_return "OR"
61218>>>>>>>>>>>end_function
61219>>>>>>>>>>>
61219>>>>>>>>>>>register_function pVM_Object returns integer
61219>>>>>>>>>>>class cExpressionParser is an cArray
61220>>>>>>>>>>>  procedure construct_object integer img#
61222>>>>>>>>>>>    forward send construct_object img#
61224>>>>>>>>>>>    property integer piExprType public TYPE.UNKNOWN
61225>>>>>>>>>>>    object oParamCountStack is a cStack NO_IMAGE
61227>>>>>>>>>>>    end_object
61228>>>>>>>>>>>    object oImpliedTypesStack is a cStack NO_IMAGE
61230>>>>>>>>>>>    end_object
61231>>>>>>>>>>>    object oEvalSequence is a cEvalSequence NO_IMAGE
61233>>>>>>>>>>>    end_object
61234>>>>>>>>>>>  end_procedure
61235>>>>>>>>>>>  item_property_list
61235>>>>>>>>>>>    item_property string  psItem.i       // The item in clear text
61235>>>>>>>>>>>    item_property integer piStructType.i // What part of the expression is this?
61235>>>>>>>>>>>    item_property integer piPos.i        // What is the starting position?
61235>>>>>>>>>>>    item_property integer piClass.i      // If item, what is item class?
61235>>>>>>>>>>>    item_property integer piType.i       // If item, what is item type?
61235>>>>>>>>>>>    item_property integer piEvalLevel.i  // When evaluating
61235>>>>>>>>>>>    item_property integer piFuncParams.i // Number of parameters
61235>>>>>>>>>>>    item_property integer piOperator.i   // Type of operator
61235>>>>>>>>>>>    item_property integer piAux.i        //
61235>>>>>>>>>>>    item_property integer piEvalOrder.i  //
61235>>>>>>>>>>>  end_item_property_list cExpressionParser
#REM 61291 DEFINE FUNCTION PIEVALORDER.I INTEGER LIROW RETURNS INTEGER
#REM 61295 DEFINE PROCEDURE SET PIEVALORDER.I INTEGER LIROW INTEGER VALUE
#REM 61299 DEFINE FUNCTION PIAUX.I INTEGER LIROW RETURNS INTEGER
#REM 61303 DEFINE PROCEDURE SET PIAUX.I INTEGER LIROW INTEGER VALUE
#REM 61307 DEFINE FUNCTION PIOPERATOR.I INTEGER LIROW RETURNS INTEGER
#REM 61311 DEFINE PROCEDURE SET PIOPERATOR.I INTEGER LIROW INTEGER VALUE
#REM 61315 DEFINE FUNCTION PIFUNCPARAMS.I INTEGER LIROW RETURNS INTEGER
#REM 61319 DEFINE PROCEDURE SET PIFUNCPARAMS.I INTEGER LIROW INTEGER VALUE
#REM 61323 DEFINE FUNCTION PIEVALLEVEL.I INTEGER LIROW RETURNS INTEGER
#REM 61327 DEFINE PROCEDURE SET PIEVALLEVEL.I INTEGER LIROW INTEGER VALUE
#REM 61331 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 61335 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 61339 DEFINE FUNCTION PICLASS.I INTEGER LIROW RETURNS INTEGER
#REM 61343 DEFINE PROCEDURE SET PICLASS.I INTEGER LIROW INTEGER VALUE
#REM 61347 DEFINE FUNCTION PIPOS.I INTEGER LIROW RETURNS INTEGER
#REM 61351 DEFINE PROCEDURE SET PIPOS.I INTEGER LIROW INTEGER VALUE
#REM 61355 DEFINE FUNCTION PISTRUCTTYPE.I INTEGER LIROW RETURNS INTEGER
#REM 61359 DEFINE PROCEDURE SET PISTRUCTTYPE.I INTEGER LIROW INTEGER VALUE
#REM 61363 DEFINE FUNCTION PSITEM.I INTEGER LIROW RETURNS STRING
#REM 61367 DEFINE PROCEDURE SET PSITEM.I INTEGER LIROW STRING VALUE
61372>>>>>>>>>>>  procedure add_item integer liType string item# integer pos#
61374>>>>>>>>>>>    integer liRow
61374>>>>>>>>>>>    get row_count to liRow
61375>>>>>>>>>>>    set psItem.i       liRow to item#
61376>>>>>>>>>>>    set piStructType.i liRow to liType
61377>>>>>>>>>>>    set piPos.i        liRow to pos#
61378>>>>>>>>>>>    set piClass.i      liRow to 0
61379>>>>>>>>>>>    set piType.i       liRow to 0
61380>>>>>>>>>>>    set piEvalLevel.i  liRow to 0
61381>>>>>>>>>>>    set piFuncParams.i liRow to 0
61382>>>>>>>>>>>    set piOperator.i   liRow to 0
61383>>>>>>>>>>>    set piAux.i        liRow to 0
61384>>>>>>>>>>>  end_procedure
61385>>>>>>>>>>>  procedure reset
61387>>>>>>>>>>>    send delete_data
61388>>>>>>>>>>>    send delete_data to (oParamCountStack(self))
61389>>>>>>>>>>>    send delete_data to (oImpliedTypesStack(self))
61390>>>>>>>>>>>    set piExprType to TYPE.UNKNOWN
61391>>>>>>>>>>>  end_procedure
61392>>>>>>>>>>>  procedure split_expression_in_items string str# integer pos_offset#
61394>>>>>>>>>>>    integer pos# len# in_item# in_string# oper_type# start_pos#
61394>>>>>>>>>>>    string char# char2# item# quote# quotes#
61394>>>>>>>>>>>    send reset
61395>>>>>>>>>>>    move (length(str#)) to len#
61396>>>>>>>>>>>    move 0 to in_string#
61397>>>>>>>>>>>    move "" to item#
61398>>>>>>>>>>>    move 0 to in_item#
61399>>>>>>>>>>>    move ("'"+'"') to quotes#
61400>>>>>>>>>>>    for pos# from 1 to len#
61406>>>>>>>>>>>>
61406>>>>>>>>>>>      move (mid(str#,1,pos#)) to char#
61407>>>>>>>>>>>      if in_item# begin
61409>>>>>>>>>>>        if in_string# begin
61411>>>>>>>>>>>          move (item#+char#) to item#
61412>>>>>>>>>>>          if char# eq quote# begin
61414>>>>>>>>>>>            send add_item EIT.SYMBOL item# (start_pos#+pos_offset#)
61415>>>>>>>>>>>            move 0 to in_string#
61416>>>>>>>>>>>            move 0 to in_item#
61417>>>>>>>>>>>            move "" to item#
61418>>>>>>>>>>>          end
61418>>>>>>>>>>>>
61418>>>>>>>>>>>        end
61418>>>>>>>>>>>>
61418>>>>>>>>>>>        else begin // We're not in a string
61419>>>>>>>>>>>          if char# eq "(" begin
61421>>>>>>>>>>>            send add_item EIT.SYMBOL item# (start_pos#+pos_offset#)
61422>>>>>>>>>>>            send add_item EIT.LEFT char# (pos#+pos_offset#)
61423>>>>>>>>>>>            move 0 to in_item#
61424>>>>>>>>>>>            move "" to item#
61425>>>>>>>>>>>          end
61425>>>>>>>>>>>>
61425>>>>>>>>>>>          else if char# eq ")" begin
61428>>>>>>>>>>>            send add_item EIT.SYMBOL item# (start_pos#+pos_offset#)
61429>>>>>>>>>>>            send add_item EIT.RIGHT char# (pos#+pos_offset#)
61430>>>>>>>>>>>            move 0 to in_item#
61431>>>>>>>>>>>            move "" to item#
61432>>>>>>>>>>>          end
61432>>>>>>>>>>>>
61432>>>>>>>>>>>          else if char# eq " " begin
61435>>>>>>>>>>>            send add_item EIT.SYMBOL item# (start_pos#+pos_offset#)
61436>>>>>>>>>>>            move 0 to in_item#
61437>>>>>>>>>>>            move "" to item#
61438>>>>>>>>>>>          end
61438>>>>>>>>>>>>
61438>>>>>>>>>>>          else if char# eq "," begin
61441>>>>>>>>>>>            send add_item EIT.SYMBOL item# (start_pos#+pos_offset#)
61442>>>>>>>>>>>            send add_item EIT.COMMA char# (pos#+pos_offset#)
61443>>>>>>>>>>>            move 0 to in_item#
61444>>>>>>>>>>>            move "" to item#
61445>>>>>>>>>>>          end
61445>>>>>>>>>>>>
61445>>>>>>>>>>>          else if char# in "=+-*/<>" begin
61448>>>>>>>>>>>            send add_item EIT.SYMBOL item# (start_pos#+pos_offset#)
61449>>>>>>>>>>>            move 0 to in_item#
61450>>>>>>>>>>>            move "" to item#
61451>>>>>>>>>>>            move (mid(str#,1,pos#+1)) to char2#
61452>>>>>>>>>>>            get iOperatorNameToID.s (char#+char2#) to oper_type#
61453>>>>>>>>>>>            if oper_type# ne OPERATOR.NONE begin
61455>>>>>>>>>>>              increment pos# // Dirty trick to handle two-character operators
61456>>>>>>>>>>>              send add_item EIT.OPERATOR (char#+char2#) (pos#+pos_offset#)
61457>>>>>>>>>>>            end
61457>>>>>>>>>>>>
61457>>>>>>>>>>>            else begin
61458>>>>>>>>>>>              get iOperatorNameToID.s char# to oper_type#
61459>>>>>>>>>>>              send add_item EIT.OPERATOR char# (pos#+pos_offset#)
61460>>>>>>>>>>>            end
61460>>>>>>>>>>>>
61460>>>>>>>>>>>            set piOperator.i (row_count(self)-1) to oper_type#
61461>>>>>>>>>>>          end
61461>>>>>>>>>>>>
61461>>>>>>>>>>>          else move (item#+char#) to item#
61463>>>>>>>>>>>        end
61463>>>>>>>>>>>>
61463>>>>>>>>>>>      end
61463>>>>>>>>>>>>
61463>>>>>>>>>>>      else begin // We're not in an item
61464>>>>>>>>>>>        if char# ne " " begin // Ignore blanks
61466>>>>>>>>>>>          if char# in quotes# begin // Now we're in a string
61468>>>>>>>>>>>            move 1 to in_string#
61469>>>>>>>>>>>            move 1 to in_item#
61470>>>>>>>>>>>            move pos# to start_pos#
61471>>>>>>>>>>>            move char# to item#
61472>>>>>>>>>>>            move char# to quote#
61473>>>>>>>>>>>          end
61473>>>>>>>>>>>>
61473>>>>>>>>>>>          else if char# in "=<>+-*/" begin
61476>>>>>>>>>>>            move (mid(str#,1,pos#+1)) to char2#
61477>>>>>>>>>>>            get iOperatorNameToID.s (char#+char2#) to oper_type#
61478>>>>>>>>>>>            if oper_type# ne OPERATOR.NONE begin
61480>>>>>>>>>>>              increment pos# // Dirty trick to handle two-character operators
61481>>>>>>>>>>>              send add_item EIT.OPERATOR (char#+char2#) (pos#+pos_offset#)
61482>>>>>>>>>>>            end
61482>>>>>>>>>>>>
61482>>>>>>>>>>>            else begin
61483>>>>>>>>>>>              get iOperatorNameToID.s char# to oper_type#
61484>>>>>>>>>>>              send add_item EIT.OPERATOR char# (pos#+pos_offset#)
61485>>>>>>>>>>>            end
61485>>>>>>>>>>>>
61485>>>>>>>>>>>            set piOperator.i (row_count(self)-1) to oper_type#
61486>>>>>>>>>>>          end
61486>>>>>>>>>>>>
61486>>>>>>>>>>>          else if char# eq "(" send add_item EIT.LEFT "(" (pos#+pos_offset#)
61490>>>>>>>>>>>          else if char# eq ")" send add_item EIT.RIGHT ")" (pos#+pos_offset#)
61494>>>>>>>>>>>          else if char# eq "," send add_item EIT.COMMA "," pos#
61498>>>>>>>>>>>          else begin
61499>>>>>>>>>>>            move 1 to in_item#
61500>>>>>>>>>>>            move pos# to start_pos#
61501>>>>>>>>>>>            move char# to item#
61502>>>>>>>>>>>          end
61502>>>>>>>>>>>>
61502>>>>>>>>>>>        end
61502>>>>>>>>>>>>
61502>>>>>>>>>>>      end
61502>>>>>>>>>>>>
61502>>>>>>>>>>>    loop
61503>>>>>>>>>>>>
61503>>>>>>>>>>>    if in_string# send ScriptError ERR.SCRIPT.MISSING_END_QUOTE (start_pos#+pos_offset#)
61506>>>>>>>>>>>    if in_item# send add_item EIT.SYMBOL item# (start_pos#+pos_offset#)
61509>>>>>>>>>>>  end_procedure
61510>>>>>>>>>>>  function iErrorOccured returns integer
61512>>>>>>>>>>>    integer error#
61512>>>>>>>>>>>    get piErrorCode to error#
61513>>>>>>>>>>>    function_return (error#<>ERR.SCRIPT.NO_ERROR)
61514>>>>>>>>>>>  end_function
61515>>>>>>>>>>>  procedure DoReplaces // Perform symbol replaces
61517>>>>>>>>>>>    integer liRow max#
61517>>>>>>>>>>>    string name#
61517>>>>>>>>>>>    get row_count to max#
61518>>>>>>>>>>>    for liRow from 0 to (max#-1)
61524>>>>>>>>>>>>
61524>>>>>>>>>>>      move (psItem.i(self,liRow)) to name#
61525>>>>>>>>>>>      get sReplaceNameToNo.s name# to name#
61526>>>>>>>>>>>      set psItem.i liRow to name#
61527>>>>>>>>>>>    loop
61528>>>>>>>>>>>>
61528>>>>>>>>>>>  end_procedure
61529>>>>>>>>>>>  procedure DoClassColumn // Identify the classes
61531>>>>>>>>>>>    integer liRow max# class# stype#
61531>>>>>>>>>>>    string item#
61531>>>>>>>>>>>    get row_count to max#
61532>>>>>>>>>>>    for liRow from 0 to (max#-1)
61538>>>>>>>>>>>>
61538>>>>>>>>>>>      move (piStructType.i(self,liRow)) to stype#
61539>>>>>>>>>>>      if (stype#=EIT.SYMBOL) begin
61541>>>>>>>>>>>        move (psItem.i(self,liRow)) to item#
61542>>>>>>>>>>>        if ("|"+uppercase(item#)+"|") in "|AND|OR|MIN|MAX|" begin
61544>>>>>>>>>>>          set piStructType.i liRow to EIT.OPERATOR
61545>>>>>>>>>>>          set piOperator.i liRow to (iOperatorNameToID.s(uppercase(item#)))
61546>>>>>>>>>>>        end
61546>>>>>>>>>>>>
61546>>>>>>>>>>>        else begin
61547>>>>>>>>>>>          get iSymbolClass.s item# to class#
61548>>>>>>>>>>>          set piClass.i liRow to class#
61549>>>>>>>>>>>        end
61549>>>>>>>>>>>>
61549>>>>>>>>>>>      end
61549>>>>>>>>>>>>
61549>>>>>>>>>>>    loop
61550>>>>>>>>>>>>
61550>>>>>>>>>>>  end_procedure
61551>>>>>>>>>>>  procedure DoTypeColumn // Identify the types
61553>>>>>>>>>>>    integer liRow liMax liClass liType liStructType
61553>>>>>>>>>>>    string lsItem
61553>>>>>>>>>>>    get row_count to liMax
61554>>>>>>>>>>>    for liRow from 0 to (liMax-1)
61560>>>>>>>>>>>>
61560>>>>>>>>>>>      move (piStructType.i(self,liRow)) to liStructType
61561>>>>>>>>>>>      if (liStructType=EIT.SYMBOL) begin
61563>>>>>>>>>>>        move (psItem.i(self,liRow)) to lsItem
61564>>>>>>>>>>>        get piClass.i liRow to liClass
61565>>>>>>>>>>>        get iSymbolType.si lsItem liClass to liType
61566>>>>>>>>>>>        set piType.i liRow to liType
61567>>>>>>>>>>>        if liClass eq CLASS.UNKNOWN    send ScriptError ERR.SCRIPT.CLASS_CHECK_ERROR (piPos.i(self,liRow)) ("Symbol: "+lsItem)
61570>>>>>>>>>>>        else if liType eq TYPE.UNKNOWN send ScriptError ERR.SCRIPT.TYPE_CHECK_ERROR (piPos.i(self,liRow)) ("Symbol: "+lsItem)
61574>>>>>>>>>>>      end
61574>>>>>>>>>>>>
61574>>>>>>>>>>>    loop
61575>>>>>>>>>>>>
61575>>>>>>>>>>>  end_procedure
61576>>>>>>>>>>>  procedure DoFuncParams
61578>>>>>>>>>>>    integer liRow max# func_row# level# stack# stype# id#
61578>>>>>>>>>>>    integer current_left_pos# param_count# gets# expects#
61578>>>>>>>>>>>    string params#
61578>>>>>>>>>>>    get row_count to max#
61579>>>>>>>>>>>    move 0 to level#
61580>>>>>>>>>>>    move 0 to func_row#
61581>>>>>>>>>>>    move -1 to current_left_pos#
61582>>>>>>>>>>>    move 0 to param_count#
61583>>>>>>>>>>>    move (oParamCountStack(self)) to stack#
61584>>>>>>>>>>>    send delete_data to stack#
61585>>>>>>>>>>>    for liRow from 0 to (max#-1)
61591>>>>>>>>>>>>
61591>>>>>>>>>>>      move (piStructType.i(self,liRow)) to stype#
61592>>>>>>>>>>>      if (piClass.i(self,liRow)=CLASS.FUNCTION) begin
61594>>>>>>>>>>>        get iFuncNameToFuncNo.s of (pVM_Object(self)) (psItem.i(self,liRow)) to id#
61595>>>>>>>>>>>        get sFuncParams.i of (pVM_Object(self)) id# to params#
61596>>>>>>>>>>>        set piAux.i liRow to id#
61597>>>>>>>>>>>        set piFuncParams.i liRow to (length(params#))
61598>>>>>>>>>>>      end
61598>>>>>>>>>>>>
61598>>>>>>>>>>>      if (stype#=EIT.LEFT) begin
61600>>>>>>>>>>>        send push.i to stack# param_count#
61601>>>>>>>>>>>        send push.i to stack# current_left_pos#
61602>>>>>>>>>>>        move liRow to current_left_pos#
61603>>>>>>>>>>>        move 0 to param_count#
61604>>>>>>>>>>>        increment level#
61605>>>>>>>>>>>      end
61605>>>>>>>>>>>>
61605>>>>>>>>>>>      if (stype#=EIT.RIGHT) begin
61607>>>>>>>>>>>        set piFuncParams.i current_left_pos# to param_count#
61608>>>>>>>>>>>        decrement level#
61609>>>>>>>>>>>        move (iPop(stack#)) to current_left_pos#
61610>>>>>>>>>>>        move (iPop(stack#)) to param_count#
61611>>>>>>>>>>>        if param_count# eq 0 increment param_count#
61614>>>>>>>>>>>      end
61614>>>>>>>>>>>>
61614>>>>>>>>>>>      if (stype#=EIT.SYMBOL) if param_count# eq 0 increment param_count#
61619>>>>>>>>>>>      if (stype#=EIT.COMMA) increment param_count#
61622>>>>>>>>>>>      set piEvalLevel.i liRow to level#
61623>>>>>>>>>>>    loop
61624>>>>>>>>>>>>
61624>>>>>>>>>>>    // Now check that all function gets the expected number of parameters
61624>>>>>>>>>>>    for liRow from 0 to (max#-1)
61630>>>>>>>>>>>>
61630>>>>>>>>>>>      ifnot (iErrorOccured(self)) begin
61632>>>>>>>>>>>        if (piClass.i(self,liRow)=CLASS.FUNCTION) begin
61634>>>>>>>>>>>          move (piStructType.i(self,liRow+1)) to stype#
61635>>>>>>>>>>>          if stype# eq EIT.LEFT begin
61637>>>>>>>>>>>            move (piFuncParams.i(self,liRow)) to expects#
61638>>>>>>>>>>>            move (piFuncParams.i(self,liRow+1)) to gets#
61639>>>>>>>>>>>            if expects# ne gets# send ScriptError ERR.SCRIPT.BAD_PARAM_COUNT (piPos.i(self,liRow)) ("Function "+uppercase(psItem.i(self,liRow))+" expects "+string(expects#)+" parameters, "+string(gets#)+" is being passed")
61642>>>>>>>>>>>          end
61642>>>>>>>>>>>>
61642>>>>>>>>>>>          else begin
61643>>>>>>>>>>>            if (liRow+1) ge max# send ScriptError ERR.SCRIPT.FUNC_MISSING_PAR (piPos.i(self,liRow))
61646>>>>>>>>>>>            else send ScriptError ERR.SCRIPT.FUNC_MISSING_PAR (piPos.i(self,liRow+1))
61648>>>>>>>>>>>          end
61648>>>>>>>>>>>>
61648>>>>>>>>>>>        end
61648>>>>>>>>>>>>
61648>>>>>>>>>>>      end
61648>>>>>>>>>>>>
61648>>>>>>>>>>>    loop
61649>>>>>>>>>>>>
61649>>>>>>>>>>>  end_procedure
61650>>>>>>>>>>>  procedure DoFinalChecks
61652>>>>>>>>>>>    integer liRow max# stype# next_stype# params#
61652>>>>>>>>>>>    get row_count to max#
61653>>>>>>>>>>>    for liRow from 0 to (max#-1)
61659>>>>>>>>>>>>
61659>>>>>>>>>>>      ifnot (iErrorOccured(self)) begin
61661>>>>>>>>>>>        move (piStructType.i(self,liRow)) to stype#
61662>>>>>>>>>>>        move (piStructType.i(self,liRow+1)) to next_stype#
61663>>>>>>>>>>>
61663>>>>>>>>>>>        // If left parenthesis and the previous row is not a function
61663>>>>>>>>>>>        // then there must be exactly 1 parameter in the p-pair:
61663>>>>>>>>>>>        if stype# eq EIT.LEFT begin
61665>>>>>>>>>>>          if (piClass.i(self,liRow-1)<>CLASS.FUNCTION) begin
61667>>>>>>>>>>>            get piFuncParams.i liRow to params#
61668>>>>>>>>>>>            if params# gt 1 send ScriptError ERR.SCRIPT.UNMOTIVATED_PARAM (piPos.i(self,liRow+1))
61671>>>>>>>>>>>            if params# lt 1 send ScriptError ERR.SCRIPT.MISSING_CONTENTS (piPos.i(self,liRow))
61674>>>>>>>>>>>          end
61674>>>>>>>>>>>>
61674>>>>>>>>>>>        end
61674>>>>>>>>>>>>
61674>>>>>>>>>>>
61674>>>>>>>>>>>        // If SYMBOL there can not be a symbols next to it:
61674>>>>>>>>>>>        ifnot (iErrorOccured(self)) if (stype#=EIT.SYMBOL and next_stype#=EIT.SYMBOL) send ScriptError ERR.SCRIPT.UNMOTIVATED_SYMBOL (piPos.i(self,liRow+1))
61679>>>>>>>>>>>
61679>>>>>>>>>>>        // If right paranthesis it cannot be followed by a left paranthesis:
61679>>>>>>>>>>>        ifnot (iErrorOccured(self)) if (stype#=EIT.RIGHT and next_stype#=EIT.LEFT) send ScriptError ERR.SCRIPT.MISSING_OPERATOR (piPos.i(self,liRow+1))
61684>>>>>>>>>>>
61684>>>>>>>>>>>        // If OPERATOR there can not be an operator next to it (unless it's monadic minus)
61684>>>>>>>>>>>        ifnot (iErrorOccured(self)) if (stype#=EIT.OPERATOR and next_stype#=EIT.OPERATOR and piOperator.i(self,liRow+1) <> OPERATOR.MINUS) send ScriptError ERR.SCRIPT.ONE_OPERATOR_TO_M (piPos.i(self,liRow+1))
61689>>>>>>>>>>>
61689>>>>>>>>>>>        // In fact, if operator it MUST be followed by a symbol (operand)
61689>>>>>>>>>>>        ifnot (iErrorOccured(self)) begin
61691>>>>>>>>>>>          if (stype#=EIT.OPERATOR and (next_stype#<>EIT.SYMBOL and next_stype#<>EIT.LEFT) and piOperator.i(self,liRow+1) <> OPERATOR.MINUS) send ScriptError ERR.SCRIPT.OPERATOR_NEEDS_OPE (piPos.i(self,liRow+1))
61694>>>>>>>>>>>        end
61694>>>>>>>>>>>>
61694>>>>>>>>>>>      end
61694>>>>>>>>>>>>
61694>>>>>>>>>>>    loop
61695>>>>>>>>>>>>
61695>>>>>>>>>>>  end_procedure
61696>>>>>>>>>>>
61696>>>>>>>>>>>  function iNewType.iii integer t1# integer op# integer t2# returns integer
61698>>>>>>>>>>>    if op# eq OPERATOR.NONE     function_return t2#
61701>>>>>>>>>>>    if op# eq OPERATOR.PLUS     function_return (t1# max t2#)
61704>>>>>>>>>>>    if op# eq OPERATOR.MINUS    function_return (t1# max t2#)
61707>>>>>>>>>>>    if op# eq OPERATOR.MULTIPLY function_return (t1# max t2#)
61710>>>>>>>>>>>    if op# eq OPERATOR.DIVIDE   function_return (t1# max t2#)
61713>>>>>>>>>>>    if op# eq OPERATOR.LT       function_return TYPE.INTEGER
61716>>>>>>>>>>>    if op# eq OPERATOR.LE       function_return TYPE.INTEGER
61719>>>>>>>>>>>    if op# eq OPERATOR.EQ       function_return TYPE.INTEGER
61722>>>>>>>>>>>    if op# eq OPERATOR.NE       function_return TYPE.INTEGER
61725>>>>>>>>>>>    if op# eq OPERATOR.GE       function_return TYPE.INTEGER
61728>>>>>>>>>>>    if op# eq OPERATOR.GT       function_return TYPE.INTEGER
61731>>>>>>>>>>>    if op# eq OPERATOR.MIN      function_return (t1# max t2#)
61734>>>>>>>>>>>    if op# eq OPERATOR.MAX      function_return (t1# max t2#)
61737>>>>>>>>>>>    if op# eq OPERATOR.AND      function_return TYPE.INTEGER
61740>>>>>>>>>>>    if op# eq OPERATOR.OR       function_return TYPE.INTEGER
61743>>>>>>>>>>>    function_return t2#
61744>>>>>>>>>>>  end_function
61745>>>>>>>>>>>
61745>>>>>>>>>>>  function PreceededByFunction integer liRow returns integer
61747>>>>>>>>>>>    integer class#
61747>>>>>>>>>>>    get piClass.i (liRow-1) to class#
61748>>>>>>>>>>>    function_return (class#=CLASS.FUNCTION)
61749>>>>>>>>>>>  end_function
61750>>>>>>>>>>>  procedure DoImpliedTypes
61752>>>>>>>>>>>    integer stack# liRow max# current_type# stype# class# liType
61752>>>>>>>>>>>    integer current_operator# otype#
61752>>>>>>>>>>>    integer current_left_pos#
61752>>>>>>>>>>>    string item#
61752>>>>>>>>>>>    move (oImpliedTypesStack(self)) to stack#
61753>>>>>>>>>>>    send delete_data to stack#
61754>>>>>>>>>>>    get row_count to max#
61755>>>>>>>>>>>    move -1 to current_left_pos#
61756>>>>>>>>>>>    move OPERATOR.NONE to current_operator#
61757>>>>>>>>>>>    move TYPE.UNKNOWN to current_type#
61758>>>>>>>>>>>    for liRow from 0 to (max#-1)
61764>>>>>>>>>>>>
61764>>>>>>>>>>>      get psItem.i       liRow to item#
61765>>>>>>>>>>>      get piStructType.i liRow to stype#
61766>>>>>>>>>>>      get piClass.i      liRow to class#
61767>>>>>>>>>>>      get piType.i       liRow to liType
61768>>>>>>>>>>>      get piOperator.i   liRow to otype#
61769>>>>>>>>>>>      if stype# eq EIT.LEFT begin
61771>>>>>>>>>>>        send push.i to stack# current_left_pos#
61772>>>>>>>>>>>        send push.i to stack# current_operator#
61773>>>>>>>>>>>        send push.i to stack# current_type#
61774>>>>>>>>>>>        move liRow to current_left_pos#
61775>>>>>>>>>>>        move OPERATOR.NONE to current_operator#
61776>>>>>>>>>>>        move TYPE.UNKNOWN to current_type#
61777>>>>>>>>>>>      end
61777>>>>>>>>>>>>
61777>>>>>>>>>>>      if stype# eq EIT.RIGHT begin
61779>>>>>>>>>>>        if (PreceededByFunction(self,current_left_pos#)) move (ipop(stack#)) to current_type#
61782>>>>>>>>>>>        else move (ipop(stack#)) to current_operator# // Through away liType // current_type#
61784>>>>>>>>>>>        set piType.i current_left_pos# to current_type#
61785>>>>>>>>>>>        move (ipop(stack#)) to current_operator#
61786>>>>>>>>>>>        move (ipop(stack#)) to current_left_pos#
61787>>>>>>>>>>>      end
61787>>>>>>>>>>>>
61787>>>>>>>>>>>      if stype# eq EIT.COMMA begin
61789>>>>>>>>>>>        set piType.i current_left_pos# to current_type#
61790>>>>>>>>>>>        move OPERATOR.NONE to current_operator#
61791>>>>>>>>>>>        move TYPE.UNKNOWN to current_type#
61792>>>>>>>>>>>        //move liRow to current_left_pos#
61792>>>>>>>>>>>      end
61792>>>>>>>>>>>>
61792>>>>>>>>>>>      if stype# eq EIT.OPERATOR move otype# to current_operator#
61795>>>>>>>>>>>      if stype# eq EIT.SYMBOL move (iNewType.iii(self,current_type#,current_operator#,liType)) to current_type#
61798>>>>>>>>>>>    loop
61799>>>>>>>>>>>>
61799>>>>>>>>>>>    set piExprType to (piType.i(self,0))
61800>>>>>>>>>>>  end_procedure
61801>>>>>>>>>>>
61801>>>>>>>>>>>  procedure add_expr_op integer op# string var#
61803>>>>>>>>>>>    send add_expr_instruction to (oEvalSequence(self)) op# var#
61804>>>>>>>>>>>  end_procedure
61805>>>>>>>>>>>
61805>>>>>>>>>>>  function iFuncEvalSeparately.i integer liRow returns integer
61807>>>>>>>>>>>    integer rval# funcclass#
61807>>>>>>>>>>>    if (piClass.i(self,liRow)=CLASS.FUNCTION) get sFuncClass.i of (pVM_Object(self)) (piAux.i(self,liRow)) to funcclass#
61810>>>>>>>>>>>    else move FTYPE.BUILTIN to funcclass#
61812>>>>>>>>>>>    function_return (funcclass#<>FTYPE.BUILTIN)
61813>>>>>>>>>>>  end_function
61814>>>>>>>>>>>
61814>>>>>>>>>>>  function iCreateExprEvaluator.ii integer liRow integer level# returns integer
61816>>>>>>>>>>>    integer emergency_stop# balance# funcclass# sType# class# id# prev_stype#
61816>>>>>>>>>>>    integer oType# max# vType# funcid# oVar# fType# liType liFileField
61816>>>>>>>>>>>    get row_count to max#
61817>>>>>>>>>>>    move -1 to prev_stype#
61818>>>>>>>>>>>    move (oVariables(pVM_Object(self))) to oVar#
61819>>>>>>>>>>>    if level# begin // then we are sure to be evaluating parameters for a function
61821>>>>>>>>>>>      move EIT.LEFT to prev_stype#
61822>>>>>>>>>>>      increment liRow // Skip parenthesis
61823>>>>>>>>>>>      move 1 to balance# // Because we just skipped a (
61824>>>>>>>>>>>    end
61824>>>>>>>>>>>>
61824>>>>>>>>>>>    repeat
61824>>>>>>>>>>>>
61824>>>>>>>>>>>      if (iFuncEvalSeparately.i(self,liRow)) begin
61826>>>>>>>>>>>        send add_expr_op EXPROP.PUSH_EXPRESSION ""
61827>>>>>>>>>>>        get piAux.i liRow to funcid#
61828>>>>>>>>>>>        get iFuncType.i of (pVM_Object(self)) funcid# to fType#
61829>>>>>>>>>>>        get iCreateExprEvaluator.ii (liRow+1) (level#+1) to liRow
61830>>>>>>>>>>>        if fType# eq VARTYP_STRING send add_expr_op EXPROP.EXEC_SFUNCTION funcid#
61833>>>>>>>>>>>        else send add_expr_op EXPROP.EXEC_FUNCTION funcid#
61835>>>>>>>>>>>      end
61835>>>>>>>>>>>>
61835>>>>>>>>>>>      else begin
61836>>>>>>>>>>>        get piStructType.i liRow to sType#
61837>>>>>>>>>>>        if sType# eq EIT.LEFT begin
61839>>>>>>>>>>>          increment balance#
61840>>>>>>>>>>>          send add_expr_op EXPROP.APPEND "("
61841>>>>>>>>>>>        end
61841>>>>>>>>>>>>
61841>>>>>>>>>>>        if sType# eq EIT.RIGHT begin
61843>>>>>>>>>>>          decrement balance#
61844>>>>>>>>>>>          if balance# eq 0 begin
61846>>>>>>>>>>>            if level# begin
61848>>>>>>>>>>>              if prev_stype# ne EIT.LEFT send add_expr_op EXPROP.PUSH_PARAM ""
61851>>>>>>>>>>>            end
61851>>>>>>>>>>>>
61851>>>>>>>>>>>            else send add_expr_op EXPROP.APPEND ")"
61853>>>>>>>>>>>            function_return liRow // Skip right parenthesis
61854>>>>>>>>>>>          end
61854>>>>>>>>>>>>
61854>>>>>>>>>>>          send add_expr_op EXPROP.APPEND ")"
61855>>>>>>>>>>>        end
61855>>>>>>>>>>>>
61855>>>>>>>>>>>        if sType# eq EIT.OPERATOR begin
61857>>>>>>>>>>>          // Operators may just be added except that AND OR MIN and MAX
61857>>>>>>>>>>>          // must have blanks around them:
61857>>>>>>>>>>>          get piOperator.i liRow to oType#
61858>>>>>>>>>>>          if (oType#=OPERATOR.MIN or oType#=OPERATOR.MAX or oType#=OPERATOR.AND or oType#=OPERATOR.OR) send add_expr_op EXPROP.APPEND (" "+psItem.i(self,liRow)+" ")
61861>>>>>>>>>>>          else send add_expr_op EXPROP.APPEND (psItem.i(self,liRow))
61863>>>>>>>>>>>        end
61863>>>>>>>>>>>>
61863>>>>>>>>>>>        if sType# eq EIT.SYMBOL begin
61865>>>>>>>>>>>          get piClass.i liRow to class#
61866>>>>>>>>>>>          // Constants may just be added:
61866>>>>>>>>>>>          if class# eq CLASS.CONST send add_expr_op EXPROP.APPEND (psItem.i(self,liRow))
61869>>>>>>>>>>>          // If it's a function we can safely just add it. Would it have been
61869>>>>>>>>>>>          // a function that we were supposed to handle manually it would
61869>>>>>>>>>>>          // have been filtered out by the iFuncEvalSeparately test in the
61869>>>>>>>>>>>          // beginning of this function:
61869>>>>>>>>>>>          if class# eq CLASS.FUNCTION send add_expr_op EXPROP.APPEND (psItem.i(self,liRow))
61872>>>>>>>>>>>          // For variables we dare inserting a (local) function call and let
61872>>>>>>>>>>>          // the EVAL function retrieve the value:
61872>>>>>>>>>>>          if class# eq CLASS.VAR begin
61874>>>>>>>>>>>            get iVarNameToVarNo of (pVM_Object(self)) (psItem.i(self,liRow)) to id#
61875>>>>>>>>>>>            get iVarType.i of (pVM_Object(self)) id# to vType#
61876>>>>>>>>>>>            if vType# eq VARTYP_INTEGER send add_expr_op EXPROP.GET_IVAR id#
61879>>>>>>>>>>>            if vType# eq VARTYP_DATE    send add_expr_op EXPROP.GET_DVAR id#
61882>>>>>>>>>>>            if vType# eq VARTYP_NUMBER  send add_expr_op EXPROP.GET_NVAR id#
61885>>>>>>>>>>>            if vType# eq VARTYP_STRING  send add_expr_op EXPROP.GET_SVAR id#
61888>>>>>>>>>>>          end
61888>>>>>>>>>>>>
61888>>>>>>>>>>>          if class# eq CLASS.FIELD begin
61890>>>>>>>>>>>            get piType.i liRow to liType
61891>>>>>>>>>>>            get iFileField.s of (pVM_Object(self)) (psItem.i(self,liRow)) to liFileField
61892>>>>>>>>>>>            if liType eq TYPE.STRING send add_expr_op EXPROP.GET_SFIELD liFileField
61895>>>>>>>>>>>            if liType eq TYPE.NUMBER send add_expr_op EXPROP.GET_NFIELD liFileField
61898>>>>>>>>>>>            if liType eq TYPE.DATE   send add_expr_op EXPROP.GET_DFIELD liFileField
61901>>>>>>>>>>>          end
61901>>>>>>>>>>>>
61901>>>>>>>>>>>        end
61901>>>>>>>>>>>>
61901>>>>>>>>>>>        if sType# eq EIT.COMMA begin
61903>>>>>>>>>>>          // Level>0 means: We are in a "manual" function
61903>>>>>>>>>>>          // Under that assumption balance=1 MUST mean that we are dealing
61903>>>>>>>>>>>          // with a parameter to that function.
61903>>>>>>>>>>>          if (level#>0 and balance#=1) send add_expr_op EXPROP.PUSH_PARAM ""
61906>>>>>>>>>>>          else send add_expr_op EXPROP.APPEND ","
61908>>>>>>>>>>>        end
61908>>>>>>>>>>>>
61908>>>>>>>>>>>        move stype# to prev_stype#
61909>>>>>>>>>>>      end
61909>>>>>>>>>>>>
61909>>>>>>>>>>>      increment liRow
61910>>>>>>>>>>>    until (balance#=0 or liRow>=max#)
61912>>>>>>>>>>>    send add_expr_op EXPROP.ERROR ""
61913>>>>>>>>>>>    function_return 1000
61914>>>>>>>>>>>  end_function
61915>>>>>>>>>>>
61915>>>>>>>>>>>  procedure DoCreateEvaluator
61917>>>>>>>>>>>    integer grb#
61917>>>>>>>>>>>    send delete_data to (oEvalSequence(self))
61918>>>>>>>>>>>    send add_expr_op EXPROP.TYPE (iTypeToVT.i(piExprType(self)))
61919>>>>>>>>>>>    get iCreateExprEvaluator.ii 0 0 to grb#
61920>>>>>>>>>>>    send add_expr_op EXPROP.END ""
61921>>>>>>>>>>>  end_procedure
61922>>>>>>>>>>>
61922>>>>>>>>>>>  function iParse_expression.si string lsExpression integer liPosOffset returns integer
61924>>>>>>>>>>>    integer lhObj liExprId
61924>>>>>>>>>>>    if liPosOffset decrement liPosOffset
61927>>>>>>>>>>>    send split_expression_in_items lsExpression liPosOffset
61928>>>>>>>>>>>    ifnot (iErrorOccured(self)) send DoReplaces
61931>>>>>>>>>>>    ifnot (iErrorOccured(self)) send DoClassColumn
61934>>>>>>>>>>>    ifnot (iErrorOccured(self)) send DoTypeColumn
61937>>>>>>>>>>>    ifnot (iErrorOccured(self)) send DoFuncParams
61940>>>>>>>>>>>    ifnot (iErrorOccured(self)) send DoFinalChecks
61943>>>>>>>>>>>    ifnot (iErrorOccured(self)) send DoImpliedTypes
61946>>>>>>>>>>>    ifnot (iErrorOccured(self)) send DoCreateEvaluator
61949>>>>>>>>>>>    if (piDebugState(self)) send DisplayExpressionDebugInfo self
61952>>>>>>>>>>>    if (piDebugState(self)) send DisplayEvalSequence (oEvalSequence(self))
61955>>>>>>>>>>>    send Optimize to (oEvalSequence(self))
61956>>>>>>>>>>>    if (piDebugState(self)) send DisplayEvalSequence (oEvalSequence(self))
61959>>>>>>>>>>>    // Add to VM's expression array:
61959>>>>>>>>>>>    move (oExprEvalSequences(pVM_Object(self))) to lhObj
61960>>>>>>>>>>>    get iAppendToOtherSequence of (oEvalSequence(self)) lhObj to liExprId
61961>>>>>>>>>>>//    send obs "Kopierer program"   (oEvalSequence(self)) lhObj (name(lhObj))
61961>>>>>>>>>>>    function_return (liExprId+1) // Skip typedef
61962>>>>>>>>>>>  end_function
61963>>>>>>>>>>>end_class // cExpressionParser
61964>>>>>>>>>>>
61964>>>>>>>>>>>class cScriptErrors is a cArray
61965>>>>>>>>>>>  procedure construct_object integer img#
61967>>>>>>>>>>>    forward send construct_object img#
61969>>>>>>>>>>>    property string  piListingFN   public "dfscript.err"
61970>>>>>>>>>>>    property integer piListingFile public 0
61971>>>>>>>>>>>    property integer piOnScreen    public 1
61972>>>>>>>>>>>  end_procedure
61973>>>>>>>>>>>  item_property_list
61973>>>>>>>>>>>    item_property integer piError.i
61973>>>>>>>>>>>    item_property integer piLine.i
61973>>>>>>>>>>>    item_property integer piPosition.i
61973>>>>>>>>>>>    item_property string  psFileName.i
61973>>>>>>>>>>>    item_property string  psMessage.i
61973>>>>>>>>>>>  end_item_property_list cScriptErrors
#REM 62014 DEFINE FUNCTION PSMESSAGE.I INTEGER LIROW RETURNS STRING
#REM 62018 DEFINE PROCEDURE SET PSMESSAGE.I INTEGER LIROW STRING VALUE
#REM 62022 DEFINE FUNCTION PSFILENAME.I INTEGER LIROW RETURNS STRING
#REM 62026 DEFINE PROCEDURE SET PSFILENAME.I INTEGER LIROW STRING VALUE
#REM 62030 DEFINE FUNCTION PIPOSITION.I INTEGER LIROW RETURNS INTEGER
#REM 62034 DEFINE PROCEDURE SET PIPOSITION.I INTEGER LIROW INTEGER VALUE
#REM 62038 DEFINE FUNCTION PILINE.I INTEGER LIROW RETURNS INTEGER
#REM 62042 DEFINE PROCEDURE SET PILINE.I INTEGER LIROW INTEGER VALUE
#REM 62046 DEFINE FUNCTION PIERROR.I INTEGER LIROW RETURNS INTEGER
#REM 62050 DEFINE PROCEDURE SET PIERROR.I INTEGER LIROW INTEGER VALUE
62055>>>>>>>>>>>  procedure display_error.i integer liRow
62057>>>>>>>>>>>    integer pos#
62057>>>>>>>>>>>    string msg#
62057>>>>>>>>>>>    get piPosition.i liRow to pos#
62058>>>>>>>>>>>    get psMessage.i liRow to msg#
62059>>>>>>>>>>>    move (trim(msg#)) to msg#
62060>>>>>>>>>>>    send obs ("Error in "+psFileName.i(self,liRow)+" on line "+string(piLine.i(self,liRow))) (ScriptError_Text(piError.i(self,liRow))+if(pos#," in position "+string(pos#),"")) msg#
62061>>>>>>>>>>>  end_procedure
62062>>>>>>>>>>>  procedure add_error integer Error# integer Line# integer Position# string FileName# string Message#
62064>>>>>>>>>>>    integer liRow
62064>>>>>>>>>>>    get row_count to liRow
62065>>>>>>>>>>>    set piError.i    liRow to Error#
62066>>>>>>>>>>>    set piLine.i     liRow to Line#
62067>>>>>>>>>>>    set piPosition.i liRow to Position#
62068>>>>>>>>>>>    set psFileName.i liRow to FileName#
62069>>>>>>>>>>>    set psMessage.i  liRow to Message#
62070>>>>>>>>>>>    if (piOnScreen(self)) send display_error.i liRow
62073>>>>>>>>>>>  end_procedure
62074>>>>>>>>>>>end_class
62075>>>>>>>>>>>class cStructuralStack is a cArray
62076>>>>>>>>>>>  procedure construct_object integer img#
62078>>>>>>>>>>>    forward send construct_object img#
62080>>>>>>>>>>>  end_procedure
62081>>>>>>>>>>>  item_property_list
62081>>>>>>>>>>>    item_property integer piStackingCmd.i // WHILE, BEGIN, REPEAT etc.
62081>>>>>>>>>>>    item_property integer piPendingCmd.i  // END, LOOP, UNTIL
62081>>>>>>>>>>>    item_property string  psFileName.i    // Name of source file
62081>>>>>>>>>>>    item_property integer piLine.i        // In which line was the structure initiated?
62081>>>>>>>>>>>  end_item_property_list cStructuralStack
#REM 62119 DEFINE FUNCTION PILINE.I INTEGER LIROW RETURNS INTEGER
#REM 62123 DEFINE PROCEDURE SET PILINE.I INTEGER LIROW INTEGER VALUE
#REM 62127 DEFINE FUNCTION PSFILENAME.I INTEGER LIROW RETURNS STRING
#REM 62131 DEFINE PROCEDURE SET PSFILENAME.I INTEGER LIROW STRING VALUE
#REM 62135 DEFINE FUNCTION PIPENDINGCMD.I INTEGER LIROW RETURNS INTEGER
#REM 62139 DEFINE PROCEDURE SET PIPENDINGCMD.I INTEGER LIROW INTEGER VALUE
#REM 62143 DEFINE FUNCTION PISTACKINGCMD.I INTEGER LIROW RETURNS INTEGER
#REM 62147 DEFINE PROCEDURE SET PISTACKINGCMD.I INTEGER LIROW INTEGER VALUE
62152>>>>>>>>>>>  function iTopStackingCmd returns integer
62154>>>>>>>>>>>    function_return (piStackingCmd.i(self,row_count(self)-1))
62155>>>>>>>>>>>  end_function
62156>>>>>>>>>>>  function iTopPendingCmd returns integer
62158>>>>>>>>>>>    function_return (piPendingCmd.i(self,row_count(self)-1))
62159>>>>>>>>>>>  end_function
62160>>>>>>>>>>>  procedure push_struct integer cmd1# integer cmd2# string fn# integer line#
62162>>>>>>>>>>>    integer liRow
62162>>>>>>>>>>>    get row_count to liRow
62163>>>>>>>>>>>    set piStackingCmd.i liRow to cmd1#
62164>>>>>>>>>>>    set piPendingCmd.i  liRow to cmd2#
62165>>>>>>>>>>>    set psFileName.i    liRow to fn#
62166>>>>>>>>>>>    set piLine.i        liRow to line#
62167>>>>>>>>>>>  end_procedure
62168>>>>>>>>>>>  procedure pop_struct
62170>>>>>>>>>>>    send delete_row (row_count(self)-1)
62171>>>>>>>>>>>  end_procedure
62172>>>>>>>>>>>end_class // cStructuralStack
62173>>>>>>>>>>>
62173>>>>>>>>>>>register_procedure Interpret_Date
62173>>>>>>>>>>>register_procedure Interpret_Else
62173>>>>>>>>>>>register_procedure Interpret_End
62173>>>>>>>>>>>register_procedure Interpret_EndIf
62173>>>>>>>>>>>register_procedure Interpret_For
62173>>>>>>>>>>>register_procedure Interpret_Gosub
62173>>>>>>>>>>>register_procedure Interpret_Goto
62173>>>>>>>>>>>register_procedure Interpret_If
62173>>>>>>>>>>>register_procedure Interpret_Pause
62173>>>>>>>>>>>register_procedure Interpret_GotoXY
62173>>>>>>>>>>>register_procedure Interpret_Input
62173>>>>>>>>>>>register_procedure Interpret_Integer
62173>>>>>>>>>>>register_procedure Interpret_Loop
62173>>>>>>>>>>>register_procedure Interpret_Move
62173>>>>>>>>>>>register_procedure Interpret_Number
62173>>>>>>>>>>>register_procedure Interpret_Return
62173>>>>>>>>>>>register_procedure Interpret_Showln
62173>>>>>>>>>>>register_procedure Interpret_Show
62173>>>>>>>>>>>register_procedure Interpret_String
62173>>>>>>>>>>>register_procedure Interpret_Abort
62173>>>>>>>>>>>register_procedure Interpret_ClearScreen
62173>>>>>>>>>>>register_procedure Interpret_While
62173>>>>>>>>>>>register_procedure Interpret_#use
62173>>>>>>>>>>>register_procedure Interpret_#include
62173>>>>>>>>>>>register_procedure Interpret_#replace
62173>>>>>>>>>>>register_procedure Interpret_#noisy
62173>>>>>>>>>>>register_procedure Interpret_Increment
62173>>>>>>>>>>>register_procedure Interpret_Decrement
62173>>>>>>>>>>>register_procedure Interpret_Debug
62173>>>>>>>>>>>register_procedure Interpret_Repeat
62173>>>>>>>>>>>register_procedure Interpret_Until
62173>>>>>>>>>>>register_procedure Interpret_Log_Open
62173>>>>>>>>>>>register_procedure Interpret_Log_Close
62173>>>>>>>>>>>register_procedure Interpret_Log_Display
62173>>>>>>>>>>>register_procedure Interpret_Log_Flush
62173>>>>>>>>>>>register_procedure Interpret_Log_Write
62173>>>>>>>>>>>register_procedure Interpret_Log_Writeln
62173>>>>>>>>>>>register_procedure Interpret_Set_Attribute
62173>>>>>>>>>>>register_procedure Interpret_Create_Field
62173>>>>>>>>>>>register_procedure Interpret_Append_Field
62173>>>>>>>>>>>register_procedure Interpret_Delete_Field
62173>>>>>>>>>>>register_procedure Interpret_Delete_Index
62173>>>>>>>>>>>register_procedure Interpret_Structure_Abort
62173>>>>>>>>>>>register_procedure Interpret_Structure_End
62173>>>>>>>>>>>register_procedure Interpret_Probe_End
62173>>>>>>>>>>>register_procedure Interpret_Set_Field
62173>>>>>>>>>>>register_procedure Interpret_InfoBox
62173>>>>>>>>>>>
62173>>>>>>>>>>>// Support commands:
62173>>>>>>>>>>>
62173>>>>>>>>>>>
62173>>>>>>>>>>>class cCommandList is a cArray
62174>>>>>>>>>>>  item_property_list
62174>>>>>>>>>>>    item_property string  psName.i
62174>>>>>>>>>>>    item_property integer piCompileMsg.i
62174>>>>>>>>>>>  end_item_property_list cCommandList
#REM 62206 DEFINE FUNCTION PICOMPILEMSG.I INTEGER LIROW RETURNS INTEGER
#REM 62210 DEFINE PROCEDURE SET PICOMPILEMSG.I INTEGER LIROW INTEGER VALUE
#REM 62214 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 62218 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
62223>>>>>>>>>>>  procedure add_command integer cmd# string name# integer msg#
62225>>>>>>>>>>>    set psName.i       cmd# to (uppercase(name#))
62226>>>>>>>>>>>    set piCompileMsg.i cmd# to msg#
62227>>>>>>>>>>>  end_procedure
62228>>>>>>>>>>>  procedure construct_object integer img#
62230>>>>>>>>>>>    forward send construct_object img#
62232>>>>>>>>>>>    enumeration_list
62232>>>>>>>>>>>      define_cmd CMD_DATE        "DATE"        msg_Interpret_Date
62233>>>>>>>>>>>      define_cmd CMD_ELSE        "ELSE"        msg_Interpret_Else
62234>>>>>>>>>>>      define_cmd CMD_END         "END"         msg_Interpret_End
62235>>>>>>>>>>>      define_cmd CMD_ENDIF       "ENDIF"       msg_Interpret_EndIf
62236>>>>>>>>>>>      define_cmd CMD_FOR         "FOR"         msg_Interpret_For
62237>>>>>>>>>>>      define_cmd CMD_GOSUB       "GOSUB"       msg_Interpret_Gosub
62238>>>>>>>>>>>      define_cmd CMD_GOTO        "GOTO"        msg_Interpret_Goto
62239>>>>>>>>>>>      define_cmd CMD_IF          "IF"          msg_Interpret_If
62240>>>>>>>>>>>      define_cmd CMD_PAUSE       "PAUSE"       msg_Interpret_Pause
62241>>>>>>>>>>>      define_cmd CMD_INPUT       "INPUT"       msg_Interpret_Input
62242>>>>>>>>>>>      define_cmd CMD_GOTOXY      "GOTOXY"      msg_Interpret_GotoXY
62243>>>>>>>>>>>      define_cmd CMD_INTEGER     "INTEGER"     msg_Interpret_Integer
62244>>>>>>>>>>>      define_cmd CMD_LOOP        "LOOP"        msg_Interpret_Loop
62245>>>>>>>>>>>      define_cmd CMD_MOVE        "MOVE"        msg_Interpret_Move
62246>>>>>>>>>>>      define_cmd CMD_NUMBER      "NUMBER"      msg_Interpret_Number
62247>>>>>>>>>>>      define_cmd CMD_RETURN      "RETURN"      msg_Interpret_Return
62248>>>>>>>>>>>      define_cmd CMD_SHOWLN      "SHOWLN"      msg_Interpret_Showln
62249>>>>>>>>>>>      define_cmd CMD_SHOW        "SHOW"        msg_Interpret_Show
62250>>>>>>>>>>>      define_cmd CMD_STRING      "STRING"      msg_Interpret_String
62251>>>>>>>>>>>      define_cmd CMD_ABORT       "ABORT"       msg_Interpret_Abort
62252>>>>>>>>>>>      define_cmd CMD_CLEARSCREEN "CLEARSCREEN" msg_Interpret_ClearScreen
62253>>>>>>>>>>>      define_cmd CMD_WHILE       "WHILE"       msg_Interpret_While
62254>>>>>>>>>>>      define_cmd CMD_#USE        "#USE"        msg_Interpret_#use     // Not implemented
62255>>>>>>>>>>>      define_cmd CMD_#INCLUDE    "#INCLUDE"    msg_Interpret_#include // Not implemented
62256>>>>>>>>>>>      define_cmd CMD_#REPLACE    "#REPLACE"    msg_Interpret_#replace
62257>>>>>>>>>>>      define_cmd CMD_#NOISY      "#NOISY"      msg_Interpret_#noisy
62258>>>>>>>>>>>      define_cmd CMD_INCREMENT   "INCREMENT"   msg_Interpret_Increment
62259>>>>>>>>>>>      define_cmd CMD_DECREMENT   "DECREMENT"   msg_Interpret_DeCrement
62260>>>>>>>>>>>      define_cmd CMD_DEBUG       "DEBUG"       msg_Interpret_Debug
62261>>>>>>>>>>>      define_cmd CMD_REPEAT      "REPEAT"      msg_Interpret_Repeat
62262>>>>>>>>>>>      define_cmd CMD_UNTIL       "UNTIL"       msg_Interpret_Until
62263>>>>>>>>>>>      define_cmd CMD_LOG_OPEN    "LOG_OPEN"    msg_Interpret_Log_Open
62264>>>>>>>>>>>      define_cmd CMD_LOG_CLOSE   "LOG_CLOSE"   msg_Interpret_Log_Close
62265>>>>>>>>>>>      define_cmd CMD_LOG_DISPLAY "LOG_DISPLAY" msg_Interpret_Log_Display
62266>>>>>>>>>>>      define_cmd CMD_LOG_FLUSH   "LOG_FLUSH"   msg_Interpret_Log_Flush
62267>>>>>>>>>>>      define_cmd CMD_LOG_WRITE   "LOG_WRITE"   msg_Interpret_Log_Write
62268>>>>>>>>>>>      define_cmd CMD_LOG_WRITELN "LOG_WRITELN" msg_Interpret_Log_Writeln
62269>>>>>>>>>>>      define_cmd CMD_SET_ATTRIBUTE   "SET_ATTRIBUTE"   msg_Interpret_Set_Attribute
62270>>>>>>>>>>>      define_cmd CMD_CREATE_FIELD    "CREATE_FIELD"    msg_Interpret_Create_Field
62271>>>>>>>>>>>      define_cmd CMD_APPEND_FIELD    "APPEND_FIELD"    msg_Interpret_Append_Field
62272>>>>>>>>>>>      define_cmd CMD_DELETE_FIELD    "DELETE_FIELD"    msg_Interpret_Delete_Field
62273>>>>>>>>>>>      define_cmd CMD_DELETE_INDEX    "DELETE_INDEX"    msg_Interpret_Delete_Index
62274>>>>>>>>>>>      define_cmd CMD_STRUCTURE_ABORT "STRUCTURE_ABORT" msg_Interpret_Structure_Abort
62275>>>>>>>>>>>      define_cmd CMD_STRUCTURE_END   "STRUCTURE_END"   msg_Interpret_Structure_End
62276>>>>>>>>>>>      define_cmd CMD_PROBE_END       "PROBE_END"       msg_Interpret_Probe_End
62277>>>>>>>>>>>      define_cmd CMD_SET_FIELD       "SET_FIELD"       msg_Interpret_Set_Field
62278>>>>>>>>>>>      define_cmd CMD_INFOBOX         "INFOBOX"         msg_Interpret_InfoBox
62279>>>>>>>>>>>    end_enumeration_list
62279>>>>>>>>>>>  end_procedure
62280>>>>>>>>>>>  function iCommand.s string command# returns integer
62282>>>>>>>>>>>    integer liRow max#
62282>>>>>>>>>>>    move (uppercase(command#)) to command#
62283>>>>>>>>>>>    get row_count to max#
62284>>>>>>>>>>>    for liRow from 0 to (max#-1)
62290>>>>>>>>>>>>
62290>>>>>>>>>>>      if command# eq (psName.i(self,liRow)) function_return liRow
62293>>>>>>>>>>>    loop
62294>>>>>>>>>>>>
62294>>>>>>>>>>>    function_return -1 // Not found
62295>>>>>>>>>>>  end_function
62296>>>>>>>>>>>end_class // cCommandList
62297>>>>>>>>>>>
62297>>>>>>>>>>>class cReplaces is a cArray
62298>>>>>>>>>>>  item_property_list
62298>>>>>>>>>>>    item_property string psName.i
62298>>>>>>>>>>>    item_property string psValue.i
62298>>>>>>>>>>>  end_item_property_list cReplaces
#REM 62330 DEFINE FUNCTION PSVALUE.I INTEGER LIROW RETURNS STRING
#REM 62334 DEFINE PROCEDURE SET PSVALUE.I INTEGER LIROW STRING VALUE
#REM 62338 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 62342 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
62347>>>>>>>>>>>
62347>>>>>>>>>>>  procedure construct_object integer img#
62349>>>>>>>>>>>    forward send construct_object img#
62351>>>>>>>>>>>    property integer piFlexInit_Count public 0
62352>>>>>>>>>>>    send initial_replaces
62353>>>>>>>>>>>  end_procedure
62354>>>>>>>>>>>
62354>>>>>>>>>>>  procedure reset
62356>>>>>>>>>>>    integer max# liRow max_flexinit#
62356>>>>>>>>>>>    get piFlexInit_Count to max_flexinit#
62357>>>>>>>>>>>    get row_count to max#
62358>>>>>>>>>>>    for_ex liRow from (max#-1) down_to max_flexinit#
62365>>>>>>>>>>>      send delete_row liRow
62366>>>>>>>>>>>    loop
62367>>>>>>>>>>>>
62367>>>>>>>>>>>  end_procedure
62368>>>>>>>>>>>
62368>>>>>>>>>>>  function iNameToNo.s string name# returns integer
62370>>>>>>>>>>>    integer liRow max# rval#
62370>>>>>>>>>>>    move (uppercase(name#)) to name#
62371>>>>>>>>>>>    get row_count to max#
62372>>>>>>>>>>>    move -1 to rval#
62373>>>>>>>>>>>    move 0 to liRow
62374>>>>>>>>>>>    while (liRow>>>>>>>>>>      if name# eq (psName.i(self,liRow)) move liRow to rval#
62381>>>>>>>>>>>      increment liRow
62382>>>>>>>>>>>    end
62383>>>>>>>>>>>>
62383>>>>>>>>>>>    function_return rval#
62384>>>>>>>>>>>  end_function
62385>>>>>>>>>>>
62385>>>>>>>>>>>  function sNameToValue.s string name# returns string
62387>>>>>>>>>>>    integer liRow
62387>>>>>>>>>>>    get iNameToNo.s name# to liRow
62388>>>>>>>>>>>    if liRow eq -1 function_return name#
62391>>>>>>>>>>>    function_return (sNameToValue.s(self,psValue.i(self,liRow)))
62392>>>>>>>>>>>  end_function
62393>>>>>>>>>>>
62393>>>>>>>>>>>  function iCircular.ss string name# string symbol_list# returns integer
62395>>>>>>>>>>>    integer liRow rval#
62395>>>>>>>>>>>    move 0 to rval#
62396>>>>>>>>>>>    if symbol_list# eq "" move "" to symbol_list#
62399>>>>>>>>>>>    if (""+name#+"") in symbol_list# function_return 1 // Circular ref!
62402>>>>>>>>>>>    get iNameToNo.s name# to liRow
62403>>>>>>>>>>>    if liRow ne -1 get iCircular.ss (psValue.i(self,liRow)) (symbol_list#+name#+"") to rval#
62406>>>>>>>>>>>    function_return rval#
62407>>>>>>>>>>>  end_function
62408>>>>>>>>>>>
62408>>>>>>>>>>>  function iNameDeclare.ss string name# string value# returns integer
62410>>>>>>>>>>>    integer liRow rval#
62410>>>>>>>>>>>    move ERR.SCRIPT.NO_ERROR to rval#
62411>>>>>>>>>>>    move (uppercase(name#)) to name#
62412>>>>>>>>>>>    get iNameToNo.s name# to liRow
62413>>>>>>>>>>>    if liRow eq -1 begin
62415>>>>>>>>>>>      get row_count to liRow
62416>>>>>>>>>>>      set psName.i  liRow to name#
62417>>>>>>>>>>>      set psValue.i liRow to value#
62418>>>>>>>>>>>    end
62418>>>>>>>>>>>>
62418>>>>>>>>>>>    else move ERR.SCRIPT.SYMBOL_ALREADY_DEF to rval#
62420>>>>>>>>>>>    ifnot rval# if (iCircular.ss(self,name#,value#)) begin
62424>>>>>>>>>>>      move ERR.SCRIPT.CIRCULAR_REFERENCE to rval#
62425>>>>>>>>>>>      send delete_row liRow
62426>>>>>>>>>>>    end
62426>>>>>>>>>>>>
62426>>>>>>>>>>>    function_return rval#
62427>>>>>>>>>>>  end_function
62428>>>>>>>>>>>  procedure add_initial_replace string name# string value#
62430>>>>>>>>>>>    integer liRow
62430>>>>>>>>>>>    get row_count to liRow
62431>>>>>>>>>>>    set psName.i  liRow to name#
62432>>>>>>>>>>>    set psValue.i liRow to value#
62433>>>>>>>>>>>  end_procedure
62434>>>>>>>>>>>  procedure initial_replaces
62436>>>>>>>>>>>    send add_initial_replace "FALSE"                               0
62437>>>>>>>>>>>    send add_initial_replace "TRUE"                                1
62438>>>>>>>>>>>    send add_initial_replace "DFTRUE"                              DFTRUE
62439>>>>>>>>>>>    send add_initial_replace "DFFALSE"                             DFFALSE
62440>>>>>>>>>>>    if DFTRUE begin // DATE STUFF
62442>>>>>>>>>>>      send add_initial_replace "DS_DAY"                 DS_DAY
62443>>>>>>>>>>>      send add_initial_replace "DS_WEEK"                DS_WEEK
62444>>>>>>>>>>>      send add_initial_replace "DS_MONTH"               DS_MONTH
62445>>>>>>>>>>>      send add_initial_replace "DS_YEAR"                DS_YEAR
62446>>>>>>>>>>>      send add_initial_replace "LargestPossibleDate"    LargestPossibleDate
62447>>>>>>>>>>>      send add_initial_replace "Jan1st1900"             Jan1st1900
62448>>>>>>>>>>>      send add_initial_replace "Jan1st2000"             Jan1st2000
62449>>>>>>>>>>>      send add_initial_replace "Jan1st1930"             Jan1st1930
62450>>>>>>>>>>>      send add_initial_replace "Jan1st1000"             Jan1st1000
62451>>>>>>>>>>>      send add_initial_replace "Jan1st105"              Jan1st105
62452>>>>>>>>>>>      send add_initial_replace "Jan1st100"              Jan1st100
62453>>>>>>>>>>>    end
62453>>>>>>>>>>>>
62453>>>>>>>>>>>    if DFFALSE begin
62455>>>>>>>>>>>      send add_initial_replace "IMPLICIT_FIELD"                      -1
62456>>>>>>>>>>>      send add_initial_replace "DF_LOCK_DELAY"                       DF_LOCK_DELAY
62457>>>>>>>>>>>      send add_initial_replace "DF_LOCK_TIMEOUT"                     DF_LOCK_TIMEOUT
62458>>>>>>>>>>>      send add_initial_replace "DF_OPEN_PATH"                        DF_OPEN_PATH
62459>>>>>>>>>>>      send add_initial_replace "DF_DATE_FORMAT"                      DF_DATE_FORMAT
62460>>>>>>>>>>>      send add_initial_replace "DF_DATE_SEPARATOR"                   DF_DATE_SEPARATOR
62461>>>>>>>>>>>      send add_initial_replace "DF_DECIMAL_SEPARATOR"                DF_DECIMAL_SEPARATOR
62462>>>>>>>>>>>      send add_initial_replace "DF_THOUSANDS_SEPARATOR"              DF_THOUSANDS_SEPARATOR
62463>>>>>>>>>>>      send add_initial_replace "DF_ALL_FILES_TOUCHED"                DF_ALL_FILES_TOUCHED
62464>>>>>>>>>>>      send add_initial_replace "DF_HIGH_DATA_INTEGRITY"              DF_HIGH_DATA_INTEGRITY
62465>>>>>>>>>>>      send add_initial_replace "DF_TRAN_COUNT"                       DF_TRAN_COUNT
62466>>>>>>>>>>>      send add_initial_replace "DF_TRANSACTION_ABORT"                DF_TRANSACTION_ABORT
62467>>>>>>>>>>>      send add_initial_replace "DF_REREAD_REQUIRED"                  DF_REREAD_REQUIRED
62468>>>>>>>>>>>      send add_initial_replace "DF_FILELIST_NAME"                    DF_FILELIST_NAME
62469>>>>>>>>>>>      send add_initial_replace "DF_REPORT_UNSUPPORTED_ATTRIBUTES"    DF_REPORT_UNSUPPORTED_ATTRIBUTES
62470>>>>>>>>>>>      send add_initial_replace "DF_STRICT_ATTRIBUTES"                DF_STRICT_ATTRIBUTES
62471>>>>>>>>>>>      send add_initial_replace "DF_NUMBER_DRIVERS"                   DF_NUMBER_DRIVERS
62472>>>>>>>>>>>      send add_initial_replace "DF_DRIVER_NAME"                      DF_DRIVER_NAME
62473>>>>>>>>>>>      send add_initial_replace "DF_DRIVER_NUMBER_SERVERS"            DF_DRIVER_NUMBER_SERVERS
62474>>>>>>>>>>>      send add_initial_replace "DF_DRIVER_SERVER_NAME"               DF_DRIVER_SERVER_NAME
62475>>>>>>>>>>>      send add_initial_replace "DF_API_DISABLED"                     DF_API_DISABLED
62476>>>>>>>>>>>      send add_initial_replace "DF_API_DISABLED_ERROR"               DF_API_DISABLED_ERROR
62477>>>>>>>>>>>      send add_initial_replace "DF_FILE_STATUS"                      DF_FILE_STATUS
62478>>>>>>>>>>>      send add_initial_replace "DF_FILE_MODE"                        DF_FILE_MODE
62479>>>>>>>>>>>      send add_initial_replace "DF_FILE_MAX_RECORDS"                 DF_FILE_MAX_RECORDS
62480>>>>>>>>>>>      send add_initial_replace "DF_FILE_RECORDS_USED"                DF_FILE_RECORDS_USED
62481>>>>>>>>>>>      send add_initial_replace "DF_FILE_TYPE"                        DF_FILE_TYPE
62482>>>>>>>>>>>      send add_initial_replace "DF_FILE_MULTIUSER"                   DF_FILE_MULTIUSER
62483>>>>>>>>>>>      send add_initial_replace "DF_FILE_REUSE_DELETED"               DF_FILE_REUSE_DELETED
62484>>>>>>>>>>>      send add_initial_replace "DF_FILE_NUMBER"                      DF_FILE_NUMBER
62485>>>>>>>>>>>      send add_initial_replace "DF_FILE_COMPRESSION"                 DF_FILE_COMPRESSION
62486>>>>>>>>>>>      send add_initial_replace "DF_FILE_LAST_INDEX_NUMBER"           DF_FILE_LAST_INDEX_NUMBER
62487>>>>>>>>>>>      send add_initial_replace "DF_FILE_NUMBER_FIELDS"               DF_FILE_NUMBER_FIELDS
62488>>>>>>>>>>>      send add_initial_replace "DF_FILE_LOGICAL_NAME"                DF_FILE_LOGICAL_NAME
62489>>>>>>>>>>>      send add_initial_replace "DF_FILE_ROOT_NAME"                   DF_FILE_ROOT_NAME
62490>>>>>>>>>>>      send add_initial_replace "DF_FILE_CHANGED"                     DF_FILE_CHANGED
62491>>>>>>>>>>>      send add_initial_replace "DF_FILE_ALIAS"                       DF_FILE_ALIAS
62492>>>>>>>>>>>      send add_initial_replace "DF_FILE_TOUCHED"                     DF_FILE_TOUCHED
62493>>>>>>>>>>>      send add_initial_replace "DF_FILE_TRANSACTION"                 DF_FILE_TRANSACTION
62494>>>>>>>>>>>      send add_initial_replace "DF_FILE_OPENED"                      DF_FILE_OPENED
62495>>>>>>>>>>>      send add_initial_replace "DF_FILE_DISPLAY_NAME"                DF_FILE_DISPLAY_NAME
62496>>>>>>>>>>>      send add_initial_replace "DF_FILE_PHYSICAL_NAME"               DF_FILE_PHYSICAL_NAME
62497>>>>>>>>>>>      send add_initial_replace "DF_FILE_NEXT_OPENED"                 DF_FILE_NEXT_OPENED
62498>>>>>>>>>>>      send add_initial_replace "DF_FILE_NEXT_USED"                   DF_FILE_NEXT_USED
62499>>>>>>>>>>>      send add_initial_replace "DF_FILE_NEXT_EMPTY"                  DF_FILE_NEXT_EMPTY
62500>>>>>>>>>>>      send add_initial_replace "DF_FILE_RECORD_LENGTH"               DF_FILE_RECORD_LENGTH
62501>>>>>>>>>>>      send add_initial_replace "DF_FILE_RESTRUCTURE"                 DF_FILE_RESTRUCTURE
62502>>>>>>>>>>>      send add_initial_replace "DF_FILE_OPEN_MODE"                   DF_FILE_OPEN_MODE
62503>>>>>>>>>>>      send add_initial_replace "DF_FILE_INTEGRITY_CHECK"             DF_FILE_INTEGRITY_CHECK
62504>>>>>>>>>>>      send add_initial_replace "DF_FILE_OWNER"                       DF_FILE_OWNER
62505>>>>>>>>>>>      send add_initial_replace "DF_FILE_IS_SYSTEM_FILE"              DF_FILE_IS_SYSTEM_FILE
62506>>>>>>>>>>>      send add_initial_replace "DF_FILE_LOCK_TYPE"                   DF_FILE_LOCK_TYPE
62507>>>>>>>>>>>      send add_initial_replace "DF_FILE_COMMITTED"                   DF_FILE_COMMITTED
62508>>>>>>>>>>>      send add_initial_replace "DF_FILE_DRIVER"                      DF_FILE_DRIVER
62509>>>>>>>>>>>      send add_initial_replace "DF_FILE_RECORD_LENGTH_USED"          DF_FILE_RECORD_LENGTH_USED
62510>>>>>>>>>>>      send add_initial_replace "DF_FILE_HANDLE_TYPE"                 DF_FILE_HANDLE_TYPE
62511>>>>>>>>>>>      send add_initial_replace "DF_FILE_RECORD_IDENTITY"             DF_FILE_RECORD_IDENTITY
62512>>>>>>>>>>>      send add_initial_replace "DF_FILE_LOGIN"                       DF_FILE_LOGIN
62513>>>>>>>>>>>      send add_initial_replace "DF_FILE_RECORD_PRIVILEGE"            DF_FILE_RECORD_PRIVILEGE
62514>>>>>>>>>>>      send add_initial_replace "DF_FILE_PRIVILEGE"                   DF_FILE_PRIVILEGE
62515>>>>>>>>>>>      send add_initial_replace "DF_FILE_CREATION_SERIAL"             DF_FILE_CREATION_SERIAL
62516>>>>>>>>>>>      send add_initial_replace "DF_FILE_REVISION"                    DF_FILE_REVISION
62517>>>>>>>>>>>      send add_initial_replace "DF_FILE_RELATED_COUNT"               DF_FILE_RELATED_COUNT
62518>>>>>>>>>>>      send add_initial_replace "DF_FILE_RELATED_FIELDS"              DF_FILE_RELATED_FIELDS
62519>>>>>>>>>>>      send add_initial_replace "DF_FILE_SYSTEM_FILE"                 DF_FILE_SYSTEM_FILE
62520>>>>>>>>>>>      send add_initial_replace "DF_FILE_SYSTEM_FIELD"                DF_FILE_SYSTEM_FIELD
62521>>>>>>>>>>>      send add_initial_replace "DF_FILE_RECORD_REREAD"               DF_FILE_RECORD_REREAD
62522>>>>>>>>>>>      send add_initial_replace "DF_FIELD_NUMBER"                     DF_FIELD_NUMBER
62523>>>>>>>>>>>      send add_initial_replace "DF_FIELD_TYPE"                       DF_FIELD_TYPE
62524>>>>>>>>>>>      send add_initial_replace "DF_FIELD_LENGTH"                     DF_FIELD_LENGTH
62525>>>>>>>>>>>      send add_initial_replace "DF_FIELD_PRECISION"                  DF_FIELD_PRECISION
62526>>>>>>>>>>>      send add_initial_replace "DF_FIELD_RELATED_FILE"               DF_FIELD_RELATED_FILE
62527>>>>>>>>>>>      send add_initial_replace "DF_FIELD_RELATED_FIELD"              DF_FIELD_RELATED_FIELD
62528>>>>>>>>>>>      send add_initial_replace "DF_FIELD_NAME"                       DF_FIELD_NAME
62529>>>>>>>>>>>      send add_initial_replace "DF_FIELD_INDEX"                      DF_FIELD_INDEX
62530>>>>>>>>>>>      send add_initial_replace "DF_FIELD_OFFSET"                     DF_FIELD_OFFSET
62531>>>>>>>>>>>      send add_initial_replace "DF_FIELD_OLD_NUMBER"                 DF_FIELD_OLD_NUMBER
62532>>>>>>>>>>>      send add_initial_replace "DF_FIELD_OVERLAP"                    DF_FIELD_OVERLAP
62533>>>>>>>>>>>      send add_initial_replace "DF_FIELD_NATIVE_LENGTH"              DF_FIELD_NATIVE_LENGTH
62534>>>>>>>>>>>      send add_initial_replace "DF_INDEX_NUMBER_SEGMENTS"            DF_INDEX_NUMBER_SEGMENTS
62535>>>>>>>>>>>      send add_initial_replace "DF_INDEX_NUMBER_BUFFERS"             DF_INDEX_NUMBER_BUFFERS
62536>>>>>>>>>>>      send add_initial_replace "DF_INDEX_TYPE"                       DF_INDEX_TYPE
62537>>>>>>>>>>>      send add_initial_replace "DF_INDEX_LEVELS"                     DF_INDEX_LEVELS
62538>>>>>>>>>>>      send add_initial_replace "DF_INDEX_KEY_LENGTH"                 DF_INDEX_KEY_LENGTH
62539>>>>>>>>>>>      send add_initial_replace "DF_INDEX_SEGMENT_DIRECTION"          DF_INDEX_SEGMENT_DIRECTION
62540>>>>>>>>>>>      send add_initial_replace "DF_INDEX_SEGMENT_CASE"               DF_INDEX_SEGMENT_CASE
62541>>>>>>>>>>>      send add_initial_replace "DF_INDEX_SEGMENT_FIELD"              DF_INDEX_SEGMENT_FIELD
62542>>>>>>>>>>>      send add_initial_replace "DF_DATE_USA"                         DF_DATE_USA
62543>>>>>>>>>>>      send add_initial_replace "DF_DATE_EUROPEAN"                    DF_DATE_EUROPEAN
62544>>>>>>>>>>>      send add_initial_replace "DF_DATE_MILITARY"                    DF_DATE_MILITARY
62545>>>>>>>>>>>      send add_initial_replace "DF_MESSAGE_TEXT"                     DF_MESSAGE_TEXT
62546>>>>>>>>>>>      send add_initial_replace "DF_MESSAGE_HEADING_1"                DF_MESSAGE_HEADING_1
62547>>>>>>>>>>>      send add_initial_replace "DF_MESSAGE_HEADING_2"                DF_MESSAGE_HEADING_2
62548>>>>>>>>>>>      send add_initial_replace "DF_MESSAGE_HEADING_3"                DF_MESSAGE_HEADING_3
62549>>>>>>>>>>>      send add_initial_replace "DF_MESSAGE_HEADING_4"                DF_MESSAGE_HEADING_4
62550>>>>>>>>>>>      send add_initial_replace "DF_MESSAGE_HEADING_5"                DF_MESSAGE_HEADING_5
62551>>>>>>>>>>>      send add_initial_replace "DF_MESSAGE_WARNING"                  DF_MESSAGE_WARNING
62552>>>>>>>>>>>      send add_initial_replace "DF_MESSAGE_PROGRESS_TITLE"           DF_MESSAGE_PROGRESS_TITLE
62553>>>>>>>>>>>      send add_initial_replace "DF_MESSAGE_PROGRESS_VALUE"           DF_MESSAGE_PROGRESS_VALUE
62554>>>>>>>>>>>      send add_initial_replace "DF_AUX_FILE_FD"                      DF_AUX_FILE_FD
62555>>>>>>>>>>>      send add_initial_replace "DF_AUX_FILE_DEF"                     DF_AUX_FILE_DEF
62556>>>>>>>>>>>      send add_initial_replace "DF_FILE_INACTIVE"                    DF_FILE_INACTIVE
62557>>>>>>>>>>>      send add_initial_replace "DF_FILE_ACTIVE"                      DF_FILE_ACTIVE
62558>>>>>>>>>>>      send add_initial_replace "DF_FILE_ACTIVE_CHANGED"              DF_FILE_ACTIVE_CHANGED
62559>>>>>>>>>>>      send add_initial_replace "DF_FILE_USER_SINGLE"                 DF_FILE_USER_SINGLE
62560>>>>>>>>>>>      send add_initial_replace "DF_FILE_USER_MULTI"                  DF_FILE_USER_MULTI
62561>>>>>>>>>>>      send add_initial_replace "DF_FILE_DELETED_NOREUSE"             DF_FILE_DELETED_NOREUSE
62562>>>>>>>>>>>      send add_initial_replace "DF_FILE_DELETED_REUSE"               DF_FILE_DELETED_REUSE
62563>>>>>>>>>>>      send add_initial_replace "DF_FILE_COMPRESS_NONE"               DF_FILE_COMPRESS_NONE
62564>>>>>>>>>>>      send add_initial_replace "DF_FILE_COMPRESS_FAST"               DF_FILE_COMPRESS_FAST
62565>>>>>>>>>>>      send add_initial_replace "DF_FILE_COMPRESS_STANDARD"           DF_FILE_COMPRESS_STANDARD
62566>>>>>>>>>>>      send add_initial_replace "DF_FILE_COMPRESS_CUSTOM"             DF_FILE_COMPRESS_CUSTOM
62567>>>>>>>>>>>      send add_initial_replace "DF_FILE_ALIAS_DEFAULT"               DF_FILE_ALIAS_DEFAULT
62568>>>>>>>>>>>      send add_initial_replace "DF_FILE_IS_MASTER"                   DF_FILE_IS_MASTER
62569>>>>>>>>>>>      send add_initial_replace "DF_FILE_IS_ALIAS"                    DF_FILE_IS_ALIAS
62570>>>>>>>>>>>      send add_initial_replace "DF_FILE_HANDLE_BAD"                  DF_FILE_HANDLE_BAD
62571>>>>>>>>>>>      send add_initial_replace "DF_FILE_HANDLE_CLOSED"               DF_FILE_HANDLE_CLOSED
62572>>>>>>>>>>>      send add_initial_replace "DF_FILE_HANDLE_OPENED"               DF_FILE_HANDLE_OPENED
62573>>>>>>>>>>>      send add_initial_replace "DF_FILE_HANDLE_EXISTING_RESTRUCTURE" DF_FILE_HANDLE_EXISTING_RESTRUCTURE
62574>>>>>>>>>>>      send add_initial_replace "DF_FILE_HANDLE_NEW_RESTRUCTURE"      DF_FILE_HANDLE_NEW_RESTRUCTURE
62575>>>>>>>>>>>      send add_initial_replace "DF_FILE_TRANSACTION_NONE"            DF_FILE_TRANSACTION_NONE
62576>>>>>>>>>>>      send add_initial_replace "DF_FILE_TRANSACTION_CLIENT_ATOMIC"   DF_FILE_TRANSACTION_CLIENT_ATOMIC
62577>>>>>>>>>>>      send add_initial_replace "DF_FILE_TRANSACTION_SERVER_ATOMIC"   DF_FILE_TRANSACTION_SERVER_ATOMIC
62578>>>>>>>>>>>      send add_initial_replace "DF_FILE_TRANSACTION_SERVER_LOGGED"   DF_FILE_TRANSACTION_SERVER_LOGGED
62579>>>>>>>>>>>      send add_initial_replace "DF_NO_RESTRUCTURE"                   DF_NO_RESTRUCTURE
62580>>>>>>>>>>>      send add_initial_replace "DF_RESTRUCTURE_FILE"                 DF_RESTRUCTURE_FILE
62581>>>>>>>>>>>      send add_initial_replace "DF_RESTRUCTURE_INDEX"                DF_RESTRUCTURE_INDEX
62582>>>>>>>>>>>      send add_initial_replace "DF_RESTRUCTURE_BOTH"                 DF_RESTRUCTURE_BOTH
62583>>>>>>>>>>>      send add_initial_replace "DF_FILE_NOT_TOUCHED"                 DF_FILE_NOT_TOUCHED
62584>>>>>>>>>>>      send add_initial_replace "DF_FILE_TOUCHED_INACTIVE"            DF_FILE_TOUCHED_INACTIVE
62585>>>>>>>>>>>      send add_initial_replace "DF_FILE_TOUCHED_ACTIVE"              DF_FILE_TOUCHED_ACTIVE
62586>>>>>>>>>>>      send add_initial_replace "DF_FILEMODE_ORIGINAL"                DF_FILEMODE_ORIGINAL
62587>>>>>>>>>>>      send add_initial_replace "DF_FILEMODE_DEFAULT"                 DF_FILEMODE_DEFAULT
62588>>>>>>>>>>>      send add_initial_replace "DF_FILEMODE_NO_REREAD"               DF_FILEMODE_NO_REREAD
62589>>>>>>>>>>>      send add_initial_replace "DF_FILEMODE_NO_LOCKS"                DF_FILEMODE_NO_LOCKS
62590>>>>>>>>>>>      send add_initial_replace "DF_FILEMODE_NO_EDITS"                DF_FILEMODE_NO_EDITS
62591>>>>>>>>>>>      send add_initial_replace "DF_FILEMODE_NO_DELETES"              DF_FILEMODE_NO_DELETES
62592>>>>>>>>>>>      send add_initial_replace "DF_FILEMODE_NO_FINDS"                DF_FILEMODE_NO_FINDS
62593>>>>>>>>>>>      send add_initial_replace "DF_FILEMODE_NO_CREATES"              DF_FILEMODE_NO_CREATES
62594>>>>>>>>>>>      send add_initial_replace "DF_FILEMODE_READONLY"                DF_FILEMODE_READONLY
62595>>>>>>>>>>>      send add_initial_replace "DF_FILEMODE_SINGLE_USER"             DF_FILEMODE_SINGLE_USER
62596>>>>>>>>>>>      send add_initial_replace "DF_PERMANENT"                        DF_PERMANENT
62597>>>>>>>>>>>      send add_initial_replace "DF_TEMPORARY"                        DF_TEMPORARY
62598>>>>>>>>>>>      send add_initial_replace "DF_LOCK_TYPE_NONE"                   DF_LOCK_TYPE_NONE
62599>>>>>>>>>>>      send add_initial_replace "DF_LOCK_TYPE_FILE"                   DF_LOCK_TYPE_FILE
62600>>>>>>>>>>>      send add_initial_replace "DF_LOCK_TYPE_RECORD"                 DF_LOCK_TYPE_RECORD
62601>>>>>>>>>>>      send add_initial_replace "DF_SHARE"                            DF_SHARE
62602>>>>>>>>>>>      send add_initial_replace "DF_EXCLUSIVE"                        DF_EXCLUSIVE
62603>>>>>>>>>>>      send add_initial_replace "DF_INDEX_TYPE_ONLINE"                DF_INDEX_TYPE_ONLINE
62604>>>>>>>>>>>      send add_initial_replace "DF_INDEX_TYPE_BATCH"                 DF_INDEX_TYPE_BATCH
62605>>>>>>>>>>>      send add_initial_replace "DF_CASE_USED"                        DF_CASE_USED
62606>>>>>>>>>>>      send add_initial_replace "DF_CASE_IGNORED"                     DF_CASE_IGNORED
62607>>>>>>>>>>>      send add_initial_replace "DF_ASCENDING"                        DF_ASCENDING
62608>>>>>>>>>>>      send add_initial_replace "DF_DESCENDING"                       DF_DESCENDING
62609>>>>>>>>>>>      send add_initial_replace "DF_ASCII"                            DF_ASCII
62610>>>>>>>>>>>      send add_initial_replace "DF_BCD"                              DF_BCD
62611>>>>>>>>>>>      send add_initial_replace "DF_DATE"                             DF_DATE
62612>>>>>>>>>>>      send add_initial_replace "DF_OVERLAP"                          DF_OVERLAP
62613>>>>>>>>>>>      send add_initial_replace "DF_TEXT"                             DF_TEXT
62614>>>>>>>>>>>      send add_initial_replace "DF_BINARY"                           DF_BINARY
62615>>>>>>>>>>>      send add_initial_replace "DF_STRUCTEND_OPT_NONE"               DF_STRUCTEND_OPT_NONE
62616>>>>>>>>>>>      send add_initial_replace "DF_STRUCTEND_OPT_FORCE"              DF_STRUCTEND_OPT_FORCE
62617>>>>>>>>>>>      send add_initial_replace "DF_STRUCTEND_OPT_RECOMPRESS"         DF_STRUCTEND_OPT_RECOMPRESS
62618>>>>>>>>>>>      send add_initial_replace "DF_STRUCTEND_OPT_IN_PLACE"           DF_STRUCTEND_OPT_IN_PLACE
62619>>>>>>>>>>>      send add_initial_replace "DF_SORT_OPTION_NONE"                 DF_SORT_OPTION_NONE
62620>>>>>>>>>>>      send add_initial_replace "DF_SORT_OPTION_NO_DATA_CHECK"        DF_SORT_OPTION_NO_DATA_CHECK
62621>>>>>>>>>>>      send add_initial_replace "DF_SORT_OPTION_BAD_DATA_FIXUP"       DF_SORT_OPTION_BAD_DATA_FIXUP
62622>>>>>>>>>>>      send add_initial_replace "DF_SORT_OPTION_BAD_DATA_FILE"        DF_SORT_OPTION_BAD_DATA_FILE
62623>>>>>>>>>>>      send add_initial_replace "DF_SORT_OPTION_BAD_DATA_ABORT"       DF_SORT_OPTION_BAD_DATA_ABORT
62624>>>>>>>>>>>      send add_initial_replace "DF_SORT_OPTION_DUP_DATA_FILE"        DF_SORT_OPTION_DUP_DATA_FILE
62625>>>>>>>>>>>      send add_initial_replace "DF_SORT_OPTION_DUP_DATA_ABORT"       DF_SORT_OPTION_DUP_DATA_ABORT
62626>>>>>>>>>>>      send add_initial_replace "DF_HIGH"                             DF_HIGH
62627>>>>>>>>>>>      send add_initial_replace "DF_LOW"                              DF_LOW
62628>>>>>>>>>>>    end
62628>>>>>>>>>>>>
62628>>>>>>>>>>>    set piFlexInit_Count to (row_count(self))
62629>>>>>>>>>>>  end_procedure
62630>>>>>>>>>>>end_class // cReplaces
62631>>>>>>>>>>>
62631>>>>>>>>>>>function dfscript_item_type global integer liType returns string
62633>>>>>>>>>>>  ifnot liType function_return "unknown"
62636>>>>>>>>>>>  if liType eq TYPE.UNKNOWN function_return "unknown"
62639>>>>>>>>>>>  if liType eq TYPE.UNTYPED function_return "un-typed"
62642>>>>>>>>>>>  if liType eq TYPE.DATE    function_return "date"
62645>>>>>>>>>>>  if liType eq TYPE.INTEGER function_return "integer"
62648>>>>>>>>>>>  if liType eq TYPE.NUMBER  function_return "number"
62651>>>>>>>>>>>  if liType eq TYPE.STRING  function_return "string"
62654>>>>>>>>>>>  function_return "ERROR"
62655>>>>>>>>>>>end_function
62656>>>>>>>>>>>function dfscript_item_class global integer class# returns string
62658>>>>>>>>>>>  ifnot class# function_return "unknown"
62661>>>>>>>>>>>  if class# eq CLASS.UNKNOWN  function_return "unknown"
62664>>>>>>>>>>>  if class# eq CLASS.LABEL    function_return "label"
62667>>>>>>>>>>>  if class# eq CLASS.VAR      function_return "var"
62670>>>>>>>>>>>  if class# eq CLASS.CONST    function_return "const"
62673>>>>>>>>>>>  if class# eq CLASS.EXPR     function_return "expr"
62676>>>>>>>>>>>  if class# eq CLASS.KEYWORD  function_return "keyword"
62679>>>>>>>>>>>  if class# eq CLASS.COMMAND  function_return "command"
62682>>>>>>>>>>>  if class# eq CLASS.REPLACE_SYMBOL function_return "replacable"
62685>>>>>>>>>>>  if class# eq CLASS.FIELD    function_return "field"
62688>>>>>>>>>>>  if class# eq CLASS.FUNCTION function_return "function"
62691>>>>>>>>>>>  function_return "ERROR"
62692>>>>>>>>>>>end_function
62693>>>>>>>>>>>
62693>>>>>>>>>>>class cScriptInterpreter is a cArray
62694>>>>>>>>>>>  procedure construct_object integer img#
62696>>>>>>>>>>>    forward send construct_object img#
62698>>>>>>>>>>>    property string  psLineBeingParsed  public ""
62699>>>>>>>>>>>    property string  psExprBeingParsed  public ""
62700>>>>>>>>>>>    property integer piErrorCode        public 0
62701>>>>>>>>>>>    property integer piErrorPos         public 0
62702>>>>>>>>>>>    property integer piLine             public 0
62703>>>>>>>>>>>    property integer pVM_Object         public 0 // Virtual Machine object
62704>>>>>>>>>>>    property string  psFileName         public "dfs.src"
62705>>>>>>>>>>>    property integer piDebugState       public 0
62706>>>>>>>>>>>    property string  psListingFile      public "dfscript.prn"
62707>>>>>>>>>>>    property integer piListingFileState public 1
62708>>>>>>>>>>>    property integer piListingFileCh    public 0
62709>>>>>>>>>>>    object oCommandList is a cCommandList
62711>>>>>>>>>>>    end_object
62712>>>>>>>>>>>    object oKeyWords is a cSet
62714>>>>>>>>>>>      send element_add "FROM"
62715>>>>>>>>>>>      send element_add "TO"
62716>>>>>>>>>>>      send element_add "LT"
62717>>>>>>>>>>>      send element_add "LE"
62718>>>>>>>>>>>      send element_add "EQ"
62719>>>>>>>>>>>      send element_add "NE"
62720>>>>>>>>>>>      send element_add "GE"
62721>>>>>>>>>>>      send element_add "GT"
62722>>>>>>>>>>>      send element_add "IN"
62723>>>>>>>>>>>      send element_add "AND"
62724>>>>>>>>>>>      send element_add "OR"
62725>>>>>>>>>>>      send element_add "MIN"
62726>>>>>>>>>>>      send element_add "MAX"
62727>>>>>>>>>>>    end_object
62728>>>>>>>>>>>    object oReplaces is a cReplaces
62730>>>>>>>>>>>    end_object
62731>>>>>>>>>>>    object oScriptErrors is a cScriptErrors
62733>>>>>>>>>>>    end_object
62734>>>>>>>>>>>    object oStructuralStack is a cStructuralStack
62736>>>>>>>>>>>    end_object
62737>>>>>>>>>>>    object oExpressionParser is a cExpressionParser
62739>>>>>>>>>>>    end_object
62740>>>>>>>>>>>    property integer piExprType public 0
62741>>>>>>>>>>>    property integer piExprID   public 0
62742>>>>>>>>>>>  end_procedure
62743>>>>>>>>>>>
62743>>>>>>>>>>>  procedure reset
62745>>>>>>>>>>>    send delete_data to (oScriptErrors(self))
62746>>>>>>>>>>>    send delete_data to (oStructuralStack(self))
62747>>>>>>>>>>>    send reset to (oReplaces(self))
62748>>>>>>>>>>>    send reset to (oExpressionParser(self))
62749>>>>>>>>>>>    set piErrorCode to 0
62750>>>>>>>>>>>    set piErrorPos  to 0
62751>>>>>>>>>>>    set piLine      to 0
62752>>>>>>>>>>>  end_procedure
62753>>>>>>>>>>>
62753>>>>>>>>>>>  function iCommand.s string command# returns integer
62755>>>>>>>>>>>    function_return (iCommand.s(oCommandList(self),command#))
62756>>>>>>>>>>>  end_function
62757>>>>>>>>>>>
62757>>>>>>>>>>>  procedure ScriptError integer error# integer pos# string tmp_str#
62759>>>>>>>>>>>    string str#
62759>>>>>>>>>>>    if num_arguments gt 2 move tmp_str# to str#
62762>>>>>>>>>>>    else move "" to str#
62764>>>>>>>>>>>    send add_error to (oScriptErrors(self)) error# (piLine(self)) pos# (psFileName(self)) str#
62765>>>>>>>>>>>    set piErrorCode to error#
62766>>>>>>>>>>>    set piErrorPos  to pos#
62767>>>>>>>>>>>  end_procedure
62768>>>>>>>>>>>
62768>>>>>>>>>>>  item_property_list
62768>>>>>>>>>>>    item_property string  psItem.i   // The item itself
62768>>>>>>>>>>>    item_property integer piPos.i    // Original starting position in original line
62768>>>>>>>>>>>    item_property integer piClass.i  // Item class
62768>>>>>>>>>>>    item_property integer piType.i   // Item type
62768>>>>>>>>>>>    item_property integer piAuxVal.i // Means different stuff
62768>>>>>>>>>>>  end_item_property_list cScriptInterpreter
#REM 62809 DEFINE FUNCTION PIAUXVAL.I INTEGER LIROW RETURNS INTEGER
#REM 62813 DEFINE PROCEDURE SET PIAUXVAL.I INTEGER LIROW INTEGER VALUE
#REM 62817 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 62821 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 62825 DEFINE FUNCTION PICLASS.I INTEGER LIROW RETURNS INTEGER
#REM 62829 DEFINE PROCEDURE SET PICLASS.I INTEGER LIROW INTEGER VALUE
#REM 62833 DEFINE FUNCTION PIPOS.I INTEGER LIROW RETURNS INTEGER
#REM 62837 DEFINE PROCEDURE SET PIPOS.I INTEGER LIROW INTEGER VALUE
#REM 62841 DEFINE FUNCTION PSITEM.I INTEGER LIROW RETURNS STRING
#REM 62845 DEFINE PROCEDURE SET PSITEM.I INTEGER LIROW STRING VALUE
62850>>>>>>>>>>>
62850>>>>>>>>>>>  function iIsLabelDeclaration.s string str# returns integer
62852>>>>>>>>>>>    if (right(str#,1)) eq ":" function_return 1
62855>>>>>>>>>>>  end_function
62856>>>>>>>>>>>
62856>>>>>>>>>>>  function iSymbolClass.s string name# returns integer
62858>>>>>>>>>>>    integer rval#
62858>>>>>>>>>>>    move (uppercase(name#)) to name#
62859>>>>>>>>>>>    // Is symbol defined in variable list of VM object?
62859>>>>>>>>>>>    get iVarNameToVarNo of (pVM_Object(self)) name# to rval#
62860>>>>>>>>>>>    if rval# ne -1 function_return CLASS.VAR
62863>>>>>>>>>>>    get iIsLabelNameUsed.s of (pVM_Object(self)) name# to rval#
62864>>>>>>>>>>>    if rval# function_return CLASS.LABEL
62867>>>>>>>>>>> // get iCommand.s name# to rval#
62867>>>>>>>>>>> // if rval# ne -1 function_return CLASS.COMMAND
62867>>>>>>>>>>>    get iNameToNo.s of (oReplaces(self)) name# to rval#
62868>>>>>>>>>>>    if rval# ne -1 function_return CLASS.REPLACE_SYMBOL
62871>>>>>>>>>>>    get iConstType.s name# to rval#
62872>>>>>>>>>>>    if rval# ne TYPE.UNKNOWN function_return CLASS.CONST
62875>>>>>>>>>>>    get element_find of (oKeyWords(self)) name# to rval#
62876>>>>>>>>>>>    if rval# ne -1 function_return CLASS.KEYWORD
62879>>>>>>>>>>>    if (left(name#,1)) eq "(" function_return CLASS.EXPR
62882>>>>>>>>>>>    get iFuncNameToFuncNo.s of (pVM_Object(self)) name# to rval#
62883>>>>>>>>>>>    if rval# ne -1 function_return CLASS.FUNCTION
62886>>>>>>>>>>>    get iFileField.s of (pVM_Object(self)) name# to rval#
62887>>>>>>>>>>>    if rval# function_return CLASS.FIELD
62890>>>>>>>>>>>    function_return CLASS.UNKNOWN // Which is 0
62891>>>>>>>>>>>  end_function // iSymbolClass.s
62892>>>>>>>>>>>
62892>>>>>>>>>>>  function iIsIntegerConstant.s string value# returns integer
62894>>>>>>>>>>>    integer pos# len#
62894>>>>>>>>>>>    if (left(value#,1)="-") move (replace("-",value#,"")) to value# // monadic minus
62897>>>>>>>>>>>    move (length(value#)) to len#
62898>>>>>>>>>>>    if len# eq 0 function_return 1
62901>>>>>>>>>>>    for pos# from 1 to len#
62907>>>>>>>>>>>>
62907>>>>>>>>>>>      ifnot (mid(value#,1,pos#)) in "0123456789" function_return 0
62910>>>>>>>>>>>    loop
62911>>>>>>>>>>>>
62911>>>>>>>>>>>    function_return 1
62912>>>>>>>>>>>  end_function
62913>>>>>>>>>>>  function iIsNumberConstant.s string value# returns integer
62915>>>>>>>>>>>    if "." in value# function_return (iIsIntegerConstant.s(self,replace(".",value#,"")))
62918>>>>>>>>>>>    // function_return 0
62918>>>>>>>>>>>  end_function
62919>>>>>>>>>>>  function iIsStringConstant.s string value# returns integer
62921>>>>>>>>>>>    string quote#
62921>>>>>>>>>>>    move (left(value#,1)) to quote#
62922>>>>>>>>>>>    if quote# in ("'"+'"') if (right(value#,1)) eq quote# if (length(value#)) ge 2 begin
62928>>>>>>>>>>>      move (replace(quote#,value#,"")) to value#
62929>>>>>>>>>>>      move (replace(quote#,value#,"")) to value#
62930>>>>>>>>>>>      ifnot quote# in value# function_return 1
62933>>>>>>>>>>>    end
62933>>>>>>>>>>>>
62933>>>>>>>>>>>    // function_return 0
62933>>>>>>>>>>>  end_function
62934>>>>>>>>>>>  function iIsDateConstant.s string value# returns integer
62936>>>>>>>>>>>    string m# d# y#
62936>>>>>>>>>>>    ifnot " " in value# begin
62938>>>>>>>>>>>      if (HowManyWords(value#,"/")=3) begin
62940>>>>>>>>>>>        move (ExtractWord(value#,"/",1)) to m#
62941>>>>>>>>>>>        move (ExtractWord(value#,"/",2)) to d#
62942>>>>>>>>>>>        move (ExtractWord(value#,"/",3)) to y#
62943>>>>>>>>>>>        if (iIsIntegerConstant.s(self,m#) and iIsIntegerConstant.s(self,d#) and iIsIntegerConstant.s(self,y#)) begin
62945>>>>>>>>>>>          if (integer(m#)>0 and integer(m#)<13 and integer(d#)>0 and integer(d#)<32 and integer(y#)>0 and integer(y#)<2500) function_return 1
62948>>>>>>>>>>>        end
62948>>>>>>>>>>>>
62948>>>>>>>>>>>      end
62948>>>>>>>>>>>>
62948>>>>>>>>>>>    end
62948>>>>>>>>>>>>
62948>>>>>>>>>>>    // function_return 0
62948>>>>>>>>>>>  end_function
62949>>>>>>>>>>>
62949>>>>>>>>>>>  function iConstType.s string value# returns integer
62951>>>>>>>>>>>    // The function returns TRUE if name is a constant. In fact, it returns
62951>>>>>>>>>>>    // the type of the constant IF indeed it is a constant
62951>>>>>>>>>>>    if (iIsIntegerConstant.s(self,value#)) function_return TYPE.INTEGER
62954>>>>>>>>>>>    if (iIsStringConstant.s(self,value#)) function_return TYPE.STRING
62957>>>>>>>>>>>    if (iIsDateConstant.s(self,value#)) function_return TYPE.DATE
62960>>>>>>>>>>>    if (iIsNumberConstant.s(self,value#)) function_return TYPE.NUMBER
62963>>>>>>>>>>>    function_return TYPE.UNKNOWN
62964>>>>>>>>>>>  end_function
62965>>>>>>>>>>>
62965>>>>>>>>>>>  function iSymbolType.si string name# integer class# returns integer
62967>>>>>>>>>>>    integer liType id# liFileField
62967>>>>>>>>>>>    if class# eq CLASS.UNKNOWN get iSymbolClass.s name# to class#
62970>>>>>>>>>>>    if class# eq CLASS.LABEL function_return TYPE.UNTYPED
62973>>>>>>>>>>>    if class# eq CLASS.VAR begin
62975>>>>>>>>>>>      get iVarType.s of (pVM_Object(self)) name# to liType
62976>>>>>>>>>>>      if liType eq VARTYP_INTEGER function_return TYPE.INTEGER
62979>>>>>>>>>>>      if liType eq VARTYP_NUMBER  function_return TYPE.NUMBER
62982>>>>>>>>>>>      if liType eq VARTYP_DATE    function_return TYPE.DATE
62985>>>>>>>>>>>      if liType eq VARTYP_STRING  function_return TYPE.STRING
62988>>>>>>>>>>>    end
62988>>>>>>>>>>>>
62988>>>>>>>>>>>    if class# eq CLASS.CONST   function_return (iConstType.s(self,name#))
62991>>>>>>>>>>>    if class# eq CLASS.EXPR    function_return TYPE.UNKNOWN
62994>>>>>>>>>>>    if class# eq CLASS.KEYWORD function_return TYPE.UNTYPED
62997>>>>>>>>>>>    if class# eq CLASS.COMMAND function_return TYPE.UNTYPED
63000>>>>>>>>>>>    if class# eq CLASS.REPLACE_SYMBOL begin
63002>>>>>>>>>>>    end
63002>>>>>>>>>>>>
63002>>>>>>>>>>>    if class# eq CLASS.FUNCTION begin
63004>>>>>>>>>>>      get iFuncNameToFuncNo.s of (pVM_Object(self)) name# to id#
63005>>>>>>>>>>>      get iFuncType.i of (pVM_Object(self)) id# to liType
63006>>>>>>>>>>>      if liType eq VARTYP_INTEGER function_return TYPE.INTEGER
63009>>>>>>>>>>>      if liType eq VARTYP_NUMBER  function_return TYPE.NUMBER
63012>>>>>>>>>>>      if liType eq VARTYP_DATE    function_return TYPE.DATE
63015>>>>>>>>>>>      if liType eq VARTYP_STRING  function_return TYPE.STRING
63018>>>>>>>>>>>    end
63018>>>>>>>>>>>>
63018>>>>>>>>>>>    if class# eq CLASS.FIELD begin
63020>>>>>>>>>>>      get iFileField.s of (pVM_Object(self)) name# to liFileField
63021>>>>>>>>>>>      get iFieldType.i of (pVM_Object(self)) liFileField to liType
63022>>>>>>>>>>>      if liType eq FLDTYP_STRING function_return TYPE.STRING
63025>>>>>>>>>>>      if liType eq FLDTYP_NUMBER function_return TYPE.NUMBER
63028>>>>>>>>>>>      if liType eq FLDTYP_DATE   function_return TYPE.DATE
63031>>>>>>>>>>>    end
63031>>>>>>>>>>>>
63031>>>>>>>>>>>    function_return TYPE.UNKNOWN
63032>>>>>>>>>>>  end_function
63033>>>>>>>>>>>
63033>>>>>>>>>>>  function iVM_ArgType.ii integer class# integer liType returns integer
63035>>>>>>>>>>>    if class#      eq CLASS.UNKNOWN function_return AT_NOT_VALID
63038>>>>>>>>>>>    else if class# eq CLASS.LABEL   function_return AT_LBL
63042>>>>>>>>>>>    else if class# eq CLASS.VAR     function_return AT_VAR
63046>>>>>>>>>>>    else if class# eq CLASS.CONST begin
63049>>>>>>>>>>>      if liType      eq TYPE.UNKNOWN function_return AT_NOT_VALID
63052>>>>>>>>>>>      else if liType eq TYPE.UNTYPED function_return AT_NOT_VALID
63056>>>>>>>>>>>      else if liType eq TYPE.INTEGER function_return AT_CINT
63060>>>>>>>>>>>      else if liType eq TYPE.STRING  function_return AT_CSTR
63064>>>>>>>>>>>      else if liType eq TYPE.NUMBER  function_return AT_CNUM
63068>>>>>>>>>>>      else if liType eq TYPE.DATE    function_return AT_CDAT
63072>>>>>>>>>>>    end
63072>>>>>>>>>>>>
63072>>>>>>>>>>>    else if class# eq CLASS.EXPR    function_return AT_EXPR
63076>>>>>>>>>>>    else if class# eq CLASS.KEYWORD function_return AT_NOT_VALID
63080>>>>>>>>>>>    else if class# eq CLASS.COMMAND function_return AT_NOT_VALID
63084>>>>>>>>>>>    else if class# eq CLASS.REPLACE_SYMBOL function_return AT_NOT_VALID
63088>>>>>>>>>>>    else if class# eq CLASS.FIELD   function_return AT_FIELD
63092>>>>>>>>>>>    function_return AT_NOT_VALID
63093>>>>>>>>>>>  end_function
63094>>>>>>>>>>>
63094>>>>>>>>>>>  function iVM_ArgType.i integer arg# returns integer
63096>>>>>>>>>>>    function_return (iVM_ArgType.ii(self,piClass.i(self,arg#),piType.i(self,arg#)))
63097>>>>>>>>>>>  end_function
63098>>>>>>>>>>>
63098>>>>>>>>>>>  function sReplaceNameToNo.s string name# returns string
63100>>>>>>>>>>>    function_return (sNameToValue.s(oReplaces(self),name#))
63101>>>>>>>>>>>  end_function
63102>>>>>>>>>>>
63102>>>>>>>>>>>  function iIsLegalVarName.s string name# returns integer
63104>>>>>>>>>>>    integer pos# len#
63104>>>>>>>>>>>    ifnot (left(name#,1)) in CHARLIST.SYMBOL.START function_return 0
63107>>>>>>>>>>>    move (length(name#)) to len#
63108>>>>>>>>>>>    for pos# from 1 to len#
63114>>>>>>>>>>>>
63114>>>>>>>>>>>      ifnot (mid(name#,1,pos#)) in (CHARLIST.SYMBOL.START+CHARLIST.SYMBOL.CHAR) function_return 0
63117>>>>>>>>>>>    loop
63118>>>>>>>>>>>>
63118>>>>>>>>>>>    function_return 1
63119>>>>>>>>>>>  end_function
63120>>>>>>>>>>>
63120>>>>>>>>>>>  function iCheckNumberOfArguments.i integer should_be# returns integer
63122>>>>>>>>>>>    integer max#
63122>>>>>>>>>>>    get row_count to max#
63123>>>>>>>>>>>    decrement max#
63124>>>>>>>>>>>    if max# gt should_be# send ScriptError ERR.SCRIPT.TOO_MANY_ARGUMENTS 0
63127>>>>>>>>>>>    if max# lt should_be# send ScriptError ERR.SCRIPT.MISSING_ARGUMENT 0
63130>>>>>>>>>>>    if max# eq should_be# function_return 1
63133>>>>>>>>>>>  end_function
63134>>>>>>>>>>>
63134>>>>>>>>>>>  procedure declare_variable integer liType
63136>>>>>>>>>>>    integer liRow max#
63136>>>>>>>>>>>    string name#
63136>>>>>>>>>>>    get row_count to max#
63137>>>>>>>>>>>    for liRow from 1 to (max#-1)
63143>>>>>>>>>>>>
63143>>>>>>>>>>>      get psItem.i liRow to name#
63144>>>>>>>>>>>      move (uppercase(name#)) to name#
63145>>>>>>>>>>>      if (iIsLegalVarName.s(self,name#)) begin
63147>>>>>>>>>>>        ifnot (iSymbolClass.s(self,name#)) ;          send declare_var to (pVM_Object(self)) name# liType
63150>>>>>>>>>>>        else send ScriptError ERR.SCRIPT.SYMBOL_ALREADY_DEF (piPos.i(self,liRow)) ("Delaring variable: "+name#)
63152>>>>>>>>>>>      end
63152>>>>>>>>>>>>
63152>>>>>>>>>>>      else send ScriptError ERR.SCRIPT.ILLEGAL_VARNAME (piPos.i(self,liRow)) ("Delaring variable: "+name#)
63154>>>>>>>>>>>    loop
63155>>>>>>>>>>>>
63155>>>>>>>>>>>  end_procedure
63156>>>>>>>>>>>
63156>>>>>>>>>>>  procedure replace_symbol string name# string value#
63158>>>>>>>>>>>    move (uppercase(name#)) to name#
63159>>>>>>>>>>>    if (iIsLegalVarName.s(self,name#)) begin
63161>>>>>>>>>>>      ifnot (iSymbolClass.s(self,name#)) begin
63163>>>>>>>>>>>        if (iNameDeclare.ss(oReplaces(self),name#,value#)) ;          send ScriptError ERR.SCRIPT.CIRCULAR_REFERENCE 0 ("Defining replace: "+name#+" -> "+value#)
63166>>>>>>>>>>>      end
63166>>>>>>>>>>>>
63166>>>>>>>>>>>      else send ScriptError ERR.SCRIPT.SYMBOL_ALREADY_DEF 0 ("Defining replace: "+name#+" -> "+value#)
63168>>>>>>>>>>>    end
63168>>>>>>>>>>>>
63168>>>>>>>>>>>    else send ScriptError ERR.SCRIPT.ILLEGAL_SYMBNAME 0 ("Defining replace: "+name#+" -> "+value#)
63170>>>>>>>>>>>  end_procedure
63171>>>>>>>>>>>
63171>>>>>>>>>>>  // Symbol checking (positive logic):
63171>>>>>>>>>>>  //
63171>>>>>>>>>>>  //    I Integer                   TYPE.INTEGER
63171>>>>>>>>>>>  //    D Date                      TYPE.DATE
63171>>>>>>>>>>>  //    N Number                    TYPE.NUMBER
63171>>>>>>>>>>>  //    S String                    TYPE.STRING
63171>>>>>>>>>>>  //    t Any type                  TYPE.INTEGER TYPE.DATE TYPE.NUMBER TYPE.STRING
63171>>>>>>>>>>>
63171>>>>>>>>>>>  //    C Constant                  CLASS.CONST
63171>>>>>>>>>>>  //    V Variable                  CLASS.VAR
63171>>>>>>>>>>>  //    E Expression                CLASS.EXPR
63171>>>>>>>>>>>  //    F File element              CLASS.FIELD
63171>>>>>>>>>>>  //    c Any of the above classes  CLASS.CONST CLASS.VAR CLASS.EXPR CLASS.FIELD
63171>>>>>>>>>>>
63171>>>>>>>>>>>  //    L Label                     CLASS.LABEL
63171>>>>>>>>>>>
63171>>>>>>>>>>>  //    R Required                  -
63171>>>>>>>>>>>  //    U Untyped                   -
63171>>>>>>>>>>>  //    . No more arguments         -
63171>>>>>>>>>>>
63171>>>>>>>>>>>  function iCheckItemPattern.isi integer quiet# string pattern# integer arg# returns integer
63173>>>>>>>>>>>    integer max# itm# rval# len# pos# liType class#
63173>>>>>>>>>>>    string key_word# char#
63173>>>>>>>>>>>    get piClass.i arg# to class#
63174>>>>>>>>>>>    get piType.i arg# to liType
63175>>>>>>>>>>>    if pattern# eq "L" begin
63177>>>>>>>>>>>      if (class#=CLASS.LABEL or class#=CLASS.UNKNOWN) function_return 1
63180>>>>>>>>>>>      ifnot quiet# send ScriptError ERR.SCRIPT.CLASS_CHECK_ERROR (piPos.i(self,arg#)) ("Symbol: "+psItem.i(self,arg#))
63183>>>>>>>>>>>      function_return 0
63184>>>>>>>>>>>    end
63184>>>>>>>>>>>>
63184>>>>>>>>>>>    if '"' in pattern# begin // Keyword indication(s)
63186>>>>>>>>>>>      move 0 to rval#
63187>>>>>>>>>>>      move (HowManyWords(pattern#,'"')) to max#
63188>>>>>>>>>>>      for itm# from 1 to max#
63194>>>>>>>>>>>>
63194>>>>>>>>>>>        if (uppercase(psItem.i(self,arg#))) eq (uppercase(ExtractWord(pattern#,'"',itm#))) move 1 to rval#
63197>>>>>>>>>>>      loop
63198>>>>>>>>>>>>
63198>>>>>>>>>>>      ifnot rval# ifnot quiet# send ScriptError ERR.SCRIPT.KEYWORD_EXPECTED (piPos.i(self,arg#))
63203>>>>>>>>>>>    end
63203>>>>>>>>>>>>
63203>>>>>>>>>>>    else begin
63204>>>>>>>>>>>      move (length(pattern#)) to len#
63205>>>>>>>>>>>      move 1 to rval#
63206>>>>>>>>>>>      for pos# from 1 to len#
63212>>>>>>>>>>>>
63212>>>>>>>>>>>        move (mid(pattern#,1,pos#)) to char#
63213>>>>>>>>>>>        if (char#=".") begin
63215>>>>>>>>>>>          if (row_count(self)>arg#) begin
63217>>>>>>>>>>>            ifnot quiet# send ScriptError ERR.SCRIPT.TOO_MANY_ARGUMENTS (piPos.i(self,arg#))
63220>>>>>>>>>>>            function_return 0
63221>>>>>>>>>>>          end
63221>>>>>>>>>>>>
63221>>>>>>>>>>>          else function_return 1 // There are no more arguments!
63223>>>>>>>>>>>        end
63223>>>>>>>>>>>>
63223>>>>>>>>>>>        if (char#="R" and row_count(self)>>>>>>>>>>          ifnot quiet# send ScriptError ERR.SCRIPT.MISSING_ARGUMENT 0
63228>>>>>>>>>>>          function_return 0
63229>>>>>>>>>>>        end
63229>>>>>>>>>>>>
63229>>>>>>>>>>>        if (char#="U" and not(piType.i(self,arg#)=TYPE.UNKNOWN or piType.i(self,arg#)=TYPE.UNTYPED)) begin
63231>>>>>>>>>>>          ifnot quiet# send ScriptError ERR.SCRIPT.ARGUMENT_TYPED (piPos.i(self,arg#))
63234>>>>>>>>>>>          function_return 0
63235>>>>>>>>>>>        end
63235>>>>>>>>>>>>
63235>>>>>>>>>>>      loop
63236>>>>>>>>>>>>
63236>>>>>>>>>>>      if rval# begin // If we pass the above testing
63238>>>>>>>>>>>        move 0 to rval#
63239>>>>>>>>>>>        if class# eq CLASS.CONST   if "C" in pattern# move 1 to rval#
63244>>>>>>>>>>>        if class# eq CLASS.CONST   if "c" in pattern# move 1 to rval#
63249>>>>>>>>>>>        if class# eq CLASS.VAR     if "V" in pattern# move 1 to rval#
63254>>>>>>>>>>>        if class# eq CLASS.VAR     if "c" in pattern# move 1 to rval#
63259>>>>>>>>>>>        if class# eq CLASS.EXPR    if "E" in pattern# move 1 to rval#
63264>>>>>>>>>>>        if class# eq CLASS.EXPR    if "c" in pattern# move 1 to rval#
63269>>>>>>>>>>>        if class# eq CLASS.FIELD   if "F" in pattern# move 1 to rval#
63274>>>>>>>>>>>        if class# eq CLASS.FIELD   if "c" in pattern# move 1 to rval#
63279>>>>>>>>>>>        if class# eq CLASS.LABEL   if "L" in pattern# move 1 to rval#
63284>>>>>>>>>>>        if class# eq CLASS.UNKNOWN if "U" in pattern# move 1 to rval#
63289>>>>>>>>>>>        if rval# begin
63291>>>>>>>>>>>          move 0 to rval#
63292>>>>>>>>>>>          if liType eq TYPE.INTEGER if "I" in pattern# move 1 to rval#
63297>>>>>>>>>>>          if liType eq TYPE.INTEGER if "t" in pattern# move 1 to rval#
63302>>>>>>>>>>>          if liType eq TYPE.DATE    if "D" in pattern# move 1 to rval#
63307>>>>>>>>>>>          if liType eq TYPE.DATE    if "t" in pattern# move 1 to rval#
63312>>>>>>>>>>>          if liType eq TYPE.NUMBER  if "N" in pattern# move 1 to rval#
63317>>>>>>>>>>>          if liType eq TYPE.NUMBER  if "t" in pattern# move 1 to rval#
63322>>>>>>>>>>>          if liType eq TYPE.STRING  if "S" in pattern# move 1 to rval#
63327>>>>>>>>>>>          if liType eq TYPE.STRING  if "t" in pattern# move 1 to rval#
63332>>>>>>>>>>>          if liType eq TYPE.UNKNOWN if "U" in pattern# move 1 to rval#
63337>>>>>>>>>>>          if liType eq TYPE.UNTYPED if "U" in pattern# move 1 to rval#
63342>>>>>>>>>>>          ifnot rval# ifnot quiet# send ScriptError ERR.SCRIPT.TYPE_CHECK_ERROR (piPos.i(self,arg#))
63347>>>>>>>>>>>        end
63347>>>>>>>>>>>>
63347>>>>>>>>>>>        else ifnot quiet# send ScriptError ERR.SCRIPT.CLASS_CHECK_ERROR (piPos.i(self,arg#)) ("Symbol: "+psItem.i(self,arg#))
63351>>>>>>>>>>>      end
63351>>>>>>>>>>>>
63351>>>>>>>>>>>    end
63351>>>>>>>>>>>>
63351>>>>>>>>>>>    function_return rval#
63352>>>>>>>>>>>  end_function
63353>>>>>>>>>>>
63353>>>>>>>>>>>  function iCheckPattern.is integer quiet# string pattern# returns integer
63355>>>>>>>>>>>    integer itm# max# rval#
63355>>>>>>>>>>>    move (HowManyWords(pattern#," ")) to max#
63356>>>>>>>>>>>    move 1 to rval#
63357>>>>>>>>>>>    for itm# from 1 to max#
63363>>>>>>>>>>>>
63363>>>>>>>>>>>      if rval# get iCheckItemPattern.isi quiet# (ExtractWord(pattern#," ",itm#)) itm# to rval#
63366>>>>>>>>>>>    loop
63367>>>>>>>>>>>>
63367>>>>>>>>>>>    function_return rval#
63368>>>>>>>>>>>  end_function
63369>>>>>>>>>>>
63369>>>>>>>>>>>  function iStructureCheck.i integer cmd# returns integer
63371>>>>>>>>>>>    integer obj# shouldbe# rval# pos#
63371>>>>>>>>>>>    move (piPos.i(self,0)) to pos#
63372>>>>>>>>>>>    move 1 to rval#
63373>>>>>>>>>>>    move (oStructuralStack(self)) to obj#
63374>>>>>>>>>>>    if (item_count(obj#)) begin
63376>>>>>>>>>>>      get iTopPendingCmd of obj# to shouldbe#
63377>>>>>>>>>>>      send pop_struct to obj#
63378>>>>>>>>>>>      if shouldbe# ne cmd# begin
63380>>>>>>>>>>>        if shouldbe# eq CMD_END send ScriptError ERR.SCRIPT.SHOULD_BE_END pos#
63383>>>>>>>>>>>        if shouldbe# eq CMD_ENDIF send ScriptError ERR.SCRIPT.SHOULD_BE_ENDIF pos#
63386>>>>>>>>>>>        if shouldbe# eq CMD_LOOP send ScriptError ERR.SCRIPT.SHOULD_BE_LOOP pos#
63389>>>>>>>>>>>        if shouldbe# eq CMD_UNTIL send ScriptError ERR.SCRIPT.SHOULD_BE_UNTIL pos#
63392>>>>>>>>>>>        move 0 to rval#
63393>>>>>>>>>>>      end
63393>>>>>>>>>>>>
63393>>>>>>>>>>>    end
63393>>>>>>>>>>>>
63393>>>>>>>>>>>    else begin
63394>>>>>>>>>>>      if cmd# eq CMD_END send ScriptError ERR.SCRIPT.UNINITIATED_END pos#
63397>>>>>>>>>>>      if cmd# eq CMD_ENDIF send ScriptError ERR.SCRIPT.UNINITIATED_ENDIF pos#
63400>>>>>>>>>>>      if cmd# eq CMD_LOOP send ScriptError ERR.SCRIPT.UNINITIATED_LOOP pos#
63403>>>>>>>>>>>      if cmd# eq CMD_UNTIL send ScriptError ERR.SCRIPT.UNINITIATED_UNTIL pos#
63406>>>>>>>>>>>      move 0 to rval#
63407>>>>>>>>>>>    end
63407>>>>>>>>>>>>
63407>>>>>>>>>>>    function_return rval#
63408>>>>>>>>>>>  end_function
63409>>>>>>>>>>>  // ==================== INTERPRETATION METHODS ====================
63409>>>>>>>>>>>  procedure Interpret_Date
63411>>>>>>>>>>>    send declare_variable VARTYP_DATE
63412>>>>>>>>>>>  end_procedure
63413>>>>>>>>>>>  procedure Interpret_If
63415>>>>>>>>>>>    integer comp#
63415>>>>>>>>>>>    send push_struct to (oStructuralStack(self)) CMD_IF CMD_ENDIF (psFileName(self)) (piLine(self))
63416>>>>>>>>>>>    if (iCheckPattern.is(self,1,'ct .')) begin
63418>>>>>>>>>>>      if (iCheckPattern.is(self,0,'cI .')) ;        send add_instruction to (pVM_Object(self)) OP_IF_BEGIN (iVM_ArgType.i(self,1)) (psItem.i(self,1)) AT_CINT COMP_NE AT_CINT 0
63421>>>>>>>>>>>    end
63421>>>>>>>>>>>>
63421>>>>>>>>>>>    else begin
63422>>>>>>>>>>>      if (iCheckPattern.is(self,0,'ct "LT""LE""EQ""NE""GE""GT" ct .')) begin
63424>>>>>>>>>>>        move (iCompStringToInt.s(psItem.i(self,2))) to comp#
63425>>>>>>>>>>>        send add_instruction to (pVM_Object(self)) OP_IF_BEGIN (iVM_ArgType.i(self,1)) (psItem.i(self,1)) AT_CINT comp# (iVM_ArgType.i(self,3)) (psItem.i(self,3))
63426>>>>>>>>>>>      end
63426>>>>>>>>>>>>
63426>>>>>>>>>>>    end
63426>>>>>>>>>>>>
63426>>>>>>>>>>>  end_procedure
63427>>>>>>>>>>>  procedure Interpret_Else
63429>>>>>>>>>>>    integer cmd#
63429>>>>>>>>>>>    if (iCheckPattern.is(self,0,'.')) begin
63431>>>>>>>>>>>      get iTopStackingCmd of (oStructuralStack(self)) to cmd#
63432>>>>>>>>>>>      if cmd# eq CMD_IF send add_instruction to (pVM_Object(self)) OP_ELSE
63435>>>>>>>>>>>      else send ScriptError ERR.SCRIPT.UNINITIATED_ELSE (piPos.i(self,0))
63437>>>>>>>>>>>    end
63437>>>>>>>>>>>>
63437>>>>>>>>>>>  end_procedure
63438>>>>>>>>>>>  procedure Interpret_EndIf
63440>>>>>>>>>>>    if (iStructureCheck.i(self,CMD_ENDIF) and iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_ENDIF
63443>>>>>>>>>>>  end_procedure
63444>>>>>>>>>>>  procedure Interpret_End
63446>>>>>>>>>>>    integer cmd#
63446>>>>>>>>>>>    get iTopStackingCmd of (oStructuralStack(self)) to cmd#
63447>>>>>>>>>>>    if (iStructureCheck.i(self,CMD_END) and iCheckPattern.is(self,0,'.')) begin
63449>>>>>>>>>>>      if cmd# eq CMD_WHILE send add_instruction to (pVM_Object(self)) OP_LOOP
63452>>>>>>>>>>>      else send add_instruction to (pVM_Object(self)) OP_ENDIF
63454>>>>>>>>>>>    end
63454>>>>>>>>>>>>
63454>>>>>>>>>>>  end_procedure
63455>>>>>>>>>>>  procedure Interpret_For // For iVar FROM cI TO
63457>>>>>>>>>>>    send push_struct to (oStructuralStack(self)) CMD_FOR CMD_LOOP (psFileName(self)) (piLine(self))
63458>>>>>>>>>>>    if (iCheckPattern.is(self,0,'IV "FROM" Ic "TO" Ic .')) begin
63460>>>>>>>>>>>      send add_instruction to (pVM_Object(self)) OP_FOR AT_VAR (psItem.i(self,1)) (iVM_ArgType.i(self,3)) (psItem.i(self,3)) (iVM_ArgType.i(self,5)) (psItem.i(self,5))
63461>>>>>>>>>>>    end
63461>>>>>>>>>>>>
63461>>>>>>>>>>>  end_procedure
63462>>>>>>>>>>>  procedure Interpret_While
63464>>>>>>>>>>>    integer comp#
63464>>>>>>>>>>>    send push_struct to (oStructuralStack(self)) CMD_WHILE CMD_END (psFileName(self)) (piLine(self))
63465>>>>>>>>>>>    if (iCheckPattern.is(self,1,'ct .')) begin
63467>>>>>>>>>>>      if (iCheckPattern.is(self,0,'cI .')) ;        send add_instruction to (pVM_Object(self)) OP_WHILE (iVM_ArgType.i(self,1)) (psItem.i(self,1)) AT_CINT COMP_NE AT_CINT 0
63470>>>>>>>>>>>    end
63470>>>>>>>>>>>>
63470>>>>>>>>>>>    else begin
63471>>>>>>>>>>>      if (iCheckPattern.is(self,0,'ct "LT""LE""NE""EQ""GE""GT" ct .')) begin
63473>>>>>>>>>>>        move (iCompStringToInt.s(psItem.i(self,2))) to comp#
63474>>>>>>>>>>>        send add_instruction to (pVM_Object(self)) OP_WHILE (iVM_ArgType.i(self,1)) (psItem.i(self,1)) AT_CINT comp# (iVM_ArgType.i(self,3)) (psItem.i(self,3))
63475>>>>>>>>>>>      end
63475>>>>>>>>>>>>
63475>>>>>>>>>>>    end
63475>>>>>>>>>>>>
63475>>>>>>>>>>>  end_procedure
63476>>>>>>>>>>>  procedure Interpret_Gosub
63478>>>>>>>>>>>    if (iCheckPattern.is(self,0,'L .')) send add_instruction to (pVM_Object(self)) OP_GOSUB AT_LBL (psItem.i(self,1))
63481>>>>>>>>>>>  end_procedure
63482>>>>>>>>>>>  procedure Interpret_Goto
63484>>>>>>>>>>>    if (iCheckPattern.is(self,0,'L .')) send add_instruction to (pVM_Object(self)) OP_GOTO AT_LBL (psItem.i(self,1))
63487>>>>>>>>>>>  end_procedure
63488>>>>>>>>>>>  procedure Interpret_Pause
63490>>>>>>>>>>>    if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_PAUSE
63493>>>>>>>>>>>  end_procedure
63494>>>>>>>>>>>  procedure Interpret_GotoXY
63496>>>>>>>>>>>    if (iCheckPattern.is(self,0,'Ic Ic .')) send add_instruction to (pVM_Object(self)) OP_GOTOXY (iVM_ArgType.i(self,1)) (psItem.i(self,1)) (iVM_ArgType.i(self,2)) (psItem.i(self,2))
63499>>>>>>>>>>>  end_procedure
63500>>>>>>>>>>>  procedure Interpret_Input
63502>>>>>>>>>>>    if (iCheckPattern.is(self,0,'tc tV .')) send add_instruction to (pVM_Object(self)) OP_INPUT AT_VAR (psItem.i(self,2)) (iVM_ArgType.i(self,1)) (psItem.i(self,1))
63505>>>>>>>>>>>  end_procedure
63506>>>>>>>>>>>  procedure Interpret_Integer
63508>>>>>>>>>>>    send declare_variable VARTYP_INTEGER
63509>>>>>>>>>>>  end_procedure
63510>>>>>>>>>>>  procedure Interpret_Loop
63512>>>>>>>>>>>    if (iStructureCheck.i(self,CMD_LOOP) and iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_LOOP
63515>>>>>>>>>>>  end_procedure
63516>>>>>>>>>>>  procedure Interpret_Move
63518>>>>>>>>>>>    integer liClass
63518>>>>>>>>>>>    if (iCheckPattern.is(self,0,'Rtc "TO" RtVF .')) begin
63520>>>>>>>>>>>//      send obs OP_ASSIGN AT_VAR (psItem.i(self,3)) (iVM_ArgType.i(self,1)) (psItem.i(self,1))
63520>>>>>>>>>>>      get piClass.i 3 to liClass // Class of target
63521>>>>>>>>>>>      if liClass eq CLASS.VAR ;        send add_instruction to (pVM_Object(self)) OP_ASSIGN AT_VAR (psItem.i(self,3)) (iVM_ArgType.i(self,1)) (psItem.i(self,1))
63524>>>>>>>>>>>      if liClass eq CLASS.FIELD ;        send add_instruction to (pVM_Object(self)) OP_ASSIGN AT_FIELD (psItem.i(self,3)) (iVM_ArgType.i(self,1)) (psItem.i(self,1))
63527>>>>>>>>>>>    end
63527>>>>>>>>>>>>
63527>>>>>>>>>>>  end_procedure
63528>>>>>>>>>>>  procedure Interpret_Number
63530>>>>>>>>>>>    send declare_variable VARTYP_NUMBER
63531>>>>>>>>>>>  end_procedure
63532>>>>>>>>>>>  procedure Interpret_Return
63534>>>>>>>>>>>    if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_RETURN
63537>>>>>>>>>>>  end_procedure
63538>>>>>>>>>>>  procedure Interpret_Showln
63540>>>>>>>>>>>    send Interpret_Show
63541>>>>>>>>>>>    send add_instruction to (pVM_Object(self)) OP_SHOWLN AT_CSTR ""
63542>>>>>>>>>>>  end_procedure
63543>>>>>>>>>>>  procedure Interpret_Show
63545>>>>>>>>>>>    integer arg# max#
63545>>>>>>>>>>>    get row_count to max#
63546>>>>>>>>>>>    for arg# from 1 to (max#-1)
63552>>>>>>>>>>>>
63552>>>>>>>>>>>      if (iCheckItemPattern.isi(self,0,'ct',arg#)) send add_instruction to (pVM_Object(self)) OP_SHOW (iVM_ArgType.i(self,arg#)) (psItem.i(self,arg#))
63555>>>>>>>>>>>    loop
63556>>>>>>>>>>>>
63556>>>>>>>>>>>  end_procedure
63557>>>>>>>>>>>  procedure Interpret_String
63559>>>>>>>>>>>    send declare_variable VARTYP_STRING
63560>>>>>>>>>>>  end_procedure
63561>>>>>>>>>>>  procedure Interpret_ClearScreen
63563>>>>>>>>>>>    if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_CLEARSCREEN
63566>>>>>>>>>>>  end_procedure
63567>>>>>>>>>>>  procedure Interpret_Abort
63569>>>>>>>>>>>    if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_ABORT
63572>>>>>>>>>>>  end_procedure
63573>>>>>>>>>>>  procedure Interpret_#use
63575>>>>>>>>>>>  end_procedure
63576>>>>>>>>>>>  procedure Interpret_#include
63578>>>>>>>>>>>  end_procedure
63579>>>>>>>>>>>  procedure Interpret_Increment
63581>>>>>>>>>>>    if (iCheckPattern.is(self,0,'VI .')) send add_instruction to (pVM_Object(self)) OP_GVAR_INCR AT_VAR (psItem.i(self,1)) AT_CINT 1
63584>>>>>>>>>>>  end_procedure
63585>>>>>>>>>>>  procedure Interpret_Decrement
63587>>>>>>>>>>>    if (iCheckPattern.is(self,0,'VI .')) send add_instruction to (pVM_Object(self)) OP_GVAR_INCR AT_VAR (psItem.i(self,1)) AT_CINT -1
63590>>>>>>>>>>>  end_procedure
63591>>>>>>>>>>>  procedure Interpret_#noisy
63593>>>>>>>>>>>    if (iCheckPattern.is(self,0,'CI .')) set piDebugState to (integer(psItem.i(self,1)))
63596>>>>>>>>>>>  end_procedure
63597>>>>>>>>>>>  procedure Interpret_#replace
63599>>>>>>>>>>>    if (iCheckNumberOfArguments.i(self,2)) send replace_symbol (psItem.i(self,1)) (psItem.i(self,2))
63602>>>>>>>>>>>  end_procedure
63603>>>>>>>>>>>  procedure Interpret_Debug
63605>>>>>>>>>>>    string mode#
63605>>>>>>>>>>>    if (iCheckPattern.is(self,0,'"ON""OFF""SINGLE_STEP""DISPLAY_VAR" .')) begin
63607>>>>>>>>>>>      move (uppercase(psItem.i(self,1))) to mode#
63608>>>>>>>>>>>      if mode#      eq "ON"          send add_instruction to (pVM_Object(self)) OP_DEBUG AT_CINT DBG.ON
63611>>>>>>>>>>>      else if mode# eq "OFF"         send add_instruction to (pVM_Object(self)) OP_DEBUG AT_CINT DBG.OFF
63615>>>>>>>>>>>      else if mode# eq "SINGLE_STEP" send add_instruction to (pVM_Object(self)) OP_DEBUG AT_CINT DBG.SINGLESTEP
63619>>>>>>>>>>>      else if mode# eq "DISPLAY_VAR" send add_instruction to (pVM_Object(self)) OP_DEBUG AT_CINT DBG.VARDISPLAY
63623>>>>>>>>>>>      else send ScriptError ERR.SCRIPT.KEYWORD_DEBUG (piPos.i(self,1))
63625>>>>>>>>>>>    end
63625>>>>>>>>>>>>
63625>>>>>>>>>>>  end_procedure
63626>>>>>>>>>>>  procedure Interpret_Repeat
63628>>>>>>>>>>>    send push_struct to (oStructuralStack(self)) CMD_REPEAT CMD_UNTIL (psFileName(self)) (piLine(self))
63629>>>>>>>>>>>    if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_REPEAT
63632>>>>>>>>>>>  end_procedure
63633>>>>>>>>>>>  procedure Interpret_Until
63635>>>>>>>>>>>    integer comp#
63635>>>>>>>>>>>    if (iCheckPattern.is(self,1,'ct .')) begin
63637>>>>>>>>>>>      if (iCheckPattern.is(self,0,'cI .')) begin
63639>>>>>>>>>>>        if (iStructureCheck.i(self,CMD_UNTIL)) ;          send add_instruction to (pVM_Object(self)) OP_UNTIL (iVM_ArgType.i(self,1)) (psItem.i(self,1)) AT_CINT COMP_NE AT_CINT 0
63642>>>>>>>>>>>      end
63642>>>>>>>>>>>>
63642>>>>>>>>>>>    end
63642>>>>>>>>>>>>
63642>>>>>>>>>>>    else begin
63643>>>>>>>>>>>      if (iStructureCheck.i(self,CMD_UNTIL) and iCheckPattern.is(self,0,'ct "LT""LE""EQ""NE""GE""GT" ct .')) begin
63645>>>>>>>>>>>        move (iCompStringToInt.s(psItem.i(self,2))) to comp#
63646>>>>>>>>>>>        send add_instruction to (pVM_Object(self)) OP_UNTIL (iVM_ArgType.i(self,1)) (psItem.i(self,1)) AT_CINT comp# (iVM_ArgType.i(self,3)) (psItem.i(self,3))
63647>>>>>>>>>>>      end
63647>>>>>>>>>>>>
63647>>>>>>>>>>>    end
63647>>>>>>>>>>>>
63647>>>>>>>>>>>  end_procedure
63648>>>>>>>>>>>  procedure Interpret_Log_Open
63650>>>>>>>>>>>    if (iCheckPattern.is(self,0,'Sc Ic .')) send add_instruction to (pVM_Object(self)) OP_LOG_OPEN (iVM_ArgType.i(self,1)) (psItem.i(self,1)) (iVM_ArgType.i(self,2)) (psItem.i(self,2))
63653>>>>>>>>>>>  end_procedure
63654>>>>>>>>>>>  procedure Interpret_Log_Close
63656>>>>>>>>>>>    if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_LOG_CLOSE
63659>>>>>>>>>>>  end_procedure
63660>>>>>>>>>>>  procedure Interpret_Log_Display
63662>>>>>>>>>>>    if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_LOG_DISPLAY
63665>>>>>>>>>>>  end_procedure
63666>>>>>>>>>>>  procedure Interpret_Log_Flush
63668>>>>>>>>>>>    if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_LOG_FLUSH
63671>>>>>>>>>>>  end_procedure
63672>>>>>>>>>>>  procedure Interpret_Log_Write
63674>>>>>>>>>>>    integer arg# max#
63674>>>>>>>>>>>    get row_count to max#
63675>>>>>>>>>>>    for arg# from 1 to (max#-1)
63681>>>>>>>>>>>>
63681>>>>>>>>>>>      if (iCheckItemPattern.isi(self,0,'ct',arg#)) send add_instruction to (pVM_Object(self)) OP_LOG_WRITE (iVM_ArgType.i(self,arg#)) (psItem.i(self,arg#))
63684>>>>>>>>>>>    loop
63685>>>>>>>>>>>>
63685>>>>>>>>>>>  end_procedure
63686>>>>>>>>>>>  procedure Interpret_Log_Writeln
63688>>>>>>>>>>>    send Interpret_Log_Write
63689>>>>>>>>>>>    send add_instruction to (pVM_Object(self)) OP_LOG_WRITELN AT_CSTR ""
63690>>>>>>>>>>>  end_procedure
63691>>>>>>>>>>>  procedure Interpret_Set_Attribute // liType
63693>>>>>>>>>>>    integer params# attr# liRow max# attrtype#
63693>>>>>>>>>>>    integer t1# t2# t3# t4# t5# t6#
63693>>>>>>>>>>>    string a1# a2# a3# a4# a5# a6#
63693>>>>>>>>>>>    if (iCheckPattern.is(self,1,'CI')) begin
63695>>>>>>>>>>>      // If we go in this branch an explicit attribute was specified
63695>>>>>>>>>>>      // and we are therefore able to check the number of parameters
63695>>>>>>>>>>>      move (psItem.i(self,1)) to attr#
63696>>>>>>>>>>>      ifnot (API_Attr_WriteAccess(attr#)) send ScriptError ERR.SCRIPT.ATTR_NO_SET (piPos.i(self,1)) (API_Attr_Name(attr#))
63699>>>>>>>>>>>      move (API_Attr_NumberOfParams(attr#)) to params#
63700>>>>>>>>>>>      if (API_AttrWorksOnStructure(attr#)) decrement params# // For these attributes the file handle is implicit
63703>>>>>>>>>>>      if (iCheckItemPattern.isi(self,0,'"TO"',params#+2)) begin
63705>>>>>>>>>>>        move (API_AttrType(attr#)) to attrtype#
63706>>>>>>>>>>>        if (attrtype#=ATTRTYPE_FILELIST or attrtype#=ATTRTYPE_FILE or attrtype#=ATTRTYPE_FIELD or attrtype#=ATTRTYPE_INDEX or attrtype#=ATTRTYPE_IDXSEG) begin
63708>>>>>>>>>>>          if attrtype# eq ATTRTYPE_FILELIST begin
63710>>>>>>>>>>>            move (iVM_ArgType.i(self,2)) to t2#
63711>>>>>>>>>>>            move (psItem.i(self,2)) to a2#
63712>>>>>>>>>>>            move (iVM_ArgType.i(self,4)) to t4#
63713>>>>>>>>>>>            move (psItem.i(self,4)) to a4#
63714>>>>>>>>>>>            send add_instruction to (pVM_Object(self)) OP_API_FILELIST AT_CINT attr# t2# a2# t4# a4#
63715>>>>>>>>>>>          end
63715>>>>>>>>>>>>
63715>>>>>>>>>>>          if attrtype# eq ATTRTYPE_FILE begin
63717>>>>>>>>>>>            move (iVM_ArgType.i(self,3)) to t3#
63718>>>>>>>>>>>            move (psItem.i(self,3)) to a3#
63719>>>>>>>>>>>            send add_instruction to (pVM_Object(self)) OP_API_FILE AT_CINT attr# t3# a3#
63720>>>>>>>>>>>          end
63720>>>>>>>>>>>>
63720>>>>>>>>>>>          if attrtype# eq ATTRTYPE_FIELD begin
63722>>>>>>>>>>>            move (iVM_ArgType.i(self,2)) to t2#
63723>>>>>>>>>>>            move (psItem.i(self,2)) to a2#
63724>>>>>>>>>>>            move (iVM_ArgType.i(self,4)) to t4#
63725>>>>>>>>>>>            move (psItem.i(self,4)) to a4#
63726>>>>>>>>>>>            send add_instruction to (pVM_Object(self)) OP_API_FIELD AT_CINT attr# t2# a2# t4# a4#
63727>>>>>>>>>>>          end
63727>>>>>>>>>>>>
63727>>>>>>>>>>>          if attrtype# eq ATTRTYPE_INDEX begin
63729>>>>>>>>>>>            move (iVM_ArgType.i(self,2)) to t2#
63730>>>>>>>>>>>            move (psItem.i(self,2)) to a2#
63731>>>>>>>>>>>            move (iVM_ArgType.i(self,4)) to t4#
63732>>>>>>>>>>>            move (psItem.i(self,4)) to a4#
63733>>>>>>>>>>>            send add_instruction to (pVM_Object(self)) OP_API_INDEX AT_CINT attr# t2# a2# t4# a4#
63734>>>>>>>>>>>          end
63734>>>>>>>>>>>>
63734>>>>>>>>>>>          if attrtype# eq ATTRTYPE_IDXSEG begin
63736>>>>>>>>>>>            move (iVM_ArgType.i(self,2)) to t2#
63737>>>>>>>>>>>            move (psItem.i(self,2)) to a2#
63738>>>>>>>>>>>            move (iVM_ArgType.i(self,3)) to t3#
63739>>>>>>>>>>>            move (psItem.i(self,3)) to a3#
63740>>>>>>>>>>>            move (iVM_ArgType.i(self,5)) to t5#
63741>>>>>>>>>>>            move (psItem.i(self,5)) to a5#
63742>>>>>>>>>>>            send add_instruction to (pVM_Object(self)) OP_API_IDXSEG AT_CINT attr# t2# a2# t3# a3# t5# a5#
63743>>>>>>>>>>>          end
63743>>>>>>>>>>>>
63743>>>>>>>>>>>        end
63743>>>>>>>>>>>>
63743>>>>>>>>>>>        else begin
63744>>>>>>>>>>>          // OK, it's got to be one of these which we do not support setting:
63744>>>>>>>>>>>          //  ATTRTYPE_GLOBAL     ATTRTYPE_DRIVER   ATTRTYPE_DRVSRV
63744>>>>>>>>>>>          //  ATTRTYPE_SPECIAL1   ATTRTYPE_FLSTNAV
63744>>>>>>>>>>>          send ScriptError ERR.SCRIPT.ATTR_NO_CHANGING (piPos.i(self,1))
63745>>>>>>>>>>>        end
63745>>>>>>>>>>>>
63745>>>>>>>>>>>      end
63745>>>>>>>>>>>>
63745>>>>>>>>>>>    end
63745>>>>>>>>>>>>
63745>>>>>>>>>>>    else begin
63746>>>>>>>>>>>      // If we go in this branch an attribute in the form of a variable was
63746>>>>>>>>>>>      // handed, and we just fill up with parameters. We can't type check it
63746>>>>>>>>>>>      // until we execute it and know which attribute is actually set.
63746>>>>>>>>>>>      send ScriptError ERR.SCRIPT.ATTR_IMPLICIT (piPos.i(self,1))
63747>>>>>>>>>>>    end
63747>>>>>>>>>>>>
63747>>>>>>>>>>>  end_procedure
63748>>>>>>>>>>>  procedure Interpret_Create_Field  // field# name# liType
63750>>>>>>>>>>>    integer t1# t2# t3#
63750>>>>>>>>>>>    string a1# a2# a3#
63750>>>>>>>>>>>    if (iCheckPattern.is(self,0,'cI cS cI .')) begin
63752>>>>>>>>>>>      move (iVM_ArgType.i(self,1)) to t1#
63753>>>>>>>>>>>      move (iVM_ArgType.i(self,2)) to t2#
63754>>>>>>>>>>>      move (iVM_ArgType.i(self,3)) to t3#
63755>>>>>>>>>>>      move (psItem.i(self,1)) to a1#
63756>>>>>>>>>>>      move (psItem.i(self,2)) to a2#
63757>>>>>>>>>>>      move (psItem.i(self,3)) to a3#
63758>>>>>>>>>>>      send add_instruction to (pVM_Object(self)) OP_API_CREATEFIELD t1# a1# t2# a2# t3# a3#
63759>>>>>>>>>>>    end
63759>>>>>>>>>>>>
63759>>>>>>>>>>>  end_procedure
63760>>>>>>>>>>>  procedure Interpret_Append_Field  // name liType
63762>>>>>>>>>>>    if (iCheckPattern.is(self,0,'cS cI .')) send add_instruction to (pVM_Object(self)) OP_API_APPENDFIELD (iVM_ArgType.i(self,1)) (psItem.i(self,1)) (iVM_ArgType.i(self,2)) (psItem.i(self,2))
63765>>>>>>>>>>>  end_procedure
63766>>>>>>>>>>>  procedure Interpret_Delete_Field  //
63768>>>>>>>>>>>    if (iCheckPattern.is(self,0,'cI .')) send add_instruction to (pVM_Object(self)) OP_API_DELETEFIELD (iVM_ArgType.i(self,1)) (psItem.i(self,1))
63771>>>>>>>>>>>  end_procedure
63772>>>>>>>>>>>  procedure Interpret_Delete_Index  //
63774>>>>>>>>>>>    if (iCheckPattern.is(self,0,'cI .')) send add_instruction to (pVM_Object(self)) OP_API_DELETEINDEX (iVM_ArgType.i(self,1)) (psItem.i(self,1))
63777>>>>>>>>>>>  end_procedure
63778>>>>>>>>>>>  procedure Interpret_Structure_Abort
63780>>>>>>>>>>>    if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_API_STRUCTURE_ABORT
63783>>>>>>>>>>>  end_procedure
63784>>>>>>>>>>>  procedure Interpret_Structure_End
63786>>>>>>>>>>>    if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_API_STRUCTURE_END
63789>>>>>>>>>>>  end_procedure
63790>>>>>>>>>>>  procedure Interpret_Probe_End
63792>>>>>>>>>>>    if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_API_PROBE_END
63795>>>>>>>>>>>  end_procedure
63796>>>>>>>>>>>  procedure Interpret_Set_Field     //
63798>>>>>>>>>>>    if (iCheckPattern.is(self,0,'cI .')) send add_instruction to (pVM_Object(self)) OP_API_SETFIELDNUMBER (iVM_ArgType.i(self,1)) (psItem.i(self,1))
63801>>>>>>>>>>>  end_procedure
63802>>>>>>>>>>>  procedure Interpret_InfoBox
63804>>>>>>>>>>>    if (iCheckPattern.is(self,0,'ct .')) send add_instruction to (pVM_Object(self)) OP_MSGBOX (iVM_ArgType.i(self,1)) (psItem.i(self,1))
63807>>>>>>>>>>>  end_procedure
63808>>>>>>>>>>>
63808>>>>>>>>>>>  procedure add_item.si string str# integer pos#
63810>>>>>>>>>>>    integer liRow
63810>>>>>>>>>>>    get row_count to liRow
63811>>>>>>>>>>>    set psItem.i  liRow to str#
63812>>>>>>>>>>>    set piPos.i   liRow to pos#
63813>>>>>>>>>>>    set piClass.i liRow to CLASS.UNKNOWN
63814>>>>>>>>>>>    set piType.i  liRow to TYPE.UNKNOWN
63815>>>>>>>>>>>  end_procedure
63816>>>>>>>>>>>
63816>>>>>>>>>>>  enumeration_list
63816>>>>>>>>>>>    define ITEMTYPE.NOT_IN_ITEM
63816>>>>>>>>>>>    define ITEMTYPE.UNKNOWN
63816>>>>>>>>>>>    define ITEMTYPE.STRING_CONSTANT
63816>>>>>>>>>>>    define ITEMTYPE.EXPRESSION
63816>>>>>>>>>>>    define ITEMTYPE.EXPRESSION_STRING_PART
63816>>>>>>>>>>>  end_enumeration_list
63816>>>>>>>>>>>
63816>>>>>>>>>>>  procedure split_line_in_items string str#
63818>>>>>>>>>>>    integer pos# len# start_pos# item_type# error_code# error_pos# balance# comment#
63818>>>>>>>>>>>    string item# char# decr_balance_char# incr_balance_char#
63818>>>>>>>>>>>    string expr_string_const_stopper#
63818>>>>>>>>>>>    move (length(str#)) to len#
63819>>>>>>>>>>>    move 0 to start_pos#
63820>>>>>>>>>>>    move 0 to comment#
63821>>>>>>>>>>>    move "" to item#
63822>>>>>>>>>>>    move ERR.SCRIPT.NO_ERROR to error_code#
63823>>>>>>>>>>>    move 0 to error_pos#
63824>>>>>>>>>>>    move ITEMTYPE.NOT_IN_ITEM to item_type#
63825>>>>>>>>>>>    for pos# from 1 to len#
63831>>>>>>>>>>>>
63831>>>>>>>>>>>      if (error_code#=0 and comment#<>2) begin
63833>>>>>>>>>>>        move (mid(str#,1,pos#)) to char#
63834>>>>>>>>>>>        if start_pos# begin // We are currently in an item
63836>>>>>>>>>>>          if comment# begin
63838>>>>>>>>>>>            if char# eq "/" begin
63840>>>>>>>>>>>              move 0 to start_pos#
63841>>>>>>>>>>>              move 2 to comment#
63842>>>>>>>>>>>            end
63842>>>>>>>>>>>>
63842>>>>>>>>>>>            else move 0 to comment#
63844>>>>>>>>>>>          end
63844>>>>>>>>>>>>
63844>>>>>>>>>>>          if comment# ne 2 begin
63846>>>>>>>>>>>            if item_type# eq ITEMTYPE.EXPRESSION_STRING_PART begin
63848>>>>>>>>>>>              if char# eq expr_string_const_stopper# begin
63850>>>>>>>>>>>                move ITEMTYPE.EXPRESSION to item_type#
63851>>>>>>>>>>>              end
63851>>>>>>>>>>>>
63851>>>>>>>>>>>              move (item#+char#) to item#
63852>>>>>>>>>>>            end
63852>>>>>>>>>>>>
63852>>>>>>>>>>>            else if item_type# eq ITEMTYPE.EXPRESSION begin
63855>>>>>>>>>>>              if char# eq '"' begin
63857>>>>>>>>>>>                move ITEMTYPE.EXPRESSION_STRING_PART to item_type#
63858>>>>>>>>>>>                move char# to expr_string_const_stopper#
63859>>>>>>>>>>>              end
63859>>>>>>>>>>>>
63859>>>>>>>>>>>              if char# eq "'" begin
63861>>>>>>>>>>>                move ITEMTYPE.EXPRESSION_STRING_PART to item_type#
63862>>>>>>>>>>>                move char# to expr_string_const_stopper#
63863>>>>>>>>>>>              end
63863>>>>>>>>>>>>
63863>>>>>>>>>>>              if char# eq decr_balance_char# decrement balance#
63866>>>>>>>>>>>              if char# eq incr_balance_char# increment balance#
63869>>>>>>>>>>>              move (item#+char#) to item#
63870>>>>>>>>>>>              if balance# eq 0 begin
63872>>>>>>>>>>>                send add_item.si item# start_pos#
63873>>>>>>>>>>>                move 0 to start_pos#
63874>>>>>>>>>>>                move "" to item#
63875>>>>>>>>>>>                move ITEMTYPE.NOT_IN_ITEM to item_type#
63876>>>>>>>>>>>              end
63876>>>>>>>>>>>>
63876>>>>>>>>>>>            end
63876>>>>>>>>>>>>
63876>>>>>>>>>>>            else if item_type# eq ITEMTYPE.STRING_CONSTANT begin
63879>>>>>>>>>>>              move (item#+char#) to item#
63880>>>>>>>>>>>              if char# eq decr_balance_char# begin
63882>>>>>>>>>>>                send add_item.si item# start_pos#
63883>>>>>>>>>>>                move 0 to start_pos#
63884>>>>>>>>>>>                move "" to item#
63885>>>>>>>>>>>                move ITEMTYPE.NOT_IN_ITEM to item_type#
63886>>>>>>>>>>>              end
63886>>>>>>>>>>>>
63886>>>>>>>>>>>            end
63886>>>>>>>>>>>>
63886>>>>>>>>>>>            else if item_type# eq ITEMTYPE.UNKNOWN begin
63889>>>>>>>>>>>              if char# eq " " begin
63891>>>>>>>>>>>                send add_item.si item# start_pos#
63892>>>>>>>>>>>                move 0 to start_pos#
63893>>>>>>>>>>>                move "" to item#
63894>>>>>>>>>>>                move ITEMTYPE.NOT_IN_ITEM to item_type#
63895>>>>>>>>>>>              end
63895>>>>>>>>>>>>
63895>>>>>>>>>>>              else begin
63896>>>>>>>>>>>                move (item#+char#) to item#
63897>>>>>>>>>>>                if char# eq ":" begin
63899>>>>>>>>>>>                  send add_item.si item# start_pos#
63900>>>>>>>>>>>                  move 0 to start_pos#
63901>>>>>>>>>>>                  move "" to item#
63902>>>>>>>>>>>                  move ITEMTYPE.NOT_IN_ITEM to item_type#
63903>>>>>>>>>>>                end
63903>>>>>>>>>>>>
63903>>>>>>>>>>>              end
63903>>>>>>>>>>>>
63903>>>>>>>>>>>            end
63903>>>>>>>>>>>>
63903>>>>>>>>>>>          end
63903>>>>>>>>>>>>
63903>>>>>>>>>>>        end
63903>>>>>>>>>>>>
63903>>>>>>>>>>>        else begin // We are currently not in an item
63904>>>>>>>>>>>          if char# eq "/" ifnot comment# increment comment#
63909>>>>>>>>>>>          if char# ne " " begin
63911>>>>>>>>>>>            if char# in CHARLIST.ILLEGAL_ITEM_START begin
63913>>>>>>>>>>>              move ERR.SCRIPT.ERROR_ILLEGAL_CHAR to error_code#
63914>>>>>>>>>>>              move pos# to error_pos#
63915>>>>>>>>>>>            end
63915>>>>>>>>>>>>
63915>>>>>>>>>>>            else begin
63916>>>>>>>>>>>              if char# eq "(" begin
63918>>>>>>>>>>>                move "(" to incr_balance_char#
63919>>>>>>>>>>>                move ")" to decr_balance_char#
63920>>>>>>>>>>>                move 1 to balance#
63921>>>>>>>>>>>                move ITEMTYPE.EXPRESSION to item_type#
63922>>>>>>>>>>>              end
63922>>>>>>>>>>>>
63922>>>>>>>>>>>              else if char# eq "{" begin
63925>>>>>>>>>>>                move "{" to incr_balance_char#
63926>>>>>>>>>>>                move "}" to decr_balance_char#
63927>>>>>>>>>>>                move 1 to balance#
63928>>>>>>>>>>>                move ITEMTYPE.EXPRESSION to item_type#
63929>>>>>>>>>>>              end
63929>>>>>>>>>>>>
63929>>>>>>>>>>>              else if char# eq "[" begin
63932>>>>>>>>>>>                move "[" to incr_balance_char#
63933>>>>>>>>>>>                move "]" to decr_balance_char#
63934>>>>>>>>>>>                move 1 to balance#
63935>>>>>>>>>>>                move ITEMTYPE.EXPRESSION to item_type#
63936>>>>>>>>>>>              end
63936>>>>>>>>>>>>
63936>>>>>>>>>>>              else if char# eq "'" begin
63939>>>>>>>>>>>                move "'" to decr_balance_char#
63940>>>>>>>>>>>                move ITEMTYPE.STRING_CONSTANT to item_type#
63941>>>>>>>>>>>              end
63941>>>>>>>>>>>>
63941>>>>>>>>>>>              else if char# eq '"' begin
63944>>>>>>>>>>>                move '"' to decr_balance_char#
63945>>>>>>>>>>>                move ITEMTYPE.STRING_CONSTANT to item_type#
63946>>>>>>>>>>>              end
63946>>>>>>>>>>>>
63946>>>>>>>>>>>              else move ITEMTYPE.UNKNOWN to item_type#
63948>>>>>>>>>>>              move char# to item#
63949>>>>>>>>>>>              move pos# to start_pos#
63950>>>>>>>>>>>            end
63950>>>>>>>>>>>>
63950>>>>>>>>>>>          end
63950>>>>>>>>>>>>
63950>>>>>>>>>>>        end
63950>>>>>>>>>>>>
63950>>>>>>>>>>>      end
63950>>>>>>>>>>>>
63950>>>>>>>>>>>    loop
63951>>>>>>>>>>>>
63951>>>>>>>>>>>    if start_pos# send add_item.si item# start_pos#
63954>>>>>>>>>>>    if (error_code#=0 and item_type#=ITEMTYPE.STRING_CONSTANT) begin
63956>>>>>>>>>>>      move ERR.SCRIPT.MISSING_END_QUOTE to error_code#
63957>>>>>>>>>>>      move pos# to error_pos#
63958>>>>>>>>>>>    end
63958>>>>>>>>>>>>
63958>>>>>>>>>>>    if error_code# ne ERR.SCRIPT.NO_ERROR send ScriptError error_code# error_pos#
63961>>>>>>>>>>>  end_procedure
63962>>>>>>>>>>>
63962>>>>>>>>>>>  // Label declarations are supposed to be at the beginning of the line.
63962>>>>>>>>>>>  // The DoLabels procedure will declare any such labels in the VM and
63962>>>>>>>>>>>  // remove them from the list of items.
63962>>>>>>>>>>>  procedure DoLabels
63964>>>>>>>>>>>    integer liRow max# islabel#
63964>>>>>>>>>>>    string str#
63964>>>>>>>>>>>    get row_count to max#
63965>>>>>>>>>>>    move 0 to liRow
63966>>>>>>>>>>>    repeat
63966>>>>>>>>>>>>
63966>>>>>>>>>>>      get psItem.i liRow to str#
63967>>>>>>>>>>>      get iIsLabelDeclaration.s str# to islabel#
63968>>>>>>>>>>>      if islabel# begin
63970>>>>>>>>>>>        move (StringLeftBut(str#,1)) to str#
63971>>>>>>>>>>>        ifnot (iSymbolClass.s(self,str#)) send declare_label to (pVM_Object(self)) str#
63974>>>>>>>>>>>        else send ScriptError ERR.SCRIPT.SYMBOL_ALREADY_DEF (piPos.i(self,liRow))
63976>>>>>>>>>>>        increment liRow
63977>>>>>>>>>>>      end
63977>>>>>>>>>>>>
63977>>>>>>>>>>>    until (not(islabel#))
63979>>>>>>>>>>>    // Now, delete the labels from the list:
63979>>>>>>>>>>>    decrement liRow
63980>>>>>>>>>>>    while liRow ge 0
63984>>>>>>>>>>>      send delete_row liRow
63985>>>>>>>>>>>      decrement liRow
63986>>>>>>>>>>>    loop
63987>>>>>>>>>>>>
63987>>>>>>>>>>>  end_procedure
63988>>>>>>>>>>>
63988>>>>>>>>>>>  procedure DoCommand
63990>>>>>>>>>>>    integer cmd#
63990>>>>>>>>>>>    if (row_count(self)) begin
63992>>>>>>>>>>>      // Get Command ID of command in row 0:
63992>>>>>>>>>>>      get iCommand.s (psItem.i(self,0)) to cmd#
63993>>>>>>>>>>>      // Set the aux value of row 0 to the Command ID
63993>>>>>>>>>>>      if cmd# ge 0 set piAuxVal.i 0 to cmd#
63996>>>>>>>>>>>      else send ScriptError ERR.SCRIPT.COMMAND_NOT_FOUND (piPos.i(self,0)) ("Command: "+psItem.i(self,0))
63998>>>>>>>>>>>    end
63998>>>>>>>>>>>>
63998>>>>>>>>>>>  end_procedure
63999>>>>>>>>>>>
63999>>>>>>>>>>>  procedure DoReplaces // Perform symbol replaces
64001>>>>>>>>>>>    integer liRow max#
64001>>>>>>>>>>>    get row_count to max#
64002>>>>>>>>>>>    for liRow from 1 to (max#-1) // We do not replace the command column
64008>>>>>>>>>>>>
64008>>>>>>>>>>>      set psItem.i liRow to (sReplaceNameToNo.s(self,psItem.i(self,liRow)))
64009>>>>>>>>>>>    loop
64010>>>>>>>>>>>>
64010>>>>>>>>>>>  end_procedure
64011>>>>>>>>>>>
64011>>>>>>>>>>>  procedure DoClassColumn // Identify the classes
64013>>>>>>>>>>>    integer liRow max# liClass
64013>>>>>>>>>>>    string lsItem
64013>>>>>>>>>>>    get row_count to max#
64014>>>>>>>>>>>    for liRow from 0 to (max#-1)
64020>>>>>>>>>>>>
64020>>>>>>>>>>>      get psItem.i liRow to lsItem
64021>>>>>>>>>>>      get iSymbolClass.s lsItem to liClass
64022>>>>>>>>>>>      set piClass.i liRow to liClass
64023>>>>>>>>>>>    loop
64024>>>>>>>>>>>>
64024>>>>>>>>>>>  end_procedure
64025>>>>>>>>>>>
64025>>>>>>>>>>>  procedure DoTypeColumn // Identify the types
64027>>>>>>>>>>>    integer liRow max#
64027>>>>>>>>>>>    get row_count to max#
64028>>>>>>>>>>>    for liRow from 0 to (max#-1)
64034>>>>>>>>>>>>
64034>>>>>>>>>>>      set piType.i liRow to (iSymbolType.si(self,psItem.i(self,liRow),piClass.i(self,liRow)))
64035>>>>>>>>>>>    loop
64036>>>>>>>>>>>>
64036>>>>>>>>>>>  end_procedure
64037>>>>>>>>>>>
64037>>>>>>>>>>>  procedure DoExpressions
64039>>>>>>>>>>>    integer liRow max# exprid#
64039>>>>>>>>>>>    get row_count to max#
64040>>>>>>>>>>>    for liRow from 1 to (max#-1)
64046>>>>>>>>>>>>
64046>>>>>>>>>>>      if (piErrorCode(self)=ERR.SCRIPT.NO_ERROR) begin
64048>>>>>>>>>>>        if (piClass.i(self,liRow)=CLASS.EXPR and piType.i(self,liRow)=TYPE.UNKNOWN) begin
64050>>>>>>>>>>>          set psExprBeingParsed to (psItem.i(self,liRow))
64051>>>>>>>>>>>          get iParse_expression.si of (oExpressionParser(self)) (psItem.i(self,liRow)) (piPos.i(self,liRow)) to exprid#
64052>>>>>>>>>>>          set piType.i liRow to (piExprType(oExpressionParser(self)))
64053>>>>>>>>>>>          set psItem.i liRow to exprid#
64054>>>>>>>>>>>          if (piDebugState(self)) send DisplayExpressionDebugInfo (oExpressionParser(self))
64057>>>>>>>>>>>        end
64057>>>>>>>>>>>>
64057>>>>>>>>>>>      end
64057>>>>>>>>>>>>
64057>>>>>>>>>>>    end
64058>>>>>>>>>>>>
64058>>>>>>>>>>>  end_procedure
64059>>>>>>>>>>>
64059>>>>>>>>>>>  procedure DoPrepareArguments
64061>>>>>>>>>>>    integer liRow max#
64061>>>>>>>>>>>    get row_count to max#
64062>>>>>>>>>>>    for liRow from 1 to (max#-1)
64068>>>>>>>>>>>>
64068>>>>>>>>>>>      // Remove quotation characters from string constants:
64068>>>>>>>>>>>      if (piClass.i(self,liRow)=CLASS.CONST and piType.i(self,liRow)=TYPE.STRING) set psItem.i liRow to (StringRightBut(StringLeftBut(psItem.i(self,liRow),1),1))
64071>>>>>>>>>>>    loop
64072>>>>>>>>>>>>
64072>>>>>>>>>>>  end_procedure
64073>>>>>>>>>>>
64073>>>>>>>>>>>  procedure parse_line string str# integer line# string fn#
64075>>>>>>>>>>>    integer msg#
64075>>>>>>>>>>>    set piErrorCode to 0
64076>>>>>>>>>>>    set piErrorPos  to 0
64077>>>>>>>>>>>    set piLine      to line#
64078>>>>>>>>>>>    set psFileName  to fn#
64079>>>>>>>>>>>    set psLineBeingParsed to str#
64080>>>>>>>>>>>    send ListingFileWriteLn (string(piProgramCounter(pVM_Object(self)))+"> "+str#)
64081>>>>>>>>>>>    send delete_data
64082>>>>>>>>>>>    send split_line_in_items str#
64083>>>>>>>>>>>    ifnot (piErrorCode(self)) begin
64085>>>>>>>>>>>      send DoLabels  //
64086>>>>>>>>>>>      send DoCommand
64087>>>>>>>>>>>      ifnot (piErrorCode(self)) begin
64089>>>>>>>>>>>        ifnot (piErrorCode(self)) send DoReplaces
64092>>>>>>>>>>>        ifnot (piErrorCode(self)) send DoClassColumn
64095>>>>>>>>>>>        ifnot (piErrorCode(self)) send DoTypeColumn
64098>>>>>>>>>>>        ifnot (piErrorCode(self)) send DoExpressions
64101>>>>>>>>>>>        ifnot (piErrorCode(self)) send DoPrepareArguments
64104>>>>>>>>>>>        get piCompileMsg.i of (oCommandList(self)) (piAuxVal.i(self,0)) to msg#
64105>>>>>>>>>>>        ifnot (piErrorCode(self)) send msg#
64108>>>>>>>>>>>      end
64108>>>>>>>>>>>>
64108>>>>>>>>>>>    end
64108>>>>>>>>>>>>
64108>>>>>>>>>>>    if (piErrorCode(self)) ne ERR.SCRIPT.NO_ERROR set piInvalidProgram of (pVM_Object(self)) to true
64111>>>>>>>>>>>    if (piDebugState(self) and item_count(self)) send DisplayInterpreterDebugInfo self
64114>>>>>>>>>>>  end_procedure
64115>>>>>>>>>>>  function iParse_Line.sis string str# integer line# string fn# returns integer
64117>>>>>>>>>>>    send parse_line str# line# fn#
64118>>>>>>>>>>>    if (piErrorCode(self)) function_return (piLine(self)*65536+piErrorPos(self))
64121>>>>>>>>>>>    //function_return 0
64121>>>>>>>>>>>  end_function
64122>>>>>>>>>>>  // After having called this function you may query the piExprType
64122>>>>>>>>>>>  // and piExprID properties
64122>>>>>>>>>>>  function iParse_Expr.s string lsExpression returns integer
64124>>>>>>>>>>>    integer lhExpr
64124>>>>>>>>>>>    set piErrorCode to 0
64125>>>>>>>>>>>    set piErrorPos  to 0
64126>>>>>>>>>>>    set piLine      to 0
64127>>>>>>>>>>>    set psFileName  to "Expression"
64128>>>>>>>>>>>//    send obs lsExpression
64128>>>>>>>>>>>    get iParse_expression.si of (oExpressionParser(self)) lsExpression 1 to lhExpr
64129>>>>>>>>>>>    set piExprType to (piExprType(oExpressionParser(self)))
64130>>>>>>>>>>>    set piExprID   to lhExpr
64131>>>>>>>>>>>    if (piDebugState(self)) send DisplayExpressionDebugInfo (oExpressionParser(self))
64134>>>>>>>>>>>    if (piErrorCode(self)) function_return (piLine(self)*65536+piErrorPos(self))
64137>>>>>>>>>>>    //function_return 0
64137>>>>>>>>>>>  end_function
64138>>>>>>>>>>>  procedure ListingFileWriteLn string str#
64140>>>>>>>>>>>    if (piListingFileState(self)) writeln channel (piListingFileCh(self)) str#
64145>>>>>>>>>>>  end_procedure
64146>>>>>>>>>>>  procedure script_begin
64148>>>>>>>>>>>    if (piListingFileState(self)) begin
64150>>>>>>>>>>>      set piListingFileCh to (SEQ_DirectOutput(psListingFile(self)))
64151>>>>>>>>>>>      send ListingFileWriteLn "Script interpreter listing file"
64152>>>>>>>>>>>      send ListingFileWriteLn (string(dSysdate())+", "+sSysTime())
64153>>>>>>>>>>>    end
64153>>>>>>>>>>>>
64153>>>>>>>>>>>    send reset
64154>>>>>>>>>>>    send script_begin to (pVM_Object(self))
64155>>>>>>>>>>>  end_procedure
64156>>>>>>>>>>>  procedure script_end
64158>>>>>>>>>>>    if (item_count(oStructuralStack(self))) send ScriptError ERR.SCRIPT.UNFINISHED_STRUCT 0
64161>>>>>>>>>>>    send script_end to (pVM_Object(self))
64162>>>>>>>>>>>    if (piListingFileState(self)) send SEQ_CloseOutput (piListingFileCh(self))
64165>>>>>>>>>>>  end_procedure
64166>>>>>>>>>>>  procedure run_script
64168>>>>>>>>>>>    send run_script to (pVM_Object(self))
64169>>>>>>>>>>>  end_procedure
64170>>>>>>>>>>>end_class // cScriptInterpreter
64171>>>>>>>>>>>
64171>>>>>>>>>>>object oDFScriptParserTest is a aps.ModalPanel label "Line being parsed"
64174>>>>>>>>>>>  set locate_mode to CENTER_ON_SCREEN
64175>>>>>>>>>>>  object oFrm is a aps.Form abstract AFT_ASCII80
64178>>>>>>>>>>>    set object_shadow_state to true
64179>>>>>>>>>>>  end_object
64180>>>>>>>>>>>  send aps_goto_max_row
64181>>>>>>>>>>>  object oLst is a aps.Grid
64183>>>>>>>>>>>    set highlight_row_state to true
64184>>>>>>>>>>>    set highlight_row_color to (rgb(0,255,255))
64185>>>>>>>>>>>    set current_item_color to (rgb(0,255,255))
64186>>>>>>>>>>>    set select_mode to no_select
64187>>>>>>>>>>>    set size to 196 0
64188>>>>>>>>>>>    set line_width to 5 0
64189>>>>>>>>>>>    set form_margin item 0 to 35
64190>>>>>>>>>>>    set form_margin item 1 to 4
64191>>>>>>>>>>>    set form_margin item 2 to 13
64192>>>>>>>>>>>    set form_margin item 3 to 13
64193>>>>>>>>>>>    set form_margin item 4 to 6
64194>>>>>>>>>>>    set header_label item 0 to "Item"
64195>>>>>>>>>>>    set header_label item 1 to "Pos"
64196>>>>>>>>>>>    set header_label item 2 to "Class"
64197>>>>>>>>>>>    set header_label item 3 to "Type"
64198>>>>>>>>>>>    set header_label item 4 to "Aux"
64199>>>>>>>>>>>    on_key knext_item send switch
64200>>>>>>>>>>>    on_key kprevious_item send switch_back
64201>>>>>>>>>>>    procedure fill_list.i integer obj#
64204>>>>>>>>>>>      integer max# liRow pos# class# liType aux#
64204>>>>>>>>>>>      string str#
64204>>>>>>>>>>>      send delete_data
64205>>>>>>>>>>>      get row_count of obj# to max#
64206>>>>>>>>>>>      for liRow from 0 to (max#-1)
64212>>>>>>>>>>>>
64212>>>>>>>>>>>        get psItem.i   of obj# liRow to str#
64213>>>>>>>>>>>        get piPos.i    of obj# liRow to pos#
64214>>>>>>>>>>>        get piClass.i  of obj# liRow to class#
64215>>>>>>>>>>>        get piType.i   of obj# liRow to liType
64216>>>>>>>>>>>        get piAuxVal.i of obj# liRow to aux#
64217>>>>>>>>>>>        send add_item msg_none str#
64218>>>>>>>>>>>        send add_item msg_none (string(pos#))
64219>>>>>>>>>>>        send add_item msg_none (dfscript_item_class(class#))
64220>>>>>>>>>>>        send add_item msg_none (dfscript_item_type(liType))
64221>>>>>>>>>>>        send add_item msg_none (string(aux#))
64222>>>>>>>>>>>      loop
64223>>>>>>>>>>>>
64223>>>>>>>>>>>      get item_count to max#
64224>>>>>>>>>>>      for liRow from 0 to (max#-1)
64230>>>>>>>>>>>>
64230>>>>>>>>>>>        set entry_state item liRow to false
64231>>>>>>>>>>>      loop
64232>>>>>>>>>>>>
64232>>>>>>>>>>>    end_procedure
64233>>>>>>>>>>>  end_object
64234>>>>>>>>>>>  object oBtn is a aps.Multi_Button
64236>>>>>>>>>>>    on_item t.btn.close send close_panel
64237>>>>>>>>>>>  end_object
64238>>>>>>>>>>>  send aps_locate_multi_buttons
64239>>>>>>>>>>>  procedure run.i integer obj#
64242>>>>>>>>>>>    set value of (oFrm(self)) item 0 to (psLineBeingParsed(obj#))
64243>>>>>>>>>>>    send fill_list.i to (oLst(self)) obj#
64244>>>>>>>>>>>    send popup
64245>>>>>>>>>>>  end_procedure
64246>>>>>>>>>>>end_object
64247>>>>>>>>>>>
64247>>>>>>>>>>>procedure DisplayInterpreterDebugInfo global integer obj#
64249>>>>>>>>>>>  send run.i to (oDFScriptParserTest(self)) obj#
64250>>>>>>>>>>>end_procedure
64251>>>>>>>>>>>
64251>>>>>>>>>>>object oDFScriptExprTest is a aps.ModalPanel label "Expression parsed"
64254>>>>>>>>>>>  set locate_mode to CENTER_ON_SCREEN
64255>>>>>>>>>>>  object oFrm is a aps.Form abstract AFT_ASCII80
64258>>>>>>>>>>>    set object_shadow_state to true
64259>>>>>>>>>>>  end_object
64260>>>>>>>>>>>  send aps_goto_max_row
64261>>>>>>>>>>>  object oLst is a aps.Grid
64263>>>>>>>>>>>    set line_width to 8 0
64264>>>>>>>>>>>    set highlight_row_state to true
64265>>>>>>>>>>>    set highlight_row_color to (rgb(0,255,255))
64266>>>>>>>>>>>    set current_item_color to (rgb(0,255,255))
64267>>>>>>>>>>>    set select_mode to no_select
64268>>>>>>>>>>>    set size to 196 0
64269>>>>>>>>>>>    set form_margin item 0 to 14
64270>>>>>>>>>>>    set form_margin item 1 to 4
64271>>>>>>>>>>>    set form_margin item 2 to 6
64272>>>>>>>>>>>    set form_margin item 3 to 3
64273>>>>>>>>>>>    set form_margin item 4 to 8
64274>>>>>>>>>>>    set form_margin item 5 to 7
64275>>>>>>>>>>>    set form_margin item 6 to 3
64276>>>>>>>>>>>    set form_margin item 7 to 3
64277>>>>>>>>>>>    set header_label item 0 to "Item"
64278>>>>>>>>>>>    set header_label item 1 to "Pos"
64279>>>>>>>>>>>    set header_label item 2 to "EIT"
64280>>>>>>>>>>>    set header_label item 3 to "Opr"
64281>>>>>>>>>>>    set header_label item 4 to "Class"
64282>>>>>>>>>>>    set header_label item 5 to "Type"
64283>>>>>>>>>>>    set header_label item 6 to "Lvl"
64284>>>>>>>>>>>    set header_label item 7 to "Par"
64285>>>>>>>>>>>    on_key kenter send close_panel
64286>>>>>>>>>>>    on_key knext_item send switch
64287>>>>>>>>>>>    on_key kprevious_item send switch_back
64288>>>>>>>>>>>    procedure fill_list.i integer obj#
64291>>>>>>>>>>>      string item#
64291>>>>>>>>>>>      integer pos# class# liType structtype# level# max# liRow params# op_type#
64291>>>>>>>>>>>      send delete_data
64292>>>>>>>>>>>      get row_count of obj# to max#
64293>>>>>>>>>>>      for liRow from 0 to (max#-1)
64299>>>>>>>>>>>>
64299>>>>>>>>>>>        get psItem.i       of obj# liRow to item#       // The item in clear text
64300>>>>>>>>>>>        get piStructType.i of obj# liRow to structtype# // What part of the expression is this?
64301>>>>>>>>>>>        get piPos.i        of obj# liRow to pos#        // What is the starting position?
64302>>>>>>>>>>>        get piClass.i      of obj# liRow to class#      // If item, what is item class?
64303>>>>>>>>>>>        get piType.i       of obj# liRow to liType       // If item, what is item type?
64304>>>>>>>>>>>        get piEvalLevel.i  of obj# liRow to level#      // When evaluating
64305>>>>>>>>>>>        get piFuncParams.i of obj# liRow to params#     // Number of params#
64306>>>>>>>>>>>        get piOperator.i   of obj# liRow to op_type#    // If operator, which one?
64307>>>>>>>>>>>
64307>>>>>>>>>>>        send add_item msg_none item#
64308>>>>>>>>>>>        send add_item msg_none (string(pos#))
64309>>>>>>>>>>>        send add_item msg_none (ExprItemType_Text(structtype#))
64310>>>>>>>>>>>        send add_item msg_none (sOperatorSymbol.i(op_type#))
64311>>>>>>>>>>>        if (structtype#=EIT.SYMBOL or structtype#=EIT.LEFT or structtype#=EIT.COMMA) begin
64313>>>>>>>>>>>          send add_item msg_none (dfscript_item_class(class#))
64314>>>>>>>>>>>          send add_item msg_none (dfscript_item_type(liType))
64315>>>>>>>>>>>        end
64315>>>>>>>>>>>>
64315>>>>>>>>>>>        else begin
64316>>>>>>>>>>>          send add_item msg_none ""
64317>>>>>>>>>>>          send add_item msg_none ""
64318>>>>>>>>>>>        end
64318>>>>>>>>>>>>
64318>>>>>>>>>>>        send add_item msg_none (string(level#))
64319>>>>>>>>>>>        send add_item msg_none (string(params#))
64320>>>>>>>>>>>      loop
64321>>>>>>>>>>>>
64321>>>>>>>>>>>      get item_count to max#
64322>>>>>>>>>>>      for liRow from 0 to (max#-1)
64328>>>>>>>>>>>>
64328>>>>>>>>>>>        set entry_state item liRow to false
64329>>>>>>>>>>>      loop
64330>>>>>>>>>>>>
64330>>>>>>>>>>>    end_procedure
64331>>>>>>>>>>>  end_object
64332>>>>>>>>>>>  object oBtn is a aps.Multi_Button
64334>>>>>>>>>>>    on_item t.btn.close send close_panel
64335>>>>>>>>>>>  end_object
64336>>>>>>>>>>>  send aps_locate_multi_buttons
64337>>>>>>>>>>>  procedure run.i integer obj#
64340>>>>>>>>>>>    set value of (oFrm(self)) item 0 to (psExprBeingParsed(obj#))
64341>>>>>>>>>>>    send fill_list.i to (oLst(self)) obj#
64342>>>>>>>>>>>    send popup
64343>>>>>>>>>>>  end_procedure
64344>>>>>>>>>>>end_object
64345>>>>>>>>>>>
64345>>>>>>>>>>>procedure DisplayExpressionDebugInfo global integer obj#
64347>>>>>>>>>>>  send run.i to (oDFScriptExprTest(self)) obj#
64348>>>>>>>>>>>end_procedure
64349>>>>>>>>>>>
64349>>>>>>>>>>>object oDFScriptExprSequence is a aps.ModalPanel label "Expression evaluation sequence"
64352>>>>>>>>>>>  set locate_mode to CENTER_ON_SCREEN
64353>>>>>>>>>>>  object oLst is a aps.Grid
64355>>>>>>>>>>>    set line_width to 2 0
64356>>>>>>>>>>>    set highlight_row_state to true
64357>>>>>>>>>>>    set highlight_row_color to (rgb(0,255,255))
64358>>>>>>>>>>>    set current_item_color to (rgb(0,255,255))
64359>>>>>>>>>>>    set select_mode to no_select
64360>>>>>>>>>>>    set size to 196 0
64361>>>>>>>>>>>    set form_margin item 0 to 14
64362>>>>>>>>>>>    set form_margin item 1 to 60
64363>>>>>>>>>>>    set header_label item 0 to "OP-Code"
64364>>>>>>>>>>>    set header_label item 1 to "Value"
64365>>>>>>>>>>>    on_key kenter send close_panel
64366>>>>>>>>>>>    on_key knext_item send switch
64367>>>>>>>>>>>    on_key kprevious_item send switch_back
64368>>>>>>>>>>>    procedure fill_list.i integer obj#
64371>>>>>>>>>>>      integer max# liRow class# op# liType
64371>>>>>>>>>>>      string val#
64371>>>>>>>>>>>      send delete_data
64372>>>>>>>>>>>      get row_count of obj# to max#
64373>>>>>>>>>>>      for liRow from 0 to (max#-1)
64379>>>>>>>>>>>>
64379>>>>>>>>>>>        get piOpCode.i  of obj# liRow to op#
64380>>>>>>>>>>>        get psVar.i     of obj# liRow to val#
64381>>>>>>>>>>>        send add_item msg_none (sExprOp_Text.i(op#))
64382>>>>>>>>>>>        send add_item msg_none val#
64383>>>>>>>>>>>      loop
64384>>>>>>>>>>>>
64384>>>>>>>>>>>    end_procedure
64385>>>>>>>>>>>  end_object
64386>>>>>>>>>>>  object oBtn is a aps.Multi_Button
64388>>>>>>>>>>>    on_item t.btn.close send close_panel
64389>>>>>>>>>>>  end_object
64390>>>>>>>>>>>  send aps_locate_multi_buttons
64391>>>>>>>>>>>  procedure run.i integer obj#
64394>>>>>>>>>>>    integer grb#
64394>>>>>>>>>>>    send fill_list.i to (oLst(self)) obj#
64395>>>>>>>>>>>    send popup
64396>>>>>>>>>>>  end_procedure
64397>>>>>>>>>>>end_object
64398>>>>>>>>>>>procedure DisplayEvalSequence global integer obj#
64400>>>>>>>>>>>  send run.i to (oDFScriptExprSequence(self)) obj#
64401>>>>>>>>>>>end_procedure
64402>>>>>>>>>>>
64402>>>>>>>>>Use vMachine.utl // Virtual machine class (heart of DFScript)
64402>>>>>>>>>Use Strings.utl  // String manipulation for VDF
64402>>>>>>>>>Use FDX_Attr.nui // FDX compatible attribute functions
64402>>>>>>>>>Use FdxField.utl // FDX Field things
64402>>>>>>>>>
64402>>>>>>>>> define t.QryExpr.Expression    for "Expression"
64402>>>>>>>>> define t.QryExpr.Tables        for "Tables"
64402>>>>>>>>> define t.QryExpr.Fields        for "Fields"
64402>>>>>>>>> define t.QryExpr.Functions     for "Functions"
64402>>>>>>>>> define t.QryExpr.LongLabel     for "Long label"
64402>>>>>>>>> define t.QryExpr.ShortLabel    for "Short label"
64402>>>>>>>>> define t.QryExpr.Width         for "Width"
64402>>>>>>>>> define t.QryExpr._Characters   for " characters"
64402>>>>>>>>> define t.QryExpr.ReturnType    for "Return type"
64402>>>>>>>>> define t.QryExpr.EditNumExpr   for "Edit numeric expression"
64402>>>>>>>>> define t.QryExpr.EditStrExpr   for "Edit string expression"
64402>>>>>>>>> define t.QryExpr.EditDatExpr   for "Edit date expression"
64402>>>>>>>>> define t.QryExpr.CreateCC_1    for "Create calculated column"
64402>>>>>>>>> define t.QryExpr.CreateCC_2    for "Edit calculated column (#"
64402>>>>>>>>> define t.QryExpr.Type_Numeric  for "Numeric"
64402>>>>>>>>> define t.QryExpr.Type_String   for "String"
64402>>>>>>>>> define t.QryExpr.Type_Text     for "Text"
64402>>>>>>>>> define t.QryExpr.Type_Date     for "Date"
64402>>>>>>>>> define t.QryExpr.DecimalPlaces for "Decimal places"
64402>>>>>>>>>
64402>>>>>>>>>// The cVirtualMachine is subclassed in order to
64402>>>>>>>>>class cQueryExpressionVirtualMachine is a cVirtualMachine
64403>>>>>>>>>  procedure construct_object integer liImage
64405>>>>>>>>>    forward send construct_object liImage
64407>>>>>>>>>    property integer pbAllowAllState public DFFALSE
64408>>>>>>>>>    object oAllowedTables is a cSet NO_IMAGE
64410>>>>>>>>>    end_object
64411>>>>>>>>>  end_procedure
64412>>>>>>>>>
64412>>>>>>>>>  procedure AllowedTables_Reset
64414>>>>>>>>>    send delete_data to (oAllowedTables(self))
64415>>>>>>>>>  end_procedure
64416>>>>>>>>>  procedure AllowedTables_Add integer liFile
64418>>>>>>>>>    send element_add to (oAllowedTables(self)) liFile
64419>>>>>>>>>  end_procedure
64420>>>>>>>>>
64420>>>>>>>>>  function iFileField.s string lsSymbol returns integer
64422>>>>>>>>>    string lsFile lsField
64422>>>>>>>>>    integer liFile liField lhFdx liRval
64422>>>>>>>>>    move (uppercase(ExtractWord(lsSymbol,".",1))) to lsFile
64423>>>>>>>>>    move (uppercase(ExtractWord(lsSymbol,".",2))) to lsField
64424>>>>>>>>>    get phFDX_Server to lhFdx
64425>>>>>>>>>    if (lsFile<>"" and lsField<>"") begin
64427>>>>>>>>>      get FDX_FindLogicalName lhFdx lsFile 0 to liFile
64428>>>>>>>>>      if (liFile>-1 and (pbAllowAllState(self) or element_find(oAllowedTables(self),liFile)<>-1)) begin
64430>>>>>>>>>        forward get iFileField.s lsSymbol to liRval
64432>>>>>>>>>        function_return liRval
64433>>>>>>>>>      end
64433>>>>>>>>>>
64433>>>>>>>>>    end
64433>>>>>>>>>>
64433>>>>>>>>>    function_return 0
64434>>>>>>>>>  end_function
64435>>>>>>>>>end_class // cQueryExpressionVirtualMachine
64436>>>>>>>>>
64436>>>>>>>>>class cQueryExpression is a cScriptInterpreter
64437>>>>>>>>>  procedure construct_object integer liImage
64439>>>>>>>>>    forward send construct_object liImage
64441>>>>>>>>>    set piListingFileState to DFFALSE
64442>>>>>>>>>    object oArray is a cArray NO_IMAGE
64444>>>>>>>>>    end_object
64445>>>>>>>>>  end_procedure
64446>>>>>>>>>  function sPrepareExpression.s string lsExpression returns string
64448>>>>>>>>>    integer lhArr liPos
64448>>>>>>>>>    string lsChar10
64448>>>>>>>>>    move (oArray(self)) to lhArr
64449>>>>>>>>>    move (character(10)) to lsChar10
64450>>>>>>>>>    send delete_data to lhArr
64451>>>>>>>>>    repeat
64451>>>>>>>>>>
64451>>>>>>>>>      move (pos(lsChar10,lsExpression)) to liPos
64452>>>>>>>>>      if liPos begin
64454>>>>>>>>>        set value of lhArr item (item_count(lhArr)) to liPos
64455>>>>>>>>>        move (replace(lsChar10,lsExpression,"")) to lsExpression
64456>>>>>>>>>      end
64456>>>>>>>>>>
64456>>>>>>>>>    until (liPos=0)
64458>>>>>>>>>    function_return lsExpression
64459>>>>>>>>>  end_function
64460>>>>>>>>>  function iTheRealErrorPosition integer liErrorPos returns integer
64462>>>>>>>>>    integer lhArr liItem liMax liLen liLine
64462>>>>>>>>>    move (oArray(self)) to lhArr
64463>>>>>>>>>    get item_count of lhArr to liMax
64464>>>>>>>>>    move 0 to liItem
64465>>>>>>>>>    move 1 to liLine
64466>>>>>>>>>    repeat
64466>>>>>>>>>>
64466>>>>>>>>>      if (liItem>>>>>>>>        get value of lhArr item liItem to liLen
64469>>>>>>>>>        if (liErrorPos>liLen) begin
64471>>>>>>>>>          move (liErrorPos-liLen+1) to liErrorPos
64472>>>>>>>>>          increment liLine
64473>>>>>>>>>        end
64473>>>>>>>>>>
64473>>>>>>>>>        else function_return (liLine*65536+liErrorPos)
64475>>>>>>>>>        increment liItem
64476>>>>>>>>>      end
64476>>>>>>>>>>
64476>>>>>>>>>    until (liItem>=liMax)
64478>>>>>>>>>    function_return (liLine*65536+liErrorPos)
64479>>>>>>>>>  end_function
64480>>>>>>>>>end_class // cQueryExpression
64481>>>>>>>>>
64481>>>>>>>>>desktop_section
64486>>>>>>>>>  object Query_ExprEvaluator is a cQueryExpressionVirtualMachine NO_IMAGE
64488>>>>>>>>>  end_object
64489>>>>>>>>>
64489>>>>>>>>>  object Query_ExprParser is a cQueryExpression NO_IMAGE
64491>>>>>>>>>    set pVM_Object to (Query_ExprEvaluator(self))
64492>>>>>>>>>    procedure AllowedTables_Reset
64495>>>>>>>>>      send AllowedTables_Reset to (pVM_Object(self))
64496>>>>>>>>>    end_procedure
64497>>>>>>>>>    procedure AllowedTables_Add integer liFile
64500>>>>>>>>>      send AllowedTables_Add to (pVM_Object(self)) liFile
64501>>>>>>>>>    end_procedure
64502>>>>>>>>>    procedure set pbAllowAllState integer lbValue
64505>>>>>>>>>      set pbAllowAllState of (pVM_Object(self)) to lbValue
64506>>>>>>>>>    end_procedure
64507>>>>>>>>>  end_object
64508>>>>>>>>>end_desktop_section
64513>>>>>>>>>
64513>>>>>>>>>class Query_cExprArrayErrors is a cArray
64514>>>>>>>>>  item_property_list
64514>>>>>>>>>    item_property integer piExprRow.i
64514>>>>>>>>>    item_property string  psError.i
64514>>>>>>>>>    item_property integer piErrorPos.i
64514>>>>>>>>>  end_item_property_list Query_cExprArrayErrors
#REM 64549 DEFINE FUNCTION PIERRORPOS.I INTEGER LIROW RETURNS INTEGER
#REM 64553 DEFINE PROCEDURE SET PIERRORPOS.I INTEGER LIROW INTEGER VALUE
#REM 64557 DEFINE FUNCTION PSERROR.I INTEGER LIROW RETURNS STRING
#REM 64561 DEFINE PROCEDURE SET PSERROR.I INTEGER LIROW STRING VALUE
#REM 64565 DEFINE FUNCTION PIEXPRROW.I INTEGER LIROW RETURNS INTEGER
#REM 64569 DEFINE PROCEDURE SET PIEXPRROW.I INTEGER LIROW INTEGER VALUE
64574>>>>>>>>>  procedure Show_Errors
64576>>>>>>>>>    integer liRow liMax
64576>>>>>>>>>    get row_count to liMax
64577>>>>>>>>>    decrement liMax
64578>>>>>>>>>    for liRow from 0 to liMax
64584>>>>>>>>>>
64584>>>>>>>>>      show (piExprRow.i (self,liRow)) " "
64586>>>>>>>>>      show (psError.i   (self,liRow)) " "
64588>>>>>>>>>      showln (piErrorPos.i(self,liRow))
64590>>>>>>>>>    loop
64591>>>>>>>>>>
64591>>>>>>>>>  end_procedure
64592>>>>>>>>>  procedure AddError integer liExprRow string lsError integer liErrorPos
64594>>>>>>>>>    integer liRow
64594>>>>>>>>>    get row_count to liRow
64595>>>>>>>>>    set piExprRow.i  liRow to liExprRow
64596>>>>>>>>>    set psError.i    liRow to lsError
64597>>>>>>>>>    set piErrorPos.i liRow to liErrorPos
64598>>>>>>>>>  end_procedure
64599>>>>>>>>>end_class // Query_cExprArrayErrors
64600>>>>>>>>>
64600>>>>>>>>>class Query_cExprArray is a cArray NO_IMAGE
64601>>>>>>>>>  procedure construct_object integer liImage
64603>>>>>>>>>    forward send construct_object liImage
64605>>>>>>>>>    object oInterpreterErrors is a Query_cExprArrayErrors
64607>>>>>>>>>    end_object
64608>>>>>>>>>  end_procedure
64609>>>>>>>>>  item_property_list
64609>>>>>>>>>    item_property string  psLongLabel.i
64609>>>>>>>>>    item_property string  psLabel.i
64609>>>>>>>>>    item_property integer piType.i
64609>>>>>>>>>    item_property integer piWidth.i
64609>>>>>>>>>    item_property integer piDecimals.i
64609>>>>>>>>>
64609>>>>>>>>>    item_property string  psExpression.i
64609>>>>>>>>>    item_property integer piExprId.i       // Temporarily used when compiled
64609>>>>>>>>>    item_property integer pbCleanupInUse.i        // Temporarily used when cleaning up
64609>>>>>>>>>    item_property integer pbCleanupNewRow.i
64609>>>>>>>>>  end_item_property_list Query_cExprArray
#REM 64662 DEFINE FUNCTION PBCLEANUPNEWROW.I INTEGER LIROW RETURNS INTEGER
#REM 64666 DEFINE PROCEDURE SET PBCLEANUPNEWROW.I INTEGER LIROW INTEGER VALUE
#REM 64670 DEFINE FUNCTION PBCLEANUPINUSE.I INTEGER LIROW RETURNS INTEGER
#REM 64674 DEFINE PROCEDURE SET PBCLEANUPINUSE.I INTEGER LIROW INTEGER VALUE
#REM 64678 DEFINE FUNCTION PIEXPRID.I INTEGER LIROW RETURNS INTEGER
#REM 64682 DEFINE PROCEDURE SET PIEXPRID.I INTEGER LIROW INTEGER VALUE
#REM 64686 DEFINE FUNCTION PSEXPRESSION.I INTEGER LIROW RETURNS STRING
#REM 64690 DEFINE PROCEDURE SET PSEXPRESSION.I INTEGER LIROW STRING VALUE
#REM 64694 DEFINE FUNCTION PIDECIMALS.I INTEGER LIROW RETURNS INTEGER
#REM 64698 DEFINE PROCEDURE SET PIDECIMALS.I INTEGER LIROW INTEGER VALUE
#REM 64702 DEFINE FUNCTION PIWIDTH.I INTEGER LIROW RETURNS INTEGER
#REM 64706 DEFINE PROCEDURE SET PIWIDTH.I INTEGER LIROW INTEGER VALUE
#REM 64710 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 64714 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 64718 DEFINE FUNCTION PSLABEL.I INTEGER LIROW RETURNS STRING
#REM 64722 DEFINE PROCEDURE SET PSLABEL.I INTEGER LIROW STRING VALUE
#REM 64726 DEFINE FUNCTION PSLONGLABEL.I INTEGER LIROW RETURNS STRING
#REM 64730 DEFINE PROCEDURE SET PSLONGLABEL.I INTEGER LIROW STRING VALUE
64735>>>>>>>>>
64735>>>>>>>>>  function iInterpretAll returns integer // DFTRUE means OK
64737>>>>>>>>>    integer liRow liMax liErrorPos liExprId lbRval liError
64737>>>>>>>>>    string lsExpression lsError lsMessage
64737>>>>>>>>>    move DFTRUE to lbRval
64738>>>>>>>>>    send delete_data to (oInterpreterErrors(self))
64739>>>>>>>>>    get row_count to liMax
64740>>>>>>>>>    send script_begin to (Query_ExprParser(self))
64741>>>>>>>>>    decrement liMax
64742>>>>>>>>>    for liRow from 0 to liMax
64748>>>>>>>>>>
64748>>>>>>>>>      set piExprId.i liRow to -1
64749>>>>>>>>>      get psExpression.i liRow to lsExpression
64750>>>>>>>>>      // This puts the expression in one line:
64750>>>>>>>>>      get sPrepareExpression.s of (Query_ExprParser(self)) lsExpression to lsExpression
64751>>>>>>>>>      if (trim(lsExpression)<>"") begin
64753>>>>>>>>>        send delete_data to (oScriptErrors(Query_ExprParser(self)))
64754>>>>>>>>>        get iParse_Expr.s of (Query_ExprParser(self)) lsExpression to liErrorPos
64755>>>>>>>>>        if (liErrorPos=0) begin
64757>>>>>>>>>          get piExprID of (Query_ExprParser(self)) to liExprId
64758>>>>>>>>>          set piExprId.i liRow to liExprId
64759>>>>>>>>>        end
64759>>>>>>>>>>
64759>>>>>>>>>        else begin
64760>>>>>>>>>          get iTheRealErrorPosition of (Query_ExprParser(self)) liErrorPos to liErrorPos
64761>>>>>>>>>          get piError.i   of (oScriptErrors(Query_ExprParser(self))) 0 to liError
64762>>>>>>>>>          get psMessage.i of (oScriptErrors(Query_ExprParser(self))) 0 to lsMessage
64763>>>>>>>>>          move (ScriptError_Text(liError)) to lsError
64764>>>>>>>>>          move (lsError+", "+lsMessage) to lsError
64765>>>>>>>>>          send AddError to (oInterpreterErrors(self)) liRow lsError liErrorPos
64766>>>>>>>>>          move DFFALSE to lbRval
64767>>>>>>>>>        end
64767>>>>>>>>>>
64767>>>>>>>>>      end
64767>>>>>>>>>>
64767>>>>>>>>>      else begin
64768>>>>>>>>>        send AddError to (oInterpreterErrors(self)) liRow "Empty expression" 0
64769>>>>>>>>>        move DFFALSE to lbRval
64770>>>>>>>>>      end
64770>>>>>>>>>>
64770>>>>>>>>>    loop
64771>>>>>>>>>>
64771>>>>>>>>>    send script_end to (Query_ExprParser(self))
64772>>>>>>>>>    function_return lbRval
64773>>>>>>>>>  end_function
64774>>>>>>>>>
64774>>>>>>>>>  procedure DisplayErrors
64776>>>>>>>>>    send Show_Errors to (oInterpreterErrors(self))
64777>>>>>>>>>    send obs "Errors were found"
64778>>>>>>>>>  end_procedure
64779>>>>>>>>>
64779>>>>>>>>>  procedure SEQ_Write integer liChannel
64781>>>>>>>>>    integer liRow liMax
64781>>>>>>>>>    string lsExpression
64781>>>>>>>>>    get row_count to liMax
64782>>>>>>>>>    decrement liMax
64783>>>>>>>>>    writeln channel liChannel (row_count(self)-1)
64786>>>>>>>>>    for liRow from 0 to liMax
64792>>>>>>>>>>
64792>>>>>>>>>      writeln (psLongLabel.i(self,liRow))
64794>>>>>>>>>      writeln (psLabel.i(self,liRow))
64796>>>>>>>>>      writeln (piType.i(self,liRow))
64798>>>>>>>>>      writeln (piWidth.i(self,liRow))
64800>>>>>>>>>      writeln (piDecimals.i(self,liRow))
64802>>>>>>>>>      get psExpression.i liRow to lsExpression
64803>>>>>>>>>      writeln (length(lsExpression))
64805>>>>>>>>>      write lsExpression
64806>>>>>>>>>    loop
64807>>>>>>>>>>
64807>>>>>>>>>  end_procedure
64808>>>>>>>>>  procedure SEQ_Read integer liChannel
64810>>>>>>>>>    integer liRow liMax liLen
64810>>>>>>>>>    string lsExpression
64810>>>>>>>>>    send delete_data
64811>>>>>>>>>    readln channel liChannel liMax
64813>>>>>>>>>    for liRow from 0 to liMax
64819>>>>>>>>>>
64819>>>>>>>>>      set psLongLabel.i liRow to (SEQ_ReadLn(liChannel))
64820>>>>>>>>>      set psLabel.i     liRow to (SEQ_ReadLn(liChannel))
64821>>>>>>>>>      set piType.i      liRow to (SEQ_ReadLn(liChannel))
64822>>>>>>>>>      set piWidth.i     liRow to (SEQ_ReadLn(liChannel))
64823>>>>>>>>>      set piDecimals.i  liRow to (SEQ_ReadLn(liChannel))
64824>>>>>>>>>      readln liLen
64825>>>>>>>>>      read_block lsExpression liLen
64826>>>>>>>>>      set psExpression.i liRow to lsExpression
64827>>>>>>>>>    loop
64828>>>>>>>>>>
64828>>>>>>>>>  end_procedure
64829>>>>>>>>>
64829>>>>>>>>>  procedure CleanUp_Prepare
64831>>>>>>>>>    integer liRow liMax
64831>>>>>>>>>    get row_count to liMax
64832>>>>>>>>>    decrement liMax
64833>>>>>>>>>    for liRow from 0 to liMax
64839>>>>>>>>>>
64839>>>>>>>>>      set pbCleanupInUse.i  liRow to DFFALSE
64840>>>>>>>>>      set pbCleanupNewRow.i liRow to -1
64841>>>>>>>>>    loop
64842>>>>>>>>>>
64842>>>>>>>>>  end_procedure
64843>>>>>>>>>  procedure CleanUp_MarkAsUsed integer liRow
64845>>>>>>>>>    set pbCleanupInUse.i liRow to DFTRUE
64846>>>>>>>>>  end_procedure
64847>>>>>>>>>  procedure CleanUp_CalcNewRow
64849>>>>>>>>>    integer liRow liMax liNewRow
64849>>>>>>>>>    move 0 to liNewRow
64850>>>>>>>>>    get row_count to liMax
64851>>>>>>>>>    decrement liMax
64852>>>>>>>>>    for liRow from 0 to liMax
64858>>>>>>>>>>
64858>>>>>>>>>      if (pbCleanupInUse.i(self,liRow)) begin
64860>>>>>>>>>        set pbCleanupNewRow.i liRow to liNewRow
64861>>>>>>>>>        increment liNewRow
64862>>>>>>>>>      end
64862>>>>>>>>>>
64862>>>>>>>>>    loop
64863>>>>>>>>>>
64863>>>>>>>>>  end_procedure
64864>>>>>>>>>  procedure CleanUp_Purge
64866>>>>>>>>>    integer liRow liMax
64866>>>>>>>>>    get row_count to liMax
64867>>>>>>>>>    decrement liMax
64868>>>>>>>>>    for_ex liRow from liMax down_to 0
64875>>>>>>>>>      ifnot (pbCleanupInUse.i(self,liRow)) send delete_row liRow
64878>>>>>>>>>    loop
64879>>>>>>>>>>
64879>>>>>>>>>  end_procedure
64880>>>>>>>>>end_class // Query_cExprArray
64881>>>>>>>>>
64881>>>>>>>>>
64881>>>>>>>>>// UI Part
64881>>>>>>>>>
64881>>>>>>>>>Use Edit.utl     // cEditor class
Including file: edit.utl    (C:\projects\BRS\VDFQuery\AppSrc\edit.utl)
64881>>>>>>>>>>>// Use Edit.utl     // cEditor class
64881>>>>>>>>>>>
64881>>>>>>>>>>>Use Files.utl    // Utilities for handling file related stuff
64881>>>>>>>>>>>Use Strings.utl  // String manipulation for VDF
64881>>>>>>>>>>>
64881>>>>>>>>>>>class cEditor is an aps.Edit
64882>>>>>>>>>>>  procedure construct_object integer img#
64884>>>>>>>>>>>    if num_arguments gt 0 forward send construct_object img#
64888>>>>>>>>>>>    else forward send construct_object
64891>>>>>>>>>>>    property integer piLeadInKey private 0 // 0=none, 1=cQ, 2=cK
64892>>>>>>>>>>>    on_key key_ctrl+key_right_arrow send word_right
64893>>>>>>>>>>>    on_key key_ctrl+key_left_arrow  send word_left
64894>>>>>>>>>>>  end_procedure
64895>>>>>>>>>>>  procedure word_left
64897>>>>>>>>>>>    send key kword_left
64898>>>>>>>>>>>  end_procedure
64899>>>>>>>>>>>  procedure word_right
64901>>>>>>>>>>>    send key kword_right
64902>>>>>>>>>>>  end_procedure
64903>>>>>>>>>>>  procedure display_position
64905>>>>>>>>>>>  end_procedure
64906>>>>>>>>>>>  procedure block_cut
64908>>>>>>>>>>>    send copy 1 clipboard true
64909>>>>>>>>>>>    set dynamic_update_state to true
64910>>>>>>>>>>>  end_procedure
64911>>>>>>>>>>>  procedure block_copy
64913>>>>>>>>>>>    send copy 0 clipboard true
64914>>>>>>>>>>>    set dynamic_update_state to true
64915>>>>>>>>>>>  end_procedure
64916>>>>>>>>>>>  procedure buffer_insert
64918>>>>>>>>>>>    send beginning_of_data to clipboard
64919>>>>>>>>>>>    send mark_on
64920>>>>>>>>>>>    send end_of_data to clipboard
64921>>>>>>>>>>>    send paste to clipboard 0 self 0
64922>>>>>>>>>>>    set dynamic_update_state to true
64923>>>>>>>>>>>  end_procedure
64924>>>>>>>>>>>  procedure line_mark
64926>>>>>>>>>>>    integer pos#
64926>>>>>>>>>>>    get position to pos#
64927>>>>>>>>>>>    send move_absolute (hi(pos#)) 0
64928>>>>>>>>>>>    send mark_on
64929>>>>>>>>>>>  end_procedure
64930>>>>>>>>>>>  procedure block_delete
64932>>>>>>>>>>>    send cut false clipboard true
64933>>>>>>>>>>>  end_procedure
64934>>>>>>>>>>>  procedure external_edit
64936>>>>>>>>>>>    string path#
64936>>>>>>>>>>>    send write "extedit.tmp" 0
64937>>>>>>>>>>>     runprogram wait "e extedit.tmp"
64938>>>>>>>>>>>    send delete_data
64939>>>>>>>>>>>    send read "extedit.tmp"
64940>>>>>>>>>>>    get SEQ_FindFileAlongDfPath "extedit.tmp" to path#
64941>>>>>>>>>>>    get SEQ_ComposeAbsoluteFileName path# "extedit.tmp" to path#
64942>>>>>>>>>>>    get SEQ_TranslatePathToAbsolute path# to path#
64943>>>>>>>>>>>    erasefile path#
64944>>>>>>>>>>>>
64944>>>>>>>>>>>    send refresh_screen
64945>>>>>>>>>>>    send beginning_of_data
64946>>>>>>>>>>>  end_procedure
64947>>>>>>>>>>>  procedure key integer key#
64949>>>>>>>>>>>    integer LeadInKey#
64949>>>>>>>>>>>    get cEditor.piLeadInKey to LeadInKey#
64950>>>>>>>>>>>    if LeadInKey# eq 1 begin // LeadIn=Q?
64952>>>>>>>>>>>      if key# eq key_ctrl+key_y send delete_to_eol
64955>>>>>>>>>>>      set cEditor.piLeadInKey to 0
64956>>>>>>>>>>>    end
64956>>>>>>>>>>>>
64956>>>>>>>>>>>    else if LeadInKey# eq 2 begin // LeadIn=K?
64959>>>>>>>>>>>      if key# eq key_ctrl+key_h send mark_off
64962>>>>>>>>>>>      if key# eq key_ctrl+key_b send mark_on
64965>>>>>>>>>>>      if key# eq key_ctrl+key_y send block_delete
64968>>>>>>>>>>>      set cEditor.piLeadInKey to 0
64969>>>>>>>>>>>    end
64969>>>>>>>>>>>>
64969>>>>>>>>>>>    else begin
64970>>>>>>>>>>>      if key# eq key_ctrl+key_q set cEditor.piLeadInKey to 1
64973>>>>>>>>>>>      else if key# eq key_ctrl+key_k set cEditor.piLeadInKey to 2
64977>>>>>>>>>>>      else begin
64978>>>>>>>>>>>        set cEditor.piLeadInKey to 0
64979>>>>>>>>>>>        if key# eq key_ctrl+key_y send delete_line
64982>>>>>>>>>>>        else if key# eq key_alt+key_k  send mark_on
64986>>>>>>>>>>>        else if key# eq key_alt+key_l  send line_mark
64990>>>>>>>>>>>        else if key# eq key_ctrl+key_c send block_copy
64994>>>>>>>>>>>        else if key# eq key_ctrl+key_v send buffer_insert
64998>>>>>>>>>>>        else if key# eq key_ctrl+key_x send block_cut
65002>>>>>>>>>>>        else if key# eq key_alt+key_u  send mark_off
65006>>>>>>>>>>>        else if key# eq key_alt+key_e  send external_edit
65010>>>>>>>>>>>        else forward send key key#
65013>>>>>>>>>>>      end
65013>>>>>>>>>>>>
65013>>>>>>>>>>>    end
65013>>>>>>>>>>>>
65013>>>>>>>>>>>    send display_position
65014>>>>>>>>>>>  end_procedure
65015>>>>>>>>>>>  procedure set psValueAsString string str#
65017>>>>>>>>>>>    send Text_SetEditObjectValue self str#
65018>>>>>>>>>>>  end_procedure
65019>>>>>>>>>>>  function psValueAsString returns string // That's a parameter for a global function
65021>>>>>>>>>>>    function_return (Text_EditObjectValue(self))
65022>>>>>>>>>>>  end_function
65023>>>>>>>>>>>end_class
65024>>>>>>>>>
65024>>>>>>>>>class cQuery_ExpressionEditorUndoer is a cArray
65025>>>>>>>>>  procedure construct_object integer liImage
65027>>>>>>>>>    forward send construct_object liImage
65029>>>>>>>>>    property integer piCurrentUndoPos public 0
65030>>>>>>>>>  end_procedure
65031>>>>>>>>>  item_property_list
65031>>>>>>>>>    item_property integer piCursor.i
65031>>>>>>>>>    item_property integer piSelectRange.i
65031>>>>>>>>>    item_property string  psValue.i
65031>>>>>>>>>    item_property string  psOperation.i
65031>>>>>>>>>  end_item_property_list cQuery_ExpressionEditorUndoer
#REM 65069 DEFINE FUNCTION PSOPERATION.I INTEGER LIROW RETURNS STRING
#REM 65073 DEFINE PROCEDURE SET PSOPERATION.I INTEGER LIROW STRING VALUE
#REM 65077 DEFINE FUNCTION PSVALUE.I INTEGER LIROW RETURNS STRING
#REM 65081 DEFINE PROCEDURE SET PSVALUE.I INTEGER LIROW STRING VALUE
#REM 65085 DEFINE FUNCTION PISELECTRANGE.I INTEGER LIROW RETURNS INTEGER
#REM 65089 DEFINE PROCEDURE SET PISELECTRANGE.I INTEGER LIROW INTEGER VALUE
#REM 65093 DEFINE FUNCTION PICURSOR.I INTEGER LIROW RETURNS INTEGER
#REM 65097 DEFINE PROCEDURE SET PICURSOR.I INTEGER LIROW INTEGER VALUE
65102>>>>>>>>>  procedure ReadCurrentState string lsOperation
65104>>>>>>>>>    integer liRow lhParent liPosition
65104>>>>>>>>>    string lsValue
65104>>>>>>>>>    move (parent(self)) to lhParent
65105>>>>>>>>>    get piCurrentUndoPos to liRow
65106>>>>>>>>>    get position of lhParent to liPosition
65107>>>>>>>>>    get Text_EditObjectValue lhParent to lsValue
65108>>>>>>>>>    set piCursor.i      liRow to liPosition
65109>>>>>>>>>//    showln "Snup " liPosition
65109>>>>>>>>>    set piSelectRange.i liRow to 0
65110>>>>>>>>>    set psValue.i       liRow to lsValue
65111>>>>>>>>>    set psOperation.i   liRow to lsOperation
65112>>>>>>>>>    increment liRow
65113>>>>>>>>>    set piCurrentUndoPos to liRow
65114>>>>>>>>>  end_procedure
65115>>>>>>>>>  procedure DoReset
65117>>>>>>>>>    send delete_data
65118>>>>>>>>>    set piCurrentUndoPos to 0
65119>>>>>>>>>  end_procedure
65120>>>>>>>>>  procedure SetCurrentState integer liRow
65122>>>>>>>>>    integer liPosition lhParent
65122>>>>>>>>>    string lsValue
65122>>>>>>>>>    move (parent(self)) to lhParent
65123>>>>>>>>>    get piCursor.i liRow to liPosition
65124>>>>>>>>>    get psValue.i  liRow to lsValue
65125>>>>>>>>>    send Text_SetEditObjectValue lhParent lsValue
65126>>>>>>>>>//    showln "Oooog Vrsgo " liPosition
65126>>>>>>>>>    send move_absolute to lhParent (hi(liPosition)) (low(liPosition))
65127>>>>>>>>>  end_procedure
65128>>>>>>>>>  function iIncrementCurrentUndoPos integer liBy returns integer
65130>>>>>>>>>    integer liCurrentUndoPos
65130>>>>>>>>>    get piCurrentUndoPos to liCurrentUndoPos
65131>>>>>>>>>    move (liCurrentUndoPos+liBy) to liCurrentUndoPos
65132>>>>>>>>>    if (liCurrentUndoPos>0 and liCurrentUndoPos>>>>>>>>      set piCurrentUndoPos to liCurrentUndoPos
65135>>>>>>>>>      function_return DFTRUE
65136>>>>>>>>>    end
65136>>>>>>>>>>
65136>>>>>>>>>    function_return DFFALSE
65137>>>>>>>>>  end_function
65138>>>>>>>>>  procedure ReDo
65140>>>>>>>>>    if (iIncrementCurrentUndoPos(self,1)) send SetCurrentState (piCurrentUndoPos(self))
65143>>>>>>>>>    else send bell to desktop
65145>>>>>>>>>  end_procedure
65146>>>>>>>>>  procedure UnDo
65148>>>>>>>>>    if (iIncrementCurrentUndoPos(self,-1)) send SetCurrentState (piCurrentUndoPos(self))
65151>>>>>>>>>    else send bell to desktop
65153>>>>>>>>>  end_procedure
65154>>>>>>>>>end_class // cQuery_ExpressionEditorUndoer
65155>>>>>>>>>
65155>>>>>>>>>
65155>>>>>>>>>class cQuery_ExpressionEditor is a cEditor
65156>>>>>>>>>  procedure construct_object integer liImage
65158>>>>>>>>>    forward send construct_object liImage
65160>>>>>>>>>    property integer piRequiredType public 0
65161>>>>>>>>>    set typeface to "Courier New"
65162>>>>>>>>>    object oUnDo is a cQuery_ExpressionEditorUndoer NO_IMAGE
65164>>>>>>>>>    end_object
65165>>>>>>>>>    on_key KEY_CTRL+KEY_U send undo
65166>>>>>>>>>    on_key KEY_CTRL+KEY_Z send redo
65167>>>>>>>>>
65167>>>>>>>>>    property integer piExpressionType // TYPE.UNKNOWN TYPE.UNTYPED TYPE.INTEGER TYPE.DATE TYPE.NUMBER TYPE.STRING
65168>>>>>>>>>  end_procedure
65169>>>>>>>>>
65169>>>>>>>>>  procedure DoClear
65171>>>>>>>>>    send delete_data
65172>>>>>>>>>  end_procedure
65173>>>>>>>>>
65173>>>>>>>>>  function bContentsNotOK returns integer
65175>>>>>>>>>    integer lbError
65175>>>>>>>>>    string lsExpression
65175>>>>>>>>>
65175>>>>>>>>>    get Text_EditObjectValue self to lsExpression
65176>>>>>>>>>    get sPrepareExpression.s of (Query_ExprParser(self)) lsExpression to lsExpression
65177>>>>>>>>>
65177>>>>>>>>>    send script_begin to (Query_ExprParser(self))
65178>>>>>>>>>    get iParse_Expr.s of (Query_ExprParser(self)) lsExpression to lbError
65179>>>>>>>>>    set piExpressionType to (piExprType(Query_ExprParser(self)))
65180>>>>>>>>>    send script_end to (Query_ExprParser(self))
65181>>>>>>>>>    function_return lbError
65182>>>>>>>>>  end_function
65183>>>>>>>>>
65183>>>>>>>>>  procedure GotoErrorPos integer liErrorPos
65185>>>>>>>>>    if liErrorPos begin
65187>>>>>>>>>      get iTheRealErrorPosition of (Query_ExprParser(self)) liErrorPos to liErrorPos
65188>>>>>>>>>      send activate
65189>>>>>>>>>      send move_absolute (hi(liErrorPos)-1) (low(liErrorPos)-1)
65190>>>>>>>>>    end
65190>>>>>>>>>>
65190>>>>>>>>>  end_procedure
65191>>>>>>>>>  procedure UnDo
65193>>>>>>>>>    send UnDo to (oUndo(self))
65194>>>>>>>>>  end_procedure
65195>>>>>>>>>  procedure Redo
65197>>>>>>>>>    send ReDo to (oUndo(self))
65198>>>>>>>>>  end_procedure
65199>>>>>>>>>  procedure Insert string lsValue
65201>>>>>>>>>    send ReadCurrentState to (oUndo(self)) "Indst"
65202>>>>>>>>>    forward send Insert lsValue
65204>>>>>>>>>  end_procedure
65205>>>>>>>>>end_class // cQuery_ExpressionEditor
65206>>>>>>>>>
65206>>>>>>>>>class QryExprTableList is a aps.List
65207>>>>>>>>>  procedure construct_object integer liImage
65209>>>>>>>>>    forward send construct_object liImage
65211>>>>>>>>>  end_procedure
65212>>>>>>>>>  procedure fill_list
65214>>>>>>>>>    integer lhSet liItem liMax liFile
65214>>>>>>>>>    set dynamic_update_state to DFFALSE
65215>>>>>>>>>    send delete_data
65216>>>>>>>>>    move (oAllowedTables(Query_ExprEvaluator(self))) to lhSet
65217>>>>>>>>>    get item_count of lhSet to liMax
65218>>>>>>>>>    decrement liMax
65219>>>>>>>>>    for liItem from 0 to liMax
65225>>>>>>>>>>
65225>>>>>>>>>      get value of lhSet item liItem to liFile
65226>>>>>>>>>      send add_item MSG_NONE (FDX_AttrValue_FILELIST(0,DF_FILE_LOGICAL_NAME,liFile))
65227>>>>>>>>>      set aux_value item (item_count(self)-1) to liFile
65228>>>>>>>>>    loop
65229>>>>>>>>>>
65229>>>>>>>>>    set dynamic_update_state to DFTRUE
65230>>>>>>>>>    set current_item to 0
65231>>>>>>>>>    send OnChange
65232>>>>>>>>>  end_procedure
65233>>>>>>>>>  procedure OnChange
65235>>>>>>>>>    integer liFile
65235>>>>>>>>>    get aux_value item (current_item(self)) to liFile
65236>>>>>>>>>    send DoFillFields liFile
65237>>>>>>>>>  end_procedure
65238>>>>>>>>>  procedure item_change integer liItem1 integer liItem2 returns integer
65240>>>>>>>>>    integer liRval liFile
65240>>>>>>>>>    forward get msg_item_change liItem1 liItem2 to liRval
65242>>>>>>>>>    procedure_return liRval
65243>>>>>>>>>  end_procedure
65244>>>>>>>>>end_class // QryExprTableList
65245>>>>>>>>>
65245>>>>>>>>>class QryExprFieldList is a aps.List
65246>>>>>>>>>  procedure construct_object integer liImage
65248>>>>>>>>>    forward send construct_object liImage
65250>>>>>>>>>    property integer piFile public 0
65251>>>>>>>>>  end_procedure
65252>>>>>>>>>  procedure OnFieldSelect string lsName
65254>>>>>>>>>  end_procedure
65255>>>>>>>>>  procedure InsertField
65257>>>>>>>>>    integer liFile liField liItem
65257>>>>>>>>>    string lsName
65257>>>>>>>>>    get current_item to liItem
65258>>>>>>>>>    get piFile to liFile
65259>>>>>>>>>    get aux_value item liItem to liField
65260>>>>>>>>>    get FDX_FieldName 0 liFile liField DFTRUE to lsName
65261>>>>>>>>>    send OnFieldSelect lsName
65262>>>>>>>>>  end_procedure
65263>>>>>>>>>  procedure HandleField integer liFile integer liField string lsName integer liType integer liLen integer liPrec integer liRelFile integer liRelField integer liIndex integer liOffSet
65265>>>>>>>>>    if (liType<>DF_OVERLAP and liType<>DF_BINARY) begin
65267>>>>>>>>>      send add_item MSG_InsertField lsName
65268>>>>>>>>>      set aux_value item (item_count(self)-1) to liField
65269>>>>>>>>>    end
65269>>>>>>>>>>
65269>>>>>>>>>  end_procedure
65270>>>>>>>>>  procedure fill_list.i integer liFile
65272>>>>>>>>>    integer lhSet liItem liMax
65272>>>>>>>>>    if liFile begin
65274>>>>>>>>>      set piFile to liFile
65275>>>>>>>>>      set dynamic_update_state to DFFALSE
65276>>>>>>>>>      send delete_data
65277>>>>>>>>>      send FDX_FieldCallBack 0 liFile MSG_HandleField self // Protected against relating file not present
65278>>>>>>>>>      set dynamic_update_state to DFTRUE
65279>>>>>>>>>      set current_item to 0
65280>>>>>>>>>    end
65280>>>>>>>>>>
65280>>>>>>>>>  end_procedure
65281>>>>>>>>>//procedure mouse_click integer liItem integer liGrb
65281>>>>>>>>>//  if ((liItem-1)>>>>>>>>//end_procedure
65281>>>>>>>>>  procedure mouse_up integer liItem integer liGrb
65283>>>>>>>>>    if ((liItem-1)>>>>>>>>  end_procedure
65287>>>>>>>>>end_class // QryExprFieldList
65288>>>>>>>>>
65288>>>>>>>>>class QryExprFunctions is a aps.List
65289>>>>>>>>>  procedure InsertFunction
65291>>>>>>>>>  end_procedure
65292>>>>>>>>>  procedure Handle_Function string lsName integer liReturnType string lsParamList string lsLongParamList
65294>>>>>>>>>    integer liLen liPos
65294>>>>>>>>>    string lsValue liChar
65294>>>>>>>>>    move (lsName+"(") to lsValue
65295>>>>>>>>>    move (length(lsParamList)) to liLen
65296>>>>>>>>>    for liPos from 1 to liLen
65302>>>>>>>>>>
65302>>>>>>>>>      move (mid(lsParamList,1,liPos)) to liChar
65303>>>>>>>>>      if (liChar="S") move (lsValue+"s") to lsValue
65306>>>>>>>>>      if (liChar="I") move (lsValue+"i") to lsValue
65309>>>>>>>>>      if (liChar="N") move (lsValue+"n") to lsValue
65312>>>>>>>>>      if (liChar="D") move (lsValue+"d") to lsValue
65315>>>>>>>>>      if (liPos<>liLen) move (lsValue+",") to lsValue
65318>>>>>>>>>    loop
65319>>>>>>>>>>
65319>>>>>>>>>    move (lsValue+")") to lsValue
65320>>>>>>>>>    send add_item MSG_InsertFunction lsValue
65321>>>>>>>>>  end_procedure
65322>>>>>>>>>  procedure fill_list
65324>>>>>>>>>    integer lhObj lhSelf
65324>>>>>>>>>    set dynamic_update_state to DFFALSE
65325>>>>>>>>>    send delete_data
65326>>>>>>>>>    move self to lhSelf
65327>>>>>>>>>    move (oDeclaredFunctions(Query_ExprEvaluator(self))) to lhObj
65328>>>>>>>>>    send reset to lhObj
65329>>>>>>>>>    send CallBack_AllFunctions to lhObj MSG_Handle_Function lhSelf
65330>>>>>>>>>    set dynamic_update_state to DFTRUE
65331>>>>>>>>>  end_procedure
65332>>>>>>>>>end_class //
65333>>>>>>>>>
65333>>>>>>>>>object Query_EditCriteriaExpression is a aps.ModalPanel label t.QryExpr.Expression // "Expression"
65336>>>>>>>>>  set locate_mode to CENTER_ON_SCREEN
65337>>>>>>>>>  on_key ksave_record send close_panel_ok
65338>>>>>>>>>  on_key kcancel send close_panel
65339>>>>>>>>>  property integer piResult public DFFALSE
65341>>>>>>>>>  property string  psExpression public ""
65343>>>>>>>>>  property integer piExprType   public 0
65345>>>>>>>>>  object oEdit is a cQuery_ExpressionEditor
65347>>>>>>>>>    set size to 100 450
65348>>>>>>>>>  end_object
65349>>>>>>>>>  send aps_goto_max_row
65350>>>>>>>>>  object oLbl1 is a aps.TextBox label t.QryExpr.Tables    //"Tabels"
65353>>>>>>>>>  end_object
65354>>>>>>>>>  object oLbl2 is a aps.TextBox label t.QryExpr.Fields    //"Fields"
65357>>>>>>>>>  end_object
65358>>>>>>>>>  object oLbl3 is a aps.TextBox label t.QryExpr.Functions //"Functions"
65361>>>>>>>>>  end_object
65362>>>>>>>>>  send aps_goto_max_row
65363>>>>>>>>>  object oTables is a QryExprTableList
65365>>>>>>>>>    set size to 114 80
65366>>>>>>>>>  end_object
65367>>>>>>>>>  object oFields is a QryExprFieldList
65369>>>>>>>>>    set size to 114 120
65370>>>>>>>>>    procedure OnFieldSelect string lsName
65373>>>>>>>>>      send Insert to (oEdit(self)) lsName
65374>>>>>>>>>      send activate to (oEdit(self))
65375>>>>>>>>>    end_procedure
65376>>>>>>>>>  end_object
65377>>>>>>>>>  procedure DoFillFields integer liFile
65380>>>>>>>>>    send fill_list.i to (oFields(self)) liFile
65381>>>>>>>>>  end_procedure
65382>>>>>>>>>
65382>>>>>>>>>  object oFunctions is a QryExprFunctions
65384>>>>>>>>>    set size to 114 245
65385>>>>>>>>>    procedure InsertFunction
65388>>>>>>>>>      string lsValue
65388>>>>>>>>>      get value item (current_item(self)) to lsValue
65389>>>>>>>>>      send Insert to (oEdit(self)) lsValue
65390>>>>>>>>>      send Activate to (oEdit(self))
65391>>>>>>>>>    end_procedure
65392>>>>>>>>>    procedure mouse_up integer liItem integer liGrb
65395>>>>>>>>>      if ((liItem-1)>>>>>>>>    end_procedure
65399>>>>>>>>>  end_object
65400>>>>>>>>>
65400>>>>>>>>>  send aps_align_by_moving (oLbl1(self)) (oTables(self)) SL_ALIGN_LEFT
65401>>>>>>>>>  send aps_align_by_moving (oLbl2(self)) (oFields(self)) SL_ALIGN_LEFT
65402>>>>>>>>>  send aps_align_by_moving (oLbl3(self)) (oFunctions(self)) SL_ALIGN_LEFT
65403>>>>>>>>>
65403>>>>>>>>>  object oBtn_Ok is a aps.Multi_Button
65405>>>>>>>>>    on_item t.btn.ok send close_panel_ok
65406>>>>>>>>>  end_object
65407>>>>>>>>>  object oBtn_Clear is a aps.Multi_Button
65409>>>>>>>>>    on_item t.btn.clear  send DoClear to (oEdit(self))
65410>>>>>>>>>  end_object
65411>>>>>>>>>  object oBtn_Cancel is a aps.Multi_Button
65413>>>>>>>>>    on_item t.btn.cancel send close_panel
65414>>>>>>>>>  end_object
65415>>>>>>>>>  send aps_locate_multi_buttons
65416>>>>>>>>>  procedure close_panel_ok
65419>>>>>>>>>    integer lbError
65419>>>>>>>>>    get bContentsNotOK of (oEdit(self)) to lbError
65420>>>>>>>>>    ifnot lbError begin
65422>>>>>>>>>      set piResult to DFTRUE
65423>>>>>>>>>      send close_panel
65424>>>>>>>>>    end
65424>>>>>>>>>>
65424>>>>>>>>>    else send GotoErrorPos to (oEdit(self)) lbError
65426>>>>>>>>>  end_procedure
65427>>>>>>>>>
65427>>>>>>>>>  function iPopup.sis string lsExpression integer liRequiredType string lsCaption returns integer
65430>>>>>>>>>    integer liType
65430>>>>>>>>>    set piResult to DFFALSE
65431>>>>>>>>>    send Text_SetEditObjectValue (oEdit(self)) lsExpression
65432>>>>>>>>>    set piRequiredType of (oEdit(self)) to liRequiredType
65433>>>>>>>>>    set label to lsCaption
65434>>>>>>>>>    send fill_list to (oTables(self))
65435>>>>>>>>>    send fill_list to (oFunctions(self))
65436>>>>>>>>>    send popup
65437>>>>>>>>>    if (piResult(self)) begin
65439>>>>>>>>>      set psExpression to (Text_EditObjectValue(oEdit(self)))
65440>>>>>>>>>//      set piExprType
65440>>>>>>>>>
65440>>>>>>>>>      function_return 1
65441>>>>>>>>>    end
65441>>>>>>>>>>
65441>>>>>>>>>    function_return -1
65442>>>>>>>>>  end_function
65443>>>>>>>>>end_object // Query_EditCriteriaExpression
65444>>>>>>>>>
65444>>>>>>>>>object Query_ColumnExpression is a aps.ModalPanel
65446>>>>>>>>>  set locate_mode to CENTER_ON_SCREEN
65447>>>>>>>>>  on_key ksave_record send close_panel_ok
65448>>>>>>>>>  on_key kcancel send close_panel
65449>>>>>>>>>  on_key kuser send testus
65450>>>>>>>>>  property integer piResult public DFFALSE
65452>>>>>>>>>  property string psExpression public ""
65454>>>>>>>>>
65454>>>>>>>>>  object oGrp is a aps.Group
65456>>>>>>>>>    object oLongLabel is a aps.Form label  (t.QryExpr.LongLabel+":") abstract AFT_ASCII30   //"Long label:"
65460>>>>>>>>>    end_object
65461>>>>>>>>>    object oShortLabel is a aps.Form label (t.QryExpr.ShortLabel+":") abstract AFT_ASCII15  // "Short label:"
65465>>>>>>>>>      procedure OnSetFocus
65468>>>>>>>>>        if (value(self,0)="") set value to (value(oLongLabel(self),0))
65471>>>>>>>>>      end_procedure
65472>>>>>>>>>    end_object
65473>>>>>>>>>    object oWidth is a aps.form label (t.QryExpr.Width+":") abstract AFT_NUMERIC2.0
65477>>>>>>>>>    end_object
65478>>>>>>>>>    object oLabel is a aps.TextBox label t.QryExpr._Characters snap SL_RIGHT
65482>>>>>>>>>    end_object
65483>>>>>>>>>    object oExprType is a aps.ComboFormAux label (t.QryExpr.ReturnType+":") abstract AFT_ASCII10
65487>>>>>>>>>      set entry_state item 0 to DFFALSE
65488>>>>>>>>>      send combo_add_item t.QryExpr.Type_Numeric DF_BCD
65489>>>>>>>>>      send combo_add_item t.QryExpr.Type_String  DF_ASCII
65490>>>>>>>>>      send combo_add_item t.QryExpr.Type_Text    DF_TEXT
65491>>>>>>>>>      send combo_add_item t.QryExpr.Type_Date    DF_DATE
65492>>>>>>>>>      register_object oDecimals
65492>>>>>>>>>      procedure OnChange
65495>>>>>>>>>        set enabled_state of (oDecimals(self)) to (Combo_Current_Aux_Value(self)=DF_BCD)
65496>>>>>>>>>      end_procedure
65497>>>>>>>>>    end_object
65498>>>>>>>>>    object oDecimals is a aps.Form label (t.QryExpr.DecimalPlaces+":") abstract AFT_NUMERIC1.0 snap SL_RIGHT_SPACE
65503>>>>>>>>>    end_object
65504>>>>>>>>>    procedure DoExpression
65507>>>>>>>>>      integer liType liTranslatedType liRval
65507>>>>>>>>>      string lsExpression lsCaption
65507>>>>>>>>>      get Combo_Current_Aux_Value of (oExprType(self)) to liType
65508>>>>>>>>>      if (liType=DF_BCD  ) move TYPE.NUMBER to liTranslatedType
65511>>>>>>>>>      if (liType=DF_ASCII) move TYPE.STRING to liTranslatedType
65514>>>>>>>>>      if (liType=DF_TEXT ) move TYPE.STRING to liTranslatedType
65517>>>>>>>>>      if (liType=DF_DATE ) move TYPE.DATE   to liTranslatedType
65520>>>>>>>>>      if (liType=DF_BCD  ) move t.QryExpr.EditNumExpr to lsCaption
65523>>>>>>>>>      if (liType=DF_ASCII) move t.QryExpr.EditStrExpr to lsCaption
65526>>>>>>>>>      if (liType=DF_TEXT ) move t.QryExpr.EditStrExpr to lsCaption
65529>>>>>>>>>      if (liType=DF_DATE ) move t.QryExpr.EditDatExpr to lsCaption
65532>>>>>>>>>      get psExpression to lsExpression
65533>>>>>>>>>      get iPopup.sis of (Query_EditCriteriaExpression(self)) lsExpression liTranslatedType lsCaption to liRval
65534>>>>>>>>>      if (liRval<>-1) set psExpression to (psExpression(Query_EditCriteriaExpression(self)))
65537>>>>>>>>>    end_procedure
65538>>>>>>>>>    send aps_make_row_space 5
65539>>>>>>>>>    object oBtn is a aps.Button
65541>>>>>>>>>      on_item t.btn.Edit send DoExpression
65542>>>>>>>>>    end_object
65543>>>>>>>>>  end_object
65544>>>>>>>>>  object oBtn1 is a aps.Multi_Button
65546>>>>>>>>>    on_item t.btn.ok send close_panel_ok
65547>>>>>>>>>  end_object
65548>>>>>>>>>  object oBtn2 is a aps.Multi_Button
65550>>>>>>>>>    on_item t.btn.cancel send close_panel
65551>>>>>>>>>  end_object
65552>>>>>>>>>  send aps_locate_multi_buttons
65553>>>>>>>>>  procedure aps_beautify
65556>>>>>>>>>    send aps_align_inside_container_by_moving (oBtn(oGrp(self))) SL_ALIGN_CENTER
65557>>>>>>>>>  end_procedure
65558>>>>>>>>>  procedure close_panel_ok
65561>>>>>>>>>    set piResult to DFTRUE
65562>>>>>>>>>    send close_panel
65563>>>>>>>>>  end_procedure
65564>>>>>>>>>
65564>>>>>>>>>  procedure testus
65567>>>>>>>>>    integer liTest
65567>>>>>>>>>    get Combo_Current_Aux_Value of (oExprType(oGrp(self))) item 0 to liTest
65568>>>>>>>>>    send obs liTest
65569>>>>>>>>>  end_procedure
65570>>>>>>>>>
65570>>>>>>>>>  function iPopup.ii integer lhObj integer liRow returns integer
65573>>>>>>>>>    integer liType
65573>>>>>>>>>    if (liRow=-1) begin
65575>>>>>>>>>      set label to t.QryExpr.CreateCC_1 // "Create calculated column"
65576>>>>>>>>>      set value of (oLongLabel(oGrp(self))) item 0 to ""
65577>>>>>>>>>      set value of (oShortLabel(oGrp(self))) item 0 to ""
65578>>>>>>>>>      set value of (oWidth(oGrp(self))) item 0 to 10
65579>>>>>>>>>      set value of (oExprType(oGrp(self))) item 0 to t.QryExpr.Type_Numeric
65580>>>>>>>>>      set value of (oDecimals(oGrp(self))) item 0 to 0
65581>>>>>>>>>      set psExpression to ""
65582>>>>>>>>>    end
65582>>>>>>>>>>
65582>>>>>>>>>    else begin
65583>>>>>>>>>      move (piType.i(lhObj,liRow)) to liType
65584>>>>>>>>>      set label to (t.QryExpr.CreateCC_2+string(liRow)+")")
65585>>>>>>>>>      set value of (oLongLabel (oGrp(self))) item 0 to (psLongLabel.i(lhObj,liRow))
65586>>>>>>>>>      set value of (oShortLabel(oGrp(self))) item 0 to (psLabel.i(lhObj,liRow))
65587>>>>>>>>>      set value of (oWidth(oGrp(self)))      item 0 to (piWidth.i(lhObj,liRow))
65588>>>>>>>>>      set Combo_Current_Aux_Value of (oExprType(oGrp(self))) to liType
65589>>>>>>>>>      set value of (oDecimals(oGrp(self)))   item 0 to (piDecimals.i(lhObj,liRow))
65590>>>>>>>>>      set psExpression to (psExpression.i(lhObj,liRow))
65591>>>>>>>>>    end
65591>>>>>>>>>>
65591>>>>>>>>>    set piResult to DFFALSE
65592>>>>>>>>>    send popup
65593>>>>>>>>>    if (piResult(self)) begin
65595>>>>>>>>>      if (liRow=-1) get row_count of lhObj to liRow
65598>>>>>>>>>      set psLongLabel.i  of lhObj liRow to (value(oLongLabel(oGrp(self)),0))
65599>>>>>>>>>      set psLabel.i      of lhObj liRow to (value(oShortLabel(oGrp(self)),0))
65600>>>>>>>>>      set piType.i       of lhObj liRow to (Combo_Current_Aux_Value(oExprType(oGrp(self))))
65601>>>>>>>>>      set piWidth.i      of lhObj liRow to (value(oWidth(oGrp(self)),0))
65602>>>>>>>>>      set piDecimals.i   of lhObj liRow to (value(oDecimals(oGrp(self)),0))
65603>>>>>>>>>      set psExpression.i of lhObj liRow to (psExpression(self))
65604>>>>>>>>>      function_return liRow
65605>>>>>>>>>    end
65605>>>>>>>>>>
65605>>>>>>>>>    function_return -1
65606>>>>>>>>>  end_function
65607>>>>>>>>>end_object // Query_ColumnExpression
65608>>>>>>>
65608>>>>>>>
65608>>>>>>>
65608>>>>>>>
65608>>>>>>>
65608>>>>>>>
65608>>>>>>>// Function iTranslate_DFTYPE translates from DF attributes to
65608>>>>>>>// selection criteria types.
65608>>>>>>>function iTranslate_DFTYPE integer type# returns integer
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
65610>>>>>>>  if type# eq DF_ASCII   function_return SC_TYPE_ASCII
65613>>>>>>>  if type# eq DF_BCD     function_return SC_TYPE_NUMERIC
65616>>>>>>>  if type# eq DF_DATE    function_return SC_TYPE_DATE
65619>>>>>>>  if type# eq DF_OVERLAP function_return SC_TYPE_ASCII
65622>>>>>>>  if type# eq DF_TEXT    function_return SC_TYPE_ASCII
65625>>>>>>>  if type# eq DF_BINARY  function_return SC_TYPE_ASCII
65628>>>>>>>end_function
65629>>>>>>>
65629>>>>>>>// A cBasicDataScanner sets up the sceleton for more complex scanning
65629>>>>>>>// classes. It was not meant for instantiation. It allows for setting
65629>>>>>>>// up pMainFile, search order and custom sort order for outputting.
65629>>>>>>>class cBasicDataScanner is a cArray
65630>>>>>>>  procedure construct_object
65632>>>>>>>    forward send construct_object
65634>>>>>>>    property integer pMainFile            public 0
65635>>>>>>>    property integer pOrdering            public 0
65636>>>>>>>    property integer phDataSetObject      public 0
65637>>>>>>>    property integer pRecordCount         public 0 // How many records have been selected?
65638>>>>>>>    property integer pScanCount           public 0 // How many records have been scanned?
65639>>>>>>>    property integer pInterrupted         public 0 // 1=user interrupt, 2=error interrupt
65640>>>>>>>    property integer pRelate_State_Select public RS_GENERIC_RELATE // RS_NO_RELATE
65641>>>>>>>    property integer pRelate_State        public RS_GENERIC_RELATE // RS_NO_RELATE
65642>>>>>>>    property integer pCustom_Sort_State   public 0
65643>>>>>>>    property integer pCustom_Sort_Object  public 0
65644>>>>>>>    property integer pFixedLengthRowID    public 8 // Enough to hold a record number
65645>>>>>>>    property integer pCustom_Sort_Dir     public ASCENDING
65646>>>>>>>    object Custom_Sort_Array is a cArray NO_IMAGE
65648>>>>>>>    end_object
65649>>>>>>>  end_procedure
65650>>>>>>>
65650>>>>>>>  procedure initialize
65652>>>>>>>    set pRecordCount to 0
65653>>>>>>>    set pScanCount   to 0
65654>>>>>>>    set pInterrupted to 0
65655>>>>>>>    send delete_data to (Custom_Sort_Array(self))
65656>>>>>>>  end_procedure
65657>>>>>>>
65657>>>>>>>  procedure reset
65659>>>>>>>    send initialize
65660>>>>>>>  end_procedure
65661>>>>>>>
65661>>>>>>>  procedure jump_in
65663>>>>>>>    clear (pMainFile(self))
65664>>>>>>>  end_procedure
65665>>>>>>>
65665>>>>>>>  function iselect returns integer
65667>>>>>>>    function_return 1
65668>>>>>>>  end_function
65669>>>>>>>
65669>>>>>>>  function ijump_out returns integer
65671>>>>>>>  end_function
65672>>>>>>>
65672>>>>>>>  procedure scan_starts // Sent unconditionally at the beginning of a scan
65674>>>>>>>  end_procedure
65675>>>>>>>
65675>>>>>>>  procedure scan_ended // Sent unconditionally at the end of a scan
65677>>>>>>>  end_procedure
65678>>>>>>>
65678>>>>>>>  procedure scan_complete  // Sent at the end of a scan if scan was complete
65680>>>>>>>  end_procedure
65681>>>>>>>
65681>>>>>>>  procedure scan_pInterrupted  // Sent at the end of a scan if scan was
65683>>>>>>>  end_procedure                // pInterrupted
65684>>>>>>>
65684>>>>>>>  procedure record_selected // Sent when a record is selected
65686>>>>>>>  end_procedure
65687>>>>>>>
65687>>>>>>>  procedure record_not_selected // Sent if record_selected is not sent
65689>>>>>>>  end_procedure
65690>>>>>>>
65690>>>>>>>  procedure record_found // Sent for each record found. This message is sent before
65692>>>>>>>  end_procedure          // it is determined if the record is selected or not.
65693>>>>>>>
65693>>>>>>>  function Custom_Sort_Value returns string
65695>>>>>>>    // This function must return the value to be sorted by if property
65695>>>>>>>    // pCustom_Sort_State has been set to true
65695>>>>>>>   integer obj#
65695>>>>>>>   get pCustom_Sort_Object to obj#
65696>>>>>>>   send ReadValues to obj#
65697>>>>>>>   function_return (sIndexValue(obj#))
65698>>>>>>>  end_function
65699>>>>>>>
65699>>>>>>>  procedure Custom_Relate
65701>>>>>>>  end_procedure
65702>>>>>>>
65702>>>>>>>  function sRecordID returns integer
65704>>>>>>>    // This function should return a unik identification of the active record.
65704>>>>>>>    integer rec#
65704>>>>>>>    get_field_value (pMainFile(self)) 0 to rec#
65707>>>>>>>    function_return rec#
65708>>>>>>>  end_function
65709>>>>>>>
65709>>>>>>>  procedure run
65711>>>>>>>    integer file# ord# pScanCount# pRecordCount# fin# found#
65711>>>>>>>    integer Custom_Sort_State# Generic_Relate# Custom_Relate#
65711>>>>>>>    integer Custom_Sort_Array# FixedLengthRowID# itm# max#
65711>>>>>>>    integer Generic_Relate_Select# Custom_Relate_Select#
65711>>>>>>>    integer IsSystemFile# lhDDO
65711>>>>>>>
65711>>>>>>>    get pCustom_Sort_State to Custom_Sort_State#
65712>>>>>>>    get pFixedLengthRowID  to FixedLengthRowID#
65713>>>>>>>
65713>>>>>>>    move (Custom_Sort_Array(self)) to Custom_Sort_Array#
65714>>>>>>>
65714>>>>>>>    get pRelate_State to Generic_Relate#
65715>>>>>>>    move (Generic_Relate# iand RS_CUSTOM_RELATE) to Custom_Relate#
65716>>>>>>>    move (Generic_Relate# iand RS_GENERIC_RELATE) to Generic_Relate#
65717>>>>>>>
65717>>>>>>>    get pRelate_State_Select to Generic_Relate_Select#
65718>>>>>>>    move (Generic_Relate_Select# iand RS_CUSTOM_RELATE) to Custom_Relate_Select#
65719>>>>>>>    move (Generic_Relate_Select# iand RS_GENERIC_RELATE) to Generic_Relate_Select#
65720>>>>>>>
65720>>>>>>>    // If relates needs to be performed before the iSelect function we must
65720>>>>>>>    // prevent it from happening after as well:
65720>>>>>>>    ifnot Custom_Sort_State# begin
65722>>>>>>>      if Custom_Relate_Select# move 0 to Custom_Relate#
65725>>>>>>>      if Generic_Relate_Select# move 0 to Generic_Relate#
65728>>>>>>>    end
65728>>>>>>>>
65728>>>>>>>
65728>>>>>>>    get phDataSetObject to lhDDO
65729>>>>>>>
65729>>>>>>>    if lhDDO begin
65731>>>>>>>      get main_file of lhDDO to file#
65732>>>>>>>      get ordering of lhDDO to ord#
65733>>>>>>>    end
65733>>>>>>>>
65733>>>>>>>    else begin
65734>>>>>>>      get pMainFile to file#
65735>>>>>>>      get pOrdering to ord#
65736>>>>>>>    end
65736>>>>>>>>
65736>>>>>>>
65736>>>>>>>    get_attribute DF_FILE_IS_SYSTEM_FILE of file# to IsSystemFile#
65739>>>>>>>
65739>>>>>>>    move 0 to pRecordCount#
65740>>>>>>>    move 0 to pScanCount#
65741>>>>>>>    move 0 to fin#
65742>>>>>>>    send initialize
65743>>>>>>>    send scan_starts
65744>>>>>>>    ifnot IsSystemFile# begin
65746>>>>>>>      send jump_in
65747>>>>>>>      if lhDDO send request_read to lhDDO FIRST_RECORD file# ord#
65750>>>>>>>      else vfind file# ord# ge // Find first
65753>>>>>>>    end
65753>>>>>>>>
65753>>>>>>>    else indicate found TRUE
65755>>>>>>>    repeat
65755>>>>>>>>
65755>>>>>>>      if (pInterrupted(self)) indicate found FALSE
65758>>>>>>>      move (found) to found#
65759>>>>>>>      if found# move (not(ijump_out(self))) to found#
65762>>>>>>>      ifnot found# move 1 to fin#
65765>>>>>>>      else begin
65766>>>>>>>        increment pScanCount#
65767>>>>>>>        set pScanCount to pScanCount#
65768>>>>>>>        send record_found
65769>>>>>>>
65769>>>>>>>        if Generic_Relate_Select# relate file#
65772>>>>>>>        if Custom_Relate_Select# send Custom_Relate
65775>>>>>>>
65775>>>>>>>        if (iSelect(self)) begin
65777>>>>>>>          if Custom_Sort_State# set value of Custom_Sort_Array# item (item_count(Custom_Sort_Array#)) to (Custom_Sort_Value(self)+pad(sRecordID(self),FixedLengthRowID#))
65780>>>>>>>          else begin
65781>>>>>>>            if Generic_Relate# relate file#
65784>>>>>>>            if Custom_Relate# send Custom_Relate
65787>>>>>>>            send record_selected
65788>>>>>>>          end
65788>>>>>>>>
65788>>>>>>>          increment pRecordCount#
65789>>>>>>>          set pRecordCount to pRecordCount#
65790>>>>>>>        end
65790>>>>>>>>
65790>>>>>>>        else send record_not_selected
65792>>>>>>>        if IsSystemFile# indicate found FALSE
65795>>>>>>>        else begin
65796>>>>>>>          if lhDDO send request_read to lhDDO GT file# ord#
65799>>>>>>>          else vfind file# ord# gt // Find next
65802>>>>>>>        end
65802>>>>>>>>
65802>>>>>>>      end
65802>>>>>>>>
65802>>>>>>>    until fin#
65804>>>>>>>    if Custom_Sort_State# begin
65806>>>>>>>      ifnot (pInterrupted(self)) begin
65808>>>>>>>        send sort_items to Custom_Sort_Array# (pCustom_Sort_Dir(self))
65809>>>>>>>        get item_count of Custom_Sort_Array# to max#
65810>>>>>>>        for itm# from 0 to (max#-1)
65816>>>>>>>>
65816>>>>>>>          clear file#
65817>>>>>>>          set_field_value file# 0 to (right(value(Custom_Sort_Array#,itm#),FixedLengthRowID#))
65820>>>>>>>          vfind file# 0 eq
65822>>>>>>>          if Generic_Relate# relate file#
65825>>>>>>>          if Custom_Relate# send Custom_Relate
65828>>>>>>>          send record_selected
65829>>>>>>>        loop
65830>>>>>>>>
65830>>>>>>>      end
65830>>>>>>>>
65830>>>>>>>      send delete_data to Custom_Sort_Array# // Release memory
65831>>>>>>>    end
65831>>>>>>>>
65831>>>>>>>    send scan_ended
65832>>>>>>>    if (pInterrupted(self)) send scan_pInterrupted
65835>>>>>>>    else send scan_complete
65837>>>>>>>    set phDataSetObject to 0
65838>>>>>>>  end_procedure
65839>>>>>>>
65839>>>>>>>  procedure run.ii integer file# integer idx#
65841>>>>>>>    set pMainFile to file#
65842>>>>>>>    set pOrdering to idx#
65843>>>>>>>    send run
65844>>>>>>>  end_procedure
65845>>>>>>>end_class // cBasicDataScanner
65846>>>>>>>
65846>>>>>>>// This class is capable of evaluating a series of conditions set up
65846>>>>>>>// to decide which records should go in a report or a batch. The
65846>>>>>>>// conditions are logically AND'ed.
65846>>>>>>>//
65846>>>>>>>// Format: 0. type  SIMPLE     FUNCTION     BOOLEAN
65846>>>>>>>//         1.       file       function ID  Boolean expression
65846>>>>>>>//         2.       field.     object       -
65846>>>>>>>//         3        type       -            -
65846>>>>>>>//         4.       comp       -            -
65846>>>>>>>//         5.       value 1    -            -
65846>>>>>>>//         6.       value 2    -            -
65846>>>>>>>//
65846>>>>>>>class cSelectionCriteriaArray is a cArray
65847>>>>>>>  procedure construct_object
65849>>>>>>>    forward send construct_object
65851>>>>>>>    property integer pMainFile public 0
65852>>>>>>>    property integer pOrdering public 0
65853>>>>>>>    send define_db_structure_layer_mixin
65854>>>>>>>    object oJumpInValues is a cArray
65856>>>>>>>    end_object
65857>>>>>>>    object oJumpOutValues is a cArray
65859>>>>>>>    end_object
65860>>>>>>>    object oMustBeDestroyed is a cArray // or-list
65862>>>>>>>    end_object
65863>>>>>>>  end_procedure
65864>>>>>>>  import_class_protocol db_structure_layer_mixin
65865>>>>>>>  procedure show_Criteria
65867>>>>>>>  end_procedure
65868>>>>>>>  procedure show_JumpInValues
65870>>>>>>>    integer obj# itm# max# base# comp#
65870>>>>>>>    string val#
65870>>>>>>>    DATASCAN$SHOWLN ("Jump-in values: "+idx_field_names(oIndexAnalyzer#,pOrdering(self),1,0))
65870>>>>>>>    move (oJumpInValues(self)) to obj#
65871>>>>>>>    move (item_count(obj#)/4-1) to max#
65872>>>>>>>    for itm# from 1 to max#
65878>>>>>>>>
65878>>>>>>>      move (itm#*4) to base#
65879>>>>>>>      get value of obj# item (base#+1) to val#
65880>>>>>>>      get value of obj# item (base#+2) to comp#
65881>>>>>>>      DATASCAN$SHOWLN ("  Segment "+string(itm#)+" ("+string(comp#)+"): "+val#)
65881>>>>>>>    loop
65882>>>>>>>>
65882>>>>>>>  end_procedure
65883>>>>>>>  procedure show_JumpOutValues
65885>>>>>>>    integer obj# itm# max# base# comp#
65885>>>>>>>    string val#
65885>>>>>>>    DATASCAN$SHOWLN ("Jump-out values: "+idx_field_names(oIndexAnalyzer#,pOrdering(self),1,0))
65885>>>>>>>    move (oJumpOutValues(self)) to obj#
65886>>>>>>>    move (item_count(obj#)/4-1) to max#
65887>>>>>>>    for itm# from 1 to max#
65893>>>>>>>>
65893>>>>>>>      move (itm#*4) to base#
65894>>>>>>>      get value of obj# item (base#+1) to val#
65895>>>>>>>      get value of obj# item (base#+2) to comp#
65896>>>>>>>      DATASCAN$SHOWLN ("  Segment "+string(itm#)+" ("+string(comp#)+"): "+val#)
65896>>>>>>>    loop
65897>>>>>>>>
65897>>>>>>>  end_procedure
65898>>>>>>>  procedure reset
65900>>>>>>>    integer lhMustBeDestroyed liMax liItm lhObj
65900>>>>>>>    send delete_data
65901>>>>>>>    send delete_data to (oJumpInValues(self))
65902>>>>>>>    send delete_data to (oJumpOutValues(self))
65903>>>>>>>    move (oMustBeDestroyed(self)) to lhMustBeDestroyed // or-list
65904>>>>>>>    get item_count of lhMustBeDestroyed to liMax
65905>>>>>>>    decrement liMax
65906>>>>>>>    for liItm from 0 to liMax
65912>>>>>>>>
65912>>>>>>>      get value of lhMustBeDestroyed item liItm to lhObj
65913>>>>>>>      send request_destroy_object to lhObj
65914>>>>>>>    loop
65915>>>>>>>>
65915>>>>>>>    send delete_data to lhMustBeDestroyed
65916>>>>>>>  end_procedure
65917>>>>>>>  procedure add_criteria_boolean_expr string str#
65919>>>>>>>    set value item (item_count(self)) to (SC_TYPE_BOOLEAN_EXPR*16384*16384)
65920>>>>>>>    set value item (item_count(self)) to str#
65921>>>>>>>  end_procedure
65922>>>>>>>  // or-list
65922>>>>>>>            function convert_orlist_to_array string lsValues returns integer
65924>>>>>>>              integer liMax liItm lhArray lhMustBeDestroyed
65924>>>>>>>              string lsItem
65924>>>>>>>              object oOrListArray is a cArray
65926>>>>>>>                move self to lhArray
65927>>>>>>>              end_object
65928>>>>>>>              get HowManyWords lsValues "|" to liMax
65929>>>>>>>              for liItm from 1 to liMax
65935>>>>>>>>
65935>>>>>>>                get ExtractWord lsValues "|" liItm to lsItem
65936>>>>>>>                set value of lhArray item (liItm-1) to lsItem
65937>>>>>>>              loop
65938>>>>>>>>
65938>>>>>>>              move (oMustBeDestroyed(self)) to lhMustBeDestroyed
65939>>>>>>>              set value of lhMustBeDestroyed item (item_count(lhMustBeDestroyed)) to lhArray
65940>>>>>>>              function_return lhArray
65941>>>>>>>            end_function
65942>>>>>>>  procedure add_criteria_orlist integer liFile integer liField string lsValues // or-list
65944>>>>>>>    integer type# composite# base# lhArray
65944>>>>>>>    move (FieldInf_FieldType(liFile,liField)) to type#
65945>>>>>>>    get iTranslate_DFTYPE type# to composite#
65946>>>>>>>    move (composite#*64+SC_COMP_OR_LIST*4096+liFile*1024+liField) to composite#
65947>>>>>>>    get item_count to base#
65948>>>>>>>    set value item  base#    to composite#
65949>>>>>>>    get convert_orlist_to_array lsValues to lhArray
65950>>>>>>>    set value item (base#+1) to lhArray
65951>>>>>>>  end_procedure
65952>>>>>>>  procedure add_criteria_function integer msg# integer obj#
65954>>>>>>>    set value item (item_count(self)) to (SC_TYPE_FUNCTION*16384+msg#*16384+obj#)
65955>>>>>>>  end_procedure
65956>>>>>>>  procedure add_criteria_simple integer file# integer fld# integer comp# string val1# string val2#
65958>>>>>>>    integer type# composite# base#
65958>>>>>>>    move (FieldInf_FieldType(file#,fld#)) to type#
65959>>>>>>>    get iTranslate_DFTYPE type# to composite#
65960>>>>>>>//  move (composite#*256+comp#*1024+file#*1024+fld#) to composite#
65960>>>>>>>    move (composite#*64+comp#*4096+file#*1024+fld#) to composite#
65961>>>>>>>    get item_count to base#
65962>>>>>>>    set value item  base#    to composite#
65963>>>>>>>    set value item (base#+1) to val1#
65964>>>>>>>    if (comp#=SC_COMP_BETWEEN or comp#=SC_COMP_CBETWEEN) set value item (base#+2) to val2#
65967>>>>>>>  end_procedure
65968>>>>>>>
65968>>>>>>>  // or-list
65968>>>>>>>       function bEvalOrListString integer liFile integer liField integer lhArray string lsValue returns integer
65970>>>>>>>         integer liMax liItm
65970>>>>>>>         get item_count of lhArray to liMax
65971>>>>>>>         decrement liMax
65972>>>>>>>         for liItm from 0 to liMax
65978>>>>>>>>
65978>>>>>>>           if (lsValue=value(lhArray,liItm)) function_return 1
65981>>>>>>>         loop
65982>>>>>>>>
65982>>>>>>>         function_return 0
65983>>>>>>>       end_function
65984>>>>>>>
65984>>>>>>>       function bEvalOrListDate integer liFile integer liField integer lhArray date ldValue returns integer
65986>>>>>>>         integer liMax liItm
65986>>>>>>>         get item_count of lhArray to liMax
65987>>>>>>>         decrement liMax
65988>>>>>>>         for liItm from 0 to liMax
65994>>>>>>>>
65994>>>>>>>           if (ldValue=value(lhArray,liItm)) function_return 1
65997>>>>>>>         loop
65998>>>>>>>>
65998>>>>>>>         function_return 0
65999>>>>>>>       end_function
66000>>>>>>>
66000>>>>>>>       function bEvalOrListNumber integer liFile integer liField integer lhArray number lnValue returns integer
66002>>>>>>>         integer liMax liItm
66002>>>>>>>         get item_count of lhArray to liMax
66003>>>>>>>         decrement liMax
66004>>>>>>>         for liItm from 0 to liMax
66010>>>>>>>>
66010>>>>>>>           if (lnValue=value(lhArray,liItm)) function_return 1
66013>>>>>>>         loop
66014>>>>>>>>
66014>>>>>>>         function_return 0
66015>>>>>>>       end_function
66016>>>>>>>  //*************************************************************************
66016>>>>>>>  //  1      1
66016>>>>>>>  //  2      2
66016>>>>>>>  //  3      4                 3          2          1
66016>>>>>>>  //  4      8               21098765 43210987 65432109 87654321
66016>>>>>>>  //  5     16               xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx
66016>>>>>>>  //  6     32
66016>>>>>>>  //  7     64    Type-------TTTT
66016>>>>>>>  //  8    128    Field------------------------------FF FFFFFFFF
66016>>>>>>>  //  9    256    File--------------------FFFF FFFFFF
66016>>>>>>>  // 10    512    Comperator-----CCCC CCCC
66016>>>>>>>  // 11   1024
66016>>>>>>>  // 12   2048
66016>>>>>>>  // 13   4096
66016>>>>>>>  // 14   8192
66016>>>>>>>  // 15  16384
66016>>>>>>>  // 16  32768
66016>>>>>>>  // 17  65536
66016>>>>>>>  function iEvaluate returns integer
66018>>>>>>>    integer itm# max# sc_type# file# fld# comp# ok# composite# lhOrList
66018>>>>>>>    date    dat1# dat2# dat_val#
66018>>>>>>>    number  num1# num2# num_val#
66018>>>>>>>    string  str1# str2# str_val#
66018>>>>>>>    get item_count to max#
66019>>>>>>>    move 0 to itm#
66020>>>>>>>    while itm# lt max#
66024>>>>>>>      get value item itm# to composite#
66025>>>>>>>      increment itm#
66026>>>>>>>      move (composite#/16384/16384) to sc_type#
66027>>>>>>>      if sc_type# eq SC_TYPE_BOOLEAN_EXPR begin
66029>>>>>>>        get value item itm# to ok# // Overload (expression id)
66030>>>>>>>        get sEvalExpression of (Query_ExprEvaluator(self)) ok# to ok#
66031>>>>>>>        ifnot ok# function_return 0
66034>>>>>>>        increment itm#
66035>>>>>>>      end
66035>>>>>>>>
66035>>>>>>>      else begin
66036>>>>>>>        if sc_type# eq SC_TYPE_FUNCTION begin
66038>>>>>>>          // In this section variable file# and fld# are treated as obj# and msg#
66038>>>>>>>          move (composite# iand 16383) to file#
66039>>>>>>>          move (composite# iand (16383*16384)) to fld#
66040>>>>>>>          get fld# of file# to ok#
66041>>>>>>>          ifnot ok# function_return 0
66044>>>>>>>        end
66044>>>>>>>>
66044>>>>>>>        else begin //
66045>>>>>>>          move (composite# iand 1023) to fld#
66046>>>>>>>          move ((composite# iand (4095*1024))/1024) to file#
66047>>>>>>>          move ((composite# iand (63*4096*1024))/4096/1024) to comp#
66048>>>>>>>
66048>>>>>>>          if comp# eq SC_COMP_OR_LIST get value item itm# to lhOrList // or-list
66051>>>>>>>
66051>>>>>>>          if sc_type# eq SC_TYPE_ASCII begin
66053>>>>>>>            get value item itm# to str1#
66054>>>>>>>            increment itm#
66055>>>>>>>            if (comp#=SC_COMP_BETWEEN or comp#=SC_COMP_CBETWEEN) begin
66057>>>>>>>              get value item itm# to str2#
66058>>>>>>>              increment itm#
66059>>>>>>>            end
66059>>>>>>>>
66059>>>>>>>            //get_field_value file# fld# to str_val#
66059>>>>>>>            move (FieldInf_FieldValue(file#,fld#)) to str_val#
66060>>>>>>>            if comp# eq SC_COMP_LT        move (str_val#>>>>>>            if comp# eq SC_COMP_LE        move (str_val#<=str1#) to ok#
66066>>>>>>>            if comp# eq SC_COMP_EQ        move (str_val#=str1#) to ok#
66069>>>>>>>            if comp# eq SC_COMP_GE        move (str_val#>=str1#) to ok#
66072>>>>>>>            if comp# eq SC_COMP_GT        move (str_val#>str1#) to ok#
66075>>>>>>>            if comp# eq SC_COMP_NE        move (str_val#<>str1#) to ok#
66078>>>>>>>            if comp# eq SC_COMP_BETWEEN   move (str_val#>=str1# and str_val#<=str2#) to ok#
66081>>>>>>>            if comp# eq SC_COMP_IN        begin
66083>>>>>>>              if str1# in str_val# move 1 to ok#
66086>>>>>>>              else move 0 to ok#
66088>>>>>>>            end
66088>>>>>>>>
66088>>>>>>>            if comp# eq SC_COMP_CONTAINS  move (str_val# contains str1#) to ok#
66091>>>>>>>            if comp# eq SC_COMP_CBETWEEN  move (str_val#str2#) to ok#
66094>>>>>>>            if comp# eq SC_COMP_CIN       begin
66096>>>>>>>//            move (not(str1# contains str_val#)) to ok#
66096>>>>>>>              if str1# in str_val# move 0 to ok#
66099>>>>>>>              else move 1 to ok#
66101>>>>>>>            end
66101>>>>>>>>
66101>>>>>>>            if comp# eq SC_COMP_CCONTAINS move (not(str_val# contains str1#)) to ok#
66104>>>>>>>            if comp# eq SC_COMP_NOT_BLANK move (trim(str_val#)<>"") to ok#
66107>>>>>>>            if comp# eq SC_COMP_BLANK     move (trim(str_val#)="") to ok#
66110>>>>>>>            if comp# eq SC_COMP_OR_LIST   get bEvalOrListString file# fld# lhOrList str_val# to ok# // or-list
66113>>>>>>>          end
66113>>>>>>>>
66113>>>>>>>          if sc_type# eq SC_TYPE_DATE begin
66115>>>>>>>            get value item itm# to dat1#
66116>>>>>>>            increment itm#
66117>>>>>>>            if (comp#=SC_COMP_BETWEEN or comp#=SC_COMP_CBETWEEN) begin
66119>>>>>>>              get value item itm# to dat2#
66120>>>>>>>              increment itm#
66121>>>>>>>            end
66121>>>>>>>>
66121>>>>>>>            //get_field_value file# fld# to dat_val#
66121>>>>>>>            move (FieldInf_FieldValue(file#,fld#)) to dat_val#
66122>>>>>>>            if comp# eq SC_COMP_LT       move (dat_val#>>>>>>            if comp# eq SC_COMP_LE       move (dat_val#<=dat1#) to ok#
66128>>>>>>>            if comp# eq SC_COMP_EQ       move (dat_val#=dat1#) to ok#
66131>>>>>>>            if comp# eq SC_COMP_GE       move (dat_val#>=dat1#) to ok#
66134>>>>>>>            if comp# eq SC_COMP_GT       move (dat_val#>dat1#) to ok#
66137>>>>>>>            if comp# eq SC_COMP_NE       move (dat_val#<>dat1#) to ok#
66140>>>>>>>            if comp# eq SC_COMP_BETWEEN  move (dat_val#>=dat1# and dat_val#<=dat2#) to ok#
66143>>>>>>>            if comp# eq SC_COMP_CBETWEEN move (dat_val#dat2#) to ok#
66146>>>>>>>            if comp# eq SC_COMP_OR_LIST  get bEvalOrListDate file# fld# lhOrList dat_val# to ok# // or-list
66149>>>>>>>          end
66149>>>>>>>>
66149>>>>>>>          if sc_type# eq SC_TYPE_NUMERIC begin
66151>>>>>>>            get value item itm# to num1#
66152>>>>>>>            increment itm#
66153>>>>>>>            if (comp#=SC_COMP_BETWEEN or comp#=SC_COMP_CBETWEEN) begin
66155>>>>>>>              get value item itm# to num2#
66156>>>>>>>              increment itm#
66157>>>>>>>            end
66157>>>>>>>>
66157>>>>>>>            //get_field_value file# fld# to num_val#
66157>>>>>>>            move (FieldInf_FieldValue(file#,fld#)) to num_val#
66158>>>>>>>            if comp# eq SC_COMP_LT       move (num_val#>>>>>>            if comp# eq SC_COMP_LE       move (num_val#<=num1#) to ok#
66164>>>>>>>            if comp# eq SC_COMP_EQ       move (num_val#=num1#) to ok#
66167>>>>>>>            if comp# eq SC_COMP_GE       move (num_val#>=num1#) to ok#
66170>>>>>>>            if comp# eq SC_COMP_GT       move (num_val#>num1#) to ok#
66173>>>>>>>            if comp# eq SC_COMP_NE       move (num_val#<>num1#) to ok#
66176>>>>>>>            if comp# eq SC_COMP_BETWEEN  move (num_val#>=num1# and num_val#<=num2#) to ok#
66179>>>>>>>            if comp# eq SC_COMP_CBETWEEN move (num_val#num2#) to ok#
66182>>>>>>>            if comp# eq SC_COMP_OR_LIST  get bEvalOrListNumber file# fld# lhOrList num_val# to ok# // or-list
66185>>>>>>>          end
66185>>>>>>>>
66185>>>>>>>          ifnot ok# function_return 0
66188>>>>>>>        end
66188>>>>>>>>
66188>>>>>>>      end
66188>>>>>>>>
66188>>>>>>>    end
66189>>>>>>>>
66189>>>>>>>    function_return 1
66190>>>>>>>  end_function
66191>>>>>>>  procedure AnalyzeJumpInOutValuesHelp integer testfile# integer testfld# ;                                       integer testsegm#
66193>>>>>>>    integer itm# max# sc_type# file# fld# comp# composite# current_segments#
66193>>>>>>>    integer oJumpInValues# oJumpOutValues# AnyJumpIn# AnyJumpOut# hit#
66193>>>>>>>    integer JumpInComp# JumpOutComp# TestType#
66193>>>>>>>    date    dat1# dat2# JumpInDat# JumpOutDat#
66193>>>>>>>    number  num1# num2# JumpInNum# JumpOutNum#
66193>>>>>>>    string  str1# str2# JumpInStr# JumpOutStr#
66193>>>>>>>    move 0 to AnyJumpIn#
66194>>>>>>>    move 0 to AnyJumpOut#
66195>>>>>>>    get item_count to max#
66196>>>>>>>    move 0 to itm#
66197>>>>>>>    while itm# lt (max#-1)
66201>>>>>>>      get value item itm# to composite#
66202>>>>>>>      increment itm#
66203>>>>>>>      move (composite#/16384/16384) to sc_type#
66204>>>>>>>      if sc_type# eq SC_TYPE_BOOLEAN_EXPR increment itm#
66207>>>>>>>      else begin
66208>>>>>>>        if sc_type# ne SC_TYPE_FUNCTION begin
66210>>>>>>>          move (composite# iand 1023) to fld#
66211>>>>>>>          move ((composite# iand (4095*1024))/1024) to file#
66212>>>>>>>          move ((composite# iand (63*4096*1024))/4096/1024) to comp#
66213>>>>>>>          move (file#=testfile# and fld#=testfld#) to hit#
66214>>>>>>>          if hit# begin
66216>>>>>>>            move sc_type# to TestType#
66217>>>>>>>            if sc_type# eq SC_TYPE_ASCII begin
66219>>>>>>>              get value item itm# to str1#
66220>>>>>>>              increment itm#
66221>>>>>>>              if comp# eq SC_COMP_BETWEEN begin
66223>>>>>>>                get value item itm# to str2#
66224>>>>>>>                increment itm#
66225>>>>>>>              end
66225>>>>>>>>
66225>>>>>>>              if comp# eq SC_COMP_LT begin
66227>>>>>>>                ifnot AnyJumpOut# move str1# to JumpOutStr#
66230>>>>>>>                else if str1# lt JumpOutStr# move str1# to JumpOutStr#
66234>>>>>>>                move 1 to AnyJumpOut#
66235>>>>>>>                move SC_COMP_LT to JumpOutComp#
66236>>>>>>>              end
66236>>>>>>>>
66236>>>>>>>              if comp# eq SC_COMP_LE begin
66238>>>>>>>                ifnot AnyJumpOut# move str1# to JumpOutStr#
66241>>>>>>>                else if str1# lt JumpOutStr# move str1# to JumpOutStr#
66245>>>>>>>                move 1 to AnyJumpOut#
66246>>>>>>>                move SC_COMP_LE to JumpOutComp#
66247>>>>>>>              end
66247>>>>>>>>
66247>>>>>>>              if comp# eq SC_COMP_EQ begin
66249>>>>>>>                ifnot AnyJumpOut# move str1# to JumpOutStr#
66252>>>>>>>                else if str1# lt JumpOutStr# move str1# to JumpOutStr#
66256>>>>>>>                ifnot AnyJumpIn# move str1# to JumpInStr#
66259>>>>>>>                else if str1# gt JumpInStr# move str1# to JumpInStr#
66263>>>>>>>                move 1 to AnyJumpOut#
66264>>>>>>>                move 1 to AnyJumpIn#
66265>>>>>>>                move SC_COMP_GE to JumpInComp#
66266>>>>>>>                move SC_COMP_LE to JumpOutComp#
66267>>>>>>>              end
66267>>>>>>>>
66267>>>>>>>              if comp# eq SC_COMP_GE begin
66269>>>>>>>                ifnot AnyJumpIn# move str1# to JumpInStr#
66272>>>>>>>                else if str1# gt JumpInStr# move str1# to JumpInStr#
66276>>>>>>>                move 1 to AnyJumpIn#
66277>>>>>>>                move SC_COMP_GE to JumpInComp#
66278>>>>>>>              end
66278>>>>>>>>
66278>>>>>>>              if comp# eq SC_COMP_GT begin
66280>>>>>>>                ifnot AnyJumpIn# move str1# to JumpInStr#
66283>>>>>>>                else if str1# gt JumpInStr# move str1# to JumpInStr#
66287>>>>>>>                move 1 to AnyJumpIn#
66288>>>>>>>                move SC_COMP_GT to JumpInComp#
66289>>>>>>>              end
66289>>>>>>>>
66289>>>>>>>              if comp# eq SC_COMP_BETWEEN begin
66291>>>>>>>                ifnot AnyJumpIn# move str1# to JumpInStr#
66294>>>>>>>                else if str1# gt JumpInStr# move str1# to JumpInStr#
66298>>>>>>>                ifnot AnyJumpOut# move str2# to JumpOutStr#
66301>>>>>>>                else if str2# lt JumpOutStr# move str2# to JumpOutStr#
66305>>>>>>>                move 1 to AnyJumpOut#
66306>>>>>>>                move 1 to AnyJumpIn#
66307>>>>>>>                move SC_COMP_GE to JumpInComp#
66308>>>>>>>                move SC_COMP_LE to JumpOutComp#
66309>>>>>>>              end
66309>>>>>>>>
66309>>>>>>>            end // SC_TYPE_ASCII
66309>>>>>>>>
66309>>>>>>>            if sc_type# eq SC_TYPE_DATE begin
66311>>>>>>>              if (item_count(self)>itm#) get value item itm# to Dat1#
66314>>>>>>>              else move 06/05/1962 to Dat1# // Let's just assume that you haven't a single data item on my birth date.
66316>>>>>>>              increment itm#
66317>>>>>>>              if comp# eq SC_COMP_BETWEEN begin
66319>>>>>>>                get value item itm# to Dat2#
66320>>>>>>>                increment itm#
66321>>>>>>>              end
66321>>>>>>>>
66321>>>>>>>              if comp# eq SC_COMP_LT begin
66323>>>>>>>                ifnot AnyJumpOut# move Dat1# to JumpOutDat#
66326>>>>>>>                else if Dat1# lt JumpOutDat# move Dat1# to JumpOutDat#
66330>>>>>>>                move 1 to AnyJumpOut#
66331>>>>>>>                move SC_COMP_LT to JumpOutComp#
66332>>>>>>>              end
66332>>>>>>>>
66332>>>>>>>              if comp# eq SC_COMP_LE begin
66334>>>>>>>                ifnot AnyJumpOut# move Dat1# to JumpOutDat#
66337>>>>>>>                else if Dat1# lt JumpOutDat# move Dat1# to JumpOutDat#
66341>>>>>>>                move 1 to AnyJumpOut#
66342>>>>>>>                move SC_COMP_LE to JumpOutComp#
66343>>>>>>>              end
66343>>>>>>>>
66343>>>>>>>              if comp# eq SC_COMP_EQ begin
66345>>>>>>>                ifnot AnyJumpOut# move Dat1# to JumpOutDat#
66348>>>>>>>                else if Dat1# lt JumpOutDat# move Dat1# to JumpOutDat#
66352>>>>>>>                ifnot AnyJumpIn# move Dat1# to JumpInDat#
66355>>>>>>>                else if Dat1# gt JumpInDat# move Dat1# to JumpInDat#
66359>>>>>>>                move 1 to AnyJumpOut#
66360>>>>>>>                move 1 to AnyJumpIn#
66361>>>>>>>                move SC_COMP_GE to JumpInComp#
66362>>>>>>>                move SC_COMP_LE to JumpOutComp#
66363>>>>>>>              end
66363>>>>>>>>
66363>>>>>>>              if comp# eq SC_COMP_GE begin
66365>>>>>>>                ifnot AnyJumpIn# move Dat1# to JumpInDat#
66368>>>>>>>                else if Dat1# gt JumpInDat# move Dat1# to JumpInDat#
66372>>>>>>>                move 1 to AnyJumpIn#
66373>>>>>>>                move SC_COMP_GE to JumpInComp#
66374>>>>>>>              end
66374>>>>>>>>
66374>>>>>>>              if comp# eq SC_COMP_GT begin
66376>>>>>>>                ifnot AnyJumpIn# move Dat1# to JumpInDat#
66379>>>>>>>                else if Dat1# gt JumpInDat# move Dat1# to JumpInDat#
66383>>>>>>>                move 1 to AnyJumpIn#
66384>>>>>>>                move SC_COMP_GT to JumpInComp#
66385>>>>>>>              end
66385>>>>>>>>
66385>>>>>>>              if comp# eq SC_COMP_BETWEEN begin
66387>>>>>>>                ifnot AnyJumpIn# move Dat1# to JumpInDat#
66390>>>>>>>                else if Dat1# gt JumpInDat# move Dat1# to JumpInDat#
66394>>>>>>>                ifnot AnyJumpOut# move Dat2# to JumpOutDat#
66397>>>>>>>                else if Dat2# lt JumpOutDat# move Dat2# to JumpOutDat#
66401>>>>>>>                move 1 to AnyJumpOut#
66402>>>>>>>                move 1 to AnyJumpIn#
66403>>>>>>>                move SC_COMP_GE to JumpInComp#
66404>>>>>>>                move SC_COMP_LE to JumpOutComp#
66405>>>>>>>              end
66405>>>>>>>>
66405>>>>>>>            end // SC_TYPE_DATE
66405>>>>>>>>
66405>>>>>>>            if sc_type# eq SC_TYPE_NUMERIC begin
66407>>>>>>>              get value item itm# to Num1#
66408>>>>>>>              increment itm#
66409>>>>>>>              if comp# eq SC_COMP_BETWEEN begin
66411>>>>>>>                get value item itm# to Num2#
66412>>>>>>>                increment itm#
66413>>>>>>>              end
66413>>>>>>>>
66413>>>>>>>              if comp# eq SC_COMP_LT begin
66415>>>>>>>                ifnot AnyJumpOut# move Num1# to JumpOutNum#
66418>>>>>>>                else if Num1# lt JumpOutNum# move Num1# to JumpOutNum#
66422>>>>>>>                move 1 to AnyJumpOut#
66423>>>>>>>                move SC_COMP_LT to JumpOutComp#
66424>>>>>>>              end
66424>>>>>>>>
66424>>>>>>>              if comp# eq SC_COMP_LE begin
66426>>>>>>>                ifnot AnyJumpOut# move Num1# to JumpOutNum#
66429>>>>>>>                else if Num1# lt JumpOutNum# move Num1# to JumpOutNum#
66433>>>>>>>                move 1 to AnyJumpOut#
66434>>>>>>>                move SC_COMP_LE to JumpOutComp#
66435>>>>>>>              end
66435>>>>>>>>
66435>>>>>>>              if comp# eq SC_COMP_EQ begin
66437>>>>>>>                ifnot AnyJumpOut# move Num1# to JumpOutNum#
66440>>>>>>>                else if Num1# lt JumpOutNum# move Num1# to JumpOutNum#
66444>>>>>>>                ifnot AnyJumpIn# move Num1# to JumpInNum#
66447>>>>>>>                else if Num1# gt JumpInNum# move Num1# to JumpInNum#
66451>>>>>>>                move 1 to AnyJumpOut#
66452>>>>>>>                move 1 to AnyJumpIn#
66453>>>>>>>                move SC_COMP_GE to JumpInComp#
66454>>>>>>>                move SC_COMP_LE to JumpOutComp#
66455>>>>>>>              end
66455>>>>>>>>
66455>>>>>>>              if comp# eq SC_COMP_GE begin
66457>>>>>>>                ifnot AnyJumpIn# move Num1# to JumpInNum#
66460>>>>>>>                else if Num1# gt JumpInNum# move Num1# to JumpInNum#
66464>>>>>>>                move 1 to AnyJumpIn#
66465>>>>>>>                move SC_COMP_GE to JumpInComp#
66466>>>>>>>              end
66466>>>>>>>>
66466>>>>>>>              if comp# eq SC_COMP_GT begin
66468>>>>>>>                ifnot AnyJumpIn# move Num1# to JumpInNum#
66471>>>>>>>                else if Num1# gt JumpInNum# move Num1# to JumpInNum#
66475>>>>>>>                move 1 to AnyJumpIn#
66476>>>>>>>                move SC_COMP_GT to JumpInComp#
66477>>>>>>>              end
66477>>>>>>>>
66477>>>>>>>              if comp# eq SC_COMP_BETWEEN begin
66479>>>>>>>                ifnot AnyJumpIn# move Num1# to JumpInNum#
66482>>>>>>>                else if Num1# gt JumpInNum# move Num1# to JumpInNum#
66486>>>>>>>                ifnot AnyJumpOut# move Num2# to JumpOutNum#
66489>>>>>>>                else if Num2# lt JumpOutNum# move Num2# to JumpOutNum#
66493>>>>>>>                move 1 to AnyJumpOut#
66494>>>>>>>                move 1 to AnyJumpIn#
66495>>>>>>>                move SC_COMP_GE to JumpInComp#
66496>>>>>>>                move SC_COMP_LE to JumpOutComp#
66497>>>>>>>              end
66497>>>>>>>>
66497>>>>>>>            end // SC_TYPE_NUMERIC
66497>>>>>>>>
66497>>>>>>>          end
66497>>>>>>>>
66497>>>>>>>          else begin
66498>>>>>>>            increment itm#
66499>>>>>>>            if comp# eq SC_COMP_BETWEEN increment itm#
66502>>>>>>>          end
66502>>>>>>>>
66502>>>>>>>        end
66502>>>>>>>>
66502>>>>>>>      end
66502>>>>>>>>
66502>>>>>>>    end
66503>>>>>>>>
66503>>>>>>>
66503>>>>>>>    if AnyJumpIn# begin
66505>>>>>>>      move (oJumpInValues(self)) to oJumpInValues#
66506>>>>>>>      get value of oJumpInValues# item 0 to current_segments#
66507>>>>>>>      if current_segments# eq (testsegm#-1) begin
66509>>>>>>>        set value of oJumpInValues# item 0 to testsegm#
66510>>>>>>>                                        set value of oJumpInValues# item (testsegm#*4+0) to TestType#
66511>>>>>>>        if TestType# eq SC_TYPE_ASCII   set value of oJumpInValues# item (testsegm#*4+1) to JumpInStr#
66514>>>>>>>        if TestType# eq SC_TYPE_DATE    set value of oJumpInValues# item (testsegm#*4+1) to JumpInDat#
66517>>>>>>>        if TestType# eq SC_TYPE_NUMERIC set value of oJumpInValues# item (testsegm#*4+1) to JumpInNum#
66520>>>>>>>                                        set value of oJumpInValues# item (testsegm#*4+2) to JumpInComp#
66521>>>>>>>                                        set value of oJumpInValues# item (testsegm#*4+3) to TestFld#
66522>>>>>>>      end
66522>>>>>>>>
66522>>>>>>>    end
66522>>>>>>>>
66522>>>>>>>    if AnyJumpOut# begin
66524>>>>>>>      move (oJumpOutValues(self)) to oJumpOutValues#
66525>>>>>>>      get value of oJumpOutValues# item 0 to current_segments#
66526>>>>>>>      if current_segments# eq (testsegm#-1) begin
66528>>>>>>>        set value of oJumpOutValues# item 0 to testsegm#
66529>>>>>>>                                        set value of oJumpOutValues# item (testsegm#*4+0) to TestType#
66530>>>>>>>        if TestType# eq SC_TYPE_ASCII   set value of oJumpOutValues# item (testsegm#*4+1) to JumpOutStr#
66533>>>>>>>        if TestType# eq SC_TYPE_DATE    set value of oJumpOutValues# item (testsegm#*4+1) to JumpOutDat#
66536>>>>>>>        if TestType# eq SC_TYPE_NUMERIC set value of oJumpOutValues# item (testsegm#*4+1) to JumpOutNum#
66539>>>>>>>                                        set value of oJumpOutValues# item (testsegm#*4+2) to JumpOutComp#
66540>>>>>>>                                        set value of oJumpOutValues# item (testsegm#*4+3) to TestFld#
66541>>>>>>>      end
66541>>>>>>>>
66541>>>>>>>    end // While
66541>>>>>>>>
66541>>>>>>>  end_procedure
66542>>>>>>>
66542>>>>>>>  procedure seed_lowest_possible integer file# integer fld# integer dir# integer seg#
66544>>>>>>>    integer len# type# dec# oJumpInValues#
66544>>>>>>>    date seeding_date#
66544>>>>>>>    number seeding_number#
66544>>>>>>>    string seeding_string#
66544>>>>>>>    get_attribute DF_FIELD_TYPE      of file# fld# to type#
66547>>>>>>>    if type# eq DF_BCD begin
66549>>>>>>>      get_attribute DF_FIELD_LENGTH    of file# fld# to len#
66552>>>>>>>      get_attribute DF_FIELD_PRECISION of file# fld# to dec#
66555>>>>>>>      move (len#-dec#) to len#
66556>>>>>>>      if dir# eq DF_DESCENDING begin // Highest possible
66558>>>>>>>        if dec# move (repeat("9",len#)+CurrentDecimalSeparator()+repeat("9",dec#)) to seeding_string#
66561>>>>>>>        else    move (repeat("9",len#)) to seeding_string#
66563>>>>>>>      end
66563>>>>>>>>
66563>>>>>>>      else begin // Lowest possible
66564>>>>>>>        decrement len#
66565>>>>>>>        if dec# move ("-"+repeat("9",len#)+CurrentDecimalSeparator()+repeat("9",dec#)) to seeding_string#
66568>>>>>>>        else    move ("-"+repeat("9",len#)) to seeding_string#
66570>>>>>>>      end
66570>>>>>>>>
66570>>>>>>>      move seeding_string# to seeding_number#
66571>>>>>>>    end
66571>>>>>>>>
66571>>>>>>>    if type# eq DF_DATE if dir# eq DF_DESCENDING move LargestPossibleDate to seeding_date#
66576>>>>>>>
66576>>>>>>>    get iTranslate_DFTYPE type# to type#
66577>>>>>>>    move (oJumpInValues(self)) to oJumpInValues#
66578>>>>>>>                                set value of oJumpInValues# item (seg#*4+0) to Type#
66579>>>>>>>    if Type# eq SC_TYPE_ASCII   set value of oJumpInValues# item (seg#*4+1) to seeding_string#
66582>>>>>>>    if Type# eq SC_TYPE_DATE    set value of oJumpInValues# item (seg#*4+1) to seeding_date#
66585>>>>>>>    if Type# eq SC_TYPE_NUMERIC set value of oJumpInValues# item (seg#*4+1) to seeding_number#
66588>>>>>>>                                set value of oJumpInValues# item (seg#*4+2) to SC_COMP_GE
66589>>>>>>>                                set value of oJumpInValues# item (seg#*4+3) to Fld#
66590>>>>>>>    set value of oJumpInValues# item 0 to (value(oJumpInValues#,0)+1)
66591>>>>>>>  end_procedure
66592>>>>>>>
66592>>>>>>>  procedure AnalyzeJumpInOutValues integer file# integer idx#
66594>>>>>>>    integer segment# max# fld# dir# stop#
66594>>>>>>>    integer last_segment_seeded#
66594>>>>>>>    string lsFields
66594>>>>>>>    set pMainFile to file#
66595>>>>>>>    set pOrdering to idx#
66596>>>>>>>
66596>>>>>>>  //get FDX_IndexAsFields 0 file# idx# to lsFields
66596>>>>>>>  //get FDX_FieldsTranslateOverlaps 0 file# lsFields to lsFields
66596>>>>>>>  //if dir# eq DF_DESCENDING move ("-"+fname#) to fname#
66596>>>>>>>  //get FDX_AttrValue_IDXSEG oFDX# DF_INDEX_SEGMENT_DIRECTION file# index# segment# to dir#
66596>>>>>>>
66596>>>>>>>
66596>>>>>>>    send read_file_definition to oIndexAnalyzer# file#
66597>>>>>>>    send idx_translate_overlaps_all to oIndexAnalyzer#
66598>>>>>>>    get idx_max_segment of oIndexAnalyzer# idx# to max#
66599>>>>>>>    move 0 to stop#
66600>>>>>>>    move 0 to last_segment_seeded#
66601>>>>>>>
66601>>>>>>>    for segment# from 1 to max#
66607>>>>>>>>
66607>>>>>>>      get idx_Segment_Direction of oIndexAnalyzer# idx# segment# to dir#
66608>>>>>>>      if dir# eq DF_DESCENDING move 1 to stop# // Stop seeding if descending segment.
66611>>>>>>>      ifnot stop# begin
66613>>>>>>>        get idx_segment of oIndexAnalyzer# idx# segment# to fld#
66614>>>>>>>        send AnalyzeJumpInOutValuesHelp file# fld# segment#
66615>>>>>>>        move segment# to last_segment_seeded#
66616>>>>>>>      end
66616>>>>>>>>
66616>>>>>>>    loop
66617>>>>>>>>
66617>>>>>>>
66617>>>>>>>    if last_segment_seeded# lt max# begin // If not all segments were seeded
66619>>>>>>>      // Get number of first field not seeded:
66619>>>>>>>      get idx_segment of oIndexAnalyzer# idx# (last_segment_seeded#+1) to fld#
66620>>>>>>>      // Get direction of first segment not seeded:
66620>>>>>>>      get idx_Segment_Direction of oIndexAnalyzer# idx# (last_segment_seeded#+1) to dir#
66621>>>>>>>      // Seed
66621>>>>>>>      send seed_lowest_possible file# fld# dir# (last_segment_seeded#+1)
66622>>>>>>>    end
66622>>>>>>>>
66622>>>>>>>  end_procedure
66623>>>>>>>
66623>>>>>>>  procedure seed_buffer.i integer file#
66625>>>>>>>    integer Segment# max# oJumpInValues# type# Fld#
66625>>>>>>>    number JumpInNum#
66625>>>>>>>    date   JumpInDat#
66625>>>>>>>    string JumpInStr#
66625>>>>>>>    move (oJumpInValues(self)) to oJumpInValues#
66626>>>>>>>    get value of oJumpInValues# item 0 to max#
66627>>>>>>>    for Segment# from 1 to max#
66633>>>>>>>>
66633>>>>>>>      get value of oJumpInValues# item (Segment#*4+0) to type#
66634>>>>>>>      if type# eq SC_TYPE_ASCII   get value of oJumpInValues# item (Segment#*4+1) to JumpInStr#
66637>>>>>>>      if type# eq SC_TYPE_DATE    get value of oJumpInValues# item (Segment#*4+1) to JumpInDat#
66640>>>>>>>      if type# eq SC_TYPE_NUMERIC get value of oJumpInValues# item (Segment#*4+1) to JumpInNum#
66643>>>>>>>      get value of oJumpInValues# item (Segment#*4+3) to Fld#
66644>>>>>>>      if type# eq SC_TYPE_ASCII   set_field_value file# fld# to JumpInStr#
66649>>>>>>>      if type# eq SC_TYPE_DATE    set_field_value file# fld# to JumpInDat#
66654>>>>>>>      if type# eq SC_TYPE_NUMERIC set_field_value file# fld# to JumpInNum#
66659>>>>>>>    loop
66660>>>>>>>>
66660>>>>>>>  end_procedure
66661>>>>>>>
66661>>>>>>>  function iJumpOut.i integer file# returns integer
66663>>>>>>>    integer Segment# max# oJumpOutValues# Type# Fld# Comp# lbEnough
66663>>>>>>>    number JumpOutNum# nCurrentVal#
66663>>>>>>>    date   JumpOutDat# dCurrentVal#
66663>>>>>>>    string JumpOutStr# sCurrentVal#
66663>>>>>>>    move (oJumpOutValues(self)) to oJumpOutValues#
66664>>>>>>>    get value of oJumpOutValues# item 0 to max#
66665>>>>>>>    move DFFALSE to lbEnough
66666>>>>>>>    for Segment# from 1 to max#
66672>>>>>>>>
66672>>>>>>>      ifnot lbEnough begin
66674>>>>>>>        get value of oJumpOutValues# item (Segment#*4+0) to Type#
66675>>>>>>>        get value of oJumpOutValues# item (Segment#*4+2) to Comp#
66676>>>>>>>        get value of oJumpOutValues# item (Segment#*4+3) to Fld#
66677>>>>>>>        if type# eq SC_TYPE_ASCII begin
66679>>>>>>>          get value of oJumpOutValues# item (Segment#*4+1) to JumpOutStr#
66680>>>>>>>          get_field_value file# fld# to sCurrentVal#
66683>>>>>>>          if comp# eq SC_COMP_LT if sCurrentVal# GE JumpOutStr# function_return 1
66688>>>>>>>          if comp# eq SC_COMP_LE if sCurrentVal# GT JumpOutStr# function_return 1
66693>>>>>>>          if sCurrentVal# NE JumpOutStr# move DFTRUE to lbEnough
66696>>>>>>>        end
66696>>>>>>>>
66696>>>>>>>        else if type# eq SC_TYPE_DATE begin
66699>>>>>>>          get value of oJumpOutValues# item (Segment#*4+1) to JumpOutDat#
66700>>>>>>>          get_field_value file# fld# to dCurrentVal#
66703>>>>>>>          if comp# eq SC_COMP_LT if dCurrentVal# GE JumpOutDat# function_return 1
66708>>>>>>>          if comp# eq SC_COMP_LE if dCurrentVal# GT JumpOutDat# function_return 1
66713>>>>>>>          if dCurrentVal# NE JumpOutDat# move DFTRUE to lbEnough
66716>>>>>>>        end
66716>>>>>>>>
66716>>>>>>>        else if type# eq SC_TYPE_NUMERIC begin
66719>>>>>>>          get value of oJumpOutValues# item (Segment#*4+1) to JumpOutNum#
66720>>>>>>>          get_field_value file# fld# to nCurrentVal#
66723>>>>>>>          if comp# eq SC_COMP_LT if nCurrentVal# GE JumpOutNum# function_return 1
66728>>>>>>>          if comp# eq SC_COMP_LE if nCurrentVal# GT JumpOutNum# function_return 1
66733>>>>>>>          if nCurrentVal# NE JumpOutNum# move DFTRUE to lbEnough
66736>>>>>>>        end
66736>>>>>>>>
66736>>>>>>>      end
66736>>>>>>>>
66736>>>>>>>    loop
66737>>>>>>>>
66737>>>>>>>  end_function
66738>>>>>>>end_class // cSelectionCriteriaArray
66739>>>>>>>
66739>>>>>>>class cDataScanner is a cBasicDataScanner
66740>>>>>>>  procedure construct_object
66742>>>>>>>    forward send construct_object
66744>>>>>>>    object oSelectionCriteriaArray is a cSelectionCriteriaArray
66746>>>>>>>    end_object
66747>>>>>>>  end_procedure
66748>>>>>>>  procedure jump_in
66750>>>>>>>    integer file# idx#
66750>>>>>>>    get pMainFile to file#
66751>>>>>>>    get pOrdering to idx#
66752>>>>>>>    forward send jump_in // Clears the record buffer
66754>>>>>>>    send seed_buffer.i to (oSelectionCriteriaArray(self)) file#
66755>>>>>>>  end_procedure
66756>>>>>>>  function iSelect returns integer
66758>>>>>>>    function_return (iEvaluate(oSelectionCriteriaArray(self)))
66759>>>>>>>  end_function
66760>>>>>>>  function iJump_Out returns integer
66762>>>>>>>    function_return (iJumpOut.i(oSelectionCriteriaArray(self),pMainFile(self)))
66763>>>>>>>  end_function
66764>>>>>>>  procedure reset_crit
66766>>>>>>>    send reset to (oSelectionCriteriaArray(self))
66767>>>>>>>  end_procedure
66768>>>>>>>  procedure reset
66770>>>>>>>    forward send reset
66772>>>>>>>    send reset_crit
66773>>>>>>>  end_procedure
66774>>>>>>>  procedure add_criteria_boolean_expr string str#
66776>>>>>>>    send add_criteria_boolean_expr to (oSelectionCriteriaArray(self)) str#
66777>>>>>>>  end_procedure
66778>>>>>>>  procedure add_criteria_function integer msg# integer obj#
66780>>>>>>>    send add_criteria_function to (oSelectionCriteriaArray(self)) msg# obj#
66781>>>>>>>  end_procedure
66782>>>>>>>  procedure add_criteria_simple integer file# integer fld# integer comp# string val1# string val2#
66784>>>>>>>    send add_criteria_simple to (oSelectionCriteriaArray(self)) file# fld# comp# val1# val2#
66785>>>>>>>  end_procedure
66786>>>>>>>  // or-list
66786>>>>>>>  procedure add_criteria_orlist integer file# integer fld# string lsValues
66788>>>>>>>    send add_criteria_orlist to (oSelectionCriteriaArray(self)) file# fld# lsValues
66789>>>>>>>  end_procedure
66790>>>>>>>  procedure run
66792>>>>>>>    send AnalyzeJumpInOutValues to (oSelectionCriteriaArray(self)) (pMainFile(self)) (pOrdering(self))
66793>>>>>>>    send show_JumpInValues      to (oSelectionCriteriaArray(self))
66794>>>>>>>    send show_JumpOutValues     to (oSelectionCriteriaArray(self))
66795>>>>>>>    forward send run
66797>>>>>>>  end_procedure
66798>>>>>>>end_class // cDataScanner
66799>>>>>>>
66799>>>>>>>class cBreakHandler is a cArray
66800>>>>>>>  procedure construct_object
66802>>>>>>>    forward send construct_object
66804>>>>>>>    property integer prv.piFirstRec public DFTRUE
66805>>>>>>>  end_procedure
66806>>>>>>>  item_property_list
66806>>>>>>>    item_property integer piFile.i      // What file? (always main file)
66806>>>>>>>    item_property integer piField.i     // What field? (If file is 0 then Break field is a function ID)
66806>>>>>>>    item_property integer phExprArr.i
66806>>>>>>>    item_property integer piExprRow.i
66806>>>>>>>    item_property integer piLevel.i     // A change in value triggers a break in what level?
66806>>>>>>>    item_property string  psPreviousValue.i
66806>>>>>>>  end_item_property_list cBreakHandler
#REM 66850 DEFINE FUNCTION PSPREVIOUSVALUE.I INTEGER LIROW RETURNS STRING
#REM 66854 DEFINE PROCEDURE SET PSPREVIOUSVALUE.I INTEGER LIROW STRING VALUE
#REM 66858 DEFINE FUNCTION PILEVEL.I INTEGER LIROW RETURNS INTEGER
#REM 66862 DEFINE PROCEDURE SET PILEVEL.I INTEGER LIROW INTEGER VALUE
#REM 66866 DEFINE FUNCTION PIEXPRROW.I INTEGER LIROW RETURNS INTEGER
#REM 66870 DEFINE PROCEDURE SET PIEXPRROW.I INTEGER LIROW INTEGER VALUE
#REM 66874 DEFINE FUNCTION PHEXPRARR.I INTEGER LIROW RETURNS INTEGER
#REM 66878 DEFINE PROCEDURE SET PHEXPRARR.I INTEGER LIROW INTEGER VALUE
#REM 66882 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 66886 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 66890 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 66894 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
66899>>>>>>>  procedure add_break_field integer liFile integer liField integer liExprRow integer lhExprArr
66901>>>>>>>    integer liRow
66901>>>>>>>    get row_count to liRow
66902>>>>>>>    set piFile.i      liRow to liFile
66903>>>>>>>    set piField.i     liRow to liField
66904>>>>>>>    set phExprArr.i   liRow to lhExprArr
66905>>>>>>>    set piExprRow.i   liRow to liExprRow
66906>>>>>>>    set psPreviousValue.i item liRow to ""
66907>>>>>>>  end_procedure
66908>>>>>>>  function break_level returns integer
66910>>>>>>>    integer liMax liRow liLevel liFile lhExprArr liExprRow
66910>>>>>>>    string lsValue
66910>>>>>>>    move 0 to liLevel
66911>>>>>>>    get row_count to liMax
66912>>>>>>>    decrement liMax
66913>>>>>>>    if (prv.piFirstRec(self)) begin
66915>>>>>>>      set prv.piFirstRec to DFFALSE
66916>>>>>>>      if (Row_Count(self)) move BRK_BEGIN to liLevel
66919>>>>>>>      else move 0 to liLevel
66921>>>>>>>    end
66921>>>>>>>>
66921>>>>>>>    else begin
66922>>>>>>>      for liRow from 0 to liMax
66928>>>>>>>>
66928>>>>>>>        get piFile.i liRow to liFile
66929>>>>>>>        if liFile get FieldInf_FieldValue liFile (piField.i(self,liRow)) to lsValue
66932>>>>>>>        else begin
66933>>>>>>>          get phExprArr.i liRow to lhExprArr
66934>>>>>>>          get piExprRow.i liRow to liExprRow
66935>>>>>>>          get sEvalExpression of (Query_ExprEvaluator(self)) (piExprId.i(lhExprArr,liExprRow)) to lsValue
66936>>>>>>>        end
66936>>>>>>>>
66936>>>>>>>        if lsValue ne (psPreviousValue.i(self,liRow)) begin
66938>>>>>>>          move (liRow+1) to liLevel
66939>>>>>>>          move liMax to liRow // Break the loop!
66940>>>>>>>        end
66940>>>>>>>>
66940>>>>>>>      loop
66941>>>>>>>>
66941>>>>>>>    end
66941>>>>>>>>
66941>>>>>>>    if liLevel begin // If a break was detected we update our 'previous' values
66943>>>>>>>      for liRow from 0 to liMax
66949>>>>>>>>
66949>>>>>>>        get piFile.i liRow to liFile
66950>>>>>>>        if liFile get FieldInf_FieldValue liFile (piField.i(self,liRow)) to lsValue
66953>>>>>>>        else begin
66954>>>>>>>          get phExprArr.i liRow to lhExprArr
66955>>>>>>>          get piExprRow.i liRow to liExprRow
66956>>>>>>>          get sEvalExpression of (Query_ExprEvaluator(self)) (piExprId.i(lhExprArr,liExprRow)) to lsValue
66957>>>>>>>        end
66957>>>>>>>>
66957>>>>>>>        set psPreviousValue.i item liRow to lsValue
66958>>>>>>>      loop
66959>>>>>>>>
66959>>>>>>>    end
66959>>>>>>>>
66959>>>>>>>    function_return liLevel // 0=No break
66960>>>>>>>  end_function
66961>>>>>>>  procedure reset
66963>>>>>>>    send delete_data
66964>>>>>>>    set prv.piFirstRec to DFTRUE
66965>>>>>>>  end_procedure
66966>>>>>>>end_class // cBreakHandler
66967>>>>>>>
66967>>>>>>>class cReportTotals is a cArray
66968>>>>>>>  procedure construct_object
66970>>>>>>>    forward send construct_object
66972>>>>>>>    property integer piNumberOfColumns public 0
66973>>>>>>>    property integer piCurrentLevel    public 0
66974>>>>>>>  end_procedure
66975>>>>>>>  procedure reset
66977>>>>>>>    send delete_data
66978>>>>>>>    set piCurrentLevel to 0
66979>>>>>>>  end_procedure
66980>>>>>>>  function nRcl_Data.i integer liColumn returns number
66982>>>>>>>    function_return (value(self,piNumberOfColumns(self)*piCurrentLevel(self)+liColumn))
66983>>>>>>>  end_function
66984>>>>>>>  procedure Sum_Data.in integer liColumn number lnValue
66986>>>>>>>    integer liItem lhSelf
66986>>>>>>>    move self to lhSelf
66987>>>>>>>    move (piNumberOfColumns(lhSelf)*piCurrentLevel(lhSelf)+liColumn) to liItem
66988>>>>>>>    //showln lnValue " " (number(value(lhSelf,liItem)))
66988>>>>>>>    set value item liItem to (lnValue+number(value(lhSelf,liItem)))
66989>>>>>>>  end_procedure
66990>>>>>>>  procedure Sto_Data.in integer liColumn number lnValue
66992>>>>>>>    set value item (piNumberOfColumns(self)*piCurrentLevel(self)+liColumn) to lnValue
66993>>>>>>>  end_procedure
66994>>>>>>>  procedure New_Level
66996>>>>>>>    integer liNumberOfColumns liCurrentLevel liBase liItem
66996>>>>>>>    get piNumberOfColumns to liNumberOfColumns
66997>>>>>>>    get piCurrentLevel to liCurrentLevel
66998>>>>>>>    increment liCurrentLevel
66999>>>>>>>    move (liCurrentLevel*liNumberOfColumns) to liBase
67000>>>>>>>    for liItem from liBase to (liBase+liNumberOfColumns-1)
67006>>>>>>>>
67006>>>>>>>      set value item liItem to 0
67007>>>>>>>    loop
67008>>>>>>>>
67008>>>>>>>    set piCurrentLevel to liCurrentLevel
67009>>>>>>>  end_procedure
67010>>>>>>>  procedure Drop_Level
67012>>>>>>>    integer liNumberOfColumns liCurrentLevel liBase liItem
67012>>>>>>>    get piNumberOfColumns to liNumberOfColumns
67013>>>>>>>    get piCurrentLevel to liCurrentLevel
67014>>>>>>>    decrement liCurrentLevel
67015>>>>>>>    move (liCurrentLevel*liNumberOfColumns) to liBase
67016>>>>>>>    for liItem from liBase to (liBase+liNumberOfColumns-1)
67022>>>>>>>>
67022>>>>>>>      set value item liItem to (number(value(self,liItem))+number(value(self,liItem+liNumberOfColumns)))
67023>>>>>>>    loop
67024>>>>>>>>
67024>>>>>>>    set piCurrentLevel to liCurrentLevel
67025>>>>>>>  end_procedure
67026>>>>>>>end_class // cReportTotals
67027>>>>>>>
67027>>>>>>>class cReport_Info is a cDataScanner
67028>>>>>>>  procedure construct_object
67030>>>>>>>    forward send construct_object
67032>>>>>>>    property string  pReportTitle public "Un-titled"
67033>>>>>>>    property string  pBottomText  public ""
67034>>>>>>>    property integer pOnlyMostSignificantBreakLevel public false
67035>>>>>>>    object oBreaks is a cBreakHandler NO_IMAGE
67037>>>>>>>    end_object
67038>>>>>>>  end_procedure
67039>>>>>>>
67039>>>>>>>  item_property_list
67039>>>>>>>    item_property integer rpt_field_file
67039>>>>>>>    item_property integer rpt_field_field
67039>>>>>>>    item_property string  rpt_field_name
67039>>>>>>>    item_property integer rpt_field_cr
67039>>>>>>>    item_property number  rpt_field_start
67039>>>>>>>    item_property number  rpt_field_width
67039>>>>>>>    item_property string  rpt_field_font
67039>>>>>>>    item_property integer rpt_field_fontsize
67039>>>>>>>    item_property integer rpt_field_sum
67039>>>>>>>    item_property integer rpt_field_fontstyle
67039>>>>>>>    item_property integer rpt_field_type
67039>>>>>>>    item_property integer rpt_field_decpoints
67039>>>>>>>    item_property integer rpt_field_expr_array
67039>>>>>>>    item_property integer rpt_field_expr_row
67039>>>>>>>  end_item_property_list cReport_info
#REM 67107 DEFINE FUNCTION RPT_FIELD_EXPR_ROW INTEGER LIROW RETURNS INTEGER
#REM 67111 DEFINE PROCEDURE SET RPT_FIELD_EXPR_ROW INTEGER LIROW INTEGER VALUE
#REM 67115 DEFINE FUNCTION RPT_FIELD_EXPR_ARRAY INTEGER LIROW RETURNS INTEGER
#REM 67119 DEFINE PROCEDURE SET RPT_FIELD_EXPR_ARRAY INTEGER LIROW INTEGER VALUE
#REM 67123 DEFINE FUNCTION RPT_FIELD_DECPOINTS INTEGER LIROW RETURNS INTEGER
#REM 67127 DEFINE PROCEDURE SET RPT_FIELD_DECPOINTS INTEGER LIROW INTEGER VALUE
#REM 67131 DEFINE FUNCTION RPT_FIELD_TYPE INTEGER LIROW RETURNS INTEGER
#REM 67135 DEFINE PROCEDURE SET RPT_FIELD_TYPE INTEGER LIROW INTEGER VALUE
#REM 67139 DEFINE FUNCTION RPT_FIELD_FONTSTYLE INTEGER LIROW RETURNS INTEGER
#REM 67143 DEFINE PROCEDURE SET RPT_FIELD_FONTSTYLE INTEGER LIROW INTEGER VALUE
#REM 67147 DEFINE FUNCTION RPT_FIELD_SUM INTEGER LIROW RETURNS INTEGER
#REM 67151 DEFINE PROCEDURE SET RPT_FIELD_SUM INTEGER LIROW INTEGER VALUE
#REM 67155 DEFINE FUNCTION RPT_FIELD_FONTSIZE INTEGER LIROW RETURNS INTEGER
#REM 67159 DEFINE PROCEDURE SET RPT_FIELD_FONTSIZE INTEGER LIROW INTEGER VALUE
#REM 67163 DEFINE FUNCTION RPT_FIELD_FONT INTEGER LIROW RETURNS STRING
#REM 67167 DEFINE PROCEDURE SET RPT_FIELD_FONT INTEGER LIROW STRING VALUE
#REM 67171 DEFINE FUNCTION RPT_FIELD_WIDTH INTEGER LIROW RETURNS NUMBER
#REM 67175 DEFINE PROCEDURE SET RPT_FIELD_WIDTH INTEGER LIROW NUMBER VALUE
#REM 67179 DEFINE FUNCTION RPT_FIELD_START INTEGER LIROW RETURNS NUMBER
#REM 67183 DEFINE PROCEDURE SET RPT_FIELD_START INTEGER LIROW NUMBER VALUE
#REM 67187 DEFINE FUNCTION RPT_FIELD_CR INTEGER LIROW RETURNS INTEGER
#REM 67191 DEFINE PROCEDURE SET RPT_FIELD_CR INTEGER LIROW INTEGER VALUE
#REM 67195 DEFINE FUNCTION RPT_FIELD_NAME INTEGER LIROW RETURNS STRING
#REM 67199 DEFINE PROCEDURE SET RPT_FIELD_NAME INTEGER LIROW STRING VALUE
#REM 67203 DEFINE FUNCTION RPT_FIELD_FIELD INTEGER LIROW RETURNS INTEGER
#REM 67207 DEFINE PROCEDURE SET RPT_FIELD_FIELD INTEGER LIROW INTEGER VALUE
#REM 67211 DEFINE FUNCTION RPT_FIELD_FILE INTEGER LIROW RETURNS INTEGER
#REM 67215 DEFINE PROCEDURE SET RPT_FIELD_FILE INTEGER LIROW INTEGER VALUE
67220>>>>>>>
67220>>>>>>>  procedure check_break
67222>>>>>>>    integer brk#
67222>>>>>>>    get break_level of (oBreaks(self)) to brk#
67223>>>>>>>    if brk# send handle_break brk#
67226>>>>>>>  end_procedure
67227>>>>>>>
67227>>>>>>>  procedure subheader integer level#
67229>>>>>>>    DATASCAN$SHOWLN ("Subheader level: "+string(level#))
67229>>>>>>>  end_procedure
67230>>>>>>>
67230>>>>>>>  procedure subtotal integer level#
67232>>>>>>>    DATASCAN$SHOWLN ("SubTotal level: "+string(level#))
67232>>>>>>>  end_procedure
67233>>>>>>>
67233>>>>>>>  procedure handle_break integer brk#
67235>>>>>>>    integer oBreaks# levels# level#
67235>>>>>>>    move (oBreaks(self)) to oBreaks#
67236>>>>>>>    if brk# begin
67238>>>>>>>      if (pOnlyMostSignificantBreakLevel(self)) begin
67240>>>>>>>        if brk# eq BRK_BEGIN send subheader 1
67243>>>>>>>        if brk# eq BRK_END send subtotal 1
67246>>>>>>>        if brk# gt 0 begin
67248>>>>>>>          send subtotal brk#
67249>>>>>>>          send subheader brk#
67250>>>>>>>        end
67250>>>>>>>>
67250>>>>>>>      end
67250>>>>>>>>
67250>>>>>>>      else begin
67251>>>>>>>        get row_count of oBreaks# to levels#
67252>>>>>>>        if (brk#>0 or brk#=BRK_END) begin
67254>>>>>>>          for_ex level# from levels# down_to 1
67261>>>>>>>            send subtotal level#
67262>>>>>>>          loop
67263>>>>>>>>
67263>>>>>>>        end
67263>>>>>>>>
67263>>>>>>>        if (brk#>0 or brk#=BRK_BEGIN) begin
67265>>>>>>>          for level# from 1 to levels#
67271>>>>>>>>
67271>>>>>>>            send subheader level#
67272>>>>>>>          loop
67273>>>>>>>>
67273>>>>>>>        end
67273>>>>>>>>
67273>>>>>>>      end
67273>>>>>>>>
67273>>>>>>>    end
67273>>>>>>>>
67273>>>>>>>  end_procedure
67274>>>>>>>
67274>>>>>>>  procedure add_break_field integer file# integer field# integer liExprRow integer lhExprArr
67276>>>>>>>    send add_break_field to (oBreaks(self)) file# field# liExprRow lhExprArr
67277>>>>>>>  end_procedure
67278>>>>>>>
67278>>>>>>>  procedure reset_breaks
67280>>>>>>>    send reset to (oBreaks(self))
67281>>>>>>>  end_procedure
67282>>>>>>>
67282>>>>>>>  procedure reset
67284>>>>>>>    forward send reset
67286>>>>>>>    send reset_crit
67287>>>>>>>    send reset_breaks
67288>>>>>>>  end_procedure
67289>>>>>>>
67289>>>>>>>  procedure DoReset
67291>>>>>>>    send reset
67292>>>>>>>    send delete_data
67293>>>>>>>  end_procedure
67294>>>>>>>
67294>>>>>>>  procedure add_field integer file# integer field# string name# integer cr# number start# number width# string font# integer fontsize# integer sum# integer fontstyle# integer lhExprArr integer liExprRow
67296>>>>>>>    integer row#
67296>>>>>>>    get row_count to row#
67297>>>>>>>    set rpt_field_file       row# to file#
67298>>>>>>>    set rpt_field_field      row# to field#
67299>>>>>>>    set rpt_field_name       row# to name#
67300>>>>>>>    set rpt_field_cr         row# to cr#
67301>>>>>>>    set rpt_field_start      row# to start#
67302>>>>>>>    set rpt_field_width      row# to width#
67303>>>>>>>    set rpt_field_font       row# to font#
67304>>>>>>>    set rpt_field_fontsize   row# to fontsize#
67305>>>>>>>    set rpt_field_sum        row# to sum#
67306>>>>>>>    set rpt_field_fontstyle  row# to fontstyle#
67307>>>>>>>    set rpt_field_expr_array row# to lhExprArr
67308>>>>>>>    set rpt_field_expr_row   row# to liExprRow
67309>>>>>>>    if file# begin
67311>>>>>>>      set rpt_field_type       row# to (FieldInf_FieldType(file#,field#))
67312>>>>>>>      set rpt_field_decpoints  row# to (FieldInf_DecPoints(file#,field#))
67313>>>>>>>    end
67313>>>>>>>>
67313>>>>>>>    else begin
67314>>>>>>>      set rpt_field_type       row# to (piType.i(lhExprArr,liExprRow))
67315>>>>>>>      set rpt_field_decpoints  row# to (piDecimals.i(lhExprArr,liExprRow))
67316>>>>>>>    end
67316>>>>>>>>
67316>>>>>>>  end_procedure
67317>>>>>>>
67317>>>>>>>  function rpt_field_count returns integer
67319>>>>>>>    function_return (row_count(self))
67320>>>>>>>  end_function
67321>>>>>>>  procedure record_not_selected
67323>>>>>>>//  showln ("NOT SELECT: "+idx_field_value(oIndexAnalyzer#,pOrdering(self),1,1))
67323>>>>>>>  end_procedure
67324>>>>>>>  procedure Record_Selected
67326>>>>>>>    send check_break
67327>>>>>>>//  showln (idx_field_value(oIndexAnalyzer#,pOrdering(self),1,1))
67327>>>>>>>  end_procedure
67328>>>>>>>  procedure scan_starts // Sent unconditionally at the beginning of a scan
67330>>>>>>>//    send handle_break BRK_BEGIN
67330>>>>>>>  end_procedure
67331>>>>>>>  procedure scan_ended // Sent unconditionally at the end of a scan
67333>>>>>>>    send handle_break BRK_END
67334>>>>>>>  end_procedure
67335>>>>>>>end_class // cReport_Info
67336>>>>>Use Files.utl    // Utilities for handling file related stuff
67336>>>>>Use Strings.utl  // String manipulation for VDF
67336>>>>>Use Dates.utl    // Date manipulation for VDF
67336>>>>>Use Wait.utl     //
67336>>>>>Use MsgBox.utl   // obs procedure
67336>>>>>Use HTML.utl     // HTML functions
Including file: html.utl    (C:\projects\BRS\VDFQuery\AppSrc\html.utl)
67336>>>>>>>//**********************************************************************
67336>>>>>>>// Use HTML.utl     // HTML functions
67336>>>>>>>//
67336>>>>>>>//
67336>>>>>>>// Create: Fri  04-09-1998
67336>>>>>>>// Update: Wed  16-09-1998 - Un-commented setting of pHtmlConversionTable
67336>>>>>>>//
67336>>>>>>>//
67336>>>>>>>//**********************************************************************
67336>>>>>>>
67336>>>>>>>Use Strings.nui  // String manipulation for VDF
67336>>>>>>>Use Files.nui    // Utilities for handling file related stuff
67336>>>>>>>Use URL.nui      // URL manipulation
Including file: url.nui    (C:\projects\BRS\VDFQuery\AppSrc\url.nui)
67336>>>>>>>>>// Use URL.nui      // URL manipulation
67336>>>>>>>>>
67336>>>>>>>>>//> From the point of view of the URL string manipulation functions an URL
67336>>>>>>>>>//> is composed of the following items:
67336>>>>>>>>>//>
67336>>>>>>>>>//>    * Protocol      "http:"
67336>>>>>>>>>//>    * User ID       "sture"
67336>>>>>>>>>//>    * Password      "headset"
67336>>>>>>>>>//>    * Host          "www.sture.dk"
67336>>>>>>>>>//>    * Port          80
67336>>>>>>>>>//>    * Path          "/Images/EDUC2001"
67336>>>>>>>>>//>    * Type          "type=xml"
67336>>>>>>>>>//>
67336>>>>>>>>>//> function URL_ParseURL global string lsURL returns integer
67336>>>>>>>>>//>
67336>>>>>>>>>//> To have a URL decomposed into the items above use the URL_ParseURL
67336>>>>>>>>>//> function. The function returns TRUE if a host could be identidfied
67336>>>>>>>>>//> as part of the lsURL string and FALSE if not.
67336>>>>>>>>>//>
67336>>>>>>>>>//>
67336>>>>>>>>>//> function URL_Value global integer liSegment returns string
67336>>>>>>>>>//>
67336>>>>>>>>>//> After having used the URL_ParseURL to decompose an URL you should use
67336>>>>>>>>>//> the URL_Value function to obtain the value of each component in the
67336>>>>>>>>>//> URL. For example, to obtain the 'Path' part of the URL you would write
67336>>>>>>>>>//>
67336>>>>>>>>>//>   get URL_Value URL_SEGMENT_PATH to lsPath
67336>>>>>>>>>//>
67336>>>>>>>>>//> The URL_SEGMENT_PATH symbol is a constant defined by the URL.nui package.
67336>>>>>>>>>//> You may pass the following segment identifiers to the function:
67336>>>>>>>>>//>
67336>>>>>>>>>//>    URL_SEGMENT_PROTOCOL, URL_SEGMENT_USER, URL_SEGMENT_PASSWORD,
67336>>>>>>>>>//>    URL_SEGMENT_HOST, URL_SEGMENT_PORT, URL_SEGMENT_PATH and
67336>>>>>>>>>//>    URL_SEGMENT_TYPE
67336>>>>>>>>>//>
67336>>>>>>>>>//> These symbols may also be used as arguments to a the 'set URL_Value'
67336>>>>>>>>>//> procedure anabling you to set the value of each individual before
67336>>>>>>>>>//> calling this function:
67336>>>>>>>>>//>
67336>>>>>>>>>//> function URL_Compose global returns string
67336>>>>>>>>>//>
67336>>>>>>>>>//> This function combines all the segments setup via the 'set URL_Value'
67336>>>>>>>>>//> procedure (and possebly leftovers from the most recent call to
67336>>>>>>>>>//> URL_ParseURL) and returns a URL.
67336>>>>>>>>>//>
67336>>>>>>>>>//>
67336>>>>>>>>>//> Note that the URL functions decribed here are merely string manipulations.
67336>>>>>>>>>//> They do not interact with any internet componenents locally on the machine
67336>>>>>>>>>//> or on the internet itself.
67336>>>>>>>>>//>
67336>>>>>>>>>
67336>>>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
67336>>>>>>>>>Use Strings.nui  // String manipulation for VDF
67336>>>>>>>>>
67336>>>>>>>>>enumeration_list
67336>>>>>>>>>  define URL_SEGMENT_PROTOCOL
67336>>>>>>>>>  define URL_SEGMENT_USER
67336>>>>>>>>>  define URL_SEGMENT_PASSWORD
67336>>>>>>>>>  define URL_SEGMENT_HOST
67336>>>>>>>>>  define URL_SEGMENT_PORT
67336>>>>>>>>>  define URL_SEGMENT_PATH
67336>>>>>>>>>  define URL_SEGMENT_TYPE
67336>>>>>>>>>end_enumeration_list
67336>>>>>>>>>
67336>>>>>>>>>
67336>>>>>>>>>desktop_section
67341>>>>>>>>>  object oUrlParser is a cArray NO_IMAGE
67343>>>>>>>>>    function iFindToken string lsToken string lsValue returns integer
67346>>>>>>>>>      integer liPos liLen liTokenLen
67346>>>>>>>>>      string lsString
67346>>>>>>>>>      move (length(lsToken)) to liTokenLen
67347>>>>>>>>>      move (length(lsValue)) to liLen
67348>>>>>>>>>      for liPos from 1 to liLen
67354>>>>>>>>>>
67354>>>>>>>>>        move (left(lsValue,liPos)) to lsString
67355>>>>>>>>>        if (right(lsString,liTokenLen)=lsToken) function_return liPos
67358>>>>>>>>>      loop
67359>>>>>>>>>>
67359>>>>>>>>>      function_return 0
67360>>>>>>>>>    end_function
67361>>>>>>>>>
67361>>>>>>>>>    //   ftp://:@:/;type=
67361>>>>>>>>>
67361>>>>>>>>>    function sParseUrl string lsUrl returns integer
67364>>>>>>>>>      integer liPos lbRval
67364>>>>>>>>>      string lsValue lsValue2 lsHost
67364>>>>>>>>>      send delete_data
67365>>>>>>>>>      move DFTRUE to lbRval
67366>>>>>>>>>      get iFindToken ("/"+"/") lsUrl to liPos // Protokol?
67367>>>>>>>>>      if liPos begin // Protokol
67369>>>>>>>>>        move (left(lsUrl,liPos)) to lsValue
67370>>>>>>>>>        move (replace(lsValue,lsUrl,"")) to lsUrl
67371>>>>>>>>>        set value item URL_SEGMENT_PROTOCOL to (StringLeftBut(lsValue,2))
67372>>>>>>>>>      end
67372>>>>>>>>>>
67372>>>>>>>>>
67372>>>>>>>>>      get iFindToken "@" lsUrl to liPos // User ?
67373>>>>>>>>>      if liPos begin // User
67375>>>>>>>>>        move (left(lsUrl,liPos)) to lsValue
67376>>>>>>>>>        move (replace(lsValue,lsUrl,"")) to lsUrl
67377>>>>>>>>>        get iFindToken ":" lsValue to liPos
67378>>>>>>>>>        if liPos begin // User and Password
67380>>>>>>>>>          move (left(lsValue,liPos)) to lsValue2
67381>>>>>>>>>          set value item URL_SEGMENT_USER to (StringLeftBut(lsValue2,1))
67382>>>>>>>>>          move (replace(lsValue2,lsValue,"")) to lsValue
67383>>>>>>>>>          set value item URL_SEGMENT_PASSWORD to (StringLeftBut(lsValue,1))
67384>>>>>>>>>        end
67384>>>>>>>>>>
67384>>>>>>>>>        else begin // User without password
67385>>>>>>>>>          set value item URL_SEGMENT_USER to (StringLeftBut(lsValue,1))
67386>>>>>>>>>        end
67386>>>>>>>>>>
67386>>>>>>>>>      end
67386>>>>>>>>>>
67386>>>>>>>>>
67386>>>>>>>>>      //   ftp://:@:/;type=
67386>>>>>>>>>
67386>>>>>>>>>      get iFindToken ";" lsUrl to liPos // Type ?
67387>>>>>>>>>      if liPos begin // Type!
67389>>>>>>>>>        move (left(lsUrl,liPos)) to lsValue
67390>>>>>>>>>        move (replace(lsValue,lsUrl,"")) to lsUrl
67391>>>>>>>>>        set value item URL_SEGMENT_TYPE to lsUrl
67392>>>>>>>>>        move (StringLeftBut(lsValue,1)) to lsValue
67393>>>>>>>>>        get iFindToken "/" lsValue to liPos // Path ?
67394>>>>>>>>>        if liPos begin // Path! www.dataaccess.dk:80/magicpath/Images
67396>>>>>>>>>          move (left(lsValue,liPos-1)) to lsValue2
67397>>>>>>>>>          set value item URL_SEGMENT_PATH to (replace(lsValue2,lsValue,""))
67398>>>>>>>>>          move lsValue2 to lsValue
67399>>>>>>>>>        end
67399>>>>>>>>>>
67399>>>>>>>>>        get iFindToken ":" lsValue to liPos // Port ?
67400>>>>>>>>>        if liPos begin // Port !  Dataaccess.kn:80
67402>>>>>>>>>          move (left(lsValue,liPos)) to lsHost
67403>>>>>>>>>          set value item URL_SEGMENT_HOST to (StringLeftBut(lsHost,1))
67404>>>>>>>>>          set value item URL_SEGMENT_PORT to (replace(lsHost,lsValue,""))
67405>>>>>>>>>        end
67405>>>>>>>>>>
67405>>>>>>>>>        else set value item URL_SEGMENT_HOST to lsValue
67407>>>>>>>>>      end
67407>>>>>>>>>>
67407>>>>>>>>>      else begin
67408>>>>>>>>>        get iFindToken "/" lsUrl to liPos // Path ?
67409>>>>>>>>>        if liPos begin
67411>>>>>>>>>          move lsUrl to lsValue
67412>>>>>>>>>
67412>>>>>>>>>          if liPos begin // Path! www.dataaccess.dk:80/magicpath/Images
67414>>>>>>>>>            move (left(lsValue,liPos-1)) to lsValue2
67415>>>>>>>>>            set value item URL_SEGMENT_PATH to (replace(lsValue2,lsValue,""))
67416>>>>>>>>>            move lsValue2 to lsValue
67417>>>>>>>>>          end
67417>>>>>>>>>>
67417>>>>>>>>>          get iFindToken ":" lsValue to liPos // Port ?
67418>>>>>>>>>          if liPos begin // Port!  Dataaccess.kn:80
67420>>>>>>>>>            move (left(lsValue,liPos)) to lsHost
67421>>>>>>>>>            set value item URL_SEGMENT_HOST to (StringLeftBut(lsHost,1))
67422>>>>>>>>>            set value item URL_SEGMENT_PORT to (replace(lsHost,lsValue,""))
67423>>>>>>>>>          end
67423>>>>>>>>>>
67423>>>>>>>>>          else set value item URL_SEGMENT_HOST to lsValue
67425>>>>>>>>>        end
67425>>>>>>>>>>
67425>>>>>>>>>        else begin
67426>>>>>>>>>          get iFindToken ":" lsUrl to liPos // Port?
67427>>>>>>>>>          if liPos begin
67429>>>>>>>>>            move (left(lsUrl,liPos)) to lsValue
67430>>>>>>>>>            move (replace(lsValue,lsUrl,"")) to lsUrl
67431>>>>>>>>>            set value item URL_SEGMENT_HOST to (StringLeftBut(lsValue,1))
67432>>>>>>>>>            set value item URL_SEGMENT_PORT to lsUrl
67433>>>>>>>>>          end
67433>>>>>>>>>>
67433>>>>>>>>>          else begin
67434>>>>>>>>>            set value item URL_SEGMENT_HOST to lsUrl
67435>>>>>>>>>          end
67435>>>>>>>>>>
67435>>>>>>>>>        end
67435>>>>>>>>>>
67435>>>>>>>>>      end
67435>>>>>>>>>>
67435>>>>>>>>>      if (value(self,URL_SEGMENT_HOST)="") move DFFALSE to lbRval
67438>>>>>>>>>      function_return lbRval
67439>>>>>>>>>    end_function
67440>>>>>>>>>  end_object
67441>>>>>>>>>end_desktop_section
67446>>>>>>>>>
67446>>>>>>>>>// Public interface:
67446>>>>>>>>>
67446>>>>>>>>>function URL_ParseURL global string lsValue returns integer
67448>>>>>>>>>  function_return (sParseUrl(oUrlParser(self),lsValue))
67449>>>>>>>>>end_function
67450>>>>>>>>>
67450>>>>>>>>>function URL_Value global integer liSegment returns string
67452>>>>>>>>>  function_return (value(oUrlParser(self),liSegment))
67453>>>>>>>>>end_function
67454>>>>>>>>>
67454>>>>>>>>>procedure set URL_Value global integer liSegment string lsValue
67456>>>>>>>>>  set value of (oUrlParser(self)) item liSegment to lsValue
67457>>>>>>>>>end_procedure
67458>>>>>>>>>
67458>>>>>>>>>procedure URL_Reset
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
67460>>>>>>>>>  send delete_data to (oUrlParser(self))
67461>>>>>>>>>end_procedure
67462>>>>>>>>>
67462>>>>>>>>>function URL_Compose global returns string
67464>>>>>>>>>  integer liPort
67464>>>>>>>>>  string lsUser lsPassword lsHost lsPath lsType lsProtocol
67464>>>>>>>>>  string lsRval
67464>>>>>>>>>
67464>>>>>>>>>  //   ftp://:@:/;type=
67464>>>>>>>>>
67464>>>>>>>>>  get URL_Value URL_SEGMENT_PROTOCOL to lsProtocol
67465>>>>>>>>>  get URL_Value URL_SEGMENT_USER     to lsUser
67466>>>>>>>>>  get URL_Value URL_SEGMENT_PASSWORD to lsPassword
67467>>>>>>>>>  get URL_Value URL_SEGMENT_HOST     to lsHost
67468>>>>>>>>>  get URL_Value URL_SEGMENT_PORT     to liPort
67469>>>>>>>>>  get URL_Value URL_SEGMENT_PATH     to lsPath
67470>>>>>>>>>  get URL_Value URL_SEGMENT_TYPE     to lsType
67471>>>>>>>>>
67471>>>>>>>>>  if (lsProtocol<>"") move (lsProtocol+"/"+"/") to lsRval
67474>>>>>>>>>
67474>>>>>>>>>  if (lsUser<>"") begin
67476>>>>>>>>>    move (lsRval+lsUser) to lsRval
67477>>>>>>>>>    if (lsPassword<>"") move (lsRval+":"+lsPassword) to lsRval
67480>>>>>>>>>    move (lsRval+"@") to lsRval
67481>>>>>>>>>  end
67481>>>>>>>>>>
67481>>>>>>>>>  move (lsRval+lsHost) to lsRval
67482>>>>>>>>>  if (liPort<>0) move (lsRval+":"+string(liPort)) to lsRval
67485>>>>>>>>>  if (lsPath<>"") begin
67487>>>>>>>>>    if (left(lsPath,1)="/") move (lsRval+lsPath) to lsRval
67490>>>>>>>>>    else move (lsRval+"/"+lsPath) to lsRval
67492>>>>>>>>>  end
67492>>>>>>>>>>
67492>>>>>>>>>  if (lsType<>"") move (lsRval+";"+lsType) to lsRval
67495>>>>>>>>>  function_return lsRval
67496>>>>>>>>>end_function
67497>>>>>>>>>
67497>>>>>>>>>// The URL_InsertLinks is meant to be used to insert links into a string
67497>>>>>>>>>// of text as a preparation for writing it to a html page.
67497>>>>>>>>>//
67497>>>>>>>>>// If an URL occurs in the text the function will insert link tags
67497>>>>>>>>>// around the URL in order to make it a clickable.
67497>>>>>>>>>//
67497>>>>>>>>>// If you have an 'ugly' link like this:
67497>>>>>>>>>//
67497>>>>>>>>>//  ftp://jakob:magic@ftp.kruse-net.dk:8000/magic/data;type=xml
67497>>>>>>>>>//
67497>>>>>>>>>// and you want the browser to simply display
67497>>>>>>>>>//
67497>>>>>>>>>//         Click [here] to download some magic data
67497>>>>>>>>>//
67497>>>>>>>>>// where [] denotes the scope of the link, just pass this text to the
67497>>>>>>>>>// function:
67497>>>>>>>>>//
67497>>>>>>>>>//   Click ftp://jakob:magic@ftp.kruse-net.dk:8000/magic/data;type=xml[here]
67497>>>>>>>>>//   to download some magic data
67497>>>>>>>>>//
67497>>>>>>>>>//
67497>>>>>>>>>//
67497>>>>>>>>>//
67497>>>>>>>>>function URL_InsertLinks global string lsValue returns string
67499>>>>>>>>>  integer liPos liLen lbInLink lbFin
67499>>>>>>>>>  string lsRval lsChar lsLeadIn lsLink lsLinkText lsDblSlash
67499>>>>>>>>>  move (length(lsValue)) to liLen
67500>>>>>>>>>  move "" to lsRval
67501>>>>>>>>>  move 1 to liPos
67502>>>>>>>>>  move ("/"+"/") to lsDblSlash
67503>>>>>>>>>  repeat
67503>>>>>>>>>>
67503>>>>>>>>>    move "" to lsLeadIn
67504>>>>>>>>>    if (lowercase(mid(lsValue,4,liPos))="www.") begin
67506>>>>>>>>>      //move "http://www." to lsLeadIn
67506>>>>>>>>>      move ("http:"+lsDblSlash+"www.") to lsLeadIn
67507>>>>>>>>>      move (liPos+4) to liPos
67508>>>>>>>>>    end
67508>>>>>>>>>>
67508>>>>>>>>>    if (lowercase(mid(lsValue,4,liPos))="ftp.") begin
67510>>>>>>>>>      //move "ftp://ftp." to lsLeadIn
67510>>>>>>>>>      move ("ftp:"+lsDblSlash+"ftp.") to lsLeadIn
67511>>>>>>>>>      move (liPos+4) to liPos
67512>>>>>>>>>    end
67512>>>>>>>>>>
67512>>>>>>>>>    if (lowercase(mid(lsValue,6,liPos))="ftp:"+lsDblSlash) begin
67514>>>>>>>>>      move ("ftp:"+lsDblSlash) to lsLeadIn
67515>>>>>>>>>      move (liPos+6) to liPos
67516>>>>>>>>>    end
67516>>>>>>>>>>
67516>>>>>>>>>    if (lowercase(mid(lsValue,7,liPos))="http:"+lsDblSlash) begin
67518>>>>>>>>>      move ("http:"+lsDblSlash) to lsLeadIn
67519>>>>>>>>>      move (liPos+7) to liPos
67520>>>>>>>>>    end
67520>>>>>>>>>>
67520>>>>>>>>>    if (lowercase(mid(lsValue,8,liPos))="https:"+lsDblSlash) begin
67522>>>>>>>>>      move ("https:"+lsDblSlash) to lsLeadIn
67523>>>>>>>>>      move (liPos+8) to liPos
67524>>>>>>>>>    end
67524>>>>>>>>>>
67524>>>>>>>>>    if (lsLeadIn<>"") begin
67526>>>>>>>>>      move lsLeadIn to lsLink
67527>>>>>>>>>      repeat
67527>>>>>>>>>>
67527>>>>>>>>>        move (mid(lsValue,1,liPos)) to lsChar
67528>>>>>>>>>        move (not(("abcdefghijklmnopqrstuvwxyz:;=?@/.-+%*_01234567890#&~'"+'"') contains lowercase(lsChar))) to lbFin
67529>>>>>>>>>        ifnot lbFin begin
67531>>>>>>>>>          move (lsLink+lsChar) to lsLink
67532>>>>>>>>>          increment liPos
67533>>>>>>>>>        end
67533>>>>>>>>>>
67533>>>>>>>>>      until (lbFin or (liPos>liLen))
67535>>>>>>>>>      if (".:@;=" contains right(lsLink,1)) begin
67537>>>>>>>>>        get StringLeftBut lsLink 1 to lsLink
67538>>>>>>>>>        decrement liPos
67539>>>>>>>>>      end
67539>>>>>>>>>>
67539>>>>>>>>>      move lsLink to lsLinkText
67540>>>>>>>>>      // Insert:
67540>>>>>>>>>      if (mid(lsValue,1,liPos)="[") begin
67542>>>>>>>>>        increment liPos // Beyond the "[" sign
67543>>>>>>>>>        move "" to lsLinkText
67544>>>>>>>>>        repeat
67544>>>>>>>>>>
67544>>>>>>>>>          move (mid(lsValue,1,liPos)) to lsChar
67545>>>>>>>>>          move (lsChar="]") to lbFin
67546>>>>>>>>>          increment liPos
67547>>>>>>>>>          ifnot lbFin begin
67549>>>>>>>>>            move (lsLinkText+lsChar) to lsLinkText
67550>>>>>>>>>          end
67550>>>>>>>>>>
67550>>>>>>>>>        until (lbFin or (liPos>liLen))
67552>>>>>>>>>      end
67552>>>>>>>>>>
67552>>>>>>>>>      // End insert
67552>>>>>>>>>      move (''+lsLinkText+'') to lsLink
67553>>>>>>>>>      move (lsRval+lsLink) to lsRval
67554>>>>>>>>>    end
67554>>>>>>>>>>
67554>>>>>>>>>    else begin
67555>>>>>>>>>      move (mid(lsValue,1,liPos)) to lsChar
67556>>>>>>>>>      move (lsRval+lsChar) to lsRval
67557>>>>>>>>>      increment liPos
67558>>>>>>>>>    end
67558>>>>>>>>>>
67558>>>>>>>>>  until (liPos>liLen)
67560>>>>>>>>>  function_return lsRval
67561>>>>>>>>>end_function
67562>>>>>>>>>
67562>>>>>>>>>
67562>>>>>>>
67562>>>>>>>integer oGlobalHtmlAttributes#
67562>>>>>>>object oGlobalHtmlAttributes is an array
67564>>>>>>>  property integer pHtmlConversionTable public 0
67566>>>>>>>  property integer pHtmlTrimCrState     public 1           // Exclamation mark
67568>>>>>>>  property string  pHtmlDocType         public ('<'+character(33)+'DOCTYPE HTML PUBLIC "-/'+'/IETF/'+'/DTD HTML/'+'/EN">')
67570>>>>>>>  property string  pHtmlMT_Generator    public "Visual DataFlex"
67572>>>>>>>  property string  pHtmlMT_Formatter    public "Visual DataFlex"
67574>>>>>>>  move self to oGlobalHtmlAttributes#
67575>>>>>>>end_object
67576>>>>>>>
67576>>>>>>>class cAnsiToHtml_ConversionTable is an array
67577>>>>>>>  procedure construct_object integer img#
67579>>>>>>>    forward send construct_object img#
67581>>>>>>>    property string pCharacterSetName public "Un-named"
67582>>>>>>>    property string pCharacterSetID   public ""
67583>>>>>>>  end_procedure
67584>>>>>>>  function Is_cAnsiToHtml_ConversionTable returns integer
67586>>>>>>>    function_return 1
67587>>>>>>>  end_function
67588>>>>>>>  procedure set CharacterConversion integer char# string html#
67590>>>>>>>    // By setting the item value to character(char#) we avoid having
67590>>>>>>>    // to call that function during the character translation:
67590>>>>>>>    set value item (item_count(self)) to (character(char#))
67591>>>>>>>    set value item (item_count(self)) to html#
67592>>>>>>>  end_procedure
67593>>>>>>>  function ConvertAnsiToHtml string str# returns string
67595>>>>>>>    integer max# itm#
67595>>>>>>>    string html# char#
67595>>>>>>>    get item_count to max#
67596>>>>>>>    move 0 to itm#
67597>>>>>>>    while itm# lt max#
67601>>>>>>>      get value item itm# to char#
67602>>>>>>>      increment itm#
67603>>>>>>>      get value item itm# to html#
67604>>>>>>>      increment itm#
67605>>>>>>>      move (replaces(char#,str#,html#)) to str#
67606>>>>>>>    end
67607>>>>>>>>
67607>>>>>>>    function_return str#
67608>>>>>>>  end_function
67609>>>>>>>end_class
67610>>>>>>>
67610>>>>>>>function html_TextToHTML global string lsValue returns string
67612>>>>>>>  get Text_Trim lsValue to lsValue
67613>>>>>>>  move (replaces(character(10),lsValue,"
")) to lsValue
67614>>>>>>>  get RemoveDblBlanks lsValue to lsValue
67615>>>>>>>  get url_InsertLinks lsValue to lsValue
67616>>>>>>>  function_return lsValue
67617>>>>>>>end_function
67618>>>>>>>
67618>>>>>>>function html_TextToHTML_LeaveSpaces global string lsValue returns string
67620>>>>>>>  get Text_Trim lsValue to lsValue
67621>>>>>>>  move (replaces(character(10),lsValue,"
")) to lsValue
67622>>>>>>>  get url_InsertLinks lsValue to lsValue
67623>>>>>>>  function_return lsValue
67624>>>>>>>end_function
67625>>>>>>>
67625>>>>>>>desktop_section
67630>>>>>>>object oAnsiToHtml_Latin_1 is a cAnsiToHtml_ConversionTable
67632>>>>>>>  set pCharacterSetName to "Latin 1"
67633>>>>>>>  set pCharacterSetID   to "iso-8859-1"
67634>>>>>>>  set CharacterConversion 160 to " "    //
67635>>>>>>>  set CharacterConversion 161 to "¡"   // 
67636>>>>>>>  set CharacterConversion 162 to "¢"    // 
67637>>>>>>>  set CharacterConversion 163 to "£"   // 
67638>>>>>>>  set CharacterConversion 164 to "¤"  // general currency
67639>>>>>>>  set CharacterConversion 165 to "¥"     // 
67640>>>>>>>  set CharacterConversion 166 to "¦"  // |
67641>>>>>>>  set CharacterConversion 167 to "§"    // 
67642>>>>>>>  set CharacterConversion 168 to "¨"     // 
67643>>>>>>>  set CharacterConversion 169 to "©"    // (c)
67644>>>>>>>  set CharacterConversion 170 to "ª"    //
67645>>>>>>>  set CharacterConversion 171 to "«"   //
67646>>>>>>>  set CharacterConversion 172 to "¬"     // 
67647>>>>>>>  set CharacterConversion 173 to "­"     //
67648>>>>>>>  set CharacterConversion 174 to "®"     // (r) 
67649>>>>>>>  set CharacterConversion 175 to "¯"    //
67650>>>>>>>  set CharacterConversion 176 to "°"     // 
67651>>>>>>>  set CharacterConversion 177 to "±"  // 
67652>>>>>>>  set CharacterConversion 178 to "²"    // exp(2)
67653>>>>>>>  set CharacterConversion 179 to "³"    // exp(3)
67654>>>>>>>  set CharacterConversion 180 to "´"   //
67655>>>>>>>  set CharacterConversion 181 to "µ"   //
67656>>>>>>>  set CharacterConversion 182 to "¶"    //
67657>>>>>>>  set CharacterConversion 183 to "·"  //
67658>>>>>>>  set CharacterConversion 184 to "¸"   //
67659>>>>>>>  set CharacterConversion 185 to "¹"    //
67660>>>>>>>  set CharacterConversion 186 to "º"    //
67661>>>>>>>  set CharacterConversion 187 to "»"   //
67662>>>>>>>  set CharacterConversion 188 to "¼"  // 1/4
67663>>>>>>>  set CharacterConversion 189 to "½"  // 1/2
67664>>>>>>>  set CharacterConversion 190 to "¾"  // 3/4
67665>>>>>>>  set CharacterConversion 191 to "¿"  // 
67666>>>>>>>  set CharacterConversion 192 to "À"  // 
67667>>>>>>>  set CharacterConversion 193 to "Á"  // 
67668>>>>>>>  set CharacterConversion 194 to "Â"   // 
67669>>>>>>>  set CharacterConversion 195 to "Ã"  // 
67670>>>>>>>  set CharacterConversion 196 to "Ä"    // 
67671>>>>>>>  set CharacterConversion 197 to "Å"   // 
67672>>>>>>>  set CharacterConversion 198 to "&Aelig;"   // 
67673>>>>>>>  set CharacterConversion 199 to "Ç"  // 
67674>>>>>>>  set CharacterConversion 200 to "È"  // 
67675>>>>>>>  set CharacterConversion 201 to "É"  // 
67676>>>>>>>  set CharacterConversion 202 to "Ê"   // 
67677>>>>>>>  set CharacterConversion 203 to "Ë"    // 
67678>>>>>>>  set CharacterConversion 204 to "Ì"  // 
67679>>>>>>>  set CharacterConversion 205 to "Í"  // 
67680>>>>>>>  set CharacterConversion 206 to "Î"   // 
67681>>>>>>>  set CharacterConversion 207 to "Ï"    // 
67682>>>>>>>  set CharacterConversion 208 to "Ð"     // 
67683>>>>>>>  set CharacterConversion 209 to "Ñ"  // 
67684>>>>>>>  set CharacterConversion 210 to "Ò"  // 
67685>>>>>>>  set CharacterConversion 211 to "Ó"  // 
67686>>>>>>>  set CharacterConversion 212 to "Ô"   // 
67687>>>>>>>  set CharacterConversion 213 to "Õ"  // 
67688>>>>>>>  set CharacterConversion 214 to "Ö"    // 
67689>>>>>>>  set CharacterConversion 216 to "Ø"  // 
67690>>>>>>>  set CharacterConversion 217 to "Ù"  // 
67691>>>>>>>  set CharacterConversion 218 to "Ú"  // 
67692>>>>>>>  set CharacterConversion 219 to "Û"   // 
67693>>>>>>>  set CharacterConversion 220 to "Ü"    // 
67694>>>>>>>  set CharacterConversion 221 to "Ý"  // 
67695>>>>>>>  set CharacterConversion 222 to "Þ"   // 
67696>>>>>>>  set CharacterConversion 223 to "ß"   // 
67697>>>>>>>  set CharacterConversion 224 to "à"  // 
67698>>>>>>>  set CharacterConversion 225 to "á"  // 
67699>>>>>>>  set CharacterConversion 226 to "â"   // 
67700>>>>>>>  set CharacterConversion 227 to "ã"  // 
67701>>>>>>>  set CharacterConversion 228 to "ä"    // 
67702>>>>>>>  set CharacterConversion 229 to "å"   // 
67703>>>>>>>  set CharacterConversion 230 to "æ"   // 
67704>>>>>>>  set CharacterConversion 231 to "ç"  // 
67705>>>>>>>  set CharacterConversion 232 to "è"  // 
67706>>>>>>>  set CharacterConversion 233 to "é"  // 
67707>>>>>>>  set CharacterConversion 234 to "ê"   // 
67708>>>>>>>  set CharacterConversion 235 to "ë"    // 
67709>>>>>>>  set CharacterConversion 236 to "ì"  // 
67710>>>>>>>  set CharacterConversion 237 to "í"  // 
67711>>>>>>>  set CharacterConversion 238 to "î"   // 
67712>>>>>>>  set CharacterConversion 239 to "ï"    // 
67713>>>>>>>  set CharacterConversion 240 to "ð"     // 
67714>>>>>>>  set CharacterConversion 241 to "ñ"  // 
67715>>>>>>>  set CharacterConversion 242 to "ò"  // 
67716>>>>>>>  set CharacterConversion 243 to "ó"  // 
67717>>>>>>>  set CharacterConversion 244 to "ô"   // 
67718>>>>>>>  set CharacterConversion 245 to "õ"  // 
67719>>>>>>>  set CharacterConversion 246 to "ö"    // 
67720>>>>>>>  set CharacterConversion 248 to "ø"  // 
67721>>>>>>>  set CharacterConversion 249 to "ù"  // 
67722>>>>>>>  set CharacterConversion 250 to "ú"  // 
67723>>>>>>>  set CharacterConversion 251 to "û"   // 
67724>>>>>>>  set CharacterConversion 252 to "ü"    // 
67725>>>>>>>  set CharacterConversion 253 to "ý"  // 
67726>>>>>>>  set CharacterConversion 254 to "þ"   // 
67727>>>>>>>  set CharacterConversion 255 to "ÿ"    // 
67728>>>>>>>end_object // oAnsiToHtml_Latin_1
67729>>>>>>>end_desktop_section
67734>>>>>>>
67734>>>>>>>// Uncomment the following line in order to have the function convert ANSI
67734>>>>>>>// characters to native html characters.
67734>>>>>>>//set pHtmlConversionTable of oGlobalHtmlAttributes# to (oAnsiToHtml_Latin_1(self))
67734>>>>>>>
67734>>>>>>>// Make the html_AnsiToHtml function cut away superflous trailing cr/lf
67734>>>>>>>// characters when printing text.
67734>>>>>>>set pHtmlTrimCrState of oGlobalHtmlAttributes# to true
67735>>>>>>>
67735>>>>>>>// If function ConvertChar is not already defined we define it here:
67735>>>>>>>
67735>>>>>>>// This function assumes that string parameter contains ANSI characters
67735>>>>>>>function html_AnsiToHtml global string str# returns string
67737>>>>>>>  move (replaces("&",str#,"&"))          to str#
67738>>>>>>>  move (replaces('"',str#,"""))         to str#
67739>>>>>>>  move (replaces("<",str#,"<"))           to str#
67740>>>>>>>  move (replaces(">",str#,">"))           to str#
67741>>>>>>>  if (pHtmlTrimCrState(oGlobalHtmlAttributes#)) ;          move (Text_RemoveTrailingCr(str#)) to str#
67744>>>>>>>  move (replaces(character(10),str#,"
")) to str#
67745>>>>>>>  move (replaces(character(13),str#,""))     to str#
67746>>>>>>>  move (RemoveDblBlanks(str#))               to str#
67747>>>>>>>  if (pHtmlConversionTable(oGlobalHtmlAttributes#)) ;    get ConvertAnsiToHtml of (pHtmlConversionTable(oGlobalHtmlAttributes#)) str# to str#
67750>>>>>>>  function_return str#
67751>>>>>>>end_function
67752>>>>>>>
67752>>>>>>>// This function is identical to html_AnsiToHtml except that it
67752>>>>>>>// assumes the parameter to be OEM characters.
67752>>>>>>>function html_DfToHtml global string str# returns string
67754>>>>>>>  function_return (html_AnsiToHtml(ConvertChar(1,str#)))
67755>>>>>>>end_function
67756>>>>>>>
67756>>>>>>>// This is identical to the html_DfToHtml function except that it will
67756>>>>>>>// never return the empty string. Where html_DfToHtml would return the
67756>>>>>>>// empty string this function will return a 'non breaking space'. You
67756>>>>>>>// may want to use this function when writing table data since it will
67756>>>>>>>// ensure that the cells are appearing even if their content is empty.
67756>>>>>>>function html_DfToHtmlTable global string str# returns string
67758>>>>>>>  string rval#
67758>>>>>>>  move (html_AnsiToHtml(ConvertChar(1,str#))) to rval#
67759>>>>>>>  if rval# eq "" move " " to rval#
67762>>>>>>>  function_return rval#
67763>>>>>>>end_function
67764>>>>>>>
67764>>>>>>>External_Function32 HtmlShellExecute "ShellExecuteA" SHELL32.DLL ;  handle hwnd# String lpszOp# String lpszFile# String lpszParams# ;  String lpszDir# integer FsShowCmd# returns integer
67765>>>>>>>
67765>>>>>>>// This may be used to start any kind of document. Not just html docs.
67765>>>>>>>procedure html_StartDoc global string doc#
67767>>>>>>>  integer grb#
67767>>>>>>>  handle scrhDC#
67767>>>>>>>  string dir#
67767>>>>>>>  move (GetDesktopWindow()) to scrhDC# // Defined in WinUser.pkg
67768>>>>>>>  // We assume that the document is in a directory along DFPATH or that
67768>>>>>>>  // the directory path is part of the doc name:
67768>>>>>>>  get SEQ_ExtractPathFromFileName doc# to dir# // Is a path specified?
67769>>>>>>>  if dir# eq "" get SEQ_FindFileAlongDFPath doc# to dir#
67772>>>>>>>  else move "" to dir#
67774>>>>>>>  //                               Parameters   Directory
67774>>>>>>>  move (HtmlShellExecute(scrhDC#,"Open",doc#,"",dir#,1)) to grb#
67775>>>>>>>end_procedure
67776>>>>>>>
67776>>>>>>>procedure html_WriteHeader global integer channel# string title#
67778>>>>>>>  writeln channel channel# (pHtmlDocType(oGlobalHtmlAttributes#))
67781>>>>>>>  writeln ''
67783>>>>>>>  writeln ''
67785>>>>>>>  writeln (' '+html_DfToHtmlTable(title#)+'')
67787>>>>>>>  //writeln ' '
67787>>>>>>>  writeln (' ')
67789>>>>>>>  writeln ''
67791>>>>>>>end_procedure
67792>>>>>>>
67792>>>>>Use Macros.utl   // Various macros (Desktop_Section)
67792>>>>>Use RGB.utl      // Some color functions
67792>>>>>Use Array.nui    // Item_Property command
67792>>>>>Use FdxSelct.utl // Functions iFdxSelectOneFile and iFdxSelectOneField
Including file: fdxselct.utl    (C:\projects\BRS\VDFQuery\AppSrc\fdxselct.utl)
67792>>>>>>>// Use FdxSelct.utl // Functions iFdxSelectOneFile and iFdxSelectOneField
67792>>>>>>>Use Fdx_Attr.utl // FDX compatible attribute functions
Including file: fdx_attr.utl    (C:\projects\BRS\VDFQuery\AppSrc\fdx_attr.utl)
67792>>>>>>>>>Use FDX_Attr.nui
67792>>>>>>>Use FdxField.nui // FDX Field things
67792>>>>>>>Use FdxIndex.nui // Index analysing functions
67792>>>>>>>Use GridUtil.utl // Grid and List utilities
67792>>>>>>>Use SetOfFld.utl // cSetOfFields class
Including file: setoffld.utl    (C:\projects\BRS\VDFQuery\AppSrc\setoffld.utl)
67792>>>>>>>>>// Use SetOfFld.utl // cSetOfFields class
67792>>>>>>>>>Use Base.utl     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
Including file: base.utl    (C:\projects\BRS\VDFQuery\AppSrc\base.utl)
67792>>>>>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
67792>>>>>>>>>Use Strings.nui  // String manipulation for VDF
67792>>>>>>>>>
67792>>>>>>>>>class cSetOfFields is a cArray
67793>>>>>>>>>  item_property_list
67793>>>>>>>>>    item_property integer piFile.i
67793>>>>>>>>>    item_property integer piField.i
67793>>>>>>>>>  end_item_property_list cSetOfFields
#REM 67825 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 67829 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 67833 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 67837 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
67842>>>>>>>>>  procedure add_field integer file# integer field#
67844>>>>>>>>>    integer row#
67844>>>>>>>>>    get row_count to row#
67845>>>>>>>>>    set piFile.i  row# to file#
67846>>>>>>>>>    set piField.i row# to field#
67847>>>>>>>>>  end_procedure
67848>>>>>>>>>  function iFindField.ii integer file# integer field# returns integer
67850>>>>>>>>>    integer row# max#
67850>>>>>>>>>    get row_count to max#
67851>>>>>>>>>    for row# from 0 to (max#-1)
67857>>>>>>>>>>
67857>>>>>>>>>      if (file#=piFile.i(self,row#) and field#=piField.i(self,row#)) function_return row#
67860>>>>>>>>>    loop
67861>>>>>>>>>>
67861>>>>>>>>>    function_return -1
67862>>>>>>>>>  end_function
67863>>>>>>>>>  procedure reset
67865>>>>>>>>>    send delete_data
67866>>>>>>>>>  end_procedure
67867>>>>>>>>>  procedure CallBack_Files integer msg# integer obj#
67869>>>>>>>>>    integer row# max# file# itm#
67869>>>>>>>>>    string files#
67869>>>>>>>>>    move "" to files#
67870>>>>>>>>>    get row_count to max#
67871>>>>>>>>>    for row# from 0 to (max#-1)
67877>>>>>>>>>>
67877>>>>>>>>>      get piFile.i row# to file#
67878>>>>>>>>>      ifnot (IsIntegerPresent(files#,file#)) move (AddIntegerToString(files#,file#)) to files#
67881>>>>>>>>>    loop
67882>>>>>>>>>>
67882>>>>>>>>>    move (HowManyIntegers(files#)) to max#
67883>>>>>>>>>    for itm# from 1 to max#
67889>>>>>>>>>>
67889>>>>>>>>>      send msg# to obj# (ExtractInteger(files#,itm#))
67890>>>>>>>>>    loop
67891>>>>>>>>>>
67891>>>>>>>>>  end_procedure
67892>>>>>>>>>end_class
67893>>>>>>>Use DBMS.utl     // Basic DBMS functions
67893>>>>>>>
67893>>>>>>>Use APS          // Auto Positioning and Sizing classes for VDF
67893>>>>>>>class cFdxSelectOneFileList is a aps.Grid
67894>>>>>>>  procedure construct_object integer img#
67896>>>>>>>    forward send construct_object img#
67898>>>>>>>    set line_width to 4 0
67899>>>>>>>    set header_label item 0 to "#"
67900>>>>>>>    set header_label item 1 to "Display name"
67901>>>>>>>    set header_label item 2 to "DF name"
67902>>>>>>>    set header_label item 3 to "Root name"
67903>>>>>>>    set form_margin item 0 to  4   //
67904>>>>>>>    set form_margin item 1 to  40  //
67905>>>>>>>    set form_margin item 2 to  10  //
67906>>>>>>>    set form_margin item 3 to  32  //
67907>>>>>>>    set highlight_row_state to true
67908>>>>>>>    set CurrentCellColor     to clHighlight
67909>>>>>>>    set CurrentCellTextColor to clHighlightText
67910>>>>>>>    set CurrentRowColor      to clHighlight
67911>>>>>>>    set CurrentRowTextColor  to clHighlightText
67912>>>>>>>//   set highlight_row_color to (rgb(0,255,255))
67912>>>>>>>//   set current_item_color to (rgb(0,255,255))
67912>>>>>>>    set select_mode to no_select
67913>>>>>>>    on_key knext_item send switch
67914>>>>>>>    on_key kprevious_item send switch_back
67915>>>>>>>    on_key key_ctrl+key_r send sort_data
67916>>>>>>>    property integer piValidateFunction public 0
67917>>>>>>>    property integer piValidateObject   public 0
67918>>>>>>>  end_procedure
67919>>>>>>>
67919>>>>>>>  procedure mouse_click integer liItem integer liGrb
67921>>>>>>>    if ((liItem-1)>>>>>>  end_procedure
67925>>>>>>>
67925>>>>>>>  function sSortValue.ii integer column# integer itm# returns string
67927>>>>>>>    if column# eq 0 function_return (IntToStrR(value(self,itm#),4))
67930>>>>>>>  end_function
67931>>>>>>>  function iSpecialSortValueOnColumn.i integer column# returns integer
67933>>>>>>>    if column# eq 0 function_return 1
67936>>>>>>>    function_return 0 // Otherwise no special anything
67937>>>>>>>  end_function
67938>>>>>>>
67938>>>>>>>  procedure sort_data.i integer column#
67940>>>>>>>    send Grid_SortByColumn self column#
67941>>>>>>>  end_procedure
67942>>>>>>>  procedure sort_data
67944>>>>>>>    integer cc#
67944>>>>>>>    get Grid_CurrentColumn self to cc#
67945>>>>>>>    send sort_data.i cc#
67946>>>>>>>  end_procedure
67947>>>>>>>  procedure header_mouse_click integer itm#
67949>>>>>>>    send sort_data.i itm#
67950>>>>>>>    forward send header_mouse_click itm#
67952>>>>>>>  end_procedure
67953>>>>>>>  procedure fill_list.ii integer oFDX# integer suggest_file#
67955>>>>>>>    integer file# suggest_itm# fnc# obj# ok#
67955>>>>>>>    send delete_data
67956>>>>>>>    get piValidateFunction to fnc#
67957>>>>>>>    get piValidateObject   to obj#
67958>>>>>>>    move 0 to file#
67959>>>>>>>    move -1 to suggest_itm#
67960>>>>>>>    send cursor_wait to (cursor_control(self))
67961>>>>>>>    repeat
67961>>>>>>>>
67961>>>>>>>      move (FDX_AttrValue_FLSTNAV(oFDX#,DF_FILE_NEXT_USED,file#)) to file#
67962>>>>>>>      if file# begin
67964>>>>>>>//      if (iCanOpen.i(oFDX#,file#)) begin
67964>>>>>>>        if (FDX_CanOpenFile(oFDX#,file#)) begin
67966>>>>>>>          if obj# ne 0 get fnc# of obj# file# to ok#
67969>>>>>>>          else move 1 to ok#
67971>>>>>>>          if ok# begin
67973>>>>>>>            if file# eq suggest_file# move (item_count(self)) to suggest_itm#
67976>>>>>>>            send add_item msg_none (string(file#))
67977>>>>>>>            send add_item msg_none (rtrim(FDX_AttrValue_FILELIST(oFDX#,DF_FILE_DISPLAY_NAME,file#)))
67978>>>>>>>            send add_item msg_none (FDX_AttrValue_FILELIST(oFDX#,DF_FILE_LOGICAL_NAME,file#))
67979>>>>>>>            send add_item msg_none (FDX_AttrValue_FILELIST(oFDX#,DF_FILE_ROOT_NAME,file#))
67980>>>>>>>          end
67980>>>>>>>>
67980>>>>>>>        end
67980>>>>>>>>
67980>>>>>>>      end
67980>>>>>>>>
67980>>>>>>>    until file# eq 0
67982>>>>>>>    send cursor_ready to (cursor_control(self))
67983>>>>>>>    set dynamic_update_state to dfTrue
67984>>>>>>>    if suggest_itm# ne -1 set current_item to suggest_itm#
67987>>>>>>>     send Grid_SetEntryState self 0
67988>>>>>>>  end_procedure
67989>>>>>>>  function iCurrentFile returns integer
67991>>>>>>>    integer itm#
67991>>>>>>>    ifnot (item_count(self)) function_return 0
67994>>>>>>>    get current_item to itm#
67995>>>>>>>    move ((itm#/4)*4) to itm#
67996>>>>>>>    function_return (value(self,itm#))
67997>>>>>>>  end_function
67998>>>>>>>end_class // cFdxSelectOneFileList
67999>>>>>>>
67999>>>>>>>class cFdxSelectOneFieldList is a aps.Grid
68000>>>>>>>  procedure construct_object integer img#
68002>>>>>>>    forward send construct_object img#
68004>>>>>>>    set line_width to 7 0
68005>>>>>>>    set header_label item 0 to "#"
68006>>>>>>>    set header_label item 1 to "Name"
68007>>>>>>>    set header_label item 2 to "Type"
68008>>>>>>>    set header_label item 3 to "Len"
68009>>>>>>>    set header_label item 4 to "Offset"
68010>>>>>>>    set header_label item 5 to "Idx"
68011>>>>>>>    set header_label item 6 to "Relation"
68012>>>>>>>    set form_margin item 0 to  2   // #
68013>>>>>>>    set form_margin item 1 to  15  // Name
68014>>>>>>>    set form_margin item 2 to  4   // Type
68015>>>>>>>    set form_margin item 3 to  5   // Len
68016>>>>>>>    set form_margin item 4 to  5   // Offset
68017>>>>>>>    set form_margin item 5 to  3   // Idx
68018>>>>>>>    set form_margin item 6 to  30  // Relation
68019>>>>>>>    set highlight_row_state to true
68020>>>>>>>    set CurrentCellColor     to clHighlight
68021>>>>>>>    set CurrentCellTextColor to clHighlightText
68022>>>>>>>    set CurrentRowColor      to clHighlight
68023>>>>>>>    set CurrentRowTextColor  to clHighlightText
68024>>>>>>>//  set highlight_row_color to (rgb(0,255,255))
68024>>>>>>>//  set current_item_color to (rgb(0,255,255))
68024>>>>>>>    set select_mode to no_select
68025>>>>>>>    on_key knext_item send switch
68026>>>>>>>    on_key kprevious_item send switch_back
68027>>>>>>>  end_procedure
68028>>>>>>>  function sRelFieldName.iii integer oFDX# integer file# integer field# returns string
68030>>>>>>>    function_return (FDX_FieldName(oFDX#,file#,field#,1))
68031>>>>>>>  end_function
68032>>>>>>>  procedure fill_list.iiii integer oFDX# integer file# integer suggest_file# integer suggest_field#
68034>>>>>>>    integer field# max_field# suggest_itm# type# len# dec# idx#
68034>>>>>>>    send delete_data
68035>>>>>>>    ifnot file# get FDX_NextFileThatCanOpen oFDX# 0 to file#
68038>>>>>>>    if file# ne suggest_file# move 0 to suggest_field#
68041>>>>>>>    move -1 to suggest_itm#
68042>>>>>>>    if (FDX_CanOpenFile(oFDX#,file#)) begin
68044>>>>>>>      move (FDX_AttrValue_FILE(oFDX#,DF_FILE_NUMBER_FIELDS,file#)) to max_field#
68045>>>>>>>      for field# from 1 to max_field#
68051>>>>>>>>
68051>>>>>>>        if field# eq suggest_field# move (item_count(self)) to suggest_itm#
68054>>>>>>>        send add_item msg_none (string(field#))
68055>>>>>>>        send add_item msg_none (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_NAME,file#,field#))
68056>>>>>>>        move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_TYPE,file#,field#)) to type#
68057>>>>>>>        send add_item msg_none (API_ShortFieldTypeName(type#))
68058>>>>>>>        move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_LENGTH,file#,field#)) to len#
68059>>>>>>>        if type# eq DF_BCD begin
68061>>>>>>>          move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_PRECISION,file#,field#)) to dec#
68062>>>>>>>          send add_item msg_none (string(len#-dec#)+"."+string(dec#))
68063>>>>>>>        end
68063>>>>>>>>
68063>>>>>>>        else send add_item msg_none (string(len#))
68065>>>>>>>        send add_item msg_none (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_OFFSET,file#,field#))
68066>>>>>>>        move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_INDEX,file#,field#)) to idx#
68067>>>>>>>        if idx# send add_item msg_none (string(idx#))
68070>>>>>>>        else    send add_item msg_none ""
68072>>>>>>>        send add_item msg_none (sRelFieldName.iii(self,oFDX#,FDX_AttrValue_FIELD(oFDX#,DF_FIELD_RELATED_FILE,file#,field#),FDX_AttrValue_FIELD(oFDX#,DF_FIELD_RELATED_FIELD,file#,field#)))
68073>>>>>>>      loop
68074>>>>>>>>
68074>>>>>>>    end
68074>>>>>>>>
68074>>>>>>>    set dynamic_update_state to true
68075>>>>>>>    if suggest_itm# ne -1 set current_item to suggest_itm#
68078>>>>>>>    send Grid_SetEntryState self 0
68079>>>>>>>  end_procedure
68080>>>>>>>  function iCurrentField returns integer
68082>>>>>>>    integer itm#
68082>>>>>>>    ifnot (item_count(self)) function_return 0
68085>>>>>>>    get current_item to itm#
68086>>>>>>>    move ((itm#/7)*7) to itm#
68087>>>>>>>    function_return (value(self,itm#))
68088>>>>>>>  end_function
68089>>>>>>>end_class // cFdxSelectOneFieldList
68090>>>>>>>
68090>>>>>>>desktop_section
68095>>>>>>>object oFdxSelectOneFile is a aps.ModalPanel label "Select table"
68098>>>>>>>  set locate_mode to CENTER_ON_SCREEN
68099>>>>>>>  set Border_Style to BORDER_THICK   // Make panel resizeable
68100>>>>>>>  property integer piResult public 0
68102>>>>>>>  on_key ksave_record send close_panel_ok
68103>>>>>>>  on_key kcancel send close_panel
68104>>>>>>>  object oLst is a cFdxSelectOneFileList
68106>>>>>>>    set size to 200 0
68107>>>>>>>    on_key kenter send close_panel_ok
68108>>>>>>>  end_object
68109>>>>>>>  object oBtn1 is a aps.Multi_Button
68111>>>>>>>      on_item t.btn.ok send close_panel_ok
68112>>>>>>>  end_object
68113>>>>>>>  object oBtn2 is a aps.Multi_Button
68115>>>>>>>      on_item t.btn.cancel send close_panel
68116>>>>>>>  end_object
68117>>>>>>>  send aps_locate_multi_buttons
68118>>>>>>>  procedure close_panel_ok
68121>>>>>>>    set piResult to 1
68122>>>>>>>    send close_panel
68123>>>>>>>  end_procedure
68124>>>>>>>  function iPopup.iiii integer oFDX# integer suggest# integer fnc# integer obj# returns integer
68127>>>>>>>    integer rval#
68127>>>>>>>    set piValidateFunction of (oLst(self)) to fnc#
68128>>>>>>>    set piValidateObject   of (oLst(self)) to obj#
68129>>>>>>>    send fill_list.ii to (oLst(self)) oFDX# suggest#
68130>>>>>>>    set piResult to 0
68131>>>>>>>    send popup
68132>>>>>>>    if (piResult(self)) move (iCurrentFile(oLst(self))) to rval#
68135>>>>>>>    else move 0 to rval#
68137>>>>>>>    function_return rval#
68138>>>>>>>  end_function
68139>>>>>>>  procedure aps_onResize integer delta_rw# integer delta_cl#
68142>>>>>>>    send aps_resize (oLst(self)) delta_rw# 0
68143>>>>>>>    send aps_register_multi_button (oBtn1(self))
68144>>>>>>>    send aps_register_multi_button (oBtn2(self))
68145>>>>>>>    send aps_locate_multi_buttons
68146>>>>>>>    send aps_auto_size_container
68147>>>>>>>  end_procedure
68148>>>>>>>end_object // oFdxSelectOneFile
68149>>>>>>>
68149>>>>>>>//>This function is defined in a package called "fdxselct.utl". This
68149>>>>>>>//>function calls an object defined just before the function (note that two
68149>>>>>>>//>versions of this object is defined, one for VDF and one for DF3.2). The
68149>>>>>>>//>Function returns the number of the selected file or 0 if the user
68149>>>>>>>//>cancelled the dialog.
68149>>>>>>>//>
68149>>>>>>>//>lhFDX: Object ID that holds a set of table definitions. VDFQuery passes
68149>>>>>>>//>zero in order not to use such an object and instead let the user select
68149>>>>>>>//>a table that is actually there (physically present).
68149>>>>>>>//>
68149>>>>>>>//>liDefaultFile: If this parameter is not zero, the cursor will locate
68149>>>>>>>//>itself on the corresponding file as the the dialog pops up. VDFQuery
68149>>>>>>>//>passes the number of the currently selected file.
68149>>>>>>>//>
68149>>>>>>>//>liValidFnc, liValidObj: Identifies a booelan function (liValidFnc) in an
68149>>>>>>>//>object (liValidObj) that may be used to validate each file, before it is
68149>>>>>>>//>added to the selection list (1 makes the file go in the list, 0 excludes
68149>>>>>>>//>the file). VDFQuery passes a function that checks that "@" is not part
68149>>>>>>>//>of the display name, and the the file has not been excluded by the
68149>>>>>>>//>programmer (this is what Dan Walsh describes with the
68149>>>>>>>//>VdfQuery_ExcludeFile message).
68149>>>>>>>//>
68149>>>>>>>//>Check the code calling this function in VDFQuery.utl to get the full
68149>>>>>>>//>picture
68149>>>>>>>function iFdxSelectOneFileValidate global integer lhFDX integer liDefaultFile integer liValidFnc integer liValidObj returns integer
68151>>>>>>>  function_return (iPopup.iiii(oFdxSelectOneFile(self),lhFDX,liDefaultFile,liValidFnc,liValidObj))
68152>>>>>>>end_function
68153>>>>>>>
68153>>>>>>>//> Function iFdxSelectOneFile returns number of selected file or 0
68153>>>>>>>//> if the user cancelled the dialog. If the liDefaultFile parameter is the number
68153>>>>>>>//> of an existing table, the cursor will locate itself on that as the
68153>>>>>>>//> the dialog pops up.
68153>>>>>>>function iFdxSelectOneFile global integer lhFDX integer liDefaultFile returns integer
68155>>>>>>>  function_return (iFdxSelectOneFileValidate(lhFDX,liDefaultFile,0,0))
68156>>>>>>>end_function
68157>>>>>>>
68157>>>>>>>object oFdxSelectOneField is a aps.ModalPanel label "Select field"
68160>>>>>>>  set locate_mode to CENTER_ON_SCREEN
68161>>>>>>>  set Border_Style to BORDER_THICK   // Make panel resizeable
68162>>>>>>>  property integer piResult public 0
68164>>>>>>>  property integer piFDX_Server  public 0
68166>>>>>>>  property integer piCurrentFile public 0
68168>>>>>>>  property integer piLockFile    public 0
68170>>>>>>>  on_key ksave_record send close_panel_ok
68171>>>>>>>  on_key kcancel      send close_panel
68172>>>>>>>  on_key kprompt      send Table_Select
68173>>>>>>>  send aps_make_row_space 10
68174>>>>>>>  object oFrm1 is a aps.Form label "Table" abstract AFT_NUMERIC4.0
68178>>>>>>>    set label_justification_mode to JMODE_TOP
68179>>>>>>>    set object_shadow_state to true
68180>>>>>>>  end_object
68181>>>>>>>  object oFrm2 is a aps.Form label "Display name" abstract AFT_ASCII40 snap SL_RIGHT
68186>>>>>>>    set label_justification_mode to JMODE_TOP
68187>>>>>>>    set object_shadow_state to true
68188>>>>>>>  end_object
68189>>>>>>>  object oFrm3 is a aps.Form label "DF name" abstract AFT_ASCII10 snap SL_RIGHT
68194>>>>>>>    set label_justification_mode to JMODE_TOP
68195>>>>>>>    set object_shadow_state to true
68196>>>>>>>  end_object
68197>>>>>>>  object oFrm4 is a aps.Form label "Root name" abstract AFT_ASCII35 snap SL_RIGHT
68202>>>>>>>    set label_justification_mode to JMODE_TOP
68203>>>>>>>    set object_shadow_state to true
68204>>>>>>>  end_object
68205>>>>>>>  procedure DoUpdateDisplay
68208>>>>>>>    integer oFDX# file#
68208>>>>>>>    get piFDX_Server  to oFDX#
68209>>>>>>>    get piCurrentFile to file#
68210>>>>>>>    set value of (oFrm1(self)) item 0 to file#
68211>>>>>>>    set value of (oFrm2(self)) item 0 to (rtrim(FDX_AttrValue_FILELIST(oFDX#,DF_FILE_DISPLAY_NAME,file#)))
68212>>>>>>>    set value of (oFrm3(self)) item 0 to (FDX_AttrValue_FILELIST(oFDX#,DF_FILE_LOGICAL_NAME,file#))
68213>>>>>>>    set value of (oFrm4(self)) item 0 to (FDX_AttrValue_FILELIST(oFDX#,DF_FILE_ROOT_NAME,file#))
68214>>>>>>>  end_procedure
68215>>>>>>>  object oLst is a cFdxSelectOneFieldList snap SL_DOWN relative_to (oFrm1(self))
68223>>>>>>>    on_key kenter send close_panel_ok
68224>>>>>>>  end_object
68225>>>>>>>  procedure close_panel_ok
68228>>>>>>>    set piResult to 1
68229>>>>>>>    send close_panel
68230>>>>>>>  end_procedure
68231>>>>>>>  object oBtn1 is a aps.Multi_Button
68233>>>>>>>    on_item t.btn.ok send close_panel_ok
68234>>>>>>>  end_object
68235>>>>>>>  object oBtn2 is a aps.Multi_Button
68237>>>>>>>    on_item "Change table" send Table_Select
68238>>>>>>>  end_object
68239>>>>>>>  object oBtn3 is a aps.Multi_Button
68241>>>>>>>    on_item t.btn.cancel send close_panel
68242>>>>>>>  end_object
68243>>>>>>>  send aps_locate_multi_buttons
68244>>>>>>>
68244>>>>>>>  procedure Table_Select
68247>>>>>>>    integer file# oFDX#
68247>>>>>>>    get piFDX_Server to oFDX#
68248>>>>>>>    ifnot (piLockFile(self)) begin
68250>>>>>>>      move (iFdxSelectOneFile(oFDX#,piCurrentFile(self))) to file#
68251>>>>>>>      if file# begin
68253>>>>>>>        send fill_list.iiii to (oLst(self)) oFDX# file# 0 0
68254>>>>>>>        set piCurrentFile to file#
68255>>>>>>>        send DoUpdateDisplay
68256>>>>>>>      end
68256>>>>>>>>
68256>>>>>>>    end
68256>>>>>>>>
68256>>>>>>>  end_procedure
68257>>>>>>>
68257>>>>>>>  function iPopup.iii integer oFDX# integer lock_file# integer suggest# returns integer
68260>>>>>>>    integer rval# suggest_file# suggest_field# file# field#
68260>>>>>>>    move (hi(suggest#)) to suggest_file#
68261>>>>>>>    move (low(suggest#)) to suggest_field#
68262>>>>>>>    set piResult to 0
68263>>>>>>>
68263>>>>>>>    if (lock_file# and suggest_file#) if lock_file# ne suggest_file# move 0 to suggest_file#
68268>>>>>>>    ifnot suggest_file# move 0 to suggest_field#
68271>>>>>>>
68271>>>>>>>    set piFDX_Server to oFDX#
68272>>>>>>>    set piLockFile   to lock_file#
68273>>>>>>>
68273>>>>>>>    if lock_file# move lock_file# to file#
68276>>>>>>>    else begin
68277>>>>>>>      if suggest_file# move suggest_file# to file#
68280>>>>>>>      else get FDX_NextFileThatCanOpen oFDX# 0 to file# // Find first#
68282>>>>>>>    end
68282>>>>>>>>
68282>>>>>>>
68282>>>>>>>    if file# begin
68284>>>>>>>      send fill_list.iiii to (oLst(self)) oFDX# file# suggest_file# suggest_field#
68285>>>>>>>      set piCurrentFile to file#
68286>>>>>>>      send DoUpdateDisplay
68287>>>>>>>      send popup
68288>>>>>>>      if (piResult(self)) begin
68290>>>>>>>        get piCurrentFile to file#
68291>>>>>>>        move (iCurrentField(oLst(self))) to field#
68292>>>>>>>        move (file#*65536+field#) to rval#
68293>>>>>>>      end
68293>>>>>>>>
68293>>>>>>>      else move 0 to rval#
68295>>>>>>>    end
68295>>>>>>>>
68295>>>>>>>    else begin
68296>>>>>>>      send obs "Sorry, no tables to select"
68297>>>>>>>      move 0 to rval#
68298>>>>>>>    end
68298>>>>>>>>
68298>>>>>>>    function_return rval#
68299>>>>>>>  end_function
68300>>>>>>>  procedure aps_onResize integer delta_rw# integer delta_cl#
68303>>>>>>>    send aps_resize (oLst(self)) delta_rw# 0
68304>>>>>>>    send aps_register_multi_button (oBtn1(self))
68305>>>>>>>    send aps_register_multi_button (oBtn2(self))
68306>>>>>>>    send aps_register_multi_button (oBtn3(self))
68307>>>>>>>    send aps_register_max_rc (oFrm4(self))
68308>>>>>>>    send aps_locate_multi_buttons
68309>>>>>>>    send aps_auto_size_container
68310>>>>>>>  end_procedure
68311>>>>>>>  procedure aps_beautify
68314>>>>>>>    send aps_align_by_moving (oFrm2(self)) (oFrm1(self)) SL_ALIGN_BOTTOM
68315>>>>>>>    send aps_align_by_moving (oFrm3(self)) (oFrm2(self)) SL_ALIGN_BOTTOM
68316>>>>>>>    send aps_align_by_moving (oFrm4(self)) (oFrm3(self)) SL_ALIGN_BOTTOM
68317>>>>>>>    send aps_align_inside_container_by_moving (oLst(self)) SL_ALIGN_CENTER
68318>>>>>>>  end_procedure
68319>>>>>>>end_object // oFdxSelectOneField
68320>>>>>>>
68320>>>>>>>//> Function iFdxSelectOneField returns selected file multiplied by 65536
68320>>>>>>>//> plus the number of the selected field. If the user cancels the dialog
68320>>>>>>>//> 0 will be returned. If a file# is passed as the first parameter the
68320>>>>>>>//> dialog will be locked to that file.
68320>>>>>>>function iFdxSelectOneField global integer oFDX# integer file# integer suggest# returns integer
68322>>>>>>>  function_return (iPopup.iii(oFdxSelectOneField(self),oFDX#,file#,suggest#))
68323>>>>>>>end_function
68324>>>>>>>
68324>>>>>>>Use APS          // Auto Positioning and Sizing classes for VDF
68324>>>>>>>class cFdxSelectFieldsList is a aps.Grid
68325>>>>>>>  procedure construct_object integer img#
68327>>>>>>>    forward send construct_object img#
68329>>>>>>>    send GridPrepare_AddColumn ""           AFT_ASCII3
68330>>>>>>>    send GridPrepare_AddColumn "Name"       AFT_ASCII25
68331>>>>>>>    send GridPrepare_AddColumn "Type"       AFT_ASCII6
68332>>>>>>>    send GridPrepare_AddColumn "Length"     AFT_ASCII8
68333>>>>>>>    send GridPrepare_AddColumn "Relates to" AFT_ASCII12
68334>>>>>>>    send GridPrepare_Apply self
68335>>>>>>>    set select_mode to MULTI_SELECT
68336>>>>>>>    on_key kswitch send switch
68337>>>>>>>    on_key kswitch_back send switch_back
68338>>>>>>>  end_procedure
68339>>>>>>>  procedure select_toggling integer itm# integer i#
68341>>>>>>>    forward send select_toggling (Grid_BaseItem(self)) i# // Redirect to first column
68343>>>>>>>  end_procedure
68344>>>>>>>  procedure fill_list.iii integer oFDX# integer file# integer set#
68346>>>>>>>    integer field# max_field# base# rel_file#
68346>>>>>>>    set dynamic_update_state to DFFALSE
68347>>>>>>>    send delete_data
68348>>>>>>>    move (FDX_AttrValue_FILE(oFDX#,DF_FILE_NUMBER_FIELDS,file#)) to max_field#
68349>>>>>>>    for field# from 0 to max_field#
68355>>>>>>>>
68355>>>>>>>      get item_count to base#
68356>>>>>>>      send add_item msg_none ""
68357>>>>>>>      set checkbox_item_state item base# to true
68358>>>>>>>      if (iFindField.ii(set#,file#,field#)<>-1) set select_state item base# to true
68361>>>>>>>      send add_item msg_none (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_NAME,file#,field#))
68362>>>>>>>      send add_item msg_none (StringFieldType(FDX_AttrValue_FIELD(oFDX#,DF_FIELD_TYPE,file#,field#)))
68363>>>>>>>      send add_item msg_none (FDX_FieldLength(oFDX#,file#,field#))
68364>>>>>>>      move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_RELATED_FILE,file#,field#)) to rel_file#
68365>>>>>>>      if rel_file# send add_item msg_none (FDX_AttrValue_FILELIST(oFDX#,DF_FILE_LOGICAL_NAME,rel_file#))
68368>>>>>>>      else send add_item msg_none ""
68370>>>>>>>    loop
68371>>>>>>>>
68371>>>>>>>    send Grid_SetEntryState self 0
68372>>>>>>>    set dynamic_update_state to DFTRUE
68373>>>>>>>  end_procedure
68374>>>>>>>  procedure rebuild_set integer set# integer file#
68376>>>>>>>    integer row# max# fld# base# columns#
68376>>>>>>>    send reset to set#
68377>>>>>>>    get Grid_Columns self to columns#
68378>>>>>>>    get Grid_RowCount self to max#
68379>>>>>>>    for row# from 0 to (max#-1)
68385>>>>>>>>
68385>>>>>>>      move (row#*columns#) to base#
68386>>>>>>>      if (select_state(self,base#)) send add_field to set# file# row#
68389>>>>>>>    loop
68390>>>>>>>>
68390>>>>>>>  end_procedure
68391>>>>>>>  procedure select_help integer st#
68393>>>>>>>    integer row# max# base# columns#
68393>>>>>>>    get Grid_Columns self to columns#
68394>>>>>>>    get Grid_RowCount self to max#
68395>>>>>>>    for row# from 0 to (max#-1)
68401>>>>>>>>
68401>>>>>>>      move (row#*columns#) to base#
68402>>>>>>>      set select_state item base# to st#
68403>>>>>>>    loop
68404>>>>>>>>
68404>>>>>>>    set dynamic_update_state to true
68405>>>>>>>  end_procedure
68406>>>>>>>  procedure select_all
68408>>>>>>>    send select_help 1
68409>>>>>>>  end_procedure
68410>>>>>>>  procedure select_none
68412>>>>>>>    send select_help 0
68413>>>>>>>  end_procedure
68414>>>>>>>end_class // cFdxSelectFieldsList
68415>>>>>>>
68415>>>>>>>object oFdxSelectFields is a aps.ModalPanel
68417>>>>>>>  set locate_mode to CENTER_ON_SCREEN
68418>>>>>>>  on_key ksave_record send close_panel_ok
68419>>>>>>>  on_key kcancel send close_panel
68420>>>>>>>  property integer piResult public 0
68422>>>>>>>  set pMinimumSize to 150 0
68423>>>>>>>  object oLst is a cFdxSelectFieldsList
68425>>>>>>>    on_key kenter send next
68426>>>>>>>    set size to 200 0
68427>>>>>>>  end_object
68428>>>>>>>  object oBtn1 is a aps.Multi_Button
68430>>>>>>>    on_item "Select all" send select_all to (oLst(self))
68431>>>>>>>  end_object
68432>>>>>>>  object oBtn2 is a aps.Multi_Button
68434>>>>>>>    on_item "Deselect all" send select_none to (oLst(self))
68435>>>>>>>  end_object
68436>>>>>>>  object oBtn3 is a aps.Multi_Button
68438>>>>>>>    on_item t.btn.ok send close_panel_ok
68439>>>>>>>  end_object
68440>>>>>>>  object oBtn4 is a aps.Multi_Button
68442>>>>>>>    on_item t.btn.cancel send close_panel
68443>>>>>>>  end_object
68444>>>>>>>  send aps_locate_multi_buttons sl_vertical
68445>>>>>>>  procedure close_panel_ok
68448>>>>>>>    set piResult to 1
68449>>>>>>>    send close_panel
68450>>>>>>>  end_procedure
68451>>>>>>>  set Border_Style to BORDER_THICK   // Make panel resizeable
68452>>>>>>>  procedure aps_onResize integer delta_rw# integer delta_cl#
68455>>>>>>>    send aps_resize (oLst(self)) delta_rw# 0
68456>>>>>>>    send aps_register_multi_button (oBtn1(self))
68457>>>>>>>    send aps_register_multi_button (oBtn2(self))
68458>>>>>>>    send aps_register_multi_button (oBtn3(self))
68459>>>>>>>    send aps_register_multi_button (oBtn4(self))
68460>>>>>>>    send aps_locate_multi_buttons sl_vertical
68461>>>>>>>    send aps_auto_size_container
68462>>>>>>>  end_procedure
68463>>>>>>>  function iPopup.iii integer oFDX# integer file# integer set# returns integer
68466>>>>>>>    set piResult to 0
68467>>>>>>>    send fill_list.iii to (oLst(self)) oFDX# file# set#
68468>>>>>>>    set label to ("Select fields: "+FDX_AttrValue_FILELIST(oFDX#,DF_FILE_LOGICAL_NAME,file#))
68469>>>>>>>    send popup
68470>>>>>>>    if (piResult(self)) begin
68472>>>>>>>      send rebuild_set to (oLst(self)) set# file#
68473>>>>>>>    end
68473>>>>>>>>
68473>>>>>>>    function_return (piResult(self))
68474>>>>>>>  end_function
68475>>>>>>>end_object // oFdxSelectFields
68476>>>>>>>
68476>>>>>>>//> Function iFdxSelectFields returns 1 if the the user did indeed select a
68476>>>>>>>//> set of fields and 0 if the user cancelled the selection. If 1 is returned
68476>>>>>>>//> the function will modify the set of fields passed to it in parameter
68476>>>>>>>//> set#.
68476>>>>>>>function iFdxSelectFields global integer oFDX# integer file# integer set# returns integer
68478>>>>>>>  integer close# open# rval#
68478>>>>>>>  ifnot oFDX# begin
68480>>>>>>>    if (DBMS_IsOpenFile(file#)) begin
68482>>>>>>>      move 0 to close#
68483>>>>>>>      move 1 to open#
68484>>>>>>>    end
68484>>>>>>>>
68484>>>>>>>    else begin
68485>>>>>>>      if (DBMS_OpenFile(file#,DF_SHARE,0)) begin
68487>>>>>>>        move 1 to close#
68488>>>>>>>        move 1 to open#
68489>>>>>>>      end
68489>>>>>>>>
68489>>>>>>>      else begin
68490>>>>>>>        move 0 to close#
68491>>>>>>>        move 0 to open#
68492>>>>>>>      end
68492>>>>>>>>
68492>>>>>>>    end
68492>>>>>>>>
68492>>>>>>>  end
68492>>>>>>>>
68492>>>>>>>  else begin
68493>>>>>>>    move 0 to close#
68494>>>>>>>    move 1 to open#
68495>>>>>>>  end
68495>>>>>>>>
68495>>>>>>>  move (iPopup.iii(oFdxSelectFields(self),oFDX#,file#,set#)) to rval#
68496>>>>>>>  if close# close file#
68499>>>>>>>  function_return rval#
68500>>>>>>>end_function
68501>>>>>>>
68501>>>>>>>Use APS          // Auto Positioning and Sizing classes for VDF
68501>>>>>>>class cFdxSelectIndexList is a aps.List
68502>>>>>>>  procedure construct_object integer img#
68504>>>>>>>    forward send construct_object img#
68506>>>>>>>    on_key kswitch send switch
68507>>>>>>>    on_key kswitch_back send switch_back
68508>>>>>>>    property integer phFDX public 0
68509>>>>>>>    property integer piFile public 0
68510>>>>>>>  end_procedure
68511>>>>>>>  procedure mouse_click integer liItem integer liGrb
68513>>>>>>>    if ((liItem-1)>>>>>>  end_procedure
68517>>>>>>>  procedure AddIndex integer liFile integer liIndex string lsFields integer liType
68519>>>>>>>    send add_item MSG_NONE (string(liIndex)+": "+FDX_IndexAsFieldNames(phFDX(self),piFile(self),liIndex,0))
68520>>>>>>>    set aux_value item (item_count(self)-1) to liIndex
68521>>>>>>>  end_procedure
68522>>>>>>>  procedure fill_list.ii integer oFDX# integer file#
68524>>>>>>>    integer field# max_field# base# rel_file#
68524>>>>>>>    set phFDX to oFDX#
68525>>>>>>>    set piFile to file#
68526>>>>>>>    set dynamic_update_state to DFFALSE
68527>>>>>>>    send delete_data
68528>>>>>>>    send FDX_IndexCallback oFDX# file# DF_INDEX_TYPE_ONLINE MSG_AddIndex self
68529>>>>>>>    send FDX_IndexCallback oFDX# file# DF_INDEX_TYPE_BATCH MSG_AddIndex self
68530>>>>>>>    set dynamic_update_state to DFTRUE
68531>>>>>>>  end_procedure
68532>>>>>>>end_class // cFdxSelectIndexList
68533>>>>>>>
68533>>>>>>>object oFdxSelectIndex is a aps.ModalPanel
68535>>>>>>>  set locate_mode to CENTER_ON_SCREEN
68536>>>>>>>  on_key ksave_record send close_panel_ok
68537>>>>>>>  on_key kcancel send close_panel
68538>>>>>>>  property integer piResult public 0
68540>>>>>>>  set pMinimumSize to 150 0
68541>>>>>>>  object oLst is a cFdxSelectIndexList
68543>>>>>>>    on_key kenter send close_panel_ok
68544>>>>>>>    set size to 100 300
68545>>>>>>>  end_object
68546>>>>>>>  object oBtn1 is a aps.Multi_Button
68548>>>>>>>    on_item t.btn.ok send close_panel_ok
68549>>>>>>>  end_object
68550>>>>>>>  object oBtn2 is a aps.Multi_Button
68552>>>>>>>    on_item t.btn.cancel send close_panel
68553>>>>>>>  end_object
68554>>>>>>>  send aps_locate_multi_buttons
68555>>>>>>>  procedure close_panel_ok
68558>>>>>>>    set piResult to (aux_value(oLst(self),CURRENT))
68559>>>>>>>    send close_panel
68560>>>>>>>  end_procedure
68561>>>>>>>  set Border_Style to BORDER_THICK   // Make panel resizeable
68562>>>>>>>  procedure aps_onResize integer delta_rw# integer delta_cl#
68565>>>>>>>    send aps_resize (oLst(self)) delta_rw# 0
68566>>>>>>>    send aps_register_multi_button (oBtn1(self))
68567>>>>>>>    send aps_register_multi_button (oBtn2(self))
68568>>>>>>>    send aps_locate_multi_buttons
68569>>>>>>>    send aps_auto_size_container
68570>>>>>>>  end_procedure
68571>>>>>>>  function iPopup.ii integer oFDX# integer file# returns integer
68574>>>>>>>    set piResult to 0
68575>>>>>>>    send fill_list.ii to (oLst(self)) oFDX# file#
68576>>>>>>>    set label to ("Select index: "+FDX_AttrValue_FILELIST(oFDX#,DF_FILE_LOGICAL_NAME,file#))
68577>>>>>>>    send popup
68578>>>>>>>    function_return (piResult(self))
68579>>>>>>>  end_function
68580>>>>>>>end_object // oFdxSelectIndex
68581>>>>>>>end_desktop_section
68586>>>>>>>
68586>>>>>>>function iFdxSelectIndex global integer oFDX# integer file# returns integer
68588>>>>>>>  integer close# open# rval#
68588>>>>>>>  ifnot oFDX# begin
68590>>>>>>>    if (DBMS_IsOpenFile(file#)) begin
68592>>>>>>>      move 0 to close#
68593>>>>>>>      move 1 to open#
68594>>>>>>>    end
68594>>>>>>>>
68594>>>>>>>    else begin
68595>>>>>>>      if (DBMS_OpenFile(file#,DF_SHARE,0)) begin
68597>>>>>>>        move 1 to close#
68598>>>>>>>        move 1 to open#
68599>>>>>>>      end
68599>>>>>>>>
68599>>>>>>>      else begin
68600>>>>>>>        move 0 to close#
68601>>>>>>>        move 0 to open#
68602>>>>>>>      end
68602>>>>>>>>
68602>>>>>>>    end
68602>>>>>>>>
68602>>>>>>>  end
68602>>>>>>>>
68602>>>>>>>  else begin
68603>>>>>>>    move 0 to close#
68604>>>>>>>    move 1 to open#
68605>>>>>>>  end
68605>>>>>>>>
68605>>>>>>>  move (iPopup.ii(oFdxSelectIndex(self),oFDX#,file#)) to rval#
68606>>>>>>>  if close# close file#
68609>>>>>>>  function_return rval#
68610>>>>>>>end_function
68611>>>>>Use AutoPrmt.utl // Automatic prompt lists for VDF, (DefaultPromptList(self))
Including file: autoprmt.utl    (C:\projects\BRS\VDFQuery\AppSrc\autoprmt.utl)
68611>>>>>>>// **********************************************************************
68611>>>>>>>// Use AutoPrmt.utl // Automatic prompt lists for VDF, (DefaultPromptList(self))
68611>>>>>>>//
68611>>>>>>>// by Sture Andersen
68611>>>>>>>//
68611>>>>>>>// Try to send popup to (DefaultPromptList(self)) and see what happens
68611>>>>>>>//
68611>>>>>>>// Create: Thu  14-04-1997
68611>>>>>>>// Update: Sat  10-05-1997 - Restructure
68611>>>>>>>//         Wed  16-07-1997 - Object index_analyzer is now private
68611>>>>>>>//         Thu  30-10-1997 - Now runs from dbForms with no server
68611>>>>>>>//         Mon  15-12-1997 - Procedure DefaultPromptList added
68611>>>>>>>//         Sat  05-12-1998 - When PL's are constructed (not auto_server)
68611>>>>>>>//                           in VDF5, the server of the dbList has to be
68611>>>>>>>//                           set.
68611>>>>>>>//         Wed  10-02-1999 - Prompt lists are now re-sizable.
68611>>>>>>>//         Tue  30-11-1999 - Changing function call from expressional to
68611>>>>>>>//                           non-expressional fixed "illegal message"
68611>>>>>>>//                           problem (shouldn't have happened in the
68611>>>>>>>//                           first place because delegation_mode was set
68611>>>>>>>//                           to no_delegate_or_error).
68611>>>>>>>//         Mon  30+06-2003 - Changed height of selection list (double height)
68611>>>>>>>// ***********************************************************************
68611>>>>>>>
68611>>>>>>>Use APS          // Auto Positioning and Sizing classes for VDF
68611>>>>>>>Use Dynamo.utl   // Dynamic creation of objects for VDF
Including file: dynamo.utl    (C:\projects\BRS\VDFQuery\AppSrc\dynamo.utl)
68611>>>>>>>>>// **********************************************************************
68611>>>>>>>>>// Use Dynamo.utl   // Dynamic creation of objects for VDF
68611>>>>>>>>>//
68611>>>>>>>>>// Version: 1.0
68611>>>>>>>>>// By Sture Andersen
68611>>>>>>>>>//
68611>>>>>>>>>// Create: Thu  03-04-1997 -
68611>>>>>>>>>// Update: Sat  10-05-1997 - Procedure push_data_fields added
68611>>>>>>>>>//         Thu  08-09-2005 - Maximum columns handled by dbGrid & dbList increased from 10 to 20
68611>>>>>>>>>//         Wed  14-09-2005 - Now also handles virtual fields (in dbGrids and dbLists, dbForms soon to come)
68611>>>>>>>>>// ***********************************************************************
68611>>>>>>>>>
68611>>>>>>>>>Use APS           // Auto Positioning and Sizing classes for VDF
68611>>>>>>>>>Use Set.utl       // cArray, cSet and cStack classes
68611>>>>>>>>>Use Classes.nui   // Class characteristics
Including file: classes.nui    (C:\projects\BRS\VDFQuery\AppSrc\classes.nui)
68611>>>>>>>>>>>// Use Classes.nui  // Class characteristics
68611>>>>>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
68611>>>>>>>>>>>Use cDbRichEdit.pkg
68611>>>>>>>>>>>
68611>>>>>>>>>>>// Start off by enumerating all kinds of object classes that can be
68611>>>>>>>>>>>// thought of. These are just symbols that will be used for indexing
68611>>>>>>>>>>>// within arrays:
68611>>>>>>>>>>>
68611>>>>>>>>>>>Enumeration_List
68611>>>>>>>>>>>  Define class.View
68611>>>>>>>>>>>  Define class.dbView
68611>>>>>>>>>>>  Define class.ModalPanel
68611>>>>>>>>>>>  Define class.dbModalPanel
68611>>>>>>>>>>>  Define class.Group
68611>>>>>>>>>>>  Define class.dbGroup
68611>>>>>>>>>>>  Define class.Container3d
68611>>>>>>>>>>>  Define class.dbContainer3d
68611>>>>>>>>>>>  Define class.TabDialog
68611>>>>>>>>>>>  Define class.dbTabDialog
68611>>>>>>>>>>>  Define class.TabPage
68611>>>>>>>>>>>  Define class.dbTabPage
68611>>>>>>>>>>>  Define class.RadioGroup
68611>>>>>>>>>>>  Define class.Form
68611>>>>>>>>>>>  Define class.dbForm
68611>>>>>>>>>>>  Define class.ComboForm
68611>>>>>>>>>>>  Define class.dbComboForm
68611>>>>>>>>>>>  Define class.SpinForm
68611>>>>>>>>>>>  Define class.dbSpinForm
68611>>>>>>>>>>>  Define class.CheckBox
68611>>>>>>>>>>>  Define class.dbCheckBox
68611>>>>>>>>>>>  Define class.Edit
68611>>>>>>>>>>>  Define class.dbEdit
68611>>>>>>>>>>>  Define class.TextBox
68611>>>>>>>>>>>  Define class.Button
68611>>>>>>>>>>>  Define class.Radio
68611>>>>>>>>>>>  Define class.List
68611>>>>>>>>>>>  Define class.dbList
68611>>>>>>>>>>>  Define class.Grid
68611>>>>>>>>>>>  Define class.dbGrid
68611>>>>>>>>>>>  Define class.Multi_Button
68611>>>>>>>>>>>  Define class.BitmapContainer
68611>>>>>>>>>>>  Define class.ToolButton
68611>>>>>>>>>>>  Define class.DataDictionary
68611>>>>>>>>>>>  Define class.ImageViewer       // This one I have completely forgotten about
68611>>>>>>>>>>>  Define class.GraphArea
68611>>>>>>>>>>>  Define class.RichEdit
68611>>>>>>>>>>>  Define class.dbRichEdit
68611>>>>>>>>>>>  Define class.TextEdit
68611>>>>>>>>>>>  Define class.dbTextEdit
68611>>>>>>>>>>>  Define class.User              // This one just marks the end
68611>>>>>>>>>>>End_Enumeration_List
68611>>>>>>>>>>>
68611>>>>>>>>>>>
68611>>>>>>>>>>>ClassReveal BaseClass       -1
68615>>>>>>>>>>>ClassReveal View            class.View
68619>>>>>>>>>>>ClassReveal dbView          class.dbView
68623>>>>>>>>>>>ClassReveal ModalPanel      class.ModalPanel
68627>>>>>>>>>>>ClassReveal dbModalPanel    class.dbModalPanel
68631>>>>>>>>>>>ClassReveal Group           class.Group
68635>>>>>>>>>>>ClassReveal dbGroup         class.dbGroup
68639>>>>>>>>>>>ClassReveal Container3d     class.Container3d
68643>>>>>>>>>>>ClassReveal dbContainer3d   class.dbContainer3d
68647>>>>>>>>>>>ClassReveal TabDialog       class.TabDialog
68651>>>>>>>>>>>ClassReveal dbTabDialog     class.dbTabDialog
68655>>>>>>>>>>>ClassReveal TabPage         class.TabPage
68659>>>>>>>>>>>ClassReveal dbTabPage       class.dbTabPage
68663>>>>>>>>>>>ClassReveal RadioGroup      class.RadioGroup
68667>>>>>>>>>>>ClassReveal Form            class.Form
68671>>>>>>>>>>>ClassReveal dbForm          class.dbForm
68675>>>>>>>>>>>ClassReveal ComboForm       class.ComboForm
68679>>>>>>>>>>>ClassReveal dbComboForm     class.dbComboForm
68683>>>>>>>>>>>ClassReveal SpinForm        class.SpinForm
68687>>>>>>>>>>>ClassReveal dbSpinForm      class.dbSpinForm
68691>>>>>>>>>>>ClassReveal CheckBox        class.CheckBox
68695>>>>>>>>>>>ClassReveal dbCheckBox      class.dbCheckBox
68699>>>>>>>>>>>ClassReveal Edit            class.Edit
68703>>>>>>>>>>>ClassReveal dbEdit          class.dbEdit
68707>>>>>>>>>>>ClassReveal TextBox         class.TextBox
68711>>>>>>>>>>>ClassReveal Button          class.Button
68715>>>>>>>>>>>ClassReveal Radio           class.Radio
68719>>>>>>>>>>>ClassReveal List            class.List
68723>>>>>>>>>>>ClassReveal dbList          class.dbList
68727>>>>>>>>>>>ClassReveal Grid            class.Grid
68731>>>>>>>>>>>ClassReveal dbGrid          class.dbGrid
68735>>>>>>>>>>>ClassReveal BitmapContainer class.BitmapContainer
68739>>>>>>>>>>>ClassReveal DataDictionary  class.DataDictionary
68743>>>>>>>>>>>ClassReveal cRichEdit       class.RichEdit
68747>>>>>>>>>>>ClassReveal cdbRichEdit     class.dbRichEdit
68751>>>>>>>>>>>ClassReveal cTextEdit       class.TextEdit
68755>>>>>>>>>>>ClassReveal cdbTextEdit     class.dbTextEdit
68759>>>>>>>>>>>
68759>>>>>>>>>>>
68759>>>>>>>>>>>
68759>>>>>>>>>>>desktop_section
68764>>>>>>>>>>>object oVdfClasses is a cArray
68766>>>>>>>>>>>  item_property_list
68766>>>>>>>>>>>    item_property string  psName.i
68766>>>>>>>>>>>    item_property integer pbDbAware.i
68766>>>>>>>>>>>    item_property integer pbContainer.i
68766>>>>>>>>>>>    item_property integer pbVisible.i
68766>>>>>>>>>>>    item_property integer pbMultiItem.i
68766>>>>>>>>>>>  end_item_property_list
#REM 68812 DEFINE FUNCTION PBMULTIITEM.I INTEGER LIROW RETURNS INTEGER
#REM 68817 DEFINE PROCEDURE SET PBMULTIITEM.I INTEGER LIROW INTEGER VALUE
#REM 68822 DEFINE FUNCTION PBVISIBLE.I INTEGER LIROW RETURNS INTEGER
#REM 68827 DEFINE PROCEDURE SET PBVISIBLE.I INTEGER LIROW INTEGER VALUE
#REM 68832 DEFINE FUNCTION PBCONTAINER.I INTEGER LIROW RETURNS INTEGER
#REM 68837 DEFINE PROCEDURE SET PBCONTAINER.I INTEGER LIROW INTEGER VALUE
#REM 68842 DEFINE FUNCTION PBDBAWARE.I INTEGER LIROW RETURNS INTEGER
#REM 68847 DEFINE PROCEDURE SET PBDBAWARE.I INTEGER LIROW INTEGER VALUE
#REM 68852 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 68857 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
68863>>>>>>>>>>>  procedure AddClass integer liClass string lsName integer lbDBAware integer lbContainer integer lbVisible integer lbMultiItem
68866>>>>>>>>>>>    set psName.i      liClass to lsName
68867>>>>>>>>>>>    set pbDbAware.i   liClass to lbDBAware
68868>>>>>>>>>>>    set pbContainer.i liClass to lbContainer
68869>>>>>>>>>>>    set pbVisible.i   liClass to lbVisible
68870>>>>>>>>>>>    set pbMultiItem.i liClass to lbMultiItem
68871>>>>>>>>>>>  end_procedure
68872>>>>>>>>>>>  send AddClass class.View            "View"           0 1 1 0
68873>>>>>>>>>>>  send AddClass class.dbView          "dbView"         1 1 1 0
68874>>>>>>>>>>>  send AddClass class.ModalPanel      "ModalPanel"     0 1 1 0
68875>>>>>>>>>>>  send AddClass class.dbModalPanel    "dbModalPanel"   1 1 1 0
68876>>>>>>>>>>>  send AddClass class.Group           "Group"          0 1 1 0
68877>>>>>>>>>>>  send AddClass class.dbGroup         "dbGroup"        1 1 1 0
68878>>>>>>>>>>>  send AddClass class.Container3d     "Container3d"    0 1 1 0
68879>>>>>>>>>>>  send AddClass class.dbContainer3d   "dbContainer3d"  1 1 1 0
68880>>>>>>>>>>>  send AddClass class.TabDialog       "TabDialog"      0 1 1 0
68881>>>>>>>>>>>  send AddClass class.dbTabDialog     "dbTabDialog"    1 1 1 0
68882>>>>>>>>>>>  send AddClass class.TabPage         "TabPage"        0 1 1 0
68883>>>>>>>>>>>  send AddClass class.dbTabPage       "dbTabPage"      1 1 1 0
68884>>>>>>>>>>>  send AddClass class.RadioGroup      "RadioGroup"     0 1 1 0
68885>>>>>>>>>>>  send AddClass class.Form            "Form"           0 0 1 0
68886>>>>>>>>>>>  send AddClass class.dbForm          "dbForm"         1 0 1 0
68887>>>>>>>>>>>  send AddClass class.ComboForm       "ComboForm"      0 0 1 0
68888>>>>>>>>>>>  send AddClass class.dbComboForm     "dbComboForm"    1 0 1 0
68889>>>>>>>>>>>  send AddClass class.SpinForm        "SpinForm"       0 0 1 0
68890>>>>>>>>>>>  send AddClass class.dbSpinForm      "dbSpinForm"     1 0 1 0
68891>>>>>>>>>>>  send AddClass class.CheckBox        "CheckBox"       0 0 1 0
68892>>>>>>>>>>>  send AddClass class.dbCheckBox      "dbCheckBox"     1 0 1 0
68893>>>>>>>>>>>  send AddClass class.Edit            "Edit"           0 0 1 0
68894>>>>>>>>>>>  send AddClass class.dbEdit          "dbEdit"         1 0 1 0
68895>>>>>>>>>>>  send AddClass class.TextBox         "TextBox"        0 0 1 0
68896>>>>>>>>>>>  send AddClass class.Button          "Button"         0 0 1 0
68897>>>>>>>>>>>  send AddClass class.Radio           "Radio"          0 0 1 0
68898>>>>>>>>>>>  send AddClass class.List            "List"           0 0 1 0
68899>>>>>>>>>>>  send AddClass class.dbList          "dbList"         1 0 1 1
68900>>>>>>>>>>>  send AddClass class.Grid            "Grid"           0 0 1 1
68901>>>>>>>>>>>  send AddClass class.dbGrid          "dbGrid"         1 0 1 1
68902>>>>>>>>>>>  send AddClass class.Multi_Button    "Multi_Button"   0 0 1 0
68903>>>>>>>>>>>  send AddClass class.BitmapContainer "BitmapContainer"0 0 1 0
68904>>>>>>>>>>>  send AddClass class.ToolButton      "ToolButton"     0 0 1 0
68905>>>>>>>>>>>  send AddClass class.DataDictionary  "DataDictionary" 1 0 0 0
68906>>>>>>>>>>>  send AddClass class.ImageViewer     "ImageViewer"    0 0 1 0
68907>>>>>>>>>>>  send AddClass class.GraphArea       "GraphArea"      0 0 1 0
68908>>>>>>>>>>>  send AddClass class.RichEdit        "RichEdit  "     0 0 1 0
68909>>>>>>>>>>>  send AddClass class.dbRichEdit      "dbRichEdit"     1 0 1 0
68910>>>>>>>>>>>  send AddClass class.TextEdit        "TextEdit  "     0 0 1 0
68911>>>>>>>>>>>  send AddClass class.dbTextEdit      "dbTextEdit"     1 0 1 0
68912>>>>>>>>>>>  send AddClass class.User            "User"           0 0 0 0
68913>>>>>>>>>>>end_object
68914>>>>>>>>>>>end_desktop_section
68919>>>>>>>>>>>
68919>>>>>>>>>>>function Cls_ClassName global integer liClass returns string
68921>>>>>>>>>>>  function_return (psName.i(oVdfClasses(self),liClass))
68922>>>>>>>>>>>end_function
68923>>>>>>>>>>>function Cls_ClassIsDbAware global integer liClass returns integer
68925>>>>>>>>>>>  function_return (pbDbAware.i(oVdfClasses(self),liClass))
68926>>>>>>>>>>>end_function
68927>>>>>>>>>>>function Cls_ClassIsContainer global integer liClass returns integer
68929>>>>>>>>>>>  function_return (pbContainer.i(oVdfClasses(self),liClass))
68930>>>>>>>>>>>end_function
68931>>>>>>>>>>>function Cls_ClassIsVisible global integer liClass returns integer
68933>>>>>>>>>>>  function_return (pbVisible.i(oVdfClasses(self),liClass))
68934>>>>>>>>>>>end_function
68935>>>>>>>>>>>function Cls_ClassIsMultiItem global integer liClass returns integer
68937>>>>>>>>>>>  function_return (pbMultiItem.i(oVdfClasses(self),liClass))
68938>>>>>>>>>>>end_function
68939>>>>>>>>>>>
68939>>>>>>>>>>>
68939>>>>>>>>>>>
68939>>>>>>>>>Use Createobj.nui // Function create_object_within_parent
Including file: createobj.nui    (C:\projects\BRS\VDFQuery\AppSrc\createobj.nui)
68939>>>>>>>>>>>// Use Createobj.nui // Function create_object_within_parent
68939>>>>>>>>>>>//
68939>>>>>>>>>>>// This function will create an object of class liClass as if it was nested
68939>>>>>>>>>>>// inside object with object_id lhParent.
68939>>>>>>>>>>>
68939>>>>>>>>>>>function create_object_within_parent global integer liClass integer lhParent returns integer
68941>>>>>>>>>>>  integer lhRval lhSelf
68941>>>>>>>>>>>  name liClass U_rizla_class
68941>>>>>>>>>>>  move self to lhSelf
68942>>>>>>>>>>>  move lhParent to self
68943>>>>>>>>>>>  object rizla_object is a rizla_class
68945>>>>>>>>>>>    move self to lhRval
68946>>>>>>>>>>>  end_object
68947>>>>>>>>>>>  move lhSelf to self
68948>>>>>>>>>>>  function_return lhRval
68949>>>>>>>>>>>end_function
68950>>>>>>>>>
68950>>>>>>>>>class dnm.Button is a aps.Button
68951>>>>>>>>>  procedure construct_object
68953>>>>>>>>>    forward send construct_object
68955>>>>>>>>>    property integer p_message public 0
68956>>>>>>>>>  end_procedure
68957>>>>>>>>>  procedure OnClick
68959>>>>>>>>>    integer lhObj lhMsg
68959>>>>>>>>>    get p_message to lhMsg
68960>>>>>>>>>    get aux_value item 0 to lhObj
68961>>>>>>>>>    if lhObj send lhMsg to lhObj
68964>>>>>>>>>    else send lhMsg
68966>>>>>>>>>  end_procedure
68967>>>>>>>>>end_class
68968>>>>>>>>>class dnm.Multi_Button is a aps.Multi_Button
68969>>>>>>>>>  procedure construct_object
68971>>>>>>>>>    forward send construct_object
68973>>>>>>>>>    property integer p_message public 0
68974>>>>>>>>>  end_procedure
68975>>>>>>>>>  procedure OnClick
68977>>>>>>>>>    integer lhObj lhMsg
68977>>>>>>>>>    get p_message to lhMsg
68978>>>>>>>>>    get aux_value item 0 to lhObj
68979>>>>>>>>>    if lhObj send lhMsg to lhObj
68982>>>>>>>>>    else send lhMsg
68984>>>>>>>>>  end_procedure
68985>>>>>>>>>end_class
68986>>>>>>>>>
68986>>>>>>>>>class dnm.virtual_field_columns is a cArray
68987>>>>>>>>>  item_property_list
68987>>>>>>>>>    item_property integer piFile.i
68987>>>>>>>>>    item_property integer piField.i
68987>>>>>>>>>  end_item_property_list dnm.virtual_field_columns
#REM 69019 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 69023 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 69027 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 69031 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
69036>>>>>>>>>end_class
69037>>>>>>>>>
69037>>>>>>>>>class dnm.dbForm is a aps.dbForm
69038>>>>>>>>>  procedure construct_object
69040>>>>>>>>>    forward send construct_object
69042>>>>>>>>>    object oVirtualFieldsColumns is a dnm.virtual_field_columns
69044>>>>>>>>>    end_object
69045>>>>>>>>>  end_procedure
69046>>>>>>>>>  procedure set_virtual_field_id integer liColumn integer liFile integer liField
69048>>>>>>>>>    set piFile.i of oVirtualFieldsColumns liColumn to liFile
69049>>>>>>>>>    set piField.i of oVirtualFieldsColumns liColumn to liField
69050>>>>>>>>>  end_procedure
69051>>>>>>>>>  function virtual_field_value integer liColumn returns string
69053>>>>>>>>>    integer liFile liField
69053>>>>>>>>>    get piFile.i of oVirtualFieldsColumns liColumn to liFile
69054>>>>>>>>>    get piField.i of oVirtualFieldsColumns liColumn to liField
69055>>>>>>>>>    function_return (FieldInf_FieldValue(liFile,liField))
69056>>>>>>>>>  end_function
69057>>>>>>>>>end_class
69058>>>>>>>>>
69058>>>>>>>>>class dnm.dbGrid is a aps.dbGrid
69059>>>>>>>>>  procedure construct_object
69061>>>>>>>>>    forward send construct_object
69063>>>>>>>>>    object oVirtualFieldsColumns is a dnm.virtual_field_columns
69065>>>>>>>>>    end_object
69066>>>>>>>>>  end_procedure
69067>>>>>>>>>  procedure set_virtual_field_id integer liColumn integer liFile integer liField
69069>>>>>>>>>    set piFile.i of oVirtualFieldsColumns liColumn to liFile
69070>>>>>>>>>    set piField.i of oVirtualFieldsColumns liColumn to liField
69071>>>>>>>>>  end_procedure
69072>>>>>>>>>  function virtual_field_value integer liColumn returns string
69074>>>>>>>>>    integer liFile liField
69074>>>>>>>>>    get piFile.i of oVirtualFieldsColumns liColumn to liFile
69075>>>>>>>>>    get piField.i of oVirtualFieldsColumns liColumn to liField
69076>>>>>>>>>    function_return (FieldInf_FieldValue(liFile,liField))
69077>>>>>>>>>  end_function
69078>>>>>>>>>end_class
69079>>>>>>>>>
69079>>>>>>>>>class dnm.dbList is a aps.dbList
69080>>>>>>>>>  procedure construct_object
69082>>>>>>>>>    forward send construct_object
69084>>>>>>>>>    object oVirtualFieldsColumns is a dnm.virtual_field_columns
69086>>>>>>>>>    end_object
69087>>>>>>>>>  end_procedure
69088>>>>>>>>>  procedure set_virtual_field_id integer liColumn integer liFile integer liField
69090>>>>>>>>>    set piFile.i of oVirtualFieldsColumns liColumn to liFile
69091>>>>>>>>>    set piField.i of oVirtualFieldsColumns liColumn to liField
69092>>>>>>>>>  end_procedure
69093>>>>>>>>>  function virtual_field_value integer liColumn returns string
69095>>>>>>>>>    integer liFile liField
69095>>>>>>>>>    get piFile.i of oVirtualFieldsColumns liColumn to liFile
69096>>>>>>>>>    get piField.i of oVirtualFieldsColumns liColumn to liField
69097>>>>>>>>>    function_return (FieldInf_FieldValue(liFile,liField))
69098>>>>>>>>>  end_function
69099>>>>>>>>>end_class
69100>>>>>>>>>
69100>>>>>>>>>class dynamo_message_dealer is a cStack
69101>>>>>>>>>  procedure deal_messages integer lhObj
69103>>>>>>>>>    integer liNumArg lhMsg liItem liBase liMax
69103>>>>>>>>>    string lsArg1 lsArg2 lsArg3 lsArg4 lsArg5
69103>>>>>>>>>    get item_count to liMax
69104>>>>>>>>>    move 0 to liBase
69105>>>>>>>>>    while liBase lt liMax
69109>>>>>>>>>      get value item liBase to lhMsg
69110>>>>>>>>>      get value item (liBase+1) to liNumArg
69111>>>>>>>>>
69111>>>>>>>>>      if liNumArg gt 1 get value item (liBase+2) to lsArg1
69114>>>>>>>>>      if liNumArg gt 2 get value item (liBase+3) to lsArg2
69117>>>>>>>>>      if liNumArg gt 3 get value item (liBase+4) to lsArg3
69120>>>>>>>>>      if liNumArg gt 4 get value item (liBase+5) to lsArg4
69123>>>>>>>>>      if liNumArg gt 5 get value item (liBase+6) to lsArg5
69126>>>>>>>>>
69126>>>>>>>>>      if liNumArg eq 6 send lhMsg to lhObj lsArg1 lsArg2 lsArg3 lsArg4 lsArg5
69129>>>>>>>>>      if liNumArg eq 5 send lhMsg to lhObj lsArg1 lsArg2 lsArg3 lsArg4
69132>>>>>>>>>      if liNumArg eq 4 send lhMsg to lhObj lsArg1 lsArg2 lsArg3
69135>>>>>>>>>      if liNumArg eq 3 send lhMsg to lhObj lsArg1 lsArg2
69138>>>>>>>>>      if liNumArg eq 2 send lhMsg to lhObj lsArg1
69141>>>>>>>>>      if liNumArg eq 1 send lhMsg to lhObj
69144>>>>>>>>>
69144>>>>>>>>>      move (liBase+liNumArg+1) to liBase
69145>>>>>>>>>    end
69146>>>>>>>>>>
69146>>>>>>>>>    send delete_data
69147>>>>>>>>>  end_procedure
69148>>>>>>>>>end_class
69149>>>>>>>>>
69149>>>>>>>>>class dynamo_data_connect_settings is a cArray
69150>>>>>>>>>  item_property_list
69150>>>>>>>>>    item_property integer piFile.i
69150>>>>>>>>>    item_property integer piField.i
69150>>>>>>>>>    item_property string  psForcedLabel.i
69150>>>>>>>>>    item_property integer piForcedWidth.i
69150>>>>>>>>>  end_item_property_list dynamo_data_connect_settings
#REM 69188 DEFINE FUNCTION PIFORCEDWIDTH.I INTEGER LIROW RETURNS INTEGER
#REM 69192 DEFINE PROCEDURE SET PIFORCEDWIDTH.I INTEGER LIROW INTEGER VALUE
#REM 69196 DEFINE FUNCTION PSFORCEDLABEL.I INTEGER LIROW RETURNS STRING
#REM 69200 DEFINE PROCEDURE SET PSFORCEDLABEL.I INTEGER LIROW STRING VALUE
#REM 69204 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 69208 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 69212 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 69216 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
69221>>>>>>>>>  procedure add_data_connect_values integer liFile integer liField string lsLabel integer liWidth
69223>>>>>>>>>    integer liRow
69223>>>>>>>>>    get row_count to liRow
69224>>>>>>>>>    set piFile.i        liRow to liFile
69225>>>>>>>>>    set piField.i       liRow to liField
69226>>>>>>>>>    set psForcedLabel.i liRow to lsLabel
69227>>>>>>>>>    set piForcedWidth.i liRow to liWidth
69228>>>>>>>>>  end_procedure
69229>>>>>>>>>end_class // dynamo_data_connect_settings
69230>>>>>>>>>
69230>>>>>>>>>// Here comes the main actor for tonight: The aps_ObjectDynamo class.
69230>>>>>>>>>class aps_ObjectDynamo is a cStack
69231>>>>>>>>>  procedure construct_object
69233>>>>>>>>>    forward send construct_object
69235>>>>>>>>>    set value item class.View            to U_aps.View
69236>>>>>>>>>    set value item class.dbView          to U_aps.dbView
69237>>>>>>>>>    set value item class.ModalPanel      to U_aps.ModalPanel
69238>>>>>>>>>    set value item class.dbModalPanel    to U_aps.dbModalPanel
69239>>>>>>>>>    set value item class.Group           to U_aps.Group
69240>>>>>>>>>    set value item class.dbGroup         to U_aps.dbGroup
69241>>>>>>>>>    set value item class.Container3d     to U_aps.Container3d
69242>>>>>>>>>    set value item class.dbContainer3d   to U_aps.dbContainer3d
69243>>>>>>>>>    set value item class.TabDialog       to U_aps.TabDialog
69244>>>>>>>>>    set value item class.dbTabDialog     to U_aps.dbTabDialog
69245>>>>>>>>>    set value item class.TabPage         to U_aps.TabPage
69246>>>>>>>>>    set value item class.dbTabPage       to U_aps.dbTabPage
69247>>>>>>>>>    set value item class.RadioGroup      to U_aps.RadioGroup
69248>>>>>>>>>    set value item class.Form            to U_aps.Form
69249>>>>>>>>>    set value item class.dbForm          to U_dnm.dbForm
69250>>>>>>>>>    set value item class.ComboForm       to U_aps.ComboForm
69251>>>>>>>>>    set value item class.dbComboForm     to U_aps.dbComboForm
69252>>>>>>>>>    set value item class.SpinForm        to U_aps.dbSpinForm
69253>>>>>>>>>    set value item class.dbSpinForm      to U_aps.dbSpinForm
69254>>>>>>>>>    set value item class.CheckBox        to U_aps.CheckBox
69255>>>>>>>>>    set value item class.dbCheckBox      to U_aps.dbCheckBox
69256>>>>>>>>>    set value item class.Edit            to U_aps.Edit
69257>>>>>>>>>    set value item class.dbEdit          to U_aps.dbEdit
69258>>>>>>>>>    set value item class.TextBox         to U_aps.TextBox
69259>>>>>>>>>    set value item class.Button          to U_dnm.Button
69260>>>>>>>>>    set value item class.Radio           to U_aps.Radio
69261>>>>>>>>>    set value item class.List            to U_aps.List
69262>>>>>>>>>    set value item class.dbList          to U_dnm.dbList
69263>>>>>>>>>    set value item class.Grid            to U_aps.Grid
69264>>>>>>>>>    set value item class.dbGrid          to U_dnm.dbGrid
69265>>>>>>>>>    set value item class.Multi_Button    to U_dnm.Multi_Button
69266>>>>>>>>>    set value item class.BitmapContainer to U_aps.BitmapContainer
69267>>>>>>>>>    set value item class.ToolButton      to U_aps.ToolButton
69268>>>>>>>>>    set value item class.DataDictionary  to U_aps.DataDictionary
69269>>>>>>>>>
69269>>>>>>>>>    // When creating object structures we have to distinguish between
69269>>>>>>>>>    // containers and controls. Containers are pushed upon this stack
69269>>>>>>>>>    // to let the objects after it be created with the container as
69269>>>>>>>>>    // the parent. The property holds the value of the outmost parent:
69269>>>>>>>>>    property integer p_dynamo_desktop private (parent(self))
69270>>>>>>>>>    object container_stack is a cStack
69272>>>>>>>>>      send push.i (aps_ObjectDynamo.p_dynamo_desktop(self))
69273>>>>>>>>>    end_object
69274>>>>>>>>>
69274>>>>>>>>>    // This object marks the data aware classes that contains
69274>>>>>>>>>    // prototype entry objects:
69274>>>>>>>>>    object prototype_entry_based_array is a cArray
69276>>>>>>>>>      set value item class.dbList to DFTRUE
69277>>>>>>>>>      set value item class.dbGrid to DFTRUE
69278>>>>>>>>>    end_object
69279>>>>>>>>>
69279>>>>>>>>>    // If values are pushed upon this array they will be set as
69279>>>>>>>>>    // data_file and data_field on the item(s) of the object
69279>>>>>>>>>    object data_connect_array is a cStack
69281>>>>>>>>>    end_object
69282>>>>>>>>>
69282>>>>>>>>>    // The two objects
69282>>>>>>>>>    object top_code_messages is a dynamo_message_dealer
69284>>>>>>>>>    end_object
69285>>>>>>>>>    object bottom_code_messages is a dynamo_message_dealer
69287>>>>>>>>>    end_object
69288>>>>>>>>>  end_procedure
69289>>>>>>>>>
69289>>>>>>>>>  procedure set p_dynamo_desktop integer obj#
69291>>>>>>>>>    integer container_stack#
69291>>>>>>>>>    move (container_stack(self)) to container_stack#
69292>>>>>>>>>    send delete_data to container_stack# // Clean up previous desktop
69293>>>>>>>>>    send push.i to container_stack# obj#
69294>>>>>>>>>    set !$.p_dynamo_desktop to obj#
69295>>>>>>>>>  end_procedure
69296>>>>>>>>>
69296>>>>>>>>>  function p_dynamo_desktop returns integer
69298>>>>>>>>>    function_return (!$.p_dynamo_desktop(self))
69299>>>>>>>>>  end_function
69300>>>>>>>>>
69300>>>>>>>>>  function should_be_pushed integer class# returns integer
69302>>>>>>>>>    function_return (Cls_ClassIsContainer(class#))
69303>>>>>>>>>  end_function
69304>>>>>>>>>
69304>>>>>>>>>  function prototype_entry_based integer class# returns integer
69306>>>>>>>>>    function_return (value(prototype_entry_based_array(self),class#))
69307>>>>>>>>>  end_function
69308>>>>>>>>>
69308>>>>>>>>>  procedure push_object integer obj#
69310>>>>>>>>>    send push.i to (container_stack(self)) obj#
69311>>>>>>>>>  end_procedure
69312>>>>>>>>>
69312>>>>>>>>>  procedure pop_object
69314>>>>>>>>>    integer grb#
69314>>>>>>>>>    get ipop of (container_stack(self)) to grb#
69315>>>>>>>>>    // Make it size and locate:
69315>>>>>>>>>    send end_construct_object to grb# // Hold your breath!
69316>>>>>>>>>  end_procedure
69317>>>>>>>>>
69317>>>>>>>>>  procedure push_data_field integer liFile integer liField string lsForcedLabel integer liForcedWidth
69319>>>>>>>>>    integer lhDataConnect liItem liTmp
69319>>>>>>>>>    move (data_connect_array(self)) to lhDataConnect // procedure push_data_field
69320>>>>>>>>>    move (item_count(lhDataConnect)/2) to liItem
69321>>>>>>>>>    send push.i to lhDataConnect liFile
69322>>>>>>>>>    send push.i to lhDataConnect liField
69323>>>>>>>>>    if (num_arguments>2 and lsForcedLabel<>"") send add_bottom_message SET_Header_Label liItem lsForcedLabel
69326>>>>>>>>>
69326>>>>>>>>>    if (num_arguments>3) move liForcedWidth to liTmp
69329>>>>>>>>>    else move 0 to liTmp
69331>>>>>>>>>
69331>>>>>>>>>    if (liField>=256 and liTmp=0) begin
69333>>>>>>>>>      // If it's a virtual field, we have to calculate the default width of
69333>>>>>>>>>      // that field since APS is not capable of doing that:
69333>>>>>>>>>      move (FieldWidthMDU(liFile,liField)) to liTmp
69334>>>>>>>>>    end
69334>>>>>>>>>>
69334>>>>>>>>>
69334>>>>>>>>>    if (liTmp<>0) send add_bottom_message SET_aps_fixed_column_width liItem liTmp
69337>>>>>>>>>  end_procedure
69338>>>>>>>>>
69338>>>>>>>>>  procedure push_data_fields string fields#
69340>>>>>>>>>    integer fld# max#
69340>>>>>>>>>    string str#
69340>>>>>>>>>    move (length(fields#)/8) to max#
69341>>>>>>>>>    for fld# from 0 to (max#-1)
69347>>>>>>>>>>
69347>>>>>>>>>      move (mid(fields#,8,fld#*8+1)) to str#
69348>>>>>>>>>      send push_data_field (left(str#,4)) (right(str#,4))
69349>>>>>>>>>    loop
69350>>>>>>>>>>
69350>>>>>>>>>  end_procedure
69351>>>>>>>>>
69351>>>>>>>>>  procedure creating_object_top_code integer object# integer class#
69353>>>>>>>>>    // This may be augmentet by descending classes
69353>>>>>>>>>  end_procedure
69354>>>>>>>>>  procedure creating_object_bottom_code integer object# integer class#
69356>>>>>>>>>    // This may be augmentet by descending classes
69356>>>>>>>>>  end_procedure
69357>>>>>>>>>
69357>>>>>>>>>  procedure load_filenumber_and_fieldindex integer lhDataConnect integer itm#
69359>>>>>>>>>    get value of lhDataConnect item (itm#*2) to filenumber
69360>>>>>>>>>    get value of lhDataConnect item (itm#*2+1) to fieldindex
69361>>>>>>>>>  end_procedure
69362>>>>>>>>>
69362>>>>>>>>>
69362>>>>>>>>>
69362>>>>>>>>>  // This procedure is rather complicated. I really could not create a
69362>>>>>>>>>  // dynamic number of columns. The procedure CASE's out.
69362>>>>>>>>>  procedure creating_object_data_connect integer object# integer class#
69364>>>>>>>>>    integer itm# max# lhDataConnect data_file# data_field#
69364>>>>>>>>>    integer prototype_entry_based# self#
69364>>>>>>>>>    move (data_connect_array(self)) to lhDataConnect // procedure creating_object_data_connect
69365>>>>>>>>>    get prototype_entry_based class# to prototype_entry_based#
69366>>>>>>>>>
69366>>>>>>>>>    get item_count of lhDataConnect to max#
69367>>>>>>>>>    if max# gt 40 move 40 to max# // Maximum 20 columns!
69370>>>>>>>>>    move 0 to itm#
69371>>>>>>>>>    if prototype_entry_based# begin // If dbList or dbGrid
69373>>>>>>>>>      move self to self#
69374>>>>>>>>>      move object# to self
69375>>>>>>>>>//      object element is a prototype_entry no_image
69375>>>>>>>>>      object element is a CM_EntryList no_image
69377>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 1   // If object contains 1 column
69388>>>>>>>>>>
69388>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 2   // If object contains 2 columns
69406>>>>>>>>>>
69406>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 3   // If object contains 3 columns
69431>>>>>>>>>>
69431>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 4   // etc...
69463>>>>>>>>>>
69463>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 5
69502>>>>>>>>>>
69502>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 6
69548>>>>>>>>>>
69548>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 7
69601>>>>>>>>>>
69601>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 8
69661>>>>>>>>>>
69661>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 9
69728>>>>>>>>>>
69728>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 10
69802>>>>>>>>>>
69802>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 11
69883>>>>>>>>>>
69883>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 12
69971>>>>>>>>>>
69971>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 13
70066>>>>>>>>>>
70066>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 14
70168>>>>>>>>>>
70168>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 15
70277>>>>>>>>>>
70277>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 16
70393>>>>>>>>>>
70393>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 17
70516>>>>>>>>>>
70516>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 18
70646>>>>>>>>>>
70646>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 19
70783>>>>>>>>>>
70783>>>>>>>>>        DYNAMO$CREATE_ENTRY_ITEMS 20  // If more than 20, they are ignored.
70927>>>>>>>>>>
70927>>>>>>>>>
70927>>>>>>>>>        // "DYNAMO$CREATE_ENTRY_ITEMS 2" will expand like this:
70927>>>>>>>>>        // if max# eq (2*2) begin // 4 means 2!
70927>>>>>>>>>        //   item_list
70927>>>>>>>>>        //     get value of lhDataConnect item 0 to filenumber
70927>>>>>>>>>        //     get value of lhDataConnect item 1 to fieldindex
70927>>>>>>>>>        //     entry_item indirect_file.recnum
70927>>>>>>>>>        //     get value of lhDataConnect item 2 to filenumber
70927>>>>>>>>>        //     get value of lhDataConnect item 3 to fieldindex
70927>>>>>>>>>        //     entry_item indirect_file.recnum
70927>>>>>>>>>        //   end_item_list
70927>>>>>>>>>        // end
70927>>>>>>>>>
70927>>>>>>>>>      end_object
70928>>>>>>>>>      set item_limit to (item_count(element(self)))
70929>>>>>>>>>      set line_width to (item_count(element(self))) (displayable_rows(self))
70930>>>>>>>>>      set matrix_size to (item_count(element(self))) (displayable_rows(self))
70931>>>>>>>>>      move self# to self
70932>>>>>>>>>
70932>>>>>>>>>    end
70932>>>>>>>>>>
70932>>>>>>>>>    else begin // Not prototype_entry:
70933>>>>>>>>>      while (itm#*2) lt max#
70937>>>>>>>>>        get value of lhDataConnect item (itm#*2) to data_file#
70938>>>>>>>>>        get value of lhDataConnect item (itm#*2+1) to data_field#
70939>>>>>>>>>        if max# eq 0 send bind_data to object# data_file# data_field#
70942>>>>>>>>>        else begin // This branch probably never gets called!
70943>>>>>>>>>          set data_file of object# item itm# to data_file#
70944>>>>>>>>>          set data_field of object# item itm# to data_field#
70945>>>>>>>>>        end
70945>>>>>>>>>>
70945>>>>>>>>>        increment itm#
70946>>>>>>>>>      end
70947>>>>>>>>>>
70947>>>>>>>>>    end
70947>>>>>>>>>>
70947>>>>>>>>>    send delete_data to lhDataConnect
70948>>>>>>>>>  end_procedure
70949>>>>>>>>>
70949>>>>>>>>>  // This procedure creates an object nested inside the object currently
70949>>>>>>>>>  // on top of the container_stack.
70949>>>>>>>>>  function icreate_dynamo_object integer class_idx# returns integer
70951>>>>>>>>>    integer parent#           // Object_Id of nesting parent
70951>>>>>>>>>    integer container_stack#  // Stack identifier
70951>>>>>>>>>    integer self#             // Temporary holder of self
70951>>>>>>>>>    integer object#           // Object ID of the object that is created
70951>>>>>>>>>    integer class#            // Class ID of the object that is created
70951>>>>>>>>>    integer should_be_pushed# // Is the object a visual container?
70951>>>>>>>>>    integer p_auto_size_container_state# // For pushing
70951>>>>>>>>>    integer p_auto_locate_control_state# // For pushing
70951>>>>>>>>>    integer dm#                          // For pushing
70951>>>>>>>>>
70951>>>>>>>>>    move (container_stack(self)) to container_stack#
70952>>>>>>>>>
70952>>>>>>>>>    move (should_be_pushed(self,class_idx#)) to should_be_pushed#
70953>>>>>>>>>
70953>>>>>>>>>    // Class# is passed to this function as a pointer to the class array.
70953>>>>>>>>>    // Translate it to the actual class identifier:
70953>>>>>>>>>    get value item class_idx# to class#
70954>>>>>>>>>
70954>>>>>>>>>    get icopy of container_stack# to parent# // Get parent from stack.
70955>>>>>>>>>    name class# U_aps_class // Dig it again!
70955>>>>>>>>>
70955>>>>>>>>>    move self to self#
70956>>>>>>>>>    move parent# to self
70957>>>>>>>>>    object dynamo_object is an aps_class
70959>>>>>>>>>      move self to object#
70960>>>>>>>>>      send creating_object_top_code     to self# object# class_idx#
70961>>>>>>>>>      send deal_messages to (top_code_messages(self#)) object#
70962>>>>>>>>>      send creating_object_data_connect to self# object# class_idx#
70963>>>>>>>>>      send deal_messages to (bottom_code_messages(self#)) object#
70964>>>>>>>>>      send creating_object_bottom_code  to self# object# class_idx#
70965>>>>>>>>>      // If visual container: postpone auto sizing and locating:
70965>>>>>>>>>      if should_be_pushed# begin
70967>>>>>>>>>        // If (db)View or (db)ModalPanel it does not understand the
70967>>>>>>>>>        // p_auto_locate_control_state. Therefore we make it quiet:
70967>>>>>>>>>        get delegation_mode to dm#
70968>>>>>>>>>        set delegation_mode to no_delegate_or_error
70969>>>>>>>>>        get p_auto_size_container_state to p_auto_size_container_state#
70970>>>>>>>>>        set p_auto_size_container_state to false
70971>>>>>>>>>        get p_auto_locate_control_state to p_auto_locate_control_state#
70972>>>>>>>>>        set p_auto_locate_control_state to false
70973>>>>>>>>>        set delegation_mode to dm#
70974>>>>>>>>>      end
70974>>>>>>>>>>
70974>>>>>>>>>    end_object
70975>>>>>>>>>
70975>>>>>>>>>    move self# to self
70976>>>>>>>>>    if should_be_pushed# begin
70978>>>>>>>>>      send aps_init to object# // Undo the effect of a premature end_construct
70979>>>>>>>>>      get delegation_mode of object# to dm#
70980>>>>>>>>>      set delegation_mode of object# to no_delegate_or_error
70981>>>>>>>>>      set p_auto_size_container_state of object# to p_auto_size_container_state#
70982>>>>>>>>>      set p_auto_locate_control_state of object# to p_auto_locate_control_state#
70983>>>>>>>>>      set delegation_mode of object# to dm#
70984>>>>>>>>>      send push_object object#
70985>>>>>>>>>    end
70985>>>>>>>>>>
70985>>>>>>>>>    function_return object#
70986>>>>>>>>>  end_function
70987>>>>>>>>>
70987>>>>>>>>>  // This procedure duplicates the function icreate_dynamo_object. Use it
70987>>>>>>>>>  // when the ID of the created object isn't needed.
70987>>>>>>>>>  procedure create_dynamo_object integer class#
70989>>>>>>>>>    integer grb#
70989>>>>>>>>>    get icreate_dynamo_object class# to grb#
70990>>>>>>>>>  end_procedure
70991>>>>>>>>>
70991>>>>>>>>>  // -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
70991>>>>>>>>>  //  Add top/bottom code messages
70991>>>>>>>>>  // -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
70991>>>>>>>>>
70991>>>>>>>>>  procedure add_top_message integer msg# string arg1# string arg2# string arg3# string arg4# string arg5#
70993>>>>>>>>>    integer top_code_messages#
70993>>>>>>>>>    move (top_code_messages(self)) to top_code_messages#
70994>>>>>>>>>                          send push.i to top_code_messages# msg#
70995>>>>>>>>>                          send push.i to top_code_messages# num_arguments
70996>>>>>>>>>    if num_arguments gt 1 send push.s to top_code_messages# arg1#
70999>>>>>>>>>    if num_arguments gt 2 send push.s to top_code_messages# arg2#
71002>>>>>>>>>    if num_arguments gt 3 send push.s to top_code_messages# arg3#
71005>>>>>>>>>    if num_arguments gt 4 send push.s to top_code_messages# arg4#
71008>>>>>>>>>    if num_arguments gt 5 send push.s to top_code_messages# arg5#
71011>>>>>>>>>  end_procedure
71012>>>>>>>>>
71012>>>>>>>>>  procedure add_bottom_message integer msg# string arg1# string arg2# string arg3# string arg4# string arg5#
71014>>>>>>>>>    integer bottom_code_messages#
71014>>>>>>>>>    move (bottom_code_messages(self)) to bottom_code_messages#
71015>>>>>>>>>                          send push.i to bottom_code_messages# msg#
71016>>>>>>>>>                          send push.i to bottom_code_messages# num_arguments
71017>>>>>>>>>    if num_arguments gt 1 send push.s to bottom_code_messages# arg1#
71020>>>>>>>>>    if num_arguments gt 2 send push.s to bottom_code_messages# arg2#
71023>>>>>>>>>    if num_arguments gt 3 send push.s to bottom_code_messages# arg3#
71026>>>>>>>>>    if num_arguments gt 4 send push.s to bottom_code_messages# arg4#
71029>>>>>>>>>    if num_arguments gt 5 send push.s to bottom_code_messages# arg5#
71032>>>>>>>>>  end_procedure
71033>>>>>>>>>
71033>>>>>>>>>  // -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
71033>>>>>>>>>  //  Create customized DD-objects
71033>>>>>>>>>  // -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
71033>>>>>>>>>
71033>>>>>>>>>  // This function creates a DSO for the file passed as an argument. If a
71033>>>>>>>>>  // specialized class has been registered for this file (fieldinf.pkg),
71033>>>>>>>>>  // that class will be instantiated, otherwise it creates a normal
71033>>>>>>>>>  // DataDictionary and set the main_file of that.
71033>>>>>>>>>  function icreate_dynamo_dso integer file# returns integer
71035>>>>>>>>>    integer parent# class# rval#
71035>>>>>>>>>    get DataDictionary_Class file# to Class#
71036>>>>>>>>>    if Class# begin // A class exists. We use it:
71038>>>>>>>>>      get icopy of (container_stack(self)) to parent# // Get parent from stack.
71039>>>>>>>>>      get create_object_within_parent class# parent# to rval#
71040>>>>>>>>>    end
71040>>>>>>>>>>
71040>>>>>>>>>    else begin // A class did not exist. We create a DD and set main_file:
71041>>>>>>>>>      get icreate_dynamo_object class.DataDictionary to rval#
71042>>>>>>>>>      set main_file of rval# to file#
71043>>>>>>>>>    end
71043>>>>>>>>>>
71043>>>>>>>>>    function_return rval#
71044>>>>>>>>>  end_function
71045>>>>>>>>>
71045>>>>>>>>>//// In order to create DSO-structures, where one DSO is constrained by another,
71045>>>>>>>>>//// I have to nest the DSO's involved. This is absolutely not DAF compliant,
71045>>>>>>>>>//// but I can find no other way, AND I STILL HAVE NOT TESTED THIS. This
71045>>>>>>>>>//// function will create a DSO for file# nested inside DSO#.
71045>>>>>>>>>//// 19/4-1997: Maybe "set/get constraint_file to ??"
71045>>>>>>>>>//function icreate_dynamo_constrained_dso integer file# integer dso# returns integer
71045>>>>>>>>>//  integer rval#
71045>>>>>>>>>//  send push_object dso#
71045>>>>>>>>>//  get icreate_dynamo_dso file# to rval#
71045>>>>>>>>>//  send pop_object
71045>>>>>>>>>//  function_return rval#
71045>>>>>>>>>//end_function
71045>>>>>>>>>end_class
71046>>>>>>>>>
71046>>>>>>>>>//  // The aps_ObjectDynamo class defined above knows a lot of low level
71046>>>>>>>>>//  // details (compared to its descenders) of how to create objects in a
71046>>>>>>>>>//  // structure. However, to become really useful rules and more techniques
71046>>>>>>>>>//  // must be added. The first level of this is implemented in this class:
71046>>>>>>>>>//
71046>>>>>>>>>//  class aps_DialogDynamo is a aps_ObjectDynamo
71046>>>>>>>>>//    procedure construct_object
71046>>>>>>>>>//      forward send construct_object
71046>>>>>>>>>//      property integer pCallBackObject public 0
71046>>>>>>>>>//    end_procedure
71046>>>>>>>>>//  end_class
71046>>>>>>>>>//
71046>>>>>>>>>//  class aps_DialogStructure is a cStack
71046>>>>>>>>>//    procedure construct_object
71046>>>>>>>>>//      forward send construct_object
71046>>>>>>>>>//    end_procedure
71046>>>>>>>>>//    function iCreate integer class returns integer
71046>>>>>>>>>//    end_function
71046>>>>>>>>>//  end_class
71046>>>>>>>Use DataView.utl // Classes for analyzing index definitions
71046>>>>>>>Use Buttons.utl  // Button texts
71046>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
71046>>>>>>>
71046>>>>>>>// define AUTOPRMT$DEBUG
71046>>>>>>>
71046>>>>>>>class apl.DataDictionary is a aps.DataDictionary
71047>>>>>>>  procedure construct_object
71049>>>>>>>    property string  pPromptList_Fields            public ""
71050>>>>>>>    property integer pPromptList_Auto_Server_State public 1
71051>>>>>>>    forward send construct_object
71053>>>>>>>  end_procedure
71054>>>>>>>  procedure PromptListAddField integer file# integer fld#
71056>>>>>>>    set pPromptList_Fields to (pPromptList_Fields(self)+pad(string(file#),4)+pad(string(fld#),4))
71057>>>>>>>  end_procedure
71058>>>>>>>  function is_apl.DataDictionary returns integer
71060>>>>>>>    function_return 1
71061>>>>>>>  end_function
71062>>>>>>>end_class
71063>>>>>>>
71063>>>>>>>class apl.dbList is a aps.dbList
71064>>>>>>>  procedure construct_object
71066>>>>>>>    forward send construct_object
71068>>>>>>>    // Mysteriously this isn't called
71068>>>>>>>    set CurrentCellColor to (rgb(255,128,128))
71069>>>>>>>    set size to 200 0
71070>>>>>>>  end_procedure
71071>>>>>>>  procedure end_construct_object
71073>>>>>>>    forward send end_construct_object
71075>>>>>>>    ifnot (move_value_out_state(self)) begin
71077>>>>>>>      on_key kenter send close_panel_ok
71078>>>>>>>    end
71078>>>>>>>>
71078>>>>>>>  end_procedure
71079>>>>>>>end_class
71080>>>>>>>
71080>>>>>>>
71080>>>>>>>class apl.dbModalPanel is a aps.dbModalPanel
71081>>>>>>>  procedure construct_object
71083>>>>>>>    forward send construct_object
71085>>>>>>>    property integer pListObj public 0
71086>>>>>>>    property integer pButton1 public 0
71087>>>>>>>    property integer pButton2 public 0
71088>>>>>>>    property integer piResult public 0
71089>>>>>>>    set Border_Style to BORDER_THICK   // Make panel resizeable
71090>>>>>>>    set pMinimumSize to 100 150
71091>>>>>>>    on_key kCancel send close_panel
71092>>>>>>>  end_procedure
71093>>>>>>>  procedure close_panel_ok
71095>>>>>>>    set piResult to 1
71096>>>>>>>    send close_panel
71097>>>>>>>  end_procedure
71098>>>>>>>  procedure aps_onResize integer delta_rw# integer delta_cl#
71100>>>>>>>    set p_max_column to 150 // Minimum width of container
71101>>>>>>>    send aps_resize (pListObj(self)) delta_rw# 0
71102>>>>>>>    send aps_register_multi_button (pButton1(self))
71103>>>>>>>    send aps_register_multi_button (pButton2(self))
71104>>>>>>>    send aps_locate_multi_buttons
71105>>>>>>>    send aps_auto_size_container
71106>>>>>>>  end_procedure
71107>>>>>>>  procedure popup
71109>>>>>>>    set piResult to 0
71110>>>>>>>    forward send popup
71112>>>>>>>  end_procedure
71113>>>>>>>end_class // apl.dbModalPanel
71114>>>>>>>
71114>>>>>>>class aps_PromptListDynamo is a aps_ObjectDynamo
71115>>>>>>>  procedure construct_object
71117>>>>>>>    forward send construct_object
71119>>>>>>>    object private.oIndexAnalyzer is a cIndexAnalyzer
71121>>>>>>>    end_object
71122>>>>>>>    set value item class.dbModalPanel to U_apl.dbModalPanel
71123>>>>>>>    set value item class.dbList       to U_apl.dbList
71124>>>>>>>  end_procedure
71125>>>>>>>
71125>>>>>>>  function iCreatePromptList integer file# string fields# integer auto_server_state# integer move_value_out_state# returns integer
71127>>>>>>>    integer ModalPanel# lst# data_file# data_field# dd#
71127>>>>>>>    integer idx# element# itm# max# btn#
71127>>>>>>>
71127>>>>>>>    ifnot file# function_return 0
71130>>>>>>>
71130>>>>>>>    // If no fields were passed, we find some ourselves:
71130>>>>>>>    if fields# eq "" get prompt_list_fields of (private.oIndexAnalyzer(self)) file# to fields#
71133>>>>>>>
71133>>>>>>>    if fields# ne "" begin // If we have any fields to display:
71135>>>>>>>      send add_top_message set_label (File_Display_Name(file#))
71136>>>>>>>      get icreate_dynamo_object class.dbModalPanel to ModalPanel#
71137>>>>>>>        // Indentation indicates that the object was pushed on the
71137>>>>>>>        // container stack
71137>>>>>>>
71137>>>>>>>        set p_max_column of ModalPanel# to 150 // Minimum width of container
71138>>>>>>>
71138>>>>>>>        if auto_server_state# begin
71140>>>>>>>          send add_top_message set_auto_server_state 1
71141>>>>>>>          send add_top_message set_deferred_state 1
71142>>>>>>>          send add_top_message set_main_file file#
71143>>>>>>>        end
71143>>>>>>>>
71143>>>>>>>        else begin
71144>>>>>>>          get icreate_dynamo_dso file# to dd#
71145>>>>>>>          set server of ModalPanel# to dd#
71146>>>>>>>          // In VDF5 we have to set the server of the dbList:
71146>>>>>>>          send add_top_message set_server dd#
71147>>>>>>>        end
71147>>>>>>>>
71147>>>>>>>
71147>>>>>>>        send push_data_fields fields#
71148>>>>>>>
71148>>>>>>>        // No single column wider than 150:
71148>>>>>>>        send add_top_message set_p_max_column_width 150
71149>>>>>>>        send add_top_message set_move_value_out_state move_value_out_state#
71150>>>>>>>        send add_top_message set_CurrentCellColor (rgb(255,128,128))
71151>>>>>>>        get icreate_dynamo_object class.dbList to lst#
71152>>>>>>>
71152>>>>>>>        set list_object of ModalPanel# to lst#
71153>>>>>>>        set pListObj    of ModalPanel# to lst#
71154>>>>>>>        // Shade the columns that do not have a main index:
71154>>>>>>>        move (element(lst#)) to element#
71155>>>>>>>        get item_count of element# to max#
71156>>>>>>>        for itm# from 0 to (max#-1)
71162>>>>>>>>
71162>>>>>>>          get data_file of element# item itm# to data_file#
71163>>>>>>>          if file# eq data_file# begin
71165>>>>>>>            get data_field of element# item itm# to data_field#
71166>>>>>>>            if data_field# begin // If recnum we allow search
71168>>>>>>>              get_attribute df_field_index of data_file# data_field# to idx# // Have an index?
71171>>>>>>>              ifnot idx# set item_option of element# item itm# to noenter true // (not(idx#))
71174>>>>>>>              //else       set item_option of element# item itm# to noenter false
71174>>>>>>>            end
71174>>>>>>>>
71174>>>>>>>          end
71174>>>>>>>>
71174>>>>>>>          else set item_option of element# item itm# to noenter true
71176>>>>>>>        loop
71177>>>>>>>>
71177>>>>>>>
71177>>>>>>>        send add_top_message set_value     0 t.btn.ok
71178>>>>>>>        if move_value_out_state# send add_top_message set_p_message msg_ok
71181>>>>>>>        else                     send add_top_message set_p_message msg_close_panel_ok
71183>>>>>>>        send add_top_message set_aux_value 0 lst#
71184>>>>>>>        send add_top_message set_psExtraLabel t.key.return
71185>>>>>>>
71185>>>>>>>        get icreate_dynamo_object class.Multi_Button to btn#
71186>>>>>>>        set pButton1 of ModalPanel# to btn#
71187>>>>>>>
71187>>>>>>>        send add_top_message set_value     0 t.btn.cancel
71188>>>>>>>        send add_top_message set_p_message msg_cancel
71189>>>>>>>        send add_top_message set_aux_value 0 lst#
71190>>>>>>>        send add_top_message set_psExtraLabel t.key.esc
71191>>>>>>>        get icreate_dynamo_object class.Multi_Button to btn#
71192>>>>>>>        set pButton2 of ModalPanel# to btn#
71193>>>>>>>
71193>>>>>>>        send aps_locate_multi_buttons to ModalPanel#
71194>>>>>>>
71194>>>>>>>      send pop_object // dbModalPanel
71195>>>>>>>    end
71195>>>>>>>>
71195>>>>>>>    else move 0 to ModalPanel#
71197>>>>>>>    function_return ModalPanel#
71198>>>>>>>  end_function
71199>>>>>>>end_class // aps_PromptListDynamo
71200>>>>>>>
71200>>>>>>>object PromptListDynamo is a aps_PromptListDynamo
71202>>>>>>>end_object
71203>>>>>>>
71203>>>>>>>class cDefaultPromptList is a cArray
71204>>>>>>>  procedure construct_object
71206>>>>>>>    forward send construct_object
71208>>>>>>>    property integer pPrevObj   public 0
71209>>>>>>>    property integer pDynamoObj public (PromptListDynamo(self))
71210>>>>>>>
71210>>>>>>>    property integer pDataFile          private 0
71211>>>>>>>    property integer pDataField         private 0
71212>>>>>>>    property string  pFields            private ""
71213>>>>>>>    property integer pAuto_Server_State private 0
71214>>>>>>>    property integer pMoveValueOutState private 0
71215>>>>>>>  end_procedure
71216>>>>>>>
71216>>>>>>>  procedure Initialize_From_File integer file# string fields#
71218>>>>>>>    set !$.pDataFile           to 0
71219>>>>>>>    set !$.pDataField          to 0
71220>>>>>>>    set !$.pFields             to ""
71221>>>>>>>    set !$.pAuto_Server_State  to 0
71222>>>>>>>    set !$.pDataFile           to file#
71223>>>>>>>    set !$.pMoveValueOutState  to 1
71224>>>>>>>    if num_arguments ge 1 set !$.pFields to fields#
71227>>>>>>>  end_procedure
71228>>>>>>>
71228>>>>>>>  procedure Initialize_From_Deo integer focus#
71230>>>>>>>    integer file# field# auto_server_state# dm# svr# is_apl_DD#
71230>>>>>>>    string fields#
71230>>>>>>>    set !$.pDataFile           to 0
71231>>>>>>>    set !$.pDataField          to 0
71232>>>>>>>    set !$.pFields             to ""
71233>>>>>>>    set !$.pAuto_Server_State  to 1
71234>>>>>>>    set !$.pMoveValueOutState  to 1
71235>>>>>>>
71235>>>>>>>    if focus# gt desktop begin
71237>>>>>>>      get delegation_mode of focus# to dm#
71238>>>>>>>      set delegation_mode of focus# to no_delegate_or_error
71239>>>>>>>      get data_file of focus# item current to file#
71240>>>>>>>      get data_field of focus# item current to field#
71241>>>>>>>      get server of focus# to svr#
71242>>>>>>>      set delegation_mode of focus# to dm#
71243>>>>>>>
71243>>>>>>>      if file# begin
71245>>>>>>>        if svr# get which_data_set of svr# file# to svr#
71248>>>>>>>        if (svr# and file# eq main_file(svr#) and Extended_DSO_State(svr#)) begin
71250>>>>>>>          get delegation_mode of svr# to dm#
71251>>>>>>>          set delegation_mode of svr# to no_delegate_or_error
71252>>>>>>>          get is_apl.DataDictionary of svr# to is_apl_DD#
71253>>>>>>>          if is_apl_DD# begin
71255>>>>>>>            get pPromptList_Fields            of svr# to fields#
71256>>>>>>>            get pPromptList_Auto_Server_State of svr# to auto_server_state#
71257>>>>>>>          end
71257>>>>>>>>
71257>>>>>>>          else move 1 to auto_server_state#
71259>>>>>>>          set delegation_mode of svr# to dm#
71260>>>>>>>        end
71260>>>>>>>>
71260>>>>>>>
71260>>>>>>>        set !$.pDataFile           to file#
71261>>>>>>>        set !$.pDataField          to field#
71262>>>>>>>        set !$.pFields             to fields#
71263>>>>>>>        set !$.pAuto_Server_State  to auto_server_state#
71264>>>>>>>      end
71264>>>>>>>>
71264>>>>>>>    end
71264>>>>>>>>
71264>>>>>>>  end_procedure
71265>>>>>>>
71265>>>>>>>  procedure exec_popup
71267>>>>>>>    integer PromptList# DataFile# Auto_Server_State# MoveValueOutState#
71267>>>>>>>    string Fields#
71267>>>>>>>    get !$.pDataFile          to DataFile#
71268>>>>>>>    get !$.pFields            to Fields#
71269>>>>>>>    get !$.pAuto_Server_State to Auto_Server_State#
71270>>>>>>>    get !$.pMoveValueOutState to MoveValueOutState#
71271>>>>>>>    if (pPrevObj(self)) begin
71273>>>>>>>      send request_destroy_object to (pPrevObj(self))
71274>>>>>>>    end
71274>>>>>>>>
71274>>>>>>>    get iCreatePromptList of (pDynamoObj(self)) DataFile# Fields# Auto_Server_State# MoveValueOutState# to PromptList#
71275>>>>>>>    set pPrevObj to PromptList#
71276>>>>>>>    if PromptList# send popup to PromptList#
71279>>>>>>>  end_procedure
71280>>>>>>>
71280>>>>>>>  procedure request_popup
71282>>>>>>>    integer file# field# idx#
71282>>>>>>>    send Initialize_From_Deo (focus(desktop))
71283>>>>>>>    get !$.pDataFile  to file#
71284>>>>>>>    get !$.pDataField to field#
71285>>>>>>>    if (file# and field#) begin // If activated from a db control.
71287>>>>>>>      get_attribute df_field_index of file# field# to idx# // Have an index?
71290>>>>>>>      // If the field is indexed, the user could find anyway:
71290>>>>>>>      if idx# send exec_popup
71293>>>>>>>    end
71293>>>>>>>>
71293>>>>>>>  end_procedure
71294>>>>>>>
71294>>>>>>>  procedure popup
71296>>>>>>>    send Initialize_From_Deo (focus(desktop))
71297>>>>>>>    send exec_popup
71298>>>>>>>  end_procedure
71299>>>>>>>
71299>>>>>>>  function iPopup.is integer file# string fields# returns integer
71301>>>>>>>    set !$.pDataFile           to file#
71302>>>>>>>    set !$.pDataField          to 0
71303>>>>>>>    set !$.pFields             to fields#
71304>>>>>>>    set !$.pAuto_Server_State  to 0
71305>>>>>>>    set !$.pMoveValueOutState  to 0
71306>>>>>>>    send exec_popup
71307>>>>>>>    function_return (piResult(pPrevObj(self)))
71308>>>>>>>  end_procedure
71309>>>>>>>end_class // cDefaultPromptList
71310>>>>>>>
71310>>>>>>>object DefaultPromptList is a cDefaultPromptList
71312>>>>>>>end_object
71313>>>>>>>
71313>>>>>>>class cDefaultPromptList_File is an array
71314>>>>>>>  procedure construct_object
71316>>>>>>>    forward send construct_object
71318>>>>>>>    property integer main_file public 0
71319>>>>>>>  end_procedure
71320>>>>>>>  procedure popup
71322>>>>>>>    send PromptListPopupFile (main_file(self))
71323>>>>>>>  end_procedure
71324>>>>>>>end_class
71325>>>>>>>
71325>>>>>>>object oDefPLs is an array
71327>>>>>>>end_object
71328>>>>>>>
71328>>>>>>>//> Function PromptList_File may be used for setting up prompt list
71328>>>>>>>//> objects for files in DD classes (on non related fields).
71328>>>>>>>function PromptList_File integer file# returns integer
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
71330>>>>>>>  integer obj#
71330>>>>>>>  get value of (oDefPLs(self)) item file# to obj#
71331>>>>>>>  ifnot obj# begin
71333>>>>>>>    object oDefaultPromptList_File is a cDefaultPromptList_File
71335>>>>>>>      set main_file to file#
71336>>>>>>>      move self to obj#
71337>>>>>>>    end_object
71338>>>>>>>    set value of (oDefPLs(self)) item file# to obj#
71339>>>>>>>  end
71339>>>>>>>>
71339>>>>>>>  function_return obj#
71340>>>>>>>end_function
71341>>>>>>>
71341>>>>>>>procedure request_popup_DefaultPromptList for BaseClass
71343>>>>>>>  send request_popup to (DefaultPromptList(self))
71344>>>>>>>end_procedure
71345>>>>>>>
71345>>>>>>>procedure PromptListPopupFile integer file#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
71347>>>>>>>  send Initialize_From_File to (DefaultPromptList(self)) file# ""
71348>>>>>>>  send exec_popup to (DefaultPromptList(self))
71349>>>>>>>end_procedure
71350>>>>>>>
71350>>>>>>>//> Function PromptListSelectRecord returns TRUE if a record was selected,
71350>>>>>>>//> otherwise FALSE. If a record is selected the record will be present
71350>>>>>>>//> in its record buffer.
71350>>>>>>>function PromptListSelectRecord global integer file# string fields# returns integer
71352>>>>>>>  function_return (iPopup.is(DefaultPromptList(self),file#,fields#))
71353>>>>>>>end_function
71354>>>>>Use API_Attr.nui // Functions for querying API attributes (No User Interface)
71354>>>>>Use Flexml.Pkg   // FlexML classes
Including file: Flexml.pkg    (C:\Programmer\Visual DataFlex 12.0\Pkg\Flexml.pkg)
71354>>>>>>>//****************************************************************************************
71354>>>>>>>//                                                                                       *
71354>>>>>>>//  FLEXML.PKG                                                                            *
71354>>>>>>>//                                                                                       *
71354>>>>>>>//  Interface package for FLEXML.DLL - extension system for Extensible Markup Language.  *
71354>>>>>>>//                                                                                       *
71354>>>>>>>//  Written by Michael Gouker, 7/31/99                                                   *
71354>>>>>>>// 12/19/2000 JJT - Major revision changes for VDF7/SP2.                                 *
71354>>>>>>>//                                                                                       *
71354>>>>>>>//****************************************************************************************
71354>>>>>>>Use LanguageText.pkg
71354>>>>>>>Use Windows.pkg
71354>>>>>>>Use GlobalFunctionsProcedures.pkg
71354>>>>>>>
71354>>>>>>>
71354>>>>>>>// Used to designate that a handle is a handle to an Xml Dom object. This
71354>>>>>>>// is used/required by server web-services but could be used elsewhere .
71354>>>>>>>
71354>>>>>>>
71354>>>>>>>// Types of Nodes
71354>>>>>>>
71354>>>>>>>
71354>>>>>>>// classes and methods defined in fmac
71354>>>>>>>
71354>>>>>>>
71354>>>>>>>register_function transformNode integer infcXSLNode returns string
71354>>>>>>>
71354>>>>>>>
71354>>>>>>>
71354>>>>>>>
71354>>>>>>>
71354>>>>>>>
71354>>>>>>>
71354>>>>>>>
71354>>>>>>>
71354>>>>>>>// XML function & procedure registration
71354>>>>>>>
71354>>>>>>>register_procedure set XmlInterface integer iHandle
71354>>>>>>>register_function XmlInterface returns integer
71354>>>>>>>
71354>>>>>>>// NODE Properties
71354>>>>>>>register_function phAttributes returns integer
71354>>>>>>>register_function psBaseName returns String
71354>>>>>>>register_function phChildNodes returns integer
71354>>>>>>>register_function phDefinition returns integer
71354>>>>>>>register_function phFirstChild returns integer
71354>>>>>>>register_function phLastChild returns integer
71354>>>>>>>register_function phNextSibling returns integer
71354>>>>>>>register_function psNameSpaceURI returns String
71354>>>>>>>register_function psNodeName returns String
71354>>>>>>>register_function piNodeType returns integer
71354>>>>>>>register_function psNodeTypeString returns string
71354>>>>>>>register_function phOwnerDocument returns integer
71354>>>>>>>register_function phParentNode returns integer
71354>>>>>>>register_function pbParsed returns integer
71354>>>>>>>register_function psPrefix returns string
71354>>>>>>>register_function phPreviousSibling returns integer
71354>>>>>>>register_function pbSpecified returns integer
71354>>>>>>>register_function psText returns string
71354>>>>>>>register_procedure set psText string sText
71354>>>>>>>register_function psXML returns string
71354>>>>>>>
71354>>>>>>>// Node Read write properties
71354>>>>>>>
71354>>>>>>>register_procedure set psDataType string sTypeName
71354>>>>>>>register_function psDataType returns String
71354>>>>>>>register_procedure set pvNodeTypedValue integer iType integer iAddress
71354>>>>>>>register_function pvNodeTypedValue integer iType returns integer  // address of data
71354>>>>>>>register_procedure set psNodeValue string sValue
71354>>>>>>>register_function psNodeValue returns string
71354>>>>>>>
71354>>>>>>>// Node Methods
71354>>>>>>>
71354>>>>>>>register_function AppendChild integer iChildInfc returns integer
71354>>>>>>>register_function CloneInfcNode integer bRecurse returns integer
71354>>>>>>>register_function HasChildNodes returns integer
71354>>>>>>>register_function InsertBefore integer infcNodeToInsert Integer iWhere returns Integer
71354>>>>>>>register_function RemoveChild integer iChildToRemove returns integer
71354>>>>>>>register_function ReplaceChild integer iNewChild integer iChildToReplace returns integer
71354>>>>>>>register_function SelectNodes string selectstring returns integer
71354>>>>>>>register_function SelectSingleNode string selectstring returns integer
71354>>>>>>>
71354>>>>>>>// Node Collections
71354>>>>>>>// READONLY PROPERTIES
71354>>>>>>>
71354>>>>>>>register_function phItem integer iItem returns integer
71354>>>>>>>register_function phElementItem integer iItem returns integer
71354>>>>>>>
71354>>>>>>>register_function piLength returns integer
71354>>>>>>>
71354>>>>>>>//*     GET_ENUMNODELIST                  */  typ_p1_int | qt_int | out_two,
71354>>>>>>>//*     GET_RESET                         */  qt_int | out_one,
71354>>>>>>>
71354>>>>>>>// Named Node Map
71354>>>>>>>
71354>>>>>>>//*     GET_NAMEDITEM                     */  typ_p1_str | qt_int | out_two,
71354>>>>>>>
71354>>>>>>>register_function NamedItem string sName returns integer
71354>>>>>>>register_function QualifiedItem string sBaseName string sNameSpace returns integer
71354>>>>>>>register_function RemoveNamedItem string sName returns integer
71354>>>>>>>register_function RemoveQualifiedItem string sBaseName string sNameSpace returns integer
71354>>>>>>>register_function SetNamedItem integer iInterface returns integer
71354>>>>>>>
71354>>>>>>>// XML DOM Document
71354>>>>>>>// Read only properties
71354>>>>>>>
71354>>>>>>>register_function phDocType returns integer
71354>>>>>>>register_function phImplementation returns integer
71354>>>>>>>register_function phParseError returns integer
71354>>>>>>>register_function piReadyState returns integer
71354>>>>>>>register_function psURL returns string
71354>>>>>>>
71354>>>>>>>// Read Write Properties
71354>>>>>>>
71354>>>>>>>register_procedure set pbAsync integer bValue
71354>>>>>>>register_function pbAsync returns integer
71354>>>>>>>register_procedure set phDocumentElement integer iElement
71354>>>>>>>register_function phDocumentElement returns Integer
71354>>>>>>>register_procedure set pbPreserveWhiteSpace integer bValue
71354>>>>>>>register_function pbPreserveWhiteSpace returns integer
71354>>>>>>>register_procedure set pbResolveExternals integer bValue
71354>>>>>>>register_function pbResolveExternals returns integer
71354>>>>>>>register_procedure set pbValidateOnParse integer bValue
71354>>>>>>>register_function pbValidateOnParse returns integer
71354>>>>>>>
71354>>>>>>>// Events
71354>>>>>>>
71354>>>>>>>// Methods
71354>>>>>>>
71354>>>>>>>register_function abort returns integer
71354>>>>>>>register_function ElementsByTagName string sTagName returns integer
71354>>>>>>>register_function LoadDocument string sURLName returns integer
71354>>>>>>>register_function LoadXML string sXMLText returns integer
71354>>>>>>>register_function NodeFromID string sNodeName returns integer
71354>>>>>>>register_function SaveDocument string sURLName returns integer
71354>>>>>>>
71354>>>>>>>// Parse Error
71354>>>>>>>// Read Only Properties
71354>>>>>>>
71354>>>>>>>register_function piErrorCode returns integer
71354>>>>>>>register_function piFilePos returns integer
71354>>>>>>>register_function piLine returns integer
71354>>>>>>>register_function piLinePos returns integer
71354>>>>>>>register_function psReason returns string
71354>>>>>>>register_function psSrcText returns string
71354>>>>>>>register_function psURL returns string
71354>>>>>>>
71354>>>>>>>// DOM Implementation
71354>>>>>>>// Method
71354>>>>>>>
71354>>>>>>>register_function HasFeature string sSystem string sFeature returns integer
71354>>>>>>>
71354>>>>>>>// Methods
71354>>>>>>>
71354>>>>>>>register_function substringData integer iOffset integer iCount returns String
71354>>>>>>>register_function appendData string sData returns integer
71354>>>>>>>register_function insertData integer iOffset string sData returns integer
71354>>>>>>>register_function deleteData integer iOffset integer iCount returns integer
71354>>>>>>>register_function replaceData integer iOffset integer iCount string sData returns Integer
71354>>>>>>>
71354>>>>>>>// Attributes
71354>>>>>>>
71354>>>>>>>register_function psName returns String
71354>>>>>>>
71354>>>>>>>// Elements
71354>>>>>>>// Read Only properties
71354>>>>>>>
71354>>>>>>>register_function psTagName returns String
71354>>>>>>>
71354>>>>>>>// Methods
71354>>>>>>>
71354>>>>>>>register_procedure set attributeValue string sName string sValue
71354>>>>>>>register_function attributeValue string sName returns string
71354>>>>>>>register_function removeAttribute string sName returns integer
71354>>>>>>>register_function attributeNode string sName returns integer
71354>>>>>>>register_procedure set attributeNode integer iNode returns integer
71354>>>>>>>register_function removeAttributeNode integer iNode returns integer
71354>>>>>>>
71354>>>>>>>// DOM Text
71354>>>>>>>// Methods
71354>>>>>>>
71354>>>>>>>register_function splitText integer iOffset returns integer
71354>>>>>>>
71354>>>>>>>// DOM Processing Instruction
71354>>>>>>>// Read Only Properties
71354>>>>>>>register_function psTarget returns String
71354>>>>>>>
71354>>>>>>>// DOM Document Type
71354>>>>>>>
71354>>>>>>>register_function phEntities returns integer
71354>>>>>>>register_function phNotations returns integer
71354>>>>>>>
71354>>>>>>>// DOM Notations
71354>>>>>>>
71354>>>>>>>register_function psPublicID returns string
71354>>>>>>>register_function psSystemID returns string
71354>>>>>>>register_function psNotationName returns string
71354>>>>>>>
71354>>>>>>>// create nodes
71354>>>>>>>
71354>>>>>>>register_function createAttribute string sName returns integer
71354>>>>>>>register_function createCDataSection string sValue returns integer
71354>>>>>>>register_function createComment string sValue returns integer
71354>>>>>>>register_function createDocumentFragment returns integer
71354>>>>>>>register_function createElement string sTagName returns integer
71354>>>>>>>register_function createEntityReference string sEntityName returns integer
71354>>>>>>>register_function createNode integer iNodeType string sName string sNameSpace returns integer
71354>>>>>>>register_function createProcessingInstruction string sTarget string sData returns Integer
71354>>>>>>>register_function createTextNode string sData returns integer
71354>>>>>>>
71354>>>>>>>register_function ChangeNodeType integer iTypeOfNode integer bSetInterface returns integer
71354>>>>>>>
71354>>>>>>>
71354>>>>>>>// ******************************************************************************
71354>>>>>>>//
71354>>>>>>>//          Part 1:  Base Document Logic Specialized For Templates
71354>>>>>>>//
71354>>>>>>>// ******************************************************************************
71354>>>>>>>
71354>>>>>>>//
71354>>>>>>>//  XML Collections
71354>>>>>>>//
71354>>>>>>>//  Collection mixin has common functions to both node lists and named node maps
71354>>>>>>>//
71354>>>>>>>
71354>>>>>>>// This provides functions required of all XMLDOM objects.
71354>>>>>>>//
71354>>>>>>>Class cXMLDOMMixin is a Mixin
71355>>>>>>>
71355>>>>>>>    // Create an XML object of passed class Id and bind passed interface. returns
71355>>>>>>>    // the object handle. All dynamic XML object can be created using this syntax
71355>>>>>>>
71355>>>>>>>    Function CreateXMLObject integer iClassId integer hinfXMLInterface returns Handle
71357>>>>>>>        Handle hoId hoDocument
71357>>>>>>>        // We will always create objects at the DOMDocument level.
71357>>>>>>>        Get DocumentObject to hoDocument
71358>>>>>>>        If (hoDocument=0) Begin  // this should never happen.
71360>>>>>>>            error DFERR_XML_INTERNAL_ERROR C_$XmlFailedNoDocObject
71361>>>>>>>>
71361>>>>>>>            Function_return 0
71362>>>>>>>        End
71362>>>>>>>>
71362>>>>>>>        If hinfXMLInterface Begin
71364>>>>>>>            Get Create of hoDocument iClassId to hoID
71365>>>>>>>            Set XMLInterface of hoID to hinfXMLInterface
71366>>>>>>>        End
71366>>>>>>>>
71366>>>>>>>        Function_return hoID
71367>>>>>>>    End_function
71368>>>>>>>
71368>>>>>>>    // create an XML Node object based on the interface type.
71368>>>>>>>    // this will convert the interface to the proper type and will create
71368>>>>>>>    // an appropriate DF object.
71368>>>>>>>    // This requires that a DocumentObject exists
71368>>>>>>>
71368>>>>>>>    Function CreateXMLNode handle hinfc returns handle
71370>>>>>>>        integer hoNode iType iClassId
71370>>>>>>>        Handle  hoDocument
71370>>>>>>>        // Get the node type of the infc handle w/o creating a DF object
71370>>>>>>>        Move (invokexml(DF_IXMLDOMNODE, GET_piNodeType, hinfc, 0, 0, 0, 0)) to iType
71371>>>>>>>        Move (invokexml(DF_IXMLDOMNODE, GET_ChangeNodeType, hinfc, iType, 1, 0, 0)) to hInfc
71372>>>>>>>        if (hinfc=0) Begin
71374>>>>>>>            // this should not happen and we would need to know about this.
71374>>>>>>>            Error DFERR_XML_INTERNAL_ERROR (C_$XmlFailedNoDocObject + string(iType))
71375>>>>>>>>
71375>>>>>>>            function_return 0
71376>>>>>>>        end
71376>>>>>>>>
71376>>>>>>>        Get DocumentObject to hoDocument
71377>>>>>>>        // you can augment your class IDs in a single place.
71377>>>>>>>        Get NodeClassId of hoDocument iType to iClassId
71378>>>>>>>        // MG: 12/6/00 Changed to create nodes inside of the document object.
71378>>>>>>>        Get CreateXMLObject of hoDocument iClassId hinfc to hoNode
71379>>>>>>>
71379>>>>>>>        Function_return hoNode
71380>>>>>>>    End_function
71381>>>>>>>
71381>>>>>>>    // Change object's class. This let's you change the class id of an object
71381>>>>>>>    // on an object by object basis. This would let you create nodes (e.g. elements)
71381>>>>>>>    // that have a custom interface for each node type. Normally, this would be sent
71381>>>>>>>    // after a node has been created using one of the default classes
71381>>>>>>>    Function ChangeNodeClass integer hoNode integer iClassID returns handle
71383>>>>>>>        integer iType
71383>>>>>>>        Handle  hinfcNew
71383>>>>>>>        Get piNodeType of hoNode to iType
71384>>>>>>>        Get ChangeNodeType of hoNode iType False to hInfcNew
71385>>>>>>>        Send Destroy to hoNode // destroy object and old infc handle.
71386>>>>>>>        Get CreateXMLObject iClassId hinfcNew to hoNode
71387>>>>>>>        Function_return hoNode
71388>>>>>>>    End_function
71389>>>>>>>
71389>>>>>>>End_Class
71390>>>>>>>
71390>>>>>>>
71390>>>>>>>Class cXMLDOMCollectionMixin Is A Mixin
71391>>>>>>>
71391>>>>>>>    Import_Class_Protocol cXMLDOMMixin
71392>>>>>>>
71392>>>>>>>    //  Returns number of items in the collection
71392>>>>>>>    //
71392>>>>>>>    Function NodeListLength Returns Integer
71394>>>>>>>        Integer iLength
71394>>>>>>>        Get piLength To iLength
71395>>>>>>>        Function_Return iLength
71396>>>>>>>    End_Function
71397>>>>>>>
71397>>>>>>>    // Returns an XML node object for pass item
71397>>>>>>>    //
71397>>>>>>>    Function CollectionNode Integer I Returns Handle
71399>>>>>>>        Integer hoNewNode
71399>>>>>>>        Integer infcItem
71399>>>>>>>        Get phItem i To infcItem
71400>>>>>>>        If (infcItem) ;            Get CreateXMLNode infcItem to hoNewNode
71403>>>>>>>        Function_Return hoNewNode
71404>>>>>>>    End_Function
71405>>>>>>>
71405>>>>>>>
71405>>>>>>>End_Class
71406>>>>>>>
71406>>>>>>>// Simple declarations of collections.
71406>>>>>>>
71406>>>>>>>Class cXMLDOMNodeList Is A BaseXmlDomNodeList
71407>>>>>>>    Import_Class_Protocol cXMLDOMCollectionMixin
71408>>>>>>>End_Class
71409>>>>>>>
71409>>>>>>>Class cXMLDOMNamedNodeMap Is A BaseXmlDomNamedNodeMap
71410>>>>>>>
71410>>>>>>>    Import_Class_Protocol cXMLDOMCollectionMixin
71411>>>>>>>
71411>>>>>>>    // returns a node attribute that matches passed name, zero if none
71411>>>>>>>    Function NamedNode string sName Returns Handle
71413>>>>>>>        Integer hoNewNode
71413>>>>>>>        Integer infcItem
71413>>>>>>>        Get NamedItem sName To infcItem
71414>>>>>>>        If infcItem ;            Get CreateXMLNode infcItem to hoNewNode
71417>>>>>>>        Function_Return hoNewNode
71418>>>>>>>    End_Function
71419>>>>>>>
71419>>>>>>>    // Adds or changes a node attribute
71419>>>>>>>    // This should return the passed object Id which is now bound to the attribute. If an error, returns 0
71419>>>>>>>    Function SetNamedNode Handle hoNode Returns Handle
71421>>>>>>>        Integer hinfcNode hinfcItem
71421>>>>>>>        Get XMLInterface of hoNode to hinfcNode // node of passed attribute
71422>>>>>>>        Get SetNamedItem hinfcNode To hinfcItem
71423>>>>>>>        If hinfcItem ;            Set XMLInterface of hoNode to hinfcItem
71426>>>>>>>        else ;            Move 0 to hoNode // zero indicates error
71428>>>>>>>        Function_Return hoNode
71429>>>>>>>    End_Function
71430>>>>>>>
71430>>>>>>>    // removes named attribute, Returns handle of removed node or zero if not found.
71430>>>>>>>    // Note that returned object must be disposed of or moved somewhere else.
71430>>>>>>>    Function RemoveNamedNode string sName Returns Handle
71432>>>>>>>        Integer hoNewNode
71432>>>>>>>        Integer infcItem
71432>>>>>>>        Get RemoveNamedItem sName To infcItem
71433>>>>>>>        If infcItem ;            Get CreateXMLNode infcItem to hoNewNode
71436>>>>>>>        Function_Return hoNewNode
71437>>>>>>>    End_Function
71438>>>>>>>
71438>>>>>>>    //(new)
71438>>>>>>>    function QualifiedNode string sNameSpace string sBaseName returns handle
71440>>>>>>>        Integer hoNewNode
71440>>>>>>>        Integer infcItem
71440>>>>>>>        Get QualifiedItem  sBaseName sNameSpace  To infcItem
71441>>>>>>>        If infcItem ;            Get CreateXMLNode infcItem to hoNewNode
71444>>>>>>>        Function_Return hoNewNode
71445>>>>>>>    End_function
71446>>>>>>>
71446>>>>>>>    //(new)
71446>>>>>>>    function RemoveQualifiedNode string sNameSpace string sBaseName returns handle
71448>>>>>>>        Integer hoNewNode
71448>>>>>>>        Integer infcItem
71448>>>>>>>        Get RemoveQualifiedItem sBaseName sNameSpace To infcItem
71449>>>>>>>        If infcItem ;            Get CreateXMLNode infcItem to hoNewNode
71452>>>>>>>        Function_Return hoNewNode
71453>>>>>>>    End_Function
71454>>>>>>>
71454>>>>>>>End_Class
71455>>>>>>>
71455>>>>>>>
71455>>>>>>>
71455>>>>>>>// Mixin for nodes.
71455>>>>>>>//
71455>>>>>>>//  First the declaration of functions that have no object references.
71455>>>>>>>//
71455>>>>>>>
71455>>>>>>>
71455>>>>>>>Class cXMLDOMNodeMixin Is A Mixin
71456>>>>>>>
71456>>>>>>>    Import_Class_Protocol cXMLDOMMixin
71457>>>>>>>
71457>>>>>>>    //  Append Node to the end of list. Returns passed Object handle if Ok, 0 if error
71457>>>>>>>
71457>>>>>>>    Function AppendNode handle hoNode Returns Handle
71459>>>>>>>        Integer hoNewTextNode
71459>>>>>>>        Integer hinfcNode
71459>>>>>>>        Integer infcReturned
71459>>>>>>>        // Get COM Interface to call Append child.
71459>>>>>>>        Get XMLInterface Of hoNode To hinfcNode
71460>>>>>>>        If (hinfcNode=0) Function_return 0
71463>>>>>>>        Get AppendChild hinfcNode To infcReturned
71464>>>>>>>        // Interface returned is stored in DataFlex object.
71464>>>>>>>        If (infcReturned=0) Function_return 0
71467>>>>>>>        Set XMLInterface Of hoNode To infcReturned
71468>>>>>>>        Function_Return hoNode
71469>>>>>>>    End_Function
71470>>>>>>>
71470>>>>>>>    //  Insert NewNode before Node. Returns passed newnode Object handle if Ok, 0 if error
71470>>>>>>>
71470>>>>>>>    Function InsertBeforeNode Integer hoNewNode Integer hoNode Returns Handle
71472>>>>>>>        Integer hinfcNewNode hinfcNode iType hoRefNode
71472>>>>>>>        Integer infcReturned
71472>>>>>>>        // DOM says if no refnode argument passed or it is 0, append to end
71472>>>>>>>        If (Num_Arguments=1) ;            Move 0 to hoRefNode
71475>>>>>>>        else ;            Move hoNode to hoRefNode
71477>>>>>>>        Get XMLInterface Of hoNewNode To hinfcNewNode
71478>>>>>>>        If (hinfcNewNode=0) Function_return 0
71481>>>>>>>        if hoRefNode begin
71483>>>>>>>            Get XMLInterface Of hoRefNode To hinfcNode
71484>>>>>>>            If (hinfcNode=0) function_return 0
71487>>>>>>>        End
71487>>>>>>>>
71487>>>>>>>        Get InsertBefore hinfcNewNode hinfcNode To infcReturned
71488>>>>>>>        If (infcReturned=0) Function_return 0
71491>>>>>>>        // Interface returned is stored in DataFlex object.
71491>>>>>>>        Set XMLInterface Of hoNewNode To infcReturned
71492>>>>>>>        Function_Return hoNewNode
71493>>>>>>>    End_Function
71494>>>>>>>
71494>>>>>>>    //  Remove Node. Returns object Id of removed node, zero if error
71494>>>>>>>    //  Important: The node is not destroyed! This lets you move it elsewhere if you want
71494>>>>>>>
71494>>>>>>>    Function RemoveNode integer hoNode Returns Handle
71496>>>>>>>        Integer hInfcNode
71496>>>>>>>        Get XMLInterface of hoNode to hInfcNode
71497>>>>>>>        If (hinfcNode=0) Function_return 0
71500>>>>>>>        Get RemoveChild hInfcNode To hinfcNode
71501>>>>>>>        If (hinfcNode=0) Function_return 0
71504>>>>>>>        Set XMLInterface of hoNode to hinfcNode
71505>>>>>>>        Function_Return hoNode
71506>>>>>>>    End_Function
71507>>>>>>>
71507>>>>>>>    //  Replace Node. Returns object Id of replaced node, zero if error
71507>>>>>>>    //  Important: The replaced node is not destroyed! This lets you move it elsewhere if you want
71507>>>>>>>
71507>>>>>>>    Function ReplaceNode integer hoNewNode integer hoNodeToReplace Returns Handle
71509>>>>>>>        Integer hInfcNewNode hinfcNodetoReplace hinfcNode
71509>>>>>>>        Get XMLInterface of hoNewNode       to hInfcNewNode
71510>>>>>>>        Get XMLInterface of hoNodetoReplace to hInfcNodetoreplace
71511>>>>>>>        If (hinfcNewNode=0 or hInfcNodeToReplace=0) Function_return 0
71514>>>>>>>        Get ReplaceChild hInfcNewNode hinfcNodeToReplace To hinfcNode
71515>>>>>>>        If (hinfcNode=0) Function_return 0
71518>>>>>>>        Set XMLInterface of hoNodetoReplace to hinfcNode
71519>>>>>>>        Function_Return hoNodetoReplace
71520>>>>>>>    End_Function
71521>>>>>>>
71521>>>>>>>    // Remove the named node. Returns handle to removed node. You must destroy
71521>>>>>>>    // or move this removed object as needed
71521>>>>>>>
71521>>>>>>>    Function RemoveNamedNode String sQueryString Returns Handle
71523>>>>>>>        Integer hoNode
71523>>>>>>>        Integer hInfcTemplate hinfcNode
71523>>>>>>>        Get SelectSingleNode sQueryString To hinfcTemplate
71524>>>>>>>        If (hinfcTemplate) Begin
71526>>>>>>>            // Remove child returns an interface to the disassociated node.
71526>>>>>>>            // It should be disposed by setting it to an object and then calling destroy
71526>>>>>>>            Get RemoveChild hInfcTemplate To hInfcNode
71527>>>>>>>            If hInfcNode Get CreateXMLNode hinfcNode to hoNode
71530>>>>>>>        End
71530>>>>>>>>
71530>>>>>>>        Function_Return hoNode
71531>>>>>>>    End_Function
71532>>>>>>>
71532>>>>>>>    // This function creates a clone of the passed Node. if bRecurse all child nodes are also
71532>>>>>>>    // cloned. The object Id of the new clone object is returned.
71532>>>>>>>    // The interface of the object returned can be used in AppendChild to add
71532>>>>>>>    // the node to the XML Document.
71532>>>>>>>
71532>>>>>>>    Function CloneNode integer bRecurse Returns Handle
71534>>>>>>>        Handle hoNewNode
71534>>>>>>>        Handle hinfcNewNode
71534>>>>>>>        Get CloneInfcNode (if(bRecurse,-1,0)) To hinfcNewNode
71535>>>>>>>        If hinfcNewNode ;            Get CreateXMLNode hinfcNewNode to hoNewNode
71538>>>>>>>        Function_Return hoNewNode
71539>>>>>>>    End_Function
71540>>>>>>>
71540>>>>>>>    //  Create a collection of all nodes. returns handle of a cXMLDomNodeList
71540>>>>>>>
71540>>>>>>>    Function ChildNodes Returns Handle
71542>>>>>>>        Integer infcNodeList
71542>>>>>>>        Integer hoNodeList
71542>>>>>>>        Get phChildNodes To infcNodeList
71543>>>>>>>        If (infcNodeList) ;            Get CreateXMLObject U_cXMLDOMNodeList infcNodeList to hoNodeList
71546>>>>>>>        Function_Return hoNodeList
71547>>>>>>>    End_Function
71548>>>>>>>
71548>>>>>>>    //  Create a collection of all attributes. returns handle of a cXMLDomNodeMapList
71548>>>>>>>
71548>>>>>>>    Function AttributeNodes Returns Handle
71550>>>>>>>        Integer hoCollectionId   // Object to hold collection
71550>>>>>>>        Integer hinfcAttributes  // XML Interface for collection
71550>>>>>>>        Get phAttributes To hinfcAttributes
71551>>>>>>>        If (hinfcAttributes) ;            Get CreateXMLObject U_cXMLDOMNamedNodeMap hinfcAttributes to hoCollectionId
71554>>>>>>>        Function_Return hoCollectionId
71555>>>>>>>    End_Function
71556>>>>>>>
71556>>>>>>>    // Returns a collection of just elements
71556>>>>>>>
71556>>>>>>>    Function ElementNodes String sQueryString Returns Handle
71558>>>>>>>        Integer hoNodeList
71558>>>>>>>        Integer hinfcNodeList
71558>>>>>>>        Get ElementsByTagName sQueryString To hinfcNodeList
71559>>>>>>>        If (hinfcNodeList <> 0) ;            Get CreateXMLObject U_cXMLDOMNodeList hinfcNodeList to hoNodeList
71562>>>>>>>        Function_Return hoNodeList
71563>>>>>>>    End_Function
71564>>>>>>>
71564>>>>>>>
71564>>>>>>>
71564>>>>>>>    // Return object handle for query.
71564>>>>>>>
71564>>>>>>>    Function FindNode String sQueryString Returns Handle
71566>>>>>>>        Integer hoNode
71566>>>>>>>        Integer hinfcNode
71566>>>>>>>        Get SelectSingleNode sQueryString To hinfcNode
71567>>>>>>>        //inkey windowindex
71567>>>>>>>        If (hinfcNode <> 0) ;            Get CreateXMLNode hInfcNode to hoNode
71570>>>>>>>        Function_Return hoNode
71571>>>>>>>    End_Function
71572>>>>>>>
71572>>>>>>>    // Return object handle for a collection node.
71572>>>>>>>
71572>>>>>>>
71572>>>>>>>    Function FindNodeList String sQueryString Returns Handle
71574>>>>>>>        Integer hoNodeList
71574>>>>>>>        Integer hinfcNodeList
71574>>>>>>>        Get SelectNodes sQueryString To hinfcNodeList
71575>>>>>>>        If (hinfcNodeList <> 0) ;            Get CreateXMLObject U_cXMLDOMNodeList hinfcNodeList to hoNodeList
71578>>>>>>>        Function_Return hoNodeList
71579>>>>>>>    End_Function
71580>>>>>>>
71580>>>>>>>    // The CreatexxxxxNode messages creates an node object for the type specified. Both
71580>>>>>>>    // the interface and the object or of the correct type (i.e. element, comment)
71580>>>>>>>    // These all return an object handle which can be used to place the object via
71580>>>>>>>    // appendNode or InsertBeforeNode
71580>>>>>>>
71580>>>>>>>    // This function creates a child element, returning a dataflex object.
71580>>>>>>>    // The interface of the object returned can be used in AppendChild to add
71580>>>>>>>    // the element to the XML Document.
71580>>>>>>>
71580>>>>>>>    Function CreateElementNode String sTagName String sValue Returns Handle
71582>>>>>>>        Integer hoNewElement
71582>>>>>>>        Integer hoDocumentObject
71582>>>>>>>        Integer infcNewElement
71582>>>>>>>        Integer iClassId
71582>>>>>>>        // The DataFlex objects are created inside the nodes (elements).
71582>>>>>>>        // Create an element in the document and assign its interface to the new DF object.
71582>>>>>>>        Get DocumentObject to hoDocumentObject
71583>>>>>>>        Get createElement of hoDocumentObject sTagName To infcNewElement
71584>>>>>>>        If infcNewElement Begin // if there was an error, no infc handle would be returned
71586>>>>>>>            Get NodeClassId of hoDocumentObject NODE_ELEMENT to iClassId
71587>>>>>>>            Get CreateXMLObject iClassId infcNewElement to hoNewElement
71588>>>>>>>            If hoNewElement ; // very unlikely this will be zero                Set psText Of hoNewElement To sValue
71591>>>>>>>        End
71591>>>>>>>>
71591>>>>>>>        Function_Return hoNewElement
71592>>>>>>>    End_Function
71593>>>>>>>
71593>>>>>>>    // This function creates an attribute in a document. Attributes are _NOT_ children of an element.
71593>>>>>>>    // A DataFlex object is returned. An attribute can be added to an xml document using
71593>>>>>>>    // get AddAttributeNode.
71593>>>>>>>
71593>>>>>>>    Function CreateAttributeNode String sName String sValue Returns Handle
71595>>>>>>>        Integer hoNewAttribute
71595>>>>>>>        Integer hoDocumentObject
71595>>>>>>>        Integer infcNewAttribute
71595>>>>>>>        Integer iClassId
71595>>>>>>>        Get DocumentObject to hoDocumentObject
71596>>>>>>>        // Create an Attribute in the document and assign its interface to the new DF object.
71596>>>>>>>        Get createAttribute of hoDocumentObject sName To infcNewAttribute
71597>>>>>>>        If infcNewAttribute Begin // if there was an error, no infc handle would be returned
71599>>>>>>>            Get NodeClassId of hoDocumentObject NODE_ATTRIBUTE to iClassId
71600>>>>>>>            Get CreateXMLObject iClassId infcNewAttribute to hoNewAttribute
71601>>>>>>>            // Set the value of the attribute.
71601>>>>>>>            If hoNewAttribute ; // very unlikely this will be 0                Set psText Of hoNewAttribute To sValue
71604>>>>>>>        End
71604>>>>>>>>
71604>>>>>>>        Function_Return hoNewAttribute
71605>>>>>>>    End_Function
71606>>>>>>>
71606>>>>>>>    // This function creates a child comment, returning a dataflex object.
71606>>>>>>>    // The interface of the object returned can be used in AppendChild to add
71606>>>>>>>    // the comment to the XML Document.
71606>>>>>>>
71606>>>>>>>    Function CreateChildComment String sValue Returns Handle
71608>>>>>>>        Integer hoNewComment
71608>>>>>>>        Integer hoDocumentObject
71608>>>>>>>        Integer infcNewComment
71608>>>>>>>        integer iClassID
71608>>>>>>>        Get DocumentObject to hoDocumentObject
71609>>>>>>>        // Create an Comment in the document and assign its interface to the new DF object.
71609>>>>>>>        Get createComment of hoDocumentObject sValue To infcNewComment
71610>>>>>>>        If infcNewComment Begin // if there was an error, no infc handle would be returned
71612>>>>>>>            Get NodeClassId of hoDocumentObject NODE_COMMENT to iClassId
71613>>>>>>>            Get CreateXMLObject iClassId infcNewComment to hoNewComment
71614>>>>>>>            If hoNewComment ; // very unlikely this will be 0                Set psText Of hoNewComment To sValue
71617>>>>>>>        End
71617>>>>>>>>
71617>>>>>>>        Function_Return hoNewComment
71618>>>>>>>    End_Function
71619>>>>>>>
71619>>>>>>>    // This function creates a child processing instruction, returning a dataflex object.
71619>>>>>>>    // The interface of the object returned can be used in AppendChild to add
71619>>>>>>>    // the processing instruction to the XML Document.
71619>>>>>>>
71619>>>>>>>    Function CreateChildProcessingInstruction String sTarget String sValue Returns Handle
71621>>>>>>>        Integer hoNewProcessingInstruction
71621>>>>>>>        Integer hoDocumentObject
71621>>>>>>>        Integer infcNewProcessingInstruction
71621>>>>>>>        integer iClassID
71621>>>>>>>        Get DocumentObject to hoDocumentObject
71622>>>>>>>        // Create an ProcessingInstruction in the document and assign its interface to the new DF object.
71622>>>>>>>        Get createProcessingInstruction of hoDocumentObject sTarget sValue To infcNewProcessingInstruction
71623>>>>>>>        If infcNewProcessingInstruction  Begin // if there was an error, no infc handle would be returned
71625>>>>>>>            Get NodeClassId of hoDocumentObject NODE_PROCESSING_INSTRUCTION to iClassId
71626>>>>>>>            Get CreateXMLObject iClassID infcNewProcessingInstruction to hoNewProcessingInstruction
71627>>>>>>>        End
71627>>>>>>>>
71627>>>>>>>        Function_Return hoNewProcessingInstruction
71628>>>>>>>    End_Function
71629>>>>>>>
71629>>>>>>>    // This function creates a child text node, returning a dataflex object.
71629>>>>>>>    // The interface of the object returned can be used in AppendChild to add
71629>>>>>>>    // the text node to the XML Document.
71629>>>>>>>
71629>>>>>>>    Function CreateChildTextNode String sValue Returns Handle
71631>>>>>>>        Integer hoNewTextNode
71631>>>>>>>        Integer hoDocumentObject
71631>>>>>>>        Integer infcNewTextNode
71631>>>>>>>        integer iClassID
71631>>>>>>>        Get DocumentObject to hoDocumentObject
71632>>>>>>>        // Create an TextNode in the document and assign its interface to the new DF object.
71632>>>>>>>        Get createTextNode of hoDocumentObject sValue To infcNewTextNode
71633>>>>>>>        If infcNewTextNode Begin // if there was an error, no infc handle would be returned
71635>>>>>>>            Get NodeClassId of hoDocumentObject NODE_TEXT to iClassId
71636>>>>>>>            Get CreateXMLObject iClassId infcNewTextNode to hoNewTextNode
71637>>>>>>>        End
71637>>>>>>>>
71637>>>>>>>        Function_Return hoNewTextNode
71638>>>>>>>    End_Function
71639>>>>>>>
71639>>>>>>>    // This function creates a cdata text node, returning a dataflex object.
71639>>>>>>>    // The interface of the object returned can be used in AppendChild to add
71639>>>>>>>    // the cdata node to the XML Document.
71639>>>>>>>
71639>>>>>>>    Function CreateCDATASectionNode String sValue Returns Handle
71641>>>>>>>        Integer hoNewNode
71641>>>>>>>        Integer hoDocumentObject
71641>>>>>>>        Integer infcNewNode
71641>>>>>>>        Integer iClassId
71641>>>>>>>        // The DataFlex objects are created inside the nodes (elements).
71641>>>>>>>        // Create an element in the document and assign its interface to the new DF object.
71641>>>>>>>        Get DocumentObject to hoDocumentObject
71642>>>>>>>        Get createCDATASection of hoDocumentObject sValue To infcNewNode
71643>>>>>>>        If infcNewNode Begin
71645>>>>>>>            Get NodeClassId of hoDocumentObject NODE_CDATA_SECTION to iClassId
71646>>>>>>>            Get CreateXMLObject iClassId infcNewNode to hoNewNode
71647>>>>>>>        End
71647>>>>>>>>
71647>>>>>>>        Function_Return hoNewNode
71648>>>>>>>    End_Function
71649>>>>>>>
71649>>>>>>>    // Create a document fragment.  Document fragments can be used to house nodes temporarily. When
71649>>>>>>>    // You append or insert a document fragment (appendNode InsertBeforeNode) child nodes are appended
71649>>>>>>>    // to the destination object and not the fragment node itself. This is useful!
71649>>>>>>>
71649>>>>>>>    Function CreateDocumentFragmentNode Returns Handle
71651>>>>>>>        Integer hoNew
71651>>>>>>>        Integer hoDocumentObject
71651>>>>>>>        Integer infcNew
71651>>>>>>>        integer iClassID
71651>>>>>>>        Get DocumentObject to hoDocumentObject
71652>>>>>>>        // Create an Comment in the document and assign its interface to the new DF object.
71652>>>>>>>        Get createDocumentFragment of hoDocumentObject To infcNew
71653>>>>>>>        If infcNew Begin // if there was an error, no infc handle would be returned
71655>>>>>>>            Get NodeClassId of hoDocumentObject NODE_DOCUMENT_FRAGMENT to iClassId
71656>>>>>>>            Get CreateXMLObject iClassId infcNew to hoNew
71657>>>>>>>        End
71657>>>>>>>>
71657>>>>>>>        Function_Return hoNew
71658>>>>>>>    End_Function
71659>>>>>>>
71659>>>>>>>    //  Create a Node of any passed Type (e.g. Node_element). Normally you don't need this as there are
71659>>>>>>>    //  specific messages to do this for each node type. Node that this lets you pass namespaces as a separate
71659>>>>>>>    //  parameter. With all of the other messages (e.g. createElementNode) you pass namespaces as prefixed to
71659>>>>>>>    // the tagname (e.g. Get CreateElementNode "MyNameSpace:MyTag" "MyValue" to hoEle)
71659>>>>>>>
71659>>>>>>>    Function CreateChildNode Integer iNodeType String sTagName String sNameSpace Returns Handle
71661>>>>>>>        Integer hoNewNode hoDocumentObject
71661>>>>>>>        Integer infcNewNode
71661>>>>>>>        Integer iClassid iType
71661>>>>>>>        Get DocumentObject to hoDocumentObject
71662>>>>>>>        Get NodeClassId iNodeType to iClassId
71663>>>>>>>        If (iClassId<>0) Begin
71665>>>>>>>            // Create a node in the document and assign its interface to the new DF object.
71665>>>>>>>            Get createNode of hoDocumentObject iNodeType sTagName sNameSpace To infcNewNode
71666>>>>>>>            // this is required to force the interface type to be correct.
71666>>>>>>>            Move (invokexml(DF_IXMLDOMNODE, GET_piNodeType, infcNewNode, 0, 0, 0, 0)) to iType
71667>>>>>>>            Move (invokexml(DF_IXMLDOMNODE, GET_ChangeNodeType, infcNewNode, iType, 1, 0, 0)) to infcNewNode
71668>>>>>>>
71668>>>>>>>            If infcNewNode ;                Get CreateXMLObject iClassId infcNewNode to hoNewNode
71671>>>>>>>        End
71671>>>>>>>>
71671>>>>>>>        Function_Return hoNewNode
71672>>>>>>>    End_Function
71673>>>>>>>
71673>>>>>>>
71673>>>>>>>
71673>>>>>>>    // The Addxxxxx messages create a new node and appends it to the list. When used as a function,
71673>>>>>>>    // the object handle is returned and must be disposed of later by the programmer.
71673>>>>>>>    // When used as a procedure, the object is destroyed--it just does it and is done.
71673>>>>>>>
71673>>>>>>>    Function AddElement String sTagName String sValue Returns Handle
71675>>>>>>>        Integer hoNewElement
71675>>>>>>>        Get CreateElementNode sTagName sValue To hoNewElement
71676>>>>>>>        If hoNewElement Get AppendNode hoNewElement to hoNewElement
71679>>>>>>>        Function_return hoNewElement
71680>>>>>>>    End_Function
71681>>>>>>>
71681>>>>>>>    Procedure AddElement String sTagName String sValue
71683>>>>>>>        Integer hoNewElement
71683>>>>>>>        Get AddElement sTagName sValue To hoNewElement
71684>>>>>>>        If hoNewElement ;            Send Destroy To hoNewElement
71687>>>>>>>        Else ;            Error DFERR_XML_INTERNAL_ERROR (SFormat(C_$XmlMethodFailure, "msg_AddElement"))
71689>>>>>>>    End_procedure
71690>>>>>>>
71690>>>>>>>    // this returns the object, This is often needed
71690>>>>>>>
71690>>>>>>>
71690>>>>>>>
71690>>>>>>>    //(new)
71690>>>>>>>    Function CreateElementNodeNS String sNameSpace String sTagName String sValue returns Handle
71692>>>>>>>        Integer hoNewElement
71692>>>>>>>        Get CreateChildNode NODE_ELEMENT sTagName sNameSpace to hoNewElement
71693>>>>>>>        If (hoNewElement and sValue<>"") ;            Set psText Of hoNewElement To sValue
71696>>>>>>>        Function_Return hoNewElement
71697>>>>>>>    End_procedure
71698>>>>>>>
71698>>>>>>>
71698>>>>>>>    // this returns the object, This is often needed
71698>>>>>>>
71698>>>>>>>    //(new)
71698>>>>>>>    Function AddElementNS string sNameSpace String sTagName String sValue Returns Handle
71700>>>>>>>        Integer hoNewElement
71700>>>>>>>        Get CreateElementNodeNS sNameSpace sTagName sValue To hoNewElement
71701>>>>>>>        If hoNewElement Begin
71703>>>>>>>            Get AppendNode hoNewElement to hoNewElement
71704>>>>>>>        end
71704>>>>>>>>
71704>>>>>>>        Function_return hoNewElement
71705>>>>>>>    End_Function
71706>>>>>>>
71706>>>>>>>    //(new)
71706>>>>>>>    Procedure AddElementNS String sNameSpace String sTagName String sValue
71708>>>>>>>        Integer hoNewElement
71708>>>>>>>        Get AddElementNS sNameSpace sTagName sValue to hoNewElement
71709>>>>>>>        If hoNewElement ;            Send Destroy To hoNewElement
71712>>>>>>>        Else ;            Error DFERR_XML_INTERNAL_ERROR (SFormat(C_$XmlMethodFailure, "msg_AddElementNS"))
71714>>>>>>>    End_procedure
71715>>>>>>>
71715>>>>>>>    //(new)
71715>>>>>>>    Function AddAttributeNode handle hoNode returns Handle
71717>>>>>>>        handle hInfc
71717>>>>>>>        get Set_AttributeNode (XmlInterface(hoNode)) to hInfc
71718>>>>>>>        if hInfc ; // if ret value we have a replacement            set XmlInterface of hoNode to hInfc
71721>>>>>>>        function_return hoNode
71722>>>>>>>    End_Function
71723>>>>>>>
71723>>>>>>>//    // is this needed
71723>>>>>>>//    Function AddAttributeNodeNS handle hoNode returns Handle
71723>>>>>>>//        Get AddAttributeNode hoNode to hoNode
71723>>>>>>>//        function_return hoNode
71723>>>>>>>//    End_Function
71723>>>>>>>
71723>>>>>>>    //(new)
71723>>>>>>>    Function AttributeValueNode string sName returns Handle
71725>>>>>>>        handle hInfc
71725>>>>>>>        handle hoNode
71725>>>>>>>        get AttributeNode sName to hInfc
71726>>>>>>>        if hInfc ; // if ret value we have a replacement           Get CreateXMLNode hInfc to hoNode
71729>>>>>>>        function_return hoNode
71730>>>>>>>    End_Function
71731>>>>>>>
71731>>>>>>>    //(new)
71731>>>>>>>    Function AttributeValueNodeNS string sNameSpace string sBaseName returns Handle
71733>>>>>>>        handle hoAttrs hoAttr
71733>>>>>>>        string sValue
71733>>>>>>>        Get AttributeNodes to hoAttrs
71734>>>>>>>        If hoAttrs begin
71736>>>>>>>            Get QualifiedNode of hoAttrs sNamespace sBaseName to hoAttr
71737>>>>>>>            send destroy of hoAttrs
71738>>>>>>>        end
71738>>>>>>>>
71738>>>>>>>        function_return hoAttr
71739>>>>>>>    End_Function
71740>>>>>>>
71740>>>>>>>
71740>>>>>>>    //(new)
71740>>>>>>>    Function CreateAttributeNodeNS string sNameSpace string sName String sValue Returns Handle
71742>>>>>>>        Integer hoNewAttribute
71742>>>>>>>        Get CreateChildNode NODE_ATTRIBUTE sName sNameSpace To hoNewAttribute
71743>>>>>>>        If hoNewAttribute ;            Set psText Of hoNewAttribute To sValue
71746>>>>>>>        Function_Return hoNewAttribute
71747>>>>>>>    End_Function
71748>>>>>>>
71748>>>>>>>    //(new)
71748>>>>>>>    Procedure AddAttributeNS String sNameSpace String sName String sValue
71750>>>>>>>       handle hoNode
71750>>>>>>>       Get CreateAttributeNodeNS sNameSpace sName sValue to hoNode
71751>>>>>>>       If hoNode Begin
71753>>>>>>>          Get AddAttributeNode hoNode to hoNode
71754>>>>>>>          If hoNode Send Destroy of hoNode
71757>>>>>>>       end
71757>>>>>>>>
71757>>>>>>>       Else ;            Error DFERR_XML_INTERNAL_ERROR (SFormat(C_$XmlMethodFailure, "msg_AddAttributeNS"))
71759>>>>>>>    End_Procedure
71760>>>>>>>
71760>>>>>>>
71760>>>>>>>       // This function encapsulates creation and addition of attributes to a node.
71760>>>>>>>    // should only work with element class
71760>>>>>>>    Procedure AddAttribute String sName String sValue
71762>>>>>>>        Set AttributeValue sName to sValue
71763>>>>>>>    End_Procedure
71764>>>>>>>
71764>>>>>>>    // This function encapsulates creation and addition of comments to a node.
71764>>>>>>>    // The return value is a Boolean that is currently unused.
71764>>>>>>>
71764>>>>>>>    Procedure AddChildComment String sValue
71766>>>>>>>        Integer hoNewNode
71766>>>>>>>        Get createChildComment sValue To hoNewNode
71767>>>>>>>        If not hoNewNode ;            Error DFERR_XML_INTERNAL_ERROR (SFormat(C_$XmlMethodFailure, "msg_AddChildComment"))
71770>>>>>>>        Else Begin
71771>>>>>>>            Get AppendNode hoNewNode to hoNewNode
71772>>>>>>>            Send Destroy To hoNewNode
71773>>>>>>>        End
71773>>>>>>>>
71773>>>>>>>    End_Procedure
71774>>>>>>>
71774>>>>>>>    // This function encapsulates creation and addition of processing instructions to a node.
71774>>>>>>>    // The return value is a Boolean that is currently unused.
71774>>>>>>>
71774>>>>>>>    Procedure AddChildProcessingInstruction String sTarget String sValue
71776>>>>>>>        Integer hoNewNode
71776>>>>>>>        Get createChildProcessingInstruction sTarget sValue To hoNewNode
71777>>>>>>>        If not hoNewNode ;            Error DFERR_XML_INTERNAL_ERROR (SFormat(C_$XmlMethodFailure, "msg_AddChildProcessingInstruction"))
71780>>>>>>>        Else Begin
71781>>>>>>>            Get AppendNode hoNewNode to hoNewNode
71782>>>>>>>            Send Destroy To hoNewNode
71783>>>>>>>        end
71783>>>>>>>>
71783>>>>>>>    End_Procedure
71784>>>>>>>
71784>>>>>>>
71784>>>>>>>    // This function encapsulates creation and addition of text nodes to a node.
71784>>>>>>>    // The return value is a Boolean that is currently unused.
71784>>>>>>>
71784>>>>>>>    Procedure AddChildTextNode String sValue
71786>>>>>>>        Integer hoNewNode
71786>>>>>>>        Get createChildTextNode sValue To hoNewNode
71787>>>>>>>        If not hoNewNode ;            Error DFERR_XML_INTERNAL_ERROR (SFormat(C_$XmlMethodFailure, "msg_AddChildTextNode"))
71790>>>>>>>        Else Begin
71791>>>>>>>            Get AppendNode hoNewNode to hoNewNode
71792>>>>>>>            Send Destroy To hoNewNode
71793>>>>>>>        End
71793>>>>>>>>
71793>>>>>>>    End_Procedure
71794>>>>>>>
71794>>>>>>>    // This procedure encapsulates creation and addition of cdata text nodes to a node.
71794>>>>>>>    Procedure AddCDataSection String sValue
71796>>>>>>>        handle hoNewNode
71796>>>>>>>        Get CreateCDATASectionNode sValue To hoNewNode
71797>>>>>>>        If not hoNewNode ;            Error DFERR_XML_INTERNAL_ERROR (SFormat(C_$XmlMethodFailure, "msg_AddCDataSection"))
71800>>>>>>>        Else Begin
71801>>>>>>>            Get AppendNode hoNewNode to hoNewNode
71802>>>>>>>            Send Destroy To hoNewNode
71803>>>>>>>        end
71803>>>>>>>>
71803>>>>>>>    End_procedure
71804>>>>>>>
71804>>>>>>>
71804>>>>>>>    Function AddChildNode Integer iNodeType String sTagName String sNameSpace Returns Handle
71806>>>>>>>        Integer hoNewNode
71806>>>>>>>        Integer hoDocumentObject
71806>>>>>>>        Get DocumentObject to hoDocumentObject
71807>>>>>>>        Get createChildNode of hoDocumentObject iNodeType sTagName sNamespace To hoNewNode
71808>>>>>>>        If hoNewNode ;            Get AppendNode hoNewNode to hoNewNode
71811>>>>>>>        Function_Return hoNewNode
71812>>>>>>>    End_Function
71813>>>>>>>
71813>>>>>>>    // ChildNodeValue is used to get the "value" of an element. This is useful when the element
71813>>>>>>>    // only has a single value (similar to an attribute).
71813>>>>>>>
71813>>>>>>>    Function ChildNodeValue String sTagName Returns String
71815>>>>>>>        Integer hoTempNode
71815>>>>>>>        Integer hinfcTempNode
71815>>>>>>>        String sRetVal
71815>>>>>>>        Get SelectSingleNode sTagName To hinfcTempNode
71816>>>>>>>        //showln "...." hinfctempNode '  ' stagName ' ' (psNodeName(self))
71816>>>>>>>        If (hinfcTempNode <> 0) Begin
71818>>>>>>>            Get CreateXMLObject U_BaseXMLDOMNode hinfcTempNode to hoTempNode
71819>>>>>>>            If hoTempNode Begin
71821>>>>>>>                Get psText Of hoTempNode To sRetVal
71822>>>>>>>                Send Destroy of hoTempNode
71823>>>>>>>            end
71823>>>>>>>>
71823>>>>>>>        End
71823>>>>>>>>
71823>>>>>>>        Function_Return sRetVal
71824>>>>>>>    End_Function
71825>>>>>>>
71825>>>>>>>    // This simple function allows a parent to change the text of one of its elements.
71825>>>>>>>    // This actually occurs quite a bit, because (as stated above) lowest level
71825>>>>>>>    // elements are frequently used as properties.
71825>>>>>>>    //
71825>>>>>>>    Procedure SetChildNodeValue String sTagName String sValue
71827>>>>>>>        Integer hoTempNode
71827>>>>>>>        Integer hinfcTempNode
71827>>>>>>>        // Search for the node that matches.
71827>>>>>>>        Get SelectSingleNode sTagName To hinfcTempNode
71828>>>>>>>        // If no match is found, add a new element with the tag.
71828>>>>>>>        If (hinfcTempNode = 0) ;            Send AddElement sTagName sValue
71831>>>>>>>        Else Begin
71832>>>>>>>            Get CreateXMLObject U_BaseXMLDOMNode hinfcTempNode to hoTempNode
71833>>>>>>>            If hoTempNode Begin
71835>>>>>>>                // Set the text of the element.
71835>>>>>>>                Set psText Of hoTempNode To sValue
71836>>>>>>>                Send Destroy To hoTempNode
71837>>>>>>>            end
71837>>>>>>>>
71837>>>>>>>            Else ;                error DFERR_XML_INTERNAL_ERROR (SFormat(C_$XmlMethodFailure, "msg_SetChildNodeValue"))
71839>>>>>>>        end
71839>>>>>>>>
71839>>>>>>>    End_Procedure
71840>>>>>>>
71840>>>>>>>    // These messages are used to allow you to travese through a nodes.
71840>>>>>>>
71840>>>>>>>    Function FirstChild Returns Handle
71842>>>>>>>        handle hoChild
71842>>>>>>>        integer hinfcChild
71842>>>>>>>        Get phFirstChild  to hinfcChild
71843>>>>>>>        If (hinfcChild) ;            Get CreateXMLNode hinfcChild to hoChild
71846>>>>>>>        Function_return hoChild
71847>>>>>>>    end_function
71848>>>>>>>
71848>>>>>>>    Function NextSibling Returns Handle
71850>>>>>>>        handle hoChild
71850>>>>>>>        integer hinfcChild
71850>>>>>>>        Get phNextSibling  to hinfcChild
71851>>>>>>>        If (hinfcChild) ;            Get CreateXMLNode hinfcChild to hoChild
71854>>>>>>>        Function_return hoChild
71855>>>>>>>    end_function
71856>>>>>>>
71856>>>>>>>    Function PreviousSibling Returns Handle
71858>>>>>>>        handle hoChild
71858>>>>>>>        integer hinfcChild
71858>>>>>>>        Get phPreviousSibling  to hinfcChild
71859>>>>>>>        If (hinfcChild) ;            Get CreateXMLNode hinfcChild to hoChild
71862>>>>>>>        Function_return hoChild
71863>>>>>>>    end_function
71864>>>>>>>
71864>>>>>>>    Function LastChild Returns Handle
71866>>>>>>>        handle hoChild
71866>>>>>>>        integer hinfcChild
71866>>>>>>>        Get phLastChild  to hinfcChild
71867>>>>>>>        If (hinfcChild) ;            Get CreateXMLNode hinfcChild to hoChild
71870>>>>>>>        Function_return hoChild
71871>>>>>>>    end_function
71872>>>>>>>
71872>>>>>>>    // Enumerate through all nodes.
71872>>>>>>>
71872>>>>>>>    Procedure EnumerateNodes Integer iMsg Integer hoReceiver String sVal1 String sVal2
71874>>>>>>>        Integer i iLen
71874>>>>>>>        Integer hoNode
71874>>>>>>>        Integer hoNodeCollection
71874>>>>>>>        Get ChildNodes To hoNodeCollection
71875>>>>>>>        If (hoNodeCollection <> 0) Begin
71877>>>>>>>            Get NodeListLength of hoNodeCollection to iLen
71878>>>>>>>            Decrement iLen
71879>>>>>>>            For i From 0 To iLen
71885>>>>>>>>
71885>>>>>>>                // For each record, process its fields.
71885>>>>>>>                Get CollectionNode Of hoNodeCollection i To hoNode
71886>>>>>>>                Send iMsg Of hoReceiver hoNode sVal1 sVal2
71887>>>>>>>                Send Destroy Of hoNode
71888>>>>>>>            Loop
71889>>>>>>>>
71889>>>>>>>            Send Destroy of hoNodeCollection
71890>>>>>>>        End
71890>>>>>>>>
71890>>>>>>>    End_Procedure
71891>>>>>>>
71891>>>>>>>    // Enumerate through all elements.
71891>>>>>>>
71891>>>>>>>    Procedure EnumerateElements Integer iMsg Integer hoReceiver String sVal1 String sVal2
71893>>>>>>>        Integer i iLen
71893>>>>>>>        Integer hoNode
71893>>>>>>>        Integer hoNodeCollection
71893>>>>>>>        Get ChildNodes To hoNodeCollection
71894>>>>>>>        If (hoNodeCollection <> 0) Begin
71896>>>>>>>            Get NodeListLength of hoNodeCollection to iLen
71897>>>>>>>            Decrement iLen
71898>>>>>>>            For i From 0 To iLen
71904>>>>>>>>
71904>>>>>>>                // For each record, process its fields.
71904>>>>>>>                Get CollectionNode Of hoNodeCollection i To hoNode
71905>>>>>>>                If (piNodeType(hoNode)=NODE_ELEMENT) ;                    Send iMsg Of hoReceiver hoNode sVal1 sVal2
71908>>>>>>>                Send Destroy Of hoNode
71909>>>>>>>            Loop
71910>>>>>>>>
71910>>>>>>>            Send Destroy of hoNodeCollection
71911>>>>>>>        End
71911>>>>>>>>
71911>>>>>>>    End_Procedure
71912>>>>>>>
71912>>>>>>>
71912>>>>>>>    // enumerate through all attributes. There is no recurse here because attributes will not
71912>>>>>>>    // contain attributes.
71912>>>>>>>
71912>>>>>>>    Procedure EnumerateAttributes Integer iMsg Integer hoReceiver String sSomeValue
71914>>>>>>>        Integer i iLen
71914>>>>>>>        Integer hoNode
71914>>>>>>>        Integer hoNodeMapCollection
71914>>>>>>>        Get AttributeNodes To hoNodeMapCollection
71915>>>>>>>        If (hoNodeMapCollection <> 0) Begin
71917>>>>>>>            Get NodeListLength of hoNodeMapCollection to iLen
71918>>>>>>>            Decrement iLen
71919>>>>>>>            For i From 0 To iLen
71925>>>>>>>>
71925>>>>>>>                // For each record, process its fields.
71925>>>>>>>                Get CollectionNode Of hoNodeMapCollection i To hoNode
71926>>>>>>>                Send iMsg Of hoReceiver hoNode sSomeValue
71927>>>>>>>                Send Destroy Of hoNode
71928>>>>>>>            Loop
71929>>>>>>>>
71929>>>>>>>            Send Destroy of hoNodeMapCollection
71930>>>>>>>        End
71930>>>>>>>>
71930>>>>>>>    End_Procedure
71931>>>>>>>
71931>>>>>>>
71931>>>>>>>    Function XSLTransformation Integer hoXSLDocument Returns String
71933>>>>>>>        integer infcXSLStartAt
71933>>>>>>>        String sBuffer
71933>>>>>>>        // Transformation is of current object using passed XSLDocument.
71933>>>>>>>        Get XMLInterface Of hoXSLDocument to infcXSLStartAt
71934>>>>>>>        Get TransformNode infcXSLStartAt to sBuffer
71935>>>>>>>        Function_Return sBuffer
71936>>>>>>>    End_Function
71937>>>>>>>
71937>>>>>>>    // This allows for transformations not limited to the size of the string buffer
71937>>>>>>>    //
71937>>>>>>>    // Note that it is up to the programmer to dispose of the memory allocated at pBuffer
71937>>>>>>>    // by using the free(pBuffer) function
71937>>>>>>>    //
71937>>>>>>>    Function XSLTransformationToAddress Integer hoXSLDocument Returns Address
71939>>>>>>>        integer infcXSLStartAt
71939>>>>>>>        Address pBuffer
71939>>>>>>>        // Transformation is of current object using passed XSLDocument.
71939>>>>>>>        Get XMLInterface Of hoXSLDocument to infcXSLStartAt
71940>>>>>>>        Get TransformNodeToAddress infcXSLStartAt to pBuffer
71941>>>>>>>        Function_Return pBuffer
71942>>>>>>>    End_Function
71943>>>>>>>
71943>>>>>>>
71943>>>>>>>    // return an object that is the parent of the current node
71943>>>>>>>    Function ParentNode returns handle
71945>>>>>>>        Handle hoId
71945>>>>>>>        Handle hinfcXMLInterface
71945>>>>>>>        get phParentNode to hinfcXMLInterface
71946>>>>>>>        If (hinfcXMLInterface) ;            Get CreateXmlNode hinfcXMLInterface to hoID
71949>>>>>>>        Function_return hoID
71950>>>>>>>    End_function
71951>>>>>>>
71951>>>>>>>    // extract base name from string. e.g.: ns:name --> name
71951>>>>>>>    //
71951>>>>>>>    Function BaseNameFromQName string sName returns string
71953>>>>>>>        integer iPos
71953>>>>>>>        Move (Pos(":",sName)) to iPos
71954>>>>>>>        If iPos Begin
71956>>>>>>>            Move (remove(sName,1,iPos)) to sName
71957>>>>>>>        end
71957>>>>>>>>
71957>>>>>>>        function_return sName
71958>>>>>>>    end_function
71959>>>>>>>
71959>>>>>>>    // extract prefix name from string. e.g.: ns:name --> ns
71959>>>>>>>    //
71959>>>>>>>    Function PrefixNameFromQName string sName returns string
71961>>>>>>>        integer iPos
71961>>>>>>>        Move (Pos(":",sName)) to iPos
71962>>>>>>>        If iPos Begin
71964>>>>>>>            Move (left(sName,iPos-1)) to sName
71965>>>>>>>        end
71965>>>>>>>>
71965>>>>>>>        function_return sName
71966>>>>>>>    end_function
71967>>>>>>>
71967>>>>>>>    // Same as NextSibling except it destroys the current node
71967>>>>>>>    //
71967>>>>>>>    Function NextNode Returns Handle
71969>>>>>>>        handle hoNode
71969>>>>>>>        Get NextSibling to hoNode
71970>>>>>>>        Send Destroy
71971>>>>>>>        Function_return hoNode
71972>>>>>>>    end_function
71973>>>>>>>
71973>>>>>>>
71973>>>>>>>    // Returns true if node is element and namespace and base name match
71973>>>>>>>    //
71973>>>>>>>    Function IsElementNS string sNamespaceURI string sBaseName returns boolean
71975>>>>>>>         Function_return (piNodeType(self)=NODE_ELEMENT and ;                          psNameSpaceURI(self)=sNamespaceURI and ;                          psBaseName(self)=sBaseName )
71976>>>>>>>    end_function
71977>>>>>>>
71977>>>>>>>    // Returns node of first occurence of child node matching namespace and base name
71977>>>>>>>    //
71977>>>>>>>    Function ChildElementNS string sNameSpaceURI string sBaseName returns handle
71979>>>>>>>        handle hoNode
71979>>>>>>>        Get FirstChild to hoNode
71980>>>>>>>        While (hoNode and not(IsElementNS(hoNode, sNameSpaceURI, sBaseName)))
71984>>>>>>>            Get NextNode of hoNode to hoNode
71985>>>>>>>        end
71986>>>>>>>>
71986>>>>>>>        function_return hoNode
71987>>>>>>>    end_function
71988>>>>>>>
71988>>>>>>>    // Returns node of next occurence of sibling node matching namespace and base name
71988>>>>>>>    //
71988>>>>>>>    Function NextElementNS string sNameSpaceURI string sBaseName returns handle
71990>>>>>>>        handle hoNode
71990>>>>>>>        Get NextSibling to hoNode
71991>>>>>>>        While (hoNode and not(IsElementNS(hoNode, sNameSpaceURI, sBaseName)))
71995>>>>>>>            Get NextNode of hoNode to hoNode
71996>>>>>>>        end
71997>>>>>>>>
71997>>>>>>>        Send Destroy
71998>>>>>>>        function_return hoNode
71999>>>>>>>    end_function
72000>>>>>>>
72000>>>>>>>
72000>>>>>>>    // Returns value (string) first occurence of child node matching namespace and base name
72000>>>>>>>    //
72000>>>>>>>    Function ChildElementValueNS string sNameSpaceURI string sBaseName returns string
72002>>>>>>>        handle hoNext
72002>>>>>>>        string sText
72002>>>>>>>        Get ChildElementNS sNameSpaceURI sBaseName to hoNext
72003>>>>>>>        If hoNext begin
72005>>>>>>>            Get psText of hoNext to sText
72006>>>>>>>            send destroy of hoNext
72007>>>>>>>        end
72007>>>>>>>>
72007>>>>>>>        Function_return sText
72008>>>>>>>    end_function
72009>>>>>>>
72009>>>>>>>    Procedure SetChildElementValueNS string sNameSpaceURI string sBaseName String sValue
72011>>>>>>>        Integer hoNode
72011>>>>>>>        Integer hinfcTempNode
72011>>>>>>>        Get ChildElementNS sNameSpaceURI sBaseName to hoNode
72012>>>>>>>        If (hoNode=0) begin
72014>>>>>>>            Send AddElementNS sNameSpaceURI sBaseName sValue
72015>>>>>>>        end
72015>>>>>>>>
72015>>>>>>>        Else Begin
72016>>>>>>>            Set psText Of hoNode To sValue
72017>>>>>>>            send destroy of hoNode
72018>>>>>>>        end
72018>>>>>>>>
72018>>>>>>>    End_Procedure
72019>>>>>>>
72019>>>>>>>
72019>>>>>>>//    // Returns node of first occurence of child node matching namespace and base name
72019>>>>>>>//    // that has an attrib value that contains a specified value
72019>>>>>>>//    //
72019>>>>>>>//    //Doc/ Visibility=Public
72019>>>>>>>//    Function FindElementNodeWithAttribNS string sNamespace string sBaseName string sAttribName string sAttribValue returns handle
72019>>>>>>>//        handle hoNext hoNode
72019>>>>>>>//        string sName
72019>>>>>>>//        Get FirstChild to hoNode
72019>>>>>>>//        While (hoNode)
72019>>>>>>>//            If (IsElementNS(hoNode, sNameSpace, sBaseName)) begin
72019>>>>>>>//                Get AttributeValue of hoNode sAttribName to sName
72019>>>>>>>//                If (sName=sAttribValue) Begin
72019>>>>>>>//                    Function_return hoNode
72019>>>>>>>//                end
72019>>>>>>>//            end
72019>>>>>>>//            Get NextSibling of hoNode to hoNext
72019>>>>>>>//            Send Destroy of hoNode
72019>>>>>>>//            Move hoNext to hoNode
72019>>>>>>>//        end
72019>>>>>>>//        function_return 0
72019>>>>>>>//    end_function
72019>>>>>>>
72019>>>>>>>    // pass a prefix and try to finds its NameSpaceURI. Start at current node and work up to parent.
72019>>>>>>>    // This can be useful when a qualified name is found in an attribute value
72019>>>>>>>    //
72019>>>>>>>    Function PrefixToNamespaceURI string sPrefix returns string
72021>>>>>>>        handle hoNode
72021>>>>>>>        Integer i iNodes
72021>>>>>>>        Integer hoNodes hoParentNode hoAttNode
72021>>>>>>>        Boolean bDone bParent
72021>>>>>>>        string sAttPrefix sName sNameSpace
72021>>>>>>>
72021>>>>>>>        Move self to hoNode
72022>>>>>>>        While Not bDone
72026>>>>>>>            Get AttributeNodes of hoNode To hoNodes
72027>>>>>>>            If (hoNodes <> 0) Begin
72029>>>>>>>                Get NodeListLength of hoNodes to iNodes
72030>>>>>>>                For i From 0 To (iNodes-1)
72036>>>>>>>>
72036>>>>>>>                    // For each record, process its fields.
72036>>>>>>>                    Get CollectionNode Of hoNodes i To hoAttNode
72037>>>>>>>                    Get psPrefix of hoAttNode to sAttPrefix
72038>>>>>>>                    If (sAttPrefix="xmlns") Begin
72040>>>>>>>                        Get psBaseName of hoAttNode to sName
72041>>>>>>>                        If (sName=sPrefix) Begin
72043>>>>>>>                            Get Value of hoAttNode to sNameSpace
72044>>>>>>>                            Move true to bDone
72045>>>>>>>                            Move (iNodes-1) to i
72046>>>>>>>                        end
72046>>>>>>>>
72046>>>>>>>                    end
72046>>>>>>>>
72046>>>>>>>                    Send Destroy Of hoAttNode
72047>>>>>>>                Loop
72048>>>>>>>>
72048>>>>>>>                Send Destroy of hoNodes
72049>>>>>>>            End
72049>>>>>>>>
72049>>>>>>>            Get ParentNode of hoNode to hoParentNode
72050>>>>>>>            If bParent send destroy of hoNode
72053>>>>>>>            If not bDone begin
72055>>>>>>>                If not hoParentNode move true to bDone
72058>>>>>>>                Else begin
72059>>>>>>>                    Move True to bParent
72060>>>>>>>                    Move hoParentNode to hoNode
72061>>>>>>>                end
72061>>>>>>>>
72061>>>>>>>            end
72061>>>>>>>>
72061>>>>>>>        end
72062>>>>>>>>
72062>>>>>>>        Function_return sNameSpace
72063>>>>>>>    end_function
72064>>>>>>>
72064>>>>>>>
72064>>>>>>>
72064>>>>>>>End_Class
72065>>>>>>>
72065>>>>>>>// Set up basic inheritance for specialized forms of XML classes.
72065>>>>>>>// This needs to be done so we can make objects of these types.
72065>>>>>>>
72065>>>>>>>Class cXMLDOMElement Is A BaseXmlDomElement
72066>>>>>>>    Import_Class_protocol cXMLDOMNodeMixin
72067>>>>>>>
72067>>>>>>>// Send AddAttribute
72067>>>>>>>// Get  AddAttributeNode
72067>>>>>>>// Send RemoveAttribute
72067>>>>>>>// Get  AttributeValue
72067>>>>>>>// Get  AttributeValueNode
72067>>>>>>>
72067>>>>>>>// Send AddAttributeNS
72067>>>>>>>// Get  AddAttributeNodeNS
72067>>>>>>>// Send RemoveAttributeNs
72067>>>>>>>// Get  AttributeValueNS
72067>>>>>>>// Get  AttributeValueNodeNS
72067>>>>>>>
72067>>>>>>>    // Should use AddAttributeValue...does same thing
72067>>>>>>>    Procedure SetAttributeValue String sName String sValue
72069>>>>>>>        Send AddAttribute sName sValue
72070>>>>>>>    End_Procedure
72071>>>>>>>
72071>>>>>>>    // Note: Get_AttributeValue already there
72071>>>>>>>
72071>>>>>>>    Procedure RemoveAttribute string sName
72073>>>>>>>        integer iVal
72073>>>>>>>        Get RemoveAttribute sName to iVal
72074>>>>>>>    End_procedure
72075>>>>>>>
72075>>>>>>>    //(new)
72075>>>>>>>    Function AttributeValueNS string sNameSpace string sBaseName returns string
72077>>>>>>>        handle hoAttr
72077>>>>>>>        string sValue
72077>>>>>>>        Get AttributeValueNodeNS sNameSpace sBaseName to hoAttr
72078>>>>>>>        If hoAttr Begin
72080>>>>>>>            Get Value of hoAttr to sValue
72081>>>>>>>            send destroy of hoAttr
72082>>>>>>>        end
72082>>>>>>>>
72082>>>>>>>        function_return sValue
72083>>>>>>>    end_function
72084>>>>>>>
72084>>>>>>>    //(new)
72084>>>>>>>    Procedure RemoveAttributeNS string sNameSpace string sBaseName
72086>>>>>>>        handle hoAttrs hoAttr
72086>>>>>>>        string sValue
72086>>>>>>>        Get AttributeNodes to hoAttrs
72087>>>>>>>        If hoAttrs begin
72089>>>>>>>            Get RemoveQualifiedNode of hoAttrs sNamespace sBaseName to hoAttr
72090>>>>>>>            If hoAttr ;                send destroy of hoAttr
72093>>>>>>>        end
72093>>>>>>>>
72093>>>>>>>        send destroy of hoAttrs
72094>>>>>>>    end_procedure
72095>>>>>>>
72095>>>>>>>End_Class
72096>>>>>>>
72096>>>>>>>Class cXMLDOMNode Is A BaseXmlDomNode
72097>>>>>>>    Import_Class_protocol cXMLDOMNodeMixin
72098>>>>>>>End_Class
72099>>>>>>>
72099>>>>>>>Class cXMLDOMAttribute Is A BaseXmlDomAttribute
72100>>>>>>>    Import_Class_protocol cXMLDOMNodeMixin
72101>>>>>>>End_Class
72102>>>>>>>
72102>>>>>>>Class cXMLDOMComment Is A BaseXmlDomComment
72103>>>>>>>    Import_Class_protocol cXMLDOMNodeMixin
72104>>>>>>>End_Class
72105>>>>>>>
72105>>>>>>>Class cXMLDOMProcessingInstruction Is A BaseXmlDomProcessingInstruction
72106>>>>>>>    Import_Class_protocol cXMLDOMNodeMixin
72107>>>>>>>End_Class
72108>>>>>>>
72108>>>>>>>Class cXMLDOMTextNode Is A BaseXmlDomTextNode
72109>>>>>>>    Import_Class_protocol cXMLDOMNodeMixin
72110>>>>>>>End_Class
72111>>>>>>>
72111>>>>>>>Class cXMLDOMCDATASection Is A BaseXmlDomCDATASection
72112>>>>>>>    Import_Class_protocol cXMLDOMNodeMixin
72113>>>>>>>End_Class
72114>>>>>>>
72114>>>>>>>Class cXMLDOMDocumentType Is A BaseXmlDomDocumentType
72115>>>>>>>    Import_Class_protocol cXMLDOMNodeMixin
72116>>>>>>>
72116>>>>>>>//        Function EnumerateEntities Integer iMsg Integer hoReceiver Integer bEnumerate Integer iSomeValue Returns Handle
72116>>>>>>>//            Integer i
72116>>>>>>>//            Integer hoNode
72116>>>>>>>//            Integer hoNamedNodeMap
72116>>>>>>>//            Integer hinfcNamedNodeMap
72116>>>>>>>//            Integer iLength
72116>>>>>>>
72116>>>>>>>//            Get phEntities To hinfcNamedNodeMap
72116>>>>>>>
72116>>>>>>>//            showln "The interface of the named node map is " hinfcNamedNodeMap
72116>>>>>>>
72116>>>>>>>//            If (hinfcNamedNodeMap <> 0) Begin
72116>>>>>>>//                Get CreateXMLObject U_cXMLDOMNamedNodeMap hinfcNamedNodeMap to hoNamedNodeMap
72116>>>>>>>//                Get piLength Of hoNamedNodeMap To iLength
72116>>>>>>>//                Showln "There are " iLength " items in map"
72116>>>>>>>
72116>>>>>>>//                ///                For i From 0 To (NodeListLength(hoNamedNodeMap)-1)
72116>>>>>>>//                ///                    // For each record, process its fields.
72116>>>>>>>//                //                    Get CollectionNode Of hoNamedNodeMap i To hoNode
72116>>>>>>>//                //                    Send iMsg Of hoReceiver hoNode bEnumerate iSomeValue
72116>>>>>>>//                //                    Send Destroy_Object Of hoNode
72116>>>>>>>//                //                Loop
72116>>>>>>>//            End
72116>>>>>>>//            Send Destroy To hoNamedNodeMap
72116>>>>>>>//            Function_Return 0
72116>>>>>>>//        End_Function
72116>>>>>>>
72116>>>>>>>//        Function EnumerateNotations Integer iMsg Integer hoReceiver Integer bEnumerate Integer iSomeValue Returns Handle
72116>>>>>>>//            Integer i
72116>>>>>>>//            Integer hoNode
72116>>>>>>>//            Integer hoNamedNodeMap
72116>>>>>>>//            Integer hinfcNamedNodeMap
72116>>>>>>>//            Integer iLength
72116>>>>>>>
72116>>>>>>>//            Object oNamedNodeMap Is A cXMLDOMNamedNodeMap
72116>>>>>>>//                Move Self To hoNamedNodeMap
72116>>>>>>>//            End_Object
72116>>>>>>>
72116>>>>>>>//            Get phNotations To hinfcNamedNodeMap
72116>>>>>>>
72116>>>>>>>//            showln "The interface of the named node map is " hinfcNamedNodeMap
72116>>>>>>>
72116>>>>>>>//            If (hinfcNamedNodeMap <> 0) Begin
72116>>>>>>>//                Set XMLInterface Of hoNamedNodeMap To hinfcNamedNodeMap
72116>>>>>>>//                Get piLength Of hoNamedNodeMap To iLength
72116>>>>>>>//                Showln "There are " iLength " items in map"
72116>>>>>>>
72116>>>>>>>/////                For i From 0 To (NodeListLength(hoNamedNodeMap)-1)
72116>>>>>>>/////                    // For each record, process its fields.
72116>>>>>>>////                    Get CollectionNode Of hoNamedNodeMap i To hoNode
72116>>>>>>>////                    Send iMsg Of hoReceiver hoNode bEnumerate iSomeValue
72116>>>>>>>////                    Send Destroy_Object Of hoNode
72116>>>>>>>////                Loop
72116>>>>>>>//            End
72116>>>>>>>//            Send Destroy_Object To hoNamedNodeMap
72116>>>>>>>//            Function_Return 0
72116>>>>>>>//        End_Function
72116>>>>>>>
72116>>>>>>>End_Class
72117>>>>>>>
72117>>>>>>>Class cXMLDOMNotation Is A BaseXmlDomNotation
72118>>>>>>>    Import_Class_protocol cXMLDOMNodeMixin
72119>>>>>>>End_Class
72120>>>>>>>
72120>>>>>>>Class cXMLDOMEntity Is A BaseXmlDomEntity
72121>>>>>>>    Import_Class_protocol cXMLDOMNodeMixin
72122>>>>>>>End_Class
72123>>>>>>>
72123>>>>>>>Class cXMLDOMEntityReference Is A BaseXmlDomEntityReference
72124>>>>>>>    Import_Class_protocol cXMLDOMNodeMixin
72125>>>>>>>End_Class
72126>>>>>>>
72126>>>>>>>Class cXMLDOMDocumentFragment Is A BaseXmlDomDocumentFragment
72127>>>>>>>    Import_Class_protocol cXMLDOMNodeMixin
72128>>>>>>>End_Class
72129>>>>>>>
72129>>>>>>>
72129>>>>>>>
72129>>>>>>>// Base document class with Base functions.
72129>>>>>>>
72129>>>>>>>Class cXMLDOMDocument is An BaseXmlDomDocument
72130>>>>>>>
72130>>>>>>>    Import_Class_protocol cXMLDOMNodeMixin
72131>>>>>>>
72131>>>>>>>    Procedure Construct_Object
72133>>>>>>>        Forward Send Construct_Object
72135>>>>>>>        Property String psDocumentName ""
72136>>>>>>>        Property integer phPrivateDocumentElement 0
72137>>>>>>>    End_Procedure
72138>>>>>>>
72138>>>>>>>    // returns the classId for the passed NodeType. This is a good augmentation point. All nodes
72138>>>>>>>    // within an xml document come here to get a class. So, if you want to augment and return a
72138>>>>>>>    // different class, just check the node type and return whatever -- else forward
72138>>>>>>>
72138>>>>>>>    Function NodeClassId integer iType returns integer
72140>>>>>>>        integer iClassId
72140>>>>>>>        Case Begin
72140>>>>>>>            Case (iType=NODE_ELEMENT)                   Move U_cXMLDOMElement      to iClassId
72143>>>>>>>            Case (iType=NODE_ATTRIBUTE)                 Move U_cXMLDOMAttribute    to iClassId
72147>>>>>>>            Case (iType=NODE_TEXT)                      Move U_cXMLDOMTextNode     to iClassId
72151>>>>>>>            Case (iType=NODE_CDATA_SECTION)             Move U_cXMLDOMCDATASection to iClassId
72155>>>>>>>            Case (iType=NODE_ENTITY_REFERENCE)          Move U_cXMLDOMEntityReference to iClassId
72159>>>>>>>            Case (iType=NODE_ENTITY)                    Move U_cXMLDOMEntity       to iClassId
72163>>>>>>>            Case (iType=NODE_PROCESSING_INSTRUCTION)    Move U_cXMLDOMProcessingInstruction to iClassId
72167>>>>>>>            Case (iType=NODE_COMMENT)                   Move U_cXMLDOMComment      to iClassId
72171>>>>>>>            Case (iType=NODE_DOCUMENT)                  Move U_cXMLDOMDocument     to iClassId
72175>>>>>>>            Case (iType=NODE_DOCUMENT_TYPE)             Move U_cXMLDOMDocumentType to iClassId
72179>>>>>>>            Case (iType=NODE_DOCUMENT_FRAGMENT)         Move U_cXMLDOMDocumentFragment to iClassId
72183>>>>>>>            Case (iType=NODE_NOTATION)                  Move U_cXMLDOMNotation     to iClassId
72187>>>>>>>            Case (iType=0)                              Move 0                     to iClassId // this is an error!!
72191>>>>>>>            Case Else                                   Move U_cXMLDOMNode         to iClassId
72193>>>>>>>        Case End
72193>>>>>>>        Function_return iClassId
72194>>>>>>>    end_function
72195>>>>>>>
72195>>>>>>>    // Load an XML Document. The name of the document is stored in a property
72195>>>>>>>    // that must be set for this function to work correctly.
72195>>>>>>>
72195>>>>>>>    Function LoadXMLDocument Returns Integer
72197>>>>>>>        String sDocumentName
72197>>>>>>>        Integer bRetVal
72197>>>>>>>        Get psDocumentName To sDocumentName
72198>>>>>>>        Get LoadDocument sDocumentName To bRetVal
72199>>>>>>>        If (bRetVal = 0);            Function_Return TRUE
72202>>>>>>>        Else;            Function_Return FALSE
72204>>>>>>>    End_Function
72205>>>>>>>
72205>>>>>>>    Function SaveXMLDocument Returns Integer
72207>>>>>>>        String sDocumentName
72207>>>>>>>        Integer bRetVal
72207>>>>>>>        Get psDocumentName To sDocumentName
72208>>>>>>>        Get SaveDocument sDocumentName To bRetVal
72209>>>>>>>        Function_Return bRetVal
72210>>>>>>>    End_Function
72211>>>>>>>
72211>>>>>>>    // Load an XML from a string. This aguments the C message to ret 1 if Ok and 0 if error.
72211>>>>>>>    //
72211>>>>>>>    Function LoadXML string sXML Returns Integer
72213>>>>>>>        Integer bRetVal
72213>>>>>>>        // for some reason the parser will not work properly with embedded double quotes.
72213>>>>>>>        // Change all " to ' in document.
72213>>>>>>>        //Move (replaces('"',sXML,"'")) to sXML  // removed this. Bad Idea.
72213>>>>>>>        Forward Get LoadXml sXML To bRetVal
72215>>>>>>>        If (bRetVal = 0) ;            Function_Return TRUE
72218>>>>>>>        Else;            Function_Return FALSE
72220>>>>>>>    End_Function
72221>>>>>>>
72221>>>>>>>    // Load an XML string from an address. This aguments the C message to ret 1 if Ok and 0 if error.
72221>>>>>>>    //
72221>>>>>>>    Function LoadXMLFromAddress address pXML Returns Integer
72223>>>>>>>        Integer bRetVal
72223>>>>>>>        Forward Get LoadXmlFromAddress pXML To bRetVal
72225>>>>>>>        If (bRetVal = 0) ;            Function_Return TRUE
72228>>>>>>>        Else;            Function_Return FALSE
72230>>>>>>>    End_Function
72231>>>>>>>
72231>>>>>>>
72231>>>>>>>    // Allow Nodes and Node node lists to get the parent document.
72231>>>>>>>
72231>>>>>>>    Function DocumentObject Returns Handle
72233>>>>>>>        Function_Return self
72234>>>>>>>    End_Function
72235>>>>>>>
72235>>>>>>>    // Access to the root node allows for searches and iterations.
72235>>>>>>>    // The root node is a cNode.
72235>>>>>>>
72235>>>>>>>    Function DocumentElement Returns Handle
72237>>>>>>>        Integer hNewNode       // Object ID of Root Node
72237>>>>>>>        Integer infcNode   // XML Element Interface
72237>>>>>>>// we used to buffer this so we'd always return the same object. This is dangerous. If the devloper
72237>>>>>>>// deletes the root and then creates some other object with this name, we will have problems. Now we
72237>>>>>>>// always create a new root now - which means you can create multiple roots (which is probably ok).
72237>>>>>>>
72237>>>>>>>//        Get phPrivateDocumentElement to hNewNode
72237>>>>>>>//        // if for some reason the developer sends destroy to the root element then
72237>>>>>>>//        // we must check that acutally exists. If not, create the root all over again
72237>>>>>>>//        Get Object_Id of hNewNode to hNewNode // if Object no longer exists, 0 is returned
72237>>>>>>>//        If not (hNewNode) Begin
72237>>>>>>>//            // Call XML to get the document root element.
72237>>>>>>>//            Get phDocumentElement To infcNode
72237>>>>>>>//            If infcNode Begin
72237>>>>>>>//                Get CreateXMLObject U_cXMLDOMElement infcNode to hNewNode
72237>>>>>>>//                Set phPrivateDocumentElement to hNewNode
72237>>>>>>>//            end
72237>>>>>>>//        End
72237>>>>>>>
72237>>>>>>>        Get phDocumentElement To infcNode
72238>>>>>>>        If infcNode Begin
72240>>>>>>>            Get CreateXMLObject U_cXMLDOMElement infcNode to hNewNode
72241>>>>>>>            Set phPrivateDocumentElement to hNewNode // we no longer use this at all
72242>>>>>>>        end
72242>>>>>>>>
72242>>>>>>>        Function_Return hNewNode
72243>>>>>>>    End_Function
72244>>>>>>>
72244>>>>>>>    //  CreateRootNode is used to set up the first element in a document.
72244>>>>>>>    //  It should only be used when creating new files.
72244>>>>>>>
72244>>>>>>>    Function CreateDocumentElement String sTagName Returns Handle
72246>>>>>>>        Integer hNewNode       // Object ID of Root Node
72246>>>>>>>        Integer infcNode   // XML Element Interface
72246>>>>>>>        // Call XML to create an element in the document.
72246>>>>>>>        Get CreateElement sTagName To infcNode
72247>>>>>>>        // Tie the element interface to the DataFlex object.
72247>>>>>>>        If infcNode ;            Get CreateXMLObject U_cXMLDOMElement infcNode to hNewNode
72250>>>>>>>        // Call XML to set the root element of the document.
72250>>>>>>>        Set phDocumentElement To infcNode
72251>>>>>>>        Set phPrivateDocumentElement to hNewNode
72252>>>>>>>        Function_Return hNewNode
72253>>>>>>>    End_Function
72254>>>>>>>
72254>>>>>>>    //(new)
72254>>>>>>>    Function CreateDocumentElementNS string sNamespace String sTagName Returns Handle
72256>>>>>>>        Integer hNewNode       // Object ID of Root Node
72256>>>>>>>        Integer infcNode iType  // XML Element Interface
72256>>>>>>>        Get CreateElementNodeNS sNameSpace sTagName "" to hNewNode
72257>>>>>>>        Get XmlInterface of hNewNode to infcNode
72258>>>>>>>        Set phDocumentElement To infcNode
72259>>>>>>>        Set phPrivateDocumentElement to hNewNode
72260>>>>>>>        Function_Return hNewNode
72261>>>>>>>    End_Function
72262>>>>>>>
72262>>>>>>>
72262>>>>>>>
72262>>>>>>>    // return the DocType as a document-type object. Returns 0 if no dtd
72262>>>>>>>    // Access to information from the doc type object is limited. Use get psXML
72262>>>>>>>    Function DocTypeNode returns handle
72264>>>>>>>        handle hinfcDocType hoDocType
72264>>>>>>>        get phDocType to hinfcDocType
72265>>>>>>>        If hinfcDocType ;            Get CreateXMLObject U_cXMLDOMDocumentType hinfcDocType to hoDocType
72268>>>>>>>        Function_return hoDocType
72269>>>>>>>    End_function
72270>>>>>>>
72270>>>>>>>    Function phXMLErrorObject Returns Handle
72272>>>>>>>        Integer hoParseErrorObject
72272>>>>>>>        Integer hInfcParseError
72272>>>>>>>        Get phParseError To hInfcParseError
72273>>>>>>>        If hInfcParseError ;            Get CreateXMLObject U_BaseXMLDOMParseError hinfcParseError to hoParseErrorObject
72276>>>>>>>        Function_Return hoParseErrorObject
72277>>>>>>>    End_Function
72278>>>>>>>
72278>>>>>>>    //  The following procedure is meant to be overridden by one provided by the developer.
72278>>>>>>>
72278>>>>>>>    Procedure BasicParseErrorReport
72280>>>>>>>        String sProblem
72280>>>>>>>        String sLinePosition
72280>>>>>>>        String sDescr
72280>>>>>>>        String sReason
72280>>>>>>>        String sSource
72280>>>>>>>        Integer hoParseErrorObject
72280>>>>>>>        Get phXMLErrorObject To hoParseErrorObject
72281>>>>>>>        If hoParseErrorObject Begin
72283>>>>>>>            Move (SFormat(C_$CannotLoad, psDocumentName(Self)) + "."+character(13)+character(10)) To sProblem
72284>>>>>>>            Move (SFormat(C_$ParsingError, piLine(hoParseErrorObject), piLinePos(hoParseErrorObject))) To sLinePosition
72285>>>>>>>            Move (sLinePosition +character(13)+character(10)) To sLinePosition
72286>>>>>>>
72286>>>>>>>            Move (C_$Reason + ":" * (psReason(hoParseErrorObject))  +character(13)+character(10)) To sReason
72287>>>>>>>            Move (C_$Source + ":" * (psSrcText(hoParseErrorObject))) To sSource
72288>>>>>>>            Move (sProblem + sLinePosition + sReason + sSource) To sDescr
72289>>>>>>>            Error DFERR_XML_INTERNAL_ERROR sDescr
72290>>>>>>>>
72290>>>>>>>            Send Destroy of hoParseErrorObject
72291>>>>>>>        End
72291>>>>>>>>
72291>>>>>>>        else ;            Error DFERR_XML_INTERNAL_ERROR C_$NotCreatedParseObject
72293>>>>>>>    End_Procedure
72294>>>>>>>
72294>>>>>>>End_Class
72295>>>>>Use Spec0011.utl // Floating menues on the fly
Including file: spec0011.utl    (C:\projects\BRS\VDFQuery\AppSrc\spec0011.utl)
72295>>>>>>>// Use Spec0011.utl // Floating menues on the fly
72295>>>>>>>
72295>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
72295>>>>>>>
72295>>>>>>>desktop_section
72300>>>>>>>  object oSpec0011Arr is a cArray
72302>>>>>>>    item_property_list
72302>>>>>>>      item_property integer piMsg.i
72302>>>>>>>      item_property string  psText.i
72302>>>>>>>    end_item_property_list
#REM 72339 DEFINE FUNCTION PSTEXT.I INTEGER LIROW RETURNS STRING
#REM 72344 DEFINE PROCEDURE SET PSTEXT.I INTEGER LIROW STRING VALUE
#REM 72349 DEFINE FUNCTION PIMSG.I INTEGER LIROW RETURNS INTEGER
#REM 72354 DEFINE PROCEDURE SET PIMSG.I INTEGER LIROW INTEGER VALUE
72360>>>>>>>    procedure add_item integer iMsg string sVal
72363>>>>>>>      integer iRow
72363>>>>>>>      get row_count to iRow
72364>>>>>>>      set piMsg.i  iRow to iMsg
72365>>>>>>>      set psText.i iRow to sVal
72366>>>>>>>    end_procedure
72367>>>>>>>  end_object
72368>>>>>>>end_desktop_section
72373>>>>>>>
72373>>>>>>>procedure FLOATMENU_PrepareAddItem global integer iMsg string sVal
72375>>>>>>>  send add_item to (oSpec0011Arr(self)) iMsg sVal
72376>>>>>>>end_procedure
72377>>>>>>>
72377>>>>>>>class cSpec0011FloatingPopupMenu is a FloatingPopupMenu
72378>>>>>>>  procedure popup
72380>>>>>>>    forward send popup
72382>>>>>>>    send request_destroy_object
72383>>>>>>>  end_procedure
72384>>>>>>>end_class
72385>>>>>>>
72385>>>>>>>function FLOATMENU_Apply global integer iObj returns integer
72387>>>>>>>  integer iSelf iArr iRow iMax iObjFM
72387>>>>>>>  move self to iSelf
72388>>>>>>>  move (oSpec0011Arr(self)) to iArr
72389>>>>>>>  get row_count of iArr to iMax
72390>>>>>>>  move desktop to self
72391>>>>>>>  object oSpec0011_FM is a cSpec0011FloatingPopupMenu
72393>>>>>>>    for iRow from 0 to (iMax-1)
72399>>>>>>>>
72399>>>>>>>      send add_item (piMsg.i(iArr,iRow)) (psText.i(iArr,iRow))
72400>>>>>>>      set aux_value item iRow to iObj
72401>>>>>>>    loop
72402>>>>>>>>
72402>>>>>>>    move self to iObjFM
72403>>>>>>>  end_object
72404>>>>>>>  move iSelf to self
72405>>>>>>>  send delete_data to iArr
72406>>>>>>>  function_return iObjFM
72407>>>>>>>end_function
72408>>>>>Use GridUtil.utl // Grid and List utilities (not for dbGrid's or Table's)
72408>>>>>Use QryOrder.utl // cQueryOrderExpression class
Including file: qryorder.utl    (C:\projects\BRS\VDFQuery\AppSrc\qryorder.utl)
72408>>>>>>>// **********************************************************************
72408>>>>>>>// Use QryOrder.utl // Ad-hoc index thing for query classes
72408>>>>>>>//
72408>>>>>>>// By Sture Andersen
72408>>>>>>>//
72408>>>>>>>// Update: Wed  24-09-2003 - Lower limit of for loop fixed in function sReverseValue.s
72408>>>>>>>//
72408>>>>>>>// **********************************************************************
72408>>>>>>>
72408>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
72408>>>>>>>Use FieldInf     // Global field info objects and abstract field types
72408>>>>>>>Use Collate.nui  // A little collating thing
Including file: collate.nui    (C:\projects\BRS\VDFQuery\AppSrc\collate.nui)
72408>>>>>>>>>// Use Collate.nui  // A little collating thing
72408>>>>>>>>>
72408>>>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
72408>>>>>>>>>Use Strings.nui  // String manipulation for VDF (No User Interface)
72408>>>>>>>>>
72408>>>>>>>>>class cCollateArray is a cArray
72409>>>>>>>>>  procedure fill_current_sort_order
72411>>>>>>>>>    integer liCharacter
72411>>>>>>>>>    for liCharacter from 32 to 255
72417>>>>>>>>>>
72417>>>>>>>>>      set value item (liCharacter-32) to (character(liCharacter))
72418>>>>>>>>>    loop
72419>>>>>>>>>>
72419>>>>>>>>>    send sort_items
72420>>>>>>>>>  end_procedure
72421>>>>>>>>>  function sStringValue returns string
72423>>>>>>>>>    integer liMax liItem
72423>>>>>>>>>    string lsRval
72423>>>>>>>>>    get item_count to liMax
72424>>>>>>>>>    decrement liMax
72425>>>>>>>>>    move "" to lsRval
72426>>>>>>>>>    for liItem from 0 to liMax
72432>>>>>>>>>>
72432>>>>>>>>>      move (lsRval+value(self,liItem)) to lsRval
72433>>>>>>>>>    loop
72434>>>>>>>>>>
72434>>>>>>>>>    function_return lsRval
72435>>>>>>>>>  end_function
72436>>>>>>>>>end_class // cCollateArray
72437>>>>>>>>>
72437>>>>>>>>>desktop_section
72442>>>>>>>>>  object oCollateArray is a cCollateArray NO_IMAGE
72444>>>>>>>>>    property string psCollateString         public ""
72446>>>>>>>>>    property string psCollateStringReversed public ""
72448>>>>>>>>>    procedure Init
72451>>>>>>>>>      string lsValue
72451>>>>>>>>>      get sStringValue to lsValue
72452>>>>>>>>>      set psCollateString to lsValue
72453>>>>>>>>>      set psCollateStringReversed to (StringReverse(lsValue))
72454>>>>>>>>>    end_procedure
72455>>>>>>>>>    send fill_current_sort_order
72456>>>>>>>>>    send Init
72457>>>>>>>>>  end_object
72458>>>>>>>>>end_desktop_section
72463>>>>>>>>>
72463>>>>>>>>>function Collate_String global returns string
72465>>>>>>>>>  function_return (psCollateString(oCollateArray(self)))
72466>>>>>>>>>end_function
72467>>>>>>>>>function Collate_ReversedString global returns string
72469>>>>>>>>>  function_return (psCollateStringReversed(oCollateArray(self)))
72470>>>>>>>>>end_function
72471>>>>>>>>>
72471>>>>>>>>>string gs$ReversedCollateString 255
72471>>>>>>>>>move (repeat(" ",31)+Collate_ReversedString()) to gs$ReversedCollateString
72472>>>>>>>>>
72472>>>>>>>Use QryExpr.utl  // Expression handling for queries
72472>>>>>>>Use Query.nui    // Basic things needed for a query tool
Including file: query.nui    (C:\projects\BRS\VDFQuery\AppSrc\query.nui)
72472>>>>>>>>>// Use Query.nui    // Basic things needed for a query tool
72472>>>>>>>>>
72472>>>>>>>>>Use DataScan.utl // Data scan classes
72472>>>>>>>>>use QueryLng.pkg // Language dependant constants
Including file: querylng.pkg    (C:\projects\BRS\VDFQuery\AppSrc\querylng.pkg)
72472>>>>>>>>>>> define t.DfQuery.DFQuery          for "Database query"
72472>>>>>>>>>>> define t.DfQuery.EQ               for "Equal to"
72472>>>>>>>>>>> define t.DfQuery.LT               for "Less than"
72472>>>>>>>>>>> define t.DfQuery.LE               for "Less than or equal"
72472>>>>>>>>>>> define t.DfQuery.GE               for "Greater than or equal"
72472>>>>>>>>>>> define t.DfQuery.GT               for "Greater than"
72472>>>>>>>>>>> define t.DfQuery.NE               for "Not equal to"
72472>>>>>>>>>>> define t.DfQuery.IN               for "String includes"
72472>>>>>>>>>>> define t.DfQuery.CIN              for "String does not include"
72472>>>>>>>>>>> define t.DfQuery.BT               for "Between"
72472>>>>>>>>>>> define t.DfQuery.CBT              for "Outside interval"
72472>>>>>>>>>>> define t.DfQuery.NB               for "Not blank"
72472>>>>>>>>>>> define t.DfQuery.B                for "Blank"
72472>>>>>>>>>>> define t.DfQuery.OrL              for "In list" // or-list
72472>>>>>>>>>>> define t.DfQuery.SetDefaultValue  for "Set Default Value"
72472>>>>>>>>>>> define t.DfQuery.QueryDefinition  for "Query Definition"
72472>>>>>>>>>>> define t.DfQuery.None             for "None"
72472>>>>>>>>>>> define t.DfQuery.Run              for "&Run"
72472>>>>>>>>>>> define t.DfQuery.LblIncludeCrit   for "Include selection criteria in printed report"
72472>>>>>>>>>>> define t.DfQuery.LblDisplayLocked for "Display locked selections"
72472>>>>>>>>>>> define t.DfQuery.LblPrintTotals   for "Print totals only"
72472>>>>>>>>>>> define t.DfQuery.LblLandscape     for "Landscape"
72472>>>>>>>>>>> define t.DfQuery.LblTab1          for "Fields"
72472>>>>>>>>>>> define t.DfQuery.LblTab2          for "Selection"
72472>>>>>>>>>>> define t.DfQuery.LblTab3          for "Ordering"
72472>>>>>>>>>>> define t.DfQuery.LblTab5          for "Output"
72472>>>>>>>>>>> define t.DfQuery.LblFont          for "Font:"
72472>>>>>>>>>>> define t.DfQuery.LblPrintOrder    for "Ordering:"
72472>>>>>>>>>>> define t.DfQuery.LblSearchOrder   for "Search order:"
72472>>>>>>>>>>> define t.DfQuery.LblInsertField   for "Insert"
72472>>>>>>>>>>> define t.DfQuery.LblAddField      for "Add"
72472>>>>>>>>>>> define t.DfQuery.LblDeleteField   for "Delete"
72472>>>>>>>>>>> define t.DfQuery.LblDefaultValue  for "Default value"
72472>>>>>>>>>>> define t.DfQuery.LblAdjustBelow   for "Ad&just below"
72472>>>>>>>>>>> define t.DfQuery.LblGrpPrnt       for "Printed fields"
72472>>>>>>>>>>> define t.DfQuery.LblGrdPrnt0      for "Field name"
72472>>>>>>>>>>> define t.DfQuery.LblGrdPrnt1      for "Sum"
72472>>>>>>>>>>> define t.DfQuery.LblGrdPrnt2      for "Cr"
72472>>>>>>>>>>> define t.DfQuery.LblGrdPrnt3      for "Start"
72472>>>>>>>>>>> define t.DfQuery.LblGrdPrnt4      for "Width"
72472>>>>>>>>>>> define t.DfQuery.SthGrdPrnt0      for "Name of the field as it will appear in the printed report"
72472>>>>>>>>>>> define t.DfQuery.SthGrdPrnt1      for "Check this if you want a total for this column"
72472>>>>>>>>>>> define t.DfQuery.SthGrdPrnt2      for "Check this if report should start a new line before printing this field"
72472>>>>>>>>>>> define t.DfQuery.SthGrdPrnt3      for "Printing position for the current field (column) in centimeters"
72472>>>>>>>>>>> define t.DfQuery.SthGrdPrnt4      for "Width of the current field (column) in centimeters"
72472>>>>>>>>>>> define t.DfQuery.LblGrpCrit       for "Selections"
72472>>>>>>>>>>> define t.DfQuery.LblGrdCrit0      for "Field name"
72472>>>>>>>>>>> define t.DfQuery.LblGrdCrit1      for "Type"
72472>>>>>>>>>>> define t.DfQuery.LblGrdCrit2      for "Value"
72472>>>>>>>>>>> define t.DfQuery.SthGrdCrit0      for "Name of the field as it will appear in the selection form"
72472>>>>>>>>>>> define t.DfQuery.SthGrdCrit1      for "Specifies the type of selection (press F4 to change)"
72472>>>>>>>>>>> define t.DfQuery.SthGrdCrit2      for "Current value of the criteria. Press F4 to change"
72472>>>>>>>>>>> define t.DfQuery.DBMSfiles        for "Table"
72472>>>>>>>>>>> define t.DfQuery.DBMSfields       for "Fields"
72472>>>>>>>>>>> define t.DfQuery.QueryTitle       for "Query Title:"
72472>>>>>>>>>>> define t.DfQuery.MainFile         for "Main File:"
72472>>>>>>>>>>> define t.DfQuery.Operators        for "Selection Operators"
72472>>>>>>>>>>> define t.DfQuery.gt_or_eq         for "Greater than or equal: "
72472>>>>>>>>>>> define t.DfQuery.lt_or_eq         for "Less than or equal: "
72472>>>>>>>>>>> define t.DfQuery.no_limit         for "No limitation"
72472>>>>>>>>>>> define t.DfQuery.illegal_interval for "Illegal interval"
72472>>>>>>>>>>> define t.DfQuery.before           for "before: "
72472>>>>>>>>>>> define t.DfQuery.after            for "after: "
72472>>>>>>>>>>> define t.DfQuery.both_incl        for "(both incl)"
72472>>>>>>>>>>> define t.DfQuery.to               for "to"
72472>>>>>>>>>>> define t.DfQuery.ReportCancelled  for "*** The report was interrupted before completion ***"
72472>>>>>>>>>>> define t.DfQuery.Dest_Printer     for "Printer"
72472>>>>>>>>>>> define t.DfQuery.Dest_Preview     for "Preview"
72472>>>>>>>>>>> define t.DfQuery.Dest_File        for "File"
72472>>>>>>>>>>> define t.DfQuery.ReportDest       for "Report destination"
72472>>>>>>>>>>> define t.DfQuery.FileNameNotSpec  for "File name not specified"
72472>>>>>>>>>>> define t.DfQuery.SelectionCrit    for "Selection criteria:"
72472>>>>>>>>>>> define t.DfQuery.NoSelectionCrit  for "No selection criteria applied"
72472>>>>>>>>>>> define t.DfQuery.Filter1          for "Text files|*.txt|XML files|*.xml|All files|*.*"
72472>>>>>>>>>>> define t.DfQuery.Caption1         for "Print to file"
72472>>>>>>>>>>> define t.DfQuery.RightHeader      for ", , Page 
 of "
72472>>>>>>>>>>> define t.DfQuery.Page             for "Page:"
72472>>>>>>>>>>> define t.DfQuery.GenerationTime   for "Generated on:"
72472>>>>>>>>>>> define t.DfQuery.OpenFileCaption  for "Open query definition"
72472>>>>>>>>>>> define t.DfQuery.SaveFileCaption  for "Save query definition"
72472>>>>>>>>>>> define t.DfQuery.FileFilter       for "Query definition file (*.qdf)|*.qdf"
72472>>>>>>>>>>> define t.DfQuery.IncompDefFile    for "Incompatible report definition file."
72472>>>>>>>>>>> define t.DfQuery.FileFormatCD     for "Comma delimited"
72472>>>>>>>>>>> define t.DfQuery.FileFormatLD     for "Line delimited"
72472>>>>>>>>>>> define t.DfQuery.FileFormatPR     for "Formatted"
72472>>>>>>>>>>> define t.DfQuery.LblRecords       for "Records:"
72472>>>>>>>>>>> define t.DfQuery.tt.Open          for "Open query definition"
72472>>>>>>>>>>> define t.DfQuery.tt.AdvTableOpen  for "Table selector"
72472>>>>>>>>>>> define t.DfQuery.tt.Save          for "Save query definition"
72472>>>>>>>>>>> define t.DfQuery.tt.New           for "New query"
72472>>>>>>>>>>> define t.DfQuery.ReadingRecords   for "Reading records (#/#)"
72472>>>>>>>>>>> define t.DfQuery.LblGrdBreak1     for "Break"
72472>>>>>>>>>>> define t.DfQuery.LblGrdBreak2     for "Field name"
72472>>>>>>>>>>> define t.DfQuery.SthGrdBreak0     for "Should the report break on this field?"
72472>>>>>>>>>>> define t.DfQuery.SthGrdBreak1     for "The field will print under this name"
72472>>>>>>>>>>> define t.DfQuery.FileCompleted    for "File completed"
72472>>>>>>>>>>> define t.DfQuery.LogicalNames     for "Logical names"
72472>>>>>>>>>>> define t.DfQuery.UserNames        for "User names"
72472>>>>>>>>>>> define t.DfQuery.UseAnsi          for "Use ANSI characters"
72472>>>>>>>>>>> define t.DfQuery.InclNames        for "Include column names"
72472>>>>>>>>>>> define t.DfQuery.Semicolon        for "Semicolon as delimiter"
72472>>>>>>>>>>> define t.DfQuery.Texts            for "Texts"
72472>>>>>>>>>>> define t.DfQuery.TextBefore       for "Before report"
72472>>>>>>>>>>> define t.DfQuery.TextAfter        for "After report"
72472>>>>>>>>>>> define t.DfQuery.Expression       for "Expression"
72472>>>>>>>>>>> define t.DfQuery.ExprCritAdded    for "Expressional selection criteria added"
72472>>>>>>>>>>> define t.DfQuery.DisplayTblDef    for "Display table definition"
72472>>>>>>>>>>> define t.DfQuery.AddAllFields     for "Add all fields"
72472>>>>>>>>>>> define t.DfQuery.AddIndexFields   for "Add fields in index"
72472>>>>>>>>>>> define t.DfQuery.SelCritExpr      for "Selection criteria (expression)"
72472>>>>>>>>>>>
72472>>>>>>>>>Use FieldInf     // Global field info objects and abstract field types
72472>>>>>>>>>
72472>>>>>>>>>define DFQ.FORMAT.CD    for 1 // Comma delimited
72472>>>>>>>>>define DFQ.FORMAT.LD    for 2 // Line delimited
72472>>>>>>>>>define DFQ.FORMAT.PRINT for 3 // Printable
72472>>>>>>>>>define DFQ.FORMAT.HTML  for 4 // HTML
72472>>>>>>>>>define DFQ.FORMAT.XML   for 5 // XML
72472>>>>>>>>>
72472>>>>>>>>>define DFQ.DEST.PRINTER for 0 // The order of these are dictated by the
72472>>>>>>>>>define DFQ.DEST.SCREEN  for 1 // order of radio buttons in the destination
72472>>>>>>>>>define DFQ.DEST.FILE    for 2 // selector
72472>>>>>>>>>define DFQ.DEST.EMAIL   for 3 // selector
72472>>>>>>>>>
72472>>>>>>>>>integer Query$ExcludeAllRecnums
72472>>>>>>>>>move 0 to Query$ExcludeAllRecnums
72473>>>>>>>>>
72473>>>>>>>>>desktop_section // Place object on desktop no matter where declared
72478>>>>>>>>>  object oDfQuery_ExcludeFields is a cFieldInfoStuff NO_IMAGE
72480>>>>>>>>>  end_object
72481>>>>>>>>>end_desktop_section
72486>>>>>>>>>
72486>>>>>>>>>function DfQuery_ExcludeField global integer file# integer field# returns integer
72488>>>>>>>>>  if (not(field#) and Query$ExcludeAllRecnums) function_return 1
72491>>>>>>>>>  if file# if field# begin
72495>>>>>>>>>  end
72495>>>>>>>>>>
72495>>>>>>>>>  function_return (integer_value.ii(oDfQuery_ExcludeFields(self),file#,field#))
72496>>>>>>>>>end_function
72497>>>>>>>>>procedure set DfQuery_ExcludeField global integer file# integer field# integer value#
72499>>>>>>>>>  ifnot (file# or field#) move value# to Query$ExcludeAllRecnums
72502>>>>>>>>>  else set integer_value.ii of (oDfQuery_ExcludeFields(self)) file# field# to value#
72504>>>>>>>>>end_procedure
72505>>>>>>>>>
72505>>>>>>>>>desktop_section // Place object on desktop no matter where declared
72510>>>>>>>>>  object oDfQuery_ExcludeFiles is a cArray NO_IMAGE
72512>>>>>>>>>  end_object
72513>>>>>>>>>end_desktop_section
72518>>>>>>>>>
72518>>>>>>>>>enumeration_list
72518>>>>>>>>>  define DFQ_FALSE
72518>>>>>>>>>  define DFQ_TRUE
72518>>>>>>>>>  define DFQ_ALWAYS
72518>>>>>>>>>end_enumeration_list
72518>>>>>>>>>
72518>>>>>>>>>define VDFQ_FALSE  for DFQ_FALSE  // For backwards compatibility
72518>>>>>>>>>define VDFQ_TRUE   for DFQ_TRUE   //
72518>>>>>>>>>define VDFQ_ALWAYS for DFQ_ALWAYS //
72518>>>>>>>>>
72518>>>>>>>>>function DfQuery_ExcludeFile global integer file# returns integer
72520>>>>>>>>>  function_return (value(oDfQuery_ExcludeFiles(self),file#))
72521>>>>>>>>>end_function
72522>>>>>>>>>procedure set DfQuery_ExcludeFile global integer file# integer value#
72524>>>>>>>>>  set value of (oDfQuery_ExcludeFiles(self)) item file# to value#
72525>>>>>>>>>end_procedure
72526>>>>>>>>>
72526>>>>>>>>>function DfQuery_CompModeTxt_Short global integer comp# returns string
72528>>>>>>>>>  if comp# eq SC_COMP_EQ        function_return "="  //"EQ"
72531>>>>>>>>>  if comp# eq SC_COMP_LT        function_return "<"  //"LT"
72534>>>>>>>>>  if comp# eq SC_COMP_LE        function_return "<=" //"LE"
72537>>>>>>>>>  if comp# eq SC_COMP_GE        function_return ">=" //"GE"
72540>>>>>>>>>  if comp# eq SC_COMP_GT        function_return ">"  //"GT"
72543>>>>>>>>>  if comp# eq SC_COMP_NE        function_return "<>" //"NE"
72546>>>>>>>>>  if comp# eq SC_COMP_IN        function_return "IN"
72549>>>>>>>>>  if comp# eq SC_COMP_CIN       function_return "CIN"
72552>>>>>>>>>  if comp# eq SC_COMP_BETWEEN   function_return "x-y" //"BT"
72555>>>>>>>>>  if comp# eq SC_COMP_CBETWEEN  function_return "CBT"
72558>>>>>>>>>  if comp# eq SC_COMP_NOT_BLANK function_return '<>""'
72561>>>>>>>>>  if comp# eq SC_COMP_BLANK     function_return '=""'
72564>>>>>>>>>  if comp# eq SC_COMP_OR_LIST   function_return "in list"
72567>>>>>>>>>end_function
72568>>>>>>>>>
72568>>>>>>>>>function DfQuery_CompModeTxt_Long global integer comp# returns string
72570>>>>>>>>>  if comp# eq SC_COMP_EQ        function_return t.DfQuery.EQ
72573>>>>>>>>>  if comp# eq SC_COMP_LT        function_return t.DfQuery.LT
72576>>>>>>>>>  if comp# eq SC_COMP_LE        function_return t.DfQuery.LE
72579>>>>>>>>>  if comp# eq SC_COMP_GE        function_return t.DfQuery.GE
72582>>>>>>>>>  if comp# eq SC_COMP_GT        function_return t.DfQuery.GT
72585>>>>>>>>>  if comp# eq SC_COMP_NE        function_return t.DfQuery.NE
72588>>>>>>>>>  if comp# eq SC_COMP_IN        function_return t.DfQuery.IN
72591>>>>>>>>>  if comp# eq SC_COMP_CIN       function_return t.DfQuery.CIN
72594>>>>>>>>>  if comp# eq SC_COMP_BETWEEN   function_return t.DfQuery.BT
72597>>>>>>>>>  if comp# eq SC_COMP_CBETWEEN  function_return t.DfQuery.CBT
72600>>>>>>>>>  if comp# eq SC_COMP_NOT_BLANK function_return t.DfQuery.NB
72603>>>>>>>>>  if comp# eq SC_COMP_BLANK     function_return t.DfQuery.B
72606>>>>>>>>>  if comp# eq SC_COMP_OR_LIST   function_return t.DfQuery.OrL
72609>>>>>>>>>end_function
72610>>>>>>>>>
72610>>>>>>>>>function DfQuery_CritText integer type# integer comp# string str1# string str2# returns string
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
72612>>>>>>>>>  date date1# date2#
72612>>>>>>>>>  number num1# num2#
72612>>>>>>>>>  string rval#
72612>>>>>>>>>  if type# eq ASCII_WINDOW move SC_TYPE_ASCII to type#
72615>>>>>>>>>  else begin
72616>>>>>>>>>    if type# eq DATE_WINDOW move SC_TYPE_DATE to type#
72619>>>>>>>>>    else move SC_TYPE_NUMERIC to type#
72621>>>>>>>>>  end
72621>>>>>>>>>>
72621>>>>>>>>>
72621>>>>>>>>>  if comp# eq SC_COMP_OR_LIST function_return (replaces("|",str1#,"; ")) // or-list
72624>>>>>>>>>
72624>>>>>>>>>  if type# eq SC_TYPE_ASCII begin
72626>>>>>>>>>    if (comp#=SC_COMP_BETWEEN or comp#=SC_COMP_CBETWEEN) begin
72628>>>>>>>>>      if (str1#+str2#) ne "" begin
72630>>>>>>>>>        if str1# eq "" move (t.DfQuery.lt_or_eq+str2#) to rval#
72633>>>>>>>>>        else begin
72634>>>>>>>>>          if str2# eq "" move (t.DfQuery.gt_or_eq+str1#) to rval#
72637>>>>>>>>>          else begin
72638>>>>>>>>>            if str1# gt str2# move t.DfQuery.illegal_interval to rval#
72641>>>>>>>>>            else move ('"'+str1#+'"'+" - "+'"'+str2#+'"'+" "+t.DfQuery.both_incl) to rval#
72643>>>>>>>>>          end
72643>>>>>>>>>>
72643>>>>>>>>>        end
72643>>>>>>>>>>
72643>>>>>>>>>      end
72643>>>>>>>>>>
72643>>>>>>>>>      else move t.DfQuery.no_limit to rval#
72645>>>>>>>>>    end
72645>>>>>>>>>>
72645>>>>>>>>>    else move ('"'+str1#+'"') to rval# // EQ LT LE GE GT or NE
72647>>>>>>>>>  end
72647>>>>>>>>>>
72647>>>>>>>>>  if type# eq SC_TYPE_DATE begin
72649>>>>>>>>>    move str1# to date1#
72650>>>>>>>>>    if (comp#=SC_COMP_BETWEEN or comp#=SC_COMP_CBETWEEN) begin
72652>>>>>>>>>      move str2# to date2#
72653>>>>>>>>>      if (date1#+date2#) begin
72655>>>>>>>>>        ifnot date1# move (t.DfQuery.before+string(date2#)) to rval#
72658>>>>>>>>>        else begin
72659>>>>>>>>>          ifnot date2# move (t.DfQuery.after+string(date1#)) to rval#
72662>>>>>>>>>          else begin
72663>>>>>>>>>            if date1# gt date2# move t.DfQuery.illegal_interval to rval#
72666>>>>>>>>>            else move (string(date1#)+" - "+string(date2#)+" "+t.DfQuery.both_incl) to rval#
72668>>>>>>>>>          end
72668>>>>>>>>>>
72668>>>>>>>>>        end
72668>>>>>>>>>>
72668>>>>>>>>>      end
72668>>>>>>>>>>
72668>>>>>>>>>      else move t.DfQuery.no_limit to rval#
72670>>>>>>>>>    end
72670>>>>>>>>>>
72670>>>>>>>>>    else begin // EQ LT LE GE GT or NE
72671>>>>>>>>>      if date1# ne 0 move date1# to rval#
72674>>>>>>>>>      else move t.DfQuery.no_limit to rval#
72676>>>>>>>>>    end
72676>>>>>>>>>>
72676>>>>>>>>>  end
72676>>>>>>>>>>
72676>>>>>>>>>  if type# eq SC_TYPE_NUMERIC begin
72678>>>>>>>>>    move str1# to num1#
72679>>>>>>>>>    if (comp#=SC_COMP_BETWEEN or comp#=SC_COMP_CBETWEEN) begin
72681>>>>>>>>>      move str2# to num2#
72682>>>>>>>>>      if (num1#<>0 or num2#<>0) begin
72684>>>>>>>>>        if (num1#=0) move (t.DfQuery.lt_or_eq+string(num2#)) to rval#
72687>>>>>>>>>        else begin
72688>>>>>>>>>          if (num2#=0) move (t.DfQuery.gt_or_eq+string(num1#)) to rval#
72691>>>>>>>>>          else begin
72692>>>>>>>>>            if num1# gt num2# move t.DfQuery.illegal_interval to rval#
72695>>>>>>>>>            else move (string(num1#)+" - "+string(num2#)+" "+t.DfQuery.both_incl) to rval#
72697>>>>>>>>>          end
72697>>>>>>>>>>
72697>>>>>>>>>        end
72697>>>>>>>>>>
72697>>>>>>>>>      end
72697>>>>>>>>>>
72697>>>>>>>>>      else move t.DfQuery.no_limit to rval#
72699>>>>>>>>>    end
72699>>>>>>>>>>
72699>>>>>>>>>    else move num1# to rval#
72701>>>>>>>>>  end
72701>>>>>>>>>>
72701>>>>>>>>>  function_return rval#
72702>>>>>>>>>end_function
72703>>>>>>>>>
72703>>>>>>>>>// Also For backwards compatibility
72703>>>>>>>>>function VDFQuery_ExcludeFile global integer file# returns integer
72705>>>>>>>>>  function_return (VDFQuery_ExcludeFile(file#))
72706>>>>>>>>>end_function
72707>>>>>>>>>procedure set VDfQuery_ExcludeFile global integer file# integer value#
72709>>>>>>>>>  set DfQuery_ExcludeFile file# to value#
72710>>>>>>>>>end_procedure
72711>>>>>>>>>function VDFQuery_ExcludeField global integer file# integer field# returns integer
72713>>>>>>>>>  function_return (VDFQuery_ExcludeField(file#,field#))
72714>>>>>>>>>end_function
72715>>>>>>>>>procedure set VDfQuery_ExcludeField global integer file# integer field# integer value#
72717>>>>>>>>>  set DfQuery_ExcludeField file# field# to value#
72718>>>>>>>>>end_procedure
72719>>>>>>>>>
72719>>>>>>>>>
72719>>>>>>>Use FdxIndex.utl // Index analysing functions
72719>>>>>>>
72719>>>>>>> define t.QryOrder.Break      for "Break"
72719>>>>>>> define t.QryOrder.Segment    for "Segment"
72719>>>>>>> define t.QryOrder.Fields     for "Fields"
72719>>>>>>> define t.QryOrder.Caps       for "Caps"
72719>>>>>>> define t.QryOrder.Reverse    for "Reverse"
72719>>>>>>> define t.QryOrder.Specify    for "Specify ad hoc index"
72719>>>>>>>
72719>>>>>>>
72719>>>>>>>
72719>>>>>>>class cQueryOrderExpression is a cArray
72720>>>>>>>  procedure construct_object integer liImage
72722>>>>>>>    forward send construct_object liImage
72724>>>>>>>    property integer phExprArr public 0
72725>>>>>>>  end_procedure
72726>>>>>>>
72726>>>>>>>  item_property_list
72726>>>>>>>    item_property integer piFile.i
72726>>>>>>>    item_property integer piField.i
72726>>>>>>>    item_property integer piExprRow.i
72726>>>>>>>    item_property integer pbCapsLock.i
72726>>>>>>>    item_property integer pbReverse.i
72726>>>>>>>    item_property string  psValue.i
72726>>>>>>>
72726>>>>>>>    item_property integer pbBreak.i
72726>>>>>>>    item_property string  psLabel.i
72726>>>>>>>  end_item_property_list_extended cQueryOrderExpression
#REM 72850 DEFINE FUNCTION PSLABEL.I INTEGER LIROW RETURNS STRING
#REM 72854 DEFINE PROCEDURE SET PSLABEL.I INTEGER LIROW STRING VALUE
#REM 72858 DEFINE FUNCTION PBBREAK.I INTEGER LIROW RETURNS INTEGER
#REM 72862 DEFINE PROCEDURE SET PBBREAK.I INTEGER LIROW INTEGER VALUE
#REM 72866 DEFINE FUNCTION PSVALUE.I INTEGER LIROW RETURNS STRING
#REM 72870 DEFINE PROCEDURE SET PSVALUE.I INTEGER LIROW STRING VALUE
#REM 72874 DEFINE FUNCTION PBREVERSE.I INTEGER LIROW RETURNS INTEGER
#REM 72878 DEFINE PROCEDURE SET PBREVERSE.I INTEGER LIROW INTEGER VALUE
#REM 72882 DEFINE FUNCTION PBCAPSLOCK.I INTEGER LIROW RETURNS INTEGER
#REM 72886 DEFINE PROCEDURE SET PBCAPSLOCK.I INTEGER LIROW INTEGER VALUE
#REM 72890 DEFINE FUNCTION PIEXPRROW.I INTEGER LIROW RETURNS INTEGER
#REM 72894 DEFINE PROCEDURE SET PIEXPRROW.I INTEGER LIROW INTEGER VALUE
#REM 72898 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 72902 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 72906 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 72910 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
72915>>>>>>>
72915>>>>>>>  procedure DoCopyFromOtherObject integer lhObj
72917>>>>>>>    set phExprArr to (phExprArr(lhObj))
72918>>>>>>>    send Clone_Array lhObj self
72919>>>>>>>  end_procedure
72920>>>>>>>
72920>>>>>>>  procedure Add_Field integer liFile integer liField
72922>>>>>>>    integer liRow
72922>>>>>>>    get row_count to liRow
72923>>>>>>>    set piFile.i  liRow to liFile
72924>>>>>>>    set piField.i liRow to liField
72925>>>>>>>  end_procedure
72926>>>>>>>  procedure Add_Expr integer liExprRow
72928>>>>>>>    integer liRow
72928>>>>>>>    get row_count to liRow
72929>>>>>>>    set piExprRow.i liRow to liExprRow
72930>>>>>>>  end_procedure
72931>>>>>>>  procedure ReadValues // Of the record buffer
72933>>>>>>>    integer liRow liMax liFile liField liType liDec
72933>>>>>>>    integer lhExprArr liExprRow lbNegative
72933>>>>>>>    number lnValue
72933>>>>>>>    string lsRval lsValue
72933>>>>>>>    move "" to lsRval
72934>>>>>>>    get row_count to liMax
72935>>>>>>>    for liRow from 0 to (liMax-1)
72941>>>>>>>>
72941>>>>>>>      get piFile.i  liRow to liFile
72942>>>>>>>      if liFile begin
72944>>>>>>>        get piField.i liRow to liField
72945>>>>>>>        get FieldInf_FieldValue liFile liField to lsValue
72946>>>>>>>        get FieldInf_FieldType liFile liField to liType
72947>>>>>>>        if liType eq DF_DATE begin
72949>>>>>>>          move (integer(date(lsValue))) to lsValue
72950>>>>>>>          move (NumToStrR(lsValue,0,6)) to lsValue
72951>>>>>>>        end
72951>>>>>>>>
72951>>>>>>>        if liType eq DF_BCD begin
72953>>>>>>>          get FieldInf_DecPoints liFile liField to liDec
72954>>>>>>>          move lsValue to lnValue
72955>>>>>>>          move (lnValue<0) to lbNegative
72956>>>>>>>          if lbNegative move (abs(lnValue)) to lnValue
72959>>>>>>>          move (NumToStrR(lnValue,liDec,14)) to lsValue
72960>>>>>>>          ifnot lbNegative move ("+"+lsValue) to lsValue
72963>>>>>>>          else             move (" "+lsValue) to lsValue
72965>>>>>>>        end
72965>>>>>>>>
72965>>>>>>>      end
72965>>>>>>>>
72965>>>>>>>      else begin // Aha! Expression:
72966>>>>>>>        get phExprArr to lhExprArr
72967>>>>>>>        get piExprRow.i liRow to liExprRow
72968>>>>>>>        get sEvalExpression of (Query_ExprEvaluator(self)) (piExprId.i(lhExprArr,liExprRow)) to lsValue
72969>>>>>>>        get piType.i of lhExprArr liExprRow to liType
72970>>>>>>>
72970>>>>>>>        if liType eq DF_DATE begin
72972>>>>>>>          move (integer(date(lsValue))) to lsValue
72973>>>>>>>          move (NumToStrR(lsValue,0,6)) to lsValue
72974>>>>>>>        end
72974>>>>>>>>
72974>>>>>>>        if liType eq DF_BCD begin
72976>>>>>>>          get piWidth.i of lhExprArr liExprRow to liDec
72977>>>>>>>//        move (NumToStrR(lsValue,liDec,14)) to lsValue
72977>>>>>>>          move lsValue to lnValue
72978>>>>>>>          move (lnValue<0) to lbNegative
72979>>>>>>>          if lbNegative move (abs(lnValue)) to lnValue
72982>>>>>>>          move (NumToStrR(lnValue,liDec,14)) to lsValue
72983>>>>>>>          ifnot lbNegative move ("+"+lsValue) to lsValue
72986>>>>>>>          else             move (" "+lsValue) to lsValue
72988>>>>>>>        end
72988>>>>>>>>
72988>>>>>>>      end
72988>>>>>>>>
72988>>>>>>>      set psValue.i liRow to lsValue
72989>>>>>>>    loop
72990>>>>>>>>
72990>>>>>>>  end_procedure
72991>>>>>>>  function sReverseValue.s string lsValue returns string
72993>>>>>>>    integer liPos liLen
72993>>>>>>>    string lsRval lsChar
72993>>>>>>>    move (length(lsValue)) to liLen
72994>>>>>>>    move "" to lsRval
72995>>>>>>>    for liPos from 1 to liLen
73001>>>>>>>>
73001>>>>>>>      move (mid(lsValue,1,liPos)) to lsChar
73002>>>>>>>      move (lsRval+mid(gs$ReversedCollateString,1,ascii(lsChar))) to lsRval
73003>>>>>>>    loop
73004>>>>>>>>
73004>>>>>>>    function_return lsRval
73005>>>>>>>  end_function
73006>>>>>>>  function sIndexValue returns string
73008>>>>>>>    integer liRow liMax liLen liPos liChar
73008>>>>>>>    string lsValue lsSegmentValue lsgr
73008>>>>>>>    move "" to lsValue
73009>>>>>>>    get row_count to liMax
73010>>>>>>>    decrement liMax
73011>>>>>>>    for liRow from 0 to liMax
73017>>>>>>>>
73017>>>>>>>      get psValue.i liRow to lsSegmentValue
73018>>>>>>>      if (pbCapsLock.i(self,liRow)) move (uppercase(lsSegmentValue)) to lsSegmentValue
73021>>>>>>>      if (pbReverse.i(self,liRow)) get sReverseValue.s lsSegmentValue to lsSegmentValue
73024>>>>>>>      move (lsValue+lsSegmentValue) to lsValue
73025>>>>>>>      if liRow ne liMax move (lsValue+" ") to lsValue
73028>>>>>>>    loop
73029>>>>>>>>
73029>>>>>>>    function_return lsValue
73030>>>>>>>  end_function
73031>>>>>>>  function sSegmentName integer liRow returns string
73033>>>>>>>    integer liFile liField lhExprArr liExprRow
73033>>>>>>>    string lsRval
73033>>>>>>>
73033>>>>>>>    get piFile.i liRow to liFile
73034>>>>>>>    if liFile begin
73036>>>>>>>      get piField.i liRow to liField
73037>>>>>>>      get FieldInf_FieldLabel_Long liFile liField to lsRval
73038>>>>>>>    end
73038>>>>>>>>
73038>>>>>>>    else begin
73039>>>>>>>      get phExprArr to lhExprArr
73040>>>>>>>      get piExprRow.i liRow to liExprRow
73041>>>>>>>      get psLabel.i of lhExprArr liExprRow to lsRval
73042>>>>>>>    end
73042>>>>>>>>
73042>>>>>>>    function_return lsRval
73043>>>>>>>  end_function
73044>>>>>>>  function sIndexNames returns string
73046>>>>>>>    integer liRow liMax
73046>>>>>>>    string lsRval
73046>>>>>>>    move "" to lsRval
73047>>>>>>>    get row_count to liMax
73048>>>>>>>    decrement liMax
73049>>>>>>>    for liRow from 0 to liMax
73055>>>>>>>>
73055>>>>>>>      move (lsRval*sSegmentName(self,liRow)) to lsRval
73056>>>>>>>      if liRow ne liMax move (lsRval+",") to lsRval
73059>>>>>>>    loop
73060>>>>>>>>
73060>>>>>>>    function_return lsRval
73061>>>>>>>  end_procedure
73062>>>>>>>
73062>>>>>>>  procedure SEQ_Read integer liChannel
73064>>>>>>>    integer liMax liRow
73064>>>>>>>    readln channel liChannel liMax
73066>>>>>>>    for liRow from 0 to liMax
73072>>>>>>>>
73072>>>>>>>      set piFile.i     liRow to (SEQ_ReadLn(liChannel))
73073>>>>>>>      set piField.i    liRow to (SEQ_ReadLn(liChannel))
73074>>>>>>>      set piExprRow.i  liRow to (SEQ_ReadLn(liChannel))
73075>>>>>>>      set pbCapsLock.i liRow to (SEQ_ReadLn(liChannel))
73076>>>>>>>      set pbReverse.i  liRow to (SEQ_ReadLn(liChannel))
73077>>>>>>>    loop
73078>>>>>>>>
73078>>>>>>>  end_procedure
73079>>>>>>>
73079>>>>>>>  procedure SEQ_Write integer liChannel
73081>>>>>>>    integer liMax liRow
73081>>>>>>>    get row_count to liMax
73082>>>>>>>    decrement liMax
73083>>>>>>>    writeln channel liChannel liMax
73086>>>>>>>    for liRow from 0 to liMax
73092>>>>>>>>
73092>>>>>>>      writeln (piFile.i(self,liRow))
73094>>>>>>>      writeln (piField.i(self,liRow))
73096>>>>>>>      writeln (piExprRow.i(self,liRow))
73098>>>>>>>      writeln (pbCapsLock.i(self,liRow))
73100>>>>>>>      writeln (pbReverse.i(self,liRow))
73102>>>>>>>    loop
73103>>>>>>>>
73103>>>>>>>  end_procedure
73104>>>>>>>  procedure MarkUsedExpressions
73106>>>>>>>    integer liRow liMax lhExprArr
73106>>>>>>>    get phExprArr to lhExprArr
73107>>>>>>>    get row_count to liMax
73108>>>>>>>    decrement liMax
73109>>>>>>>    for liRow from 0 to liMax
73115>>>>>>>>
73115>>>>>>>      ifnot (piFile.i(self,liRow)) send CleanUp_MarkAsUsed to lhExprArr (piExprRow.i(self,liRow))
73118>>>>>>>    loop
73119>>>>>>>>
73119>>>>>>>  end_procedure
73120>>>>>>>
73120>>>>>>>  procedure GetNewExpressionIDs
73122>>>>>>>    integer liRow liMax lhExprArr liExprRow
73122>>>>>>>    get phExprArr to lhExprArr
73123>>>>>>>    get row_count to liMax
73124>>>>>>>    decrement liMax
73125>>>>>>>    for liRow from 0 to liMax
73131>>>>>>>>
73131>>>>>>>      ifnot (piFile.i(self,liRow)) begin
73133>>>>>>>        get piExprRow.i liRow to liExprRow
73134>>>>>>>        get pbCleanupNewRow.i of lhExprArr liExprRow to liExprRow
73135>>>>>>>        set piExprRow.i liRow to liExprRow
73136>>>>>>>      end
73136>>>>>>>>
73136>>>>>>>    loop
73137>>>>>>>>
73137>>>>>>>  end_procedure
73138>>>>>>>end_class // cQueryOrderExpression
73139>>>>>>>
73139>>>>>>>
73139>>>>>>>use aps
73139>>>>>>>class cFieldInf.IndexBreakList is a aps.list
73140>>>>>>>  procedure construct_object integer liImage
73142>>>>>>>    forward send construct_object liImage
73144>>>>>>>    property integer pbDisplayFileNamesUser public DFTRUE
73145>>>>>>>    send GridPrepare_AddColumn t.QryOrder.Break   AFT_ASCII4
73146>>>>>>>    send GridPrepare_AddColumn t.QryOrder.Segment AFT_ASCII25
73147>>>>>>>    send GridPrepare_Apply self
73148>>>>>>>    set select_mode to NO_SELECT
73149>>>>>>>    on_key KNEXT_ITEM send switch
73150>>>>>>>    on_key KPREVIOUS_ITEM send switch_back
73151>>>>>>>    property integer phServer public 0 // of class cQueryOrderExpression
73152>>>>>>>    set select_mode to MULTI_SELECT
73153>>>>>>>  end_procedure
73154>>>>>>>
73154>>>>>>>  procedure select_toggling integer liItem integer i#
73156>>>>>>>    integer liColumn
73156>>>>>>>    get Grid_ItemColumn self liItem to liColumn
73157>>>>>>>    if (liColumn=0) forward send select_toggling liItem i#
73161>>>>>>>  end_procedure
73162>>>>>>>
73162>>>>>>>  procedure fill_list.iii integer liFile integer liIndex integer lhOrderExpression
73164>>>>>>>    integer liMax liSegment liField liBase lhObj liRow
73164>>>>>>>    set dynamic_update_state to DFFALSE
73165>>>>>>>    send delete_data
73166>>>>>>>    if liFile begin
73168>>>>>>>      if (liIndex<256) begin // Normal index
73170>>>>>>>        get FDX_AttrValue_INDEX 0 DF_INDEX_NUMBER_SEGMENTS liFile liIndex to liMax
73171>>>>>>>        if liMax begin
73173>>>>>>>          for liSegment from 1 to (liMax-1) // Exclude the least significant segment
73179>>>>>>>>
73179>>>>>>>            get FDX_AttrValue_IDXSEG 0 DF_INDEX_SEGMENT_FIELD liFile liIndex liSegment to liField
73180>>>>>>>            get item_count to liBase
73181>>>>>>>            send add_item MSG_NONE ""
73182>>>>>>>            set aux_value item liBase to (liFile*65536+liField)
73183>>>>>>>            set checkbox_item_state item liBase to DFTRUE
73184>>>>>>>            send add_item MSG_NONE (FieldInf_FieldLabel_Long(liFile,liField)+": ")
73185>>>>>>>            set entry_state item (liBase+1) to DFTRUE
73186>>>>>>>          loop
73187>>>>>>>>
73187>>>>>>>        end
73187>>>>>>>>
73187>>>>>>>      end
73187>>>>>>>>
73187>>>>>>>      else begin
73188>>>>>>>        if (liIndex=1023) begin // Ad hoc
73190>>>>>>>          move lhOrderExpression to lhObj
73191>>>>>>>          get row_count of lhObj to liMax
73192>>>>>>>          for liSegment from 0 to (liMax-1) // Exclude the least significant segment
73198>>>>>>>>
73198>>>>>>>            get piFile.i  of lhObj liSegment to liFile
73199>>>>>>>            get piField.i of lhObj liSegment to liField
73200>>>>>>>            get item_count to liBase
73201>>>>>>>            send add_item MSG_NONE ""
73202>>>>>>>            set aux_value item liBase to (liFile*65536+liField)
73203>>>>>>>            set checkbox_item_state item liBase to DFTRUE
73204>>>>>>>            send add_item MSG_NONE (sSegmentName(lhObj,liSegment)+": ")
73205>>>>>>>            set aux_value item (liBase+1) to (piExprRow.i(lhObj,liSegment))
73206>>>>>>>            set entry_state item (liBase+1) to DFTRUE
73207>>>>>>>          loop
73208>>>>>>>>
73208>>>>>>>        end
73208>>>>>>>>
73208>>>>>>>        else begin // Virtual Index
73209>>>>>>>          move (liIndex-256) to liIndex
73210>>>>>>>          get FieldInf_VirtualIndex_Object liFile liIndex to lhObj
73211>>>>>>>          if lhObj begin
73213>>>>>>>            get row_count of lhObj to liMax
73214>>>>>>>            for liSegment from 0 to (liMax-2) // Exclude the least significant segment
73220>>>>>>>>
73220>>>>>>>              get piField.i of lhObj liSegment to liField
73221>>>>>>>              get item_count to liBase
73222>>>>>>>              send add_item MSG_NONE ""
73223>>>>>>>              set aux_value item liBase to (liFile*65536+liField)
73224>>>>>>>              set checkbox_item_state item liBase to DFTRUE
73225>>>>>>>              send add_item MSG_NONE (sSegmentName(lhObj,liSegment)+": ")
73226>>>>>>>            set entry_state item (liBase+1) to DFTRUE
73227>>>>>>>            loop
73228>>>>>>>>
73228>>>>>>>          end
73228>>>>>>>>
73228>>>>>>>        end
73228>>>>>>>>
73228>>>>>>>      end
73228>>>>>>>>
73228>>>>>>>    end
73228>>>>>>>>
73228>>>>>>>    set dynamic_update_state to DFTRUE
73229>>>>>>>  end_procedure
73230>>>>>>>
73230>>>>>>>end_class // cFieldInf.IndexBreak_List
73231>>>>>>>
73231>>>>>>>Use Buttons.utl  // Button texts
73231>>>>>>>Use GridUtil.utl
73231>>>>>>>
73231>>>>>>>use APS          // Auto Positioning and Sizing classes for VDF
73231>>>>>>>class cQueryOrderingGrid is a aps.Grid
73232>>>>>>>  procedure construct_object integer liImage
73234>>>>>>>    forward send construct_object liImage
73236>>>>>>>    send GridPrepare_AddColumn "#"       AFT_ASCII2
73237>>>>>>>    send GridPrepare_AddColumn t.QryOrder.Fields  AFT_ASCII20
73238>>>>>>>    send GridPrepare_AddColumn t.QryOrder.Caps    AFT_ASCII3
73239>>>>>>>    send GridPrepare_AddColumn t.QryOrder.Reverse AFT_ASCII3
73240>>>>>>>    send GridPrepare_Apply self
73241>>>>>>>    on_key KNEXT_ITEM send switch
73242>>>>>>>    on_key KPREVIOUS_ITEM send switch_back
73243>>>>>>>    property integer phServer public 0 // of class cQueryOrderExpression
73244>>>>>>>    set select_mode to MULTI_SELECT
73245>>>>>>>    on_key key_ctrl+key_up_arrow   send MoveRowUp
73246>>>>>>>    on_key key_ctrl+key_down_arrow send MoveRowDown
73247>>>>>>>    on_key kDelete_Record send DeleteRow
73248>>>>>>>  end_procedure
73249>>>>>>>  procedure select_toggling integer liItem integer i#
73251>>>>>>>    integer liColumn
73251>>>>>>>    get Grid_ItemColumn self liItem to liColumn
73252>>>>>>>    if (liColumn=2 or liColumn=3) forward send select_toggling liItem i#
73256>>>>>>>  end_procedure
73257>>>>>>>  procedure fill_list
73259>>>>>>>    integer lhServer liRow liMax liBase
73259>>>>>>>    get phServer to lhServer
73260>>>>>>>    set dynamic_update_state to DFFALSE
73261>>>>>>>    send delete_data
73262>>>>>>>    get row_count of lhServer to liMax
73263>>>>>>>    decrement liMax
73264>>>>>>>    for liRow from 0 to liMax
73270>>>>>>>>
73270>>>>>>>      get item_count to liBase
73271>>>>>>>      send add_item MSG_NONE (liRow+1)
73272>>>>>>>      send add_item MSG_NONE (sSegmentName(lhServer,liRow))
73273>>>>>>>      send add_item MSG_NONE ""
73274>>>>>>>      set checkbox_item_state item (liBase+2) to DFTRUE
73275>>>>>>>      set select_state item (liBase+2) to (pbCapsLock.i(lhServer,liRow))
73276>>>>>>>      send add_item MSG_NONE ""
73277>>>>>>>      set checkbox_item_state item (liBase+3) to DFTRUE
73278>>>>>>>      set select_state item (liBase+3) to (pbReverse.i(lhServer,liRow))
73279>>>>>>>    loop
73280>>>>>>>>
73280>>>>>>>    send Grid_SetEntryState self DFFALSE
73281>>>>>>>    set dynamic_update_state to DFTRUE
73282>>>>>>>  end_procedure
73283>>>>>>>  procedure RowFromGridToArray integer liRow integer liBase
73285>>>>>>>    integer lhServer
73285>>>>>>>    get phServer to lhServer
73286>>>>>>>    set pbCapsLock.i of lhServer liRow to (select_state(self,liBase+2))
73287>>>>>>>    set pbReverse.i  of lhServer liRow to (select_state(self,liBase+3))
73288>>>>>>>  end_procedure
73289>>>>>>>  procedure DoAddField integer liFile integer liField
73291>>>>>>>    integer liRow
73291>>>>>>>    get Grid_CurrentRow self to liRow
73292>>>>>>>    send MoveGridToArray
73293>>>>>>>    send Add_Field to (phServer(self)) liFile liField
73294>>>>>>>    send fill_list
73295>>>>>>>    set Grid_CurrentRow self to liRow
73296>>>>>>>  end_procedure
73297>>>>>>>  procedure MoveGridToArray
73299>>>>>>>    integer liMax liRow lhServer liBase
73299>>>>>>>    get phServer to lhServer
73300>>>>>>>    get row_count of lhServer to liMax
73301>>>>>>>    decrement liMax
73302>>>>>>>    for liRow from 0 to liMax
73308>>>>>>>>
73308>>>>>>>      get Grid_RowBaseItem self liRow to liBase
73309>>>>>>>      send RowFromGridToArray liRow liBase
73310>>>>>>>    loop
73311>>>>>>>>
73311>>>>>>>  end_procedure
73312>>>>>>>  procedure DeleteRow
73314>>>>>>>    integer liRow lhServer liMax
73314>>>>>>>    get phServer to lhServer
73315>>>>>>>    if (item_count(self)) begin
73317>>>>>>>      get Grid_CurrentRow self to liRow
73318>>>>>>>      send MoveGridToArray
73319>>>>>>>      send delete_row to lhServer liRow
73320>>>>>>>      send fill_list
73321>>>>>>>      get row_count of lhServer to liMax
73322>>>>>>>      if liMax begin
73324>>>>>>>        if (liRow>>>>>>        else set Grid_CurrentRow self to (liRow-1)
73329>>>>>>>      end
73329>>>>>>>>
73329>>>>>>>    end
73329>>>>>>>>
73329>>>>>>>  end_procedure
73330>>>>>>>  procedure MoveRowUp
73332>>>>>>>    integer liRow lhServer
73332>>>>>>>    get phServer to lhServer
73333>>>>>>>    if (item_count(self)) begin
73335>>>>>>>      get Grid_CurrentRow self to liRow
73336>>>>>>>      if (liRow>0) begin
73338>>>>>>>        send MoveGridToArray
73339>>>>>>>        send swap_rows to lhServer liRow (liRow-1)
73340>>>>>>>        send fill_list
73341>>>>>>>        set Grid_CurrentRow self to (liRow-1)
73342>>>>>>>      end
73342>>>>>>>>
73342>>>>>>>    end
73342>>>>>>>>
73342>>>>>>>  end_procedure
73343>>>>>>>
73343>>>>>>>  procedure MoveRowDown
73345>>>>>>>    integer liRow lhServer
73345>>>>>>>    get phServer to lhServer
73346>>>>>>>    if (item_count(self)) begin
73348>>>>>>>      get Grid_CurrentRow self to liRow
73349>>>>>>>      if (liRow<(row_count(lhServer)-1)) begin
73351>>>>>>>        send MoveGridToArray
73352>>>>>>>        send swap_rows to lhServer liRow (liRow+1)
73353>>>>>>>        send fill_list
73354>>>>>>>        set Grid_CurrentRow self to (liRow+1)
73355>>>>>>>      end
73355>>>>>>>>
73355>>>>>>>    end
73355>>>>>>>>
73355>>>>>>>  end_procedure
73356>>>>>>>end_class // cQueryOrderingGrid
73357>>>>>>>
73357>>>>>>>
73357>>>>>>>use aps
73357>>>>>>>class cFieldInf.IndexSelectList is a aps.list
73358>>>>>>>  procedure construct_object integer liImage
73360>>>>>>>    forward send construct_object liImage
73362>>>>>>>    set highlight_row_state to DFTRUE
73363>>>>>>>    property integer piFile public 0
73364>>>>>>>  end_procedure
73365>>>>>>>  procedure AddIndex integer liFile integer liIndex string lsIndexDef integer liType
73367>>>>>>>    send add_item MSG_NONE (string(liIndex)+": "+FDX_IndexAsFieldNames(0,liFile,liIndex,0))
73368>>>>>>>    set aux_value item (item_count(self)-1) to liIndex
73369>>>>>>>  end_procedure
73370>>>>>>>  procedure AddBatchIndex integer liFile integer liIndex string lsIndexDef integer liType
73372>>>>>>>    send add_item MSG_NONE (string(liIndex)+": "+FDX_IndexAsFieldNames(0,liFile,liIndex,0))
73373>>>>>>>    set aux_value item (item_count(self)-1) to liIndex
73374>>>>>>>  end_procedure
73375>>>>>>>  procedure SetSelectedIndex integer liIndex
73377>>>>>>>    integer liMax liItem
73377>>>>>>>    get item_count to liMax
73378>>>>>>>    decrement liMax
73379>>>>>>>    for liItem from 0 to liMax
73385>>>>>>>>
73385>>>>>>>      if (liIndex=aux_value(self,liItem)) set current_item to liItem
73388>>>>>>>    loop
73389>>>>>>>>
73389>>>>>>>  end_procedure
73390>>>>>>>  procedure fill_list.iii integer liFile integer liIndex integer lbGenericIndicesOnly
73392>>>>>>>    integer lhObj liMax
73392>>>>>>>    set dynamic_update_state to DFFALSE
73393>>>>>>>    send delete_data
73394>>>>>>>    set piFile to liFile
73395>>>>>>>    if liFile begin
73397>>>>>>>      send add_item MSG_NONE "0: Recnum"
73398>>>>>>>      send FDX_IndexCallback 0 liFile DF_INDEX_TYPE_ONLINE MSG_AddIndex self
73399>>>>>>>      send FDX_IndexCallback 0 liFile DF_INDEX_TYPE_BATCH MSG_AddBatchIndex self
73400>>>>>>>      ifnot lbGenericIndicesOnly begin
73402>>>>>>>        send add_item MSG_NONE "Ad hoc"
73403>>>>>>>        set aux_value item (item_count(self)-1) to 1023
73404>>>>>>>
73404>>>>>>>        get FieldInf_VirtualIndices_Object liFile to lhObj
73405>>>>>>>        if lhObj begin
73407>>>>>>>          get row_count of lhObj to liMax
73408>>>>>>>          decrement liMax
73409>>>>>>>          for liIndex from 0 to liMax
73415>>>>>>>>
73415>>>>>>>            send add_item MSG_NONE (psIndexName.i(lhObj,liIndex))
73416>>>>>>>            set aux_value item (item_count(self)-1) to (liIndex+256)
73417>>>>>>>          loop
73418>>>>>>>>
73418>>>>>>>        end
73418>>>>>>>>
73418>>>>>>>
73418>>>>>>>      end
73418>>>>>>>>
73418>>>>>>>      send SetSelectedIndex liIndex
73419>>>>>>>    end
73419>>>>>>>>
73419>>>>>>>    set dynamic_update_state to DFTRUE
73420>>>>>>>  end_procedure
73421>>>>>>>end_class // cFieldInf.IndexSelectList
73422>>>>>>>
73422>>>>>>>///////////////////////////////////////////////////////////////////////////
73422>>>>>>>
73422>>>>>>>
73422>>>>>>>Use QryFldSl.pkg // cFieldInf.Table_List and cFieldInf.Field_List classes
Including file: qryfldsl.pkg    (C:\projects\BRS\VDFQuery\AppSrc\qryfldsl.pkg)
73422>>>>>>>>>// Use QryFldSl.pkg // cFieldInf.Table_List and cFieldInf.Field_List classes
73422>>>>>>>>>
73422>>>>>>>>>Use FieldInf     // Global field info objects and abstract field types
73422>>>>>>>>>Use Fdx2.utl     // FDX aware object for displaying a table definition
73422>>>>>>>>>
73422>>>>>>>>>use aps
73422>>>>>>>>>class cFieldInf.Table_List is a aps.List
73423>>>>>>>>>  procedure construct_object integer liImage
73425>>>>>>>>>    forward send construct_object liImage
73427>>>>>>>>>    property integer pbDisplayFileNamesUser public DFTRUE
73428>>>>>>>>>    on_key KEY_CTRL+KEY_D send DisplayDefinition
73429>>>>>>>>>    on_key kuser send toggle_display
73430>>>>>>>>>    on_key kenter send Next
73431>>>>>>>>>    on_key KSWITCH send switch
73432>>>>>>>>>    on_key KSWITCH_BACK send switch_back
73433>>>>>>>>>    object oSet is a set NO_IMAGE
73435>>>>>>>>>    end_object
73436>>>>>>>>>  end_procedure
73437>>>>>>>>>
73437>>>>>>>>>  procedure GoToFile integer liFile
73439>>>>>>>>>    integer liMax liItm
73439>>>>>>>>>    get item_count to liMax
73440>>>>>>>>>    decrement liMax
73441>>>>>>>>>    for liItm from 0 to liMax
73447>>>>>>>>>>
73447>>>>>>>>>      if (aux_value(self,liItm)=liFile) set current_item to liItm
73450>>>>>>>>>    loop
73451>>>>>>>>>>
73451>>>>>>>>>  end_procedure
73452>>>>>>>>>               procedure DisplayDefinition
73454>>>>>>>>>                 integer liFile
73454>>>>>>>>>                 if (item_count(self)) begin
73456>>>>>>>>>                   get aux_value item CURRENT to liFile
73457>>>>>>>>>                   send FDX_ModalDisplayFileAttributes 0 liFile
73458>>>>>>>>>                 end
73458>>>>>>>>>>
73458>>>>>>>>>               end_procedure
73459>>>>>>>>>               procedure toggle_display
73461>>>>>>>>>                 set pbDisplayFileNamesUser to (not(pbDisplayFileNamesUser(self)))
73462>>>>>>>>>                 send InsertFileNames
73463>>>>>>>>>               end_procedure
73464>>>>>>>>>               procedure InsertFileNames
73466>>>>>>>>>                 integer liType
73466>>>>>>>>>                 integer liItem liMax liFile
73466>>>>>>>>>                 string lsValue
73466>>>>>>>>>                 get pbDisplayFileNamesUser to liType
73467>>>>>>>>>                 get item_count to liMax
73468>>>>>>>>>                 for liItem from 0 to (liMax-1)
73474>>>>>>>>>>
73474>>>>>>>>>                   get aux_value item liItem to liFile
73475>>>>>>>>>                   if liType get File_Display_Name liFile to lsValue
73478>>>>>>>>>                   else get_attribute DF_FILE_LOGICAL_NAME of liFile to lsValue
73482>>>>>>>>>                   set value item liItem to lsValue
73483>>>>>>>>>                 loop
73484>>>>>>>>>>
73484>>>>>>>>>                 set dynamic_update_state to DFTRUE
73485>>>>>>>>>               end_procedure
73486>>>>>>>>>               procedure FileNamesLogical
73488>>>>>>>>>                 set pbDisplayFileNamesUser to DFFALSE
73489>>>>>>>>>                 send InsertFileNames
73490>>>>>>>>>               end_procedure
73491>>>>>>>>>               procedure FileNamesUser
73493>>>>>>>>>                 set pbDisplayFileNamesUser to DFTRUE
73494>>>>>>>>>                 send InsertFileNames
73495>>>>>>>>>               end_procedure
73496>>>>>>>>>
73496>>>>>>>>>  function bIncludeFile integer liFile returns integer
73498>>>>>>>>>    // function_return (DfQuery_ExcludeFile(liFile)<>DFQ_ALWAYS)
73498>>>>>>>>>    function_return DFTRUE
73499>>>>>>>>>  end_function
73500>>>>>>>>>
73500>>>>>>>>>               procedure add_file integer liFile
73502>>>>>>>>>                 integer liField liMax liRelFile
73502>>>>>>>>>
73502>>>>>>>>>                 if (DBMS_OpenFile(liFile,DF_SHARE,0)) begin
73504>>>>>>>>>                   get_attribute DF_FILE_NUMBER_FIELDS of liFile to liMax
73507>>>>>>>>>
73507>>>>>>>>>                   if (find_element(oSet(self),liFile)=-1) begin
73509>>>>>>>>>                     send add_element to (oSet(self)) liFile
73510>>>>>>>>>                     send add_item msg_none ""
73511>>>>>>>>>                     set aux_value item (item_count(self)-1) to liFile
73512>>>>>>>>>
73512>>>>>>>>>                     for liField from 1 to liMax
73518>>>>>>>>>>
73518>>>>>>>>>                       get_attribute DF_FIELD_RELATED_FILE of liFile liField to liRelFile
73521>>>>>>>>>                       if (liRelFile and bIncludeFile(self,liFile)) send add_file liRelFile
73524>>>>>>>>>                     loop
73525>>>>>>>>>>
73525>>>>>>>>>                   end
73525>>>>>>>>>>
73525>>>>>>>>>                 end
73525>>>>>>>>>>
73525>>>>>>>>>                 else error 200 ("Related file could not be opened (entry: "+string(liFile)+")")
73527>>>>>>>>>               end_procedure
73528>>>>>>>>>
73528>>>>>>>>>  procedure fill_list.i integer liFile
73530>>>>>>>>>    send delete_data
73531>>>>>>>>>    send delete_data to (oSet(self))
73532>>>>>>>>>
73532>>>>>>>>>    if liFile send add_file liFile
73535>>>>>>>>>    send InsertFileNames
73536>>>>>>>>>    send OnNewFile liFile
73537>>>>>>>>>  end_procedure
73538>>>>>>>>>
73538>>>>>>>>>  procedure OnNewFile integer liFile
73540>>>>>>>>>    //send notify_filechange liFile
73540>>>>>>>>>  end_procedure
73541>>>>>>>>>
73541>>>>>>>>>  procedure OnChange
73543>>>>>>>>>    integer liFile
73543>>>>>>>>>    if (item_count(self)) begin
73545>>>>>>>>>      get aux_value item (current_item(self)) to liFile
73546>>>>>>>>>      send OnNewFile liFile
73547>>>>>>>>>    end
73547>>>>>>>>>>
73547>>>>>>>>>  end_procedure
73548>>>>>>>>>  function iCurrentFile returns integer
73550>>>>>>>>>    function_return (aux_value(self,current_item(self)))
73551>>>>>>>>>  end_function
73552>>>>>>>>>end_class // cFieldInf.Table_List
73553>>>>>>>>>
73553>>>>>>>>>class cFieldInf.Field_List is a aps.list
73554>>>>>>>>>  procedure construct_object integer liImage
73556>>>>>>>>>    forward send construct_object liImage
73558>>>>>>>>>    property integer pbDisplayFieldNamesUser public DFTRUE
73559>>>>>>>>>    property integer piFile                  public 0
73560>>>>>>>>>    property integer priv.pbDisplayOverlaps  public DFFALSE
73561>>>>>>>>>    on_key kuser send toggle_display
73562>>>>>>>>>    on_key KEY_CTRL+KEY_D send DisplayDefinition
73563>>>>>>>>>    on_key KSWITCH send switch
73564>>>>>>>>>    on_key KSWITCH_BACK send switch_back
73565>>>>>>>>>    on_key KEY_CTRL+KEY_O send ToggleDisplayOverlaps
73566>>>>>>>>>  end_procedure
73567>>>>>>>>>  procedure GoToField integer liField
73569>>>>>>>>>    integer liMax liItm
73569>>>>>>>>>    get item_count to liMax
73570>>>>>>>>>    decrement liMax
73571>>>>>>>>>    for liItm from 0 to liMax
73577>>>>>>>>>>
73577>>>>>>>>>      if (aux_value(self,liItm)=liField) set current_item to liItm
73580>>>>>>>>>    loop
73581>>>>>>>>>>
73581>>>>>>>>>  end_procedure
73582>>>>>>>>>                procedure ToggleDisplayOverlaps
73584>>>>>>>>>                  set priv.pbDisplayOverlaps to (not(priv.pbDisplayOverlaps(self)))
73585>>>>>>>>>                  send fill_list.i (piFile(self))
73586>>>>>>>>>                end_procedure
73587>>>>>>>>>                procedure DisplayDefinition
73589>>>>>>>>>                  if (item_count(self)) send FDX_ModalDisplayFileAttributes 0 (piFile(self))
73592>>>>>>>>>                end_procedure
73593>>>>>>>>>                procedure toggle_display
73595>>>>>>>>>                  set pbDisplayFieldNamesUser to (not(pbDisplayFieldNamesUser(self)))
73596>>>>>>>>>                  send InsertFieldNames
73597>>>>>>>>>                end_procedure
73598>>>>>>>>>
73598>>>>>>>>>                procedure InsertFieldNames
73600>>>>>>>>>                  integer liType
73600>>>>>>>>>                  integer liItem liMax fld# liFile
73600>>>>>>>>>                  string lsValue
73600>>>>>>>>>                  get piFile to liFile
73601>>>>>>>>>                  get pbDisplayFieldNamesUser to liType
73602>>>>>>>>>                  get item_count to liMax
73603>>>>>>>>>                  for liItem from 0 to (liMax-1)
73609>>>>>>>>>>
73609>>>>>>>>>                    get aux_value item liItem to fld#
73610>>>>>>>>>                    if fld# lt 256 begin
73612>>>>>>>>>                      if liType get FieldInf_FieldLabel_Long liFile fld# to lsValue
73615>>>>>>>>>                      else get_attribute DF_FIELD_NAME of liFile fld# to lsValue
73619>>>>>>>>>                      set value item liItem to lsValue
73620>>>>>>>>>                    end
73620>>>>>>>>>>
73620>>>>>>>>>                  loop
73621>>>>>>>>>>
73621>>>>>>>>>                  set dynamic_update_state to true
73622>>>>>>>>>                end_procedure
73623>>>>>>>>>
73623>>>>>>>>>                procedure FieldNamesLogical
73625>>>>>>>>>                  set pbDisplayFieldNamesUser to DFFALSE
73626>>>>>>>>>                  send InsertFieldNames
73627>>>>>>>>>                end_procedure
73628>>>>>>>>>                procedure FieldNamesUser
73630>>>>>>>>>                  set pbDisplayFieldNamesUser to DFTRUE
73631>>>>>>>>>                  send InsertFieldNames
73632>>>>>>>>>                end_procedure
73633>>>>>>>>>
73633>>>>>>>>>                procedure OnFieldSelect
73635>>>>>>>>>                  // Send do_add_field
73635>>>>>>>>>                end_procedure
73636>>>>>>>>>
73636>>>>>>>>>                procedure mouse_click integer i1 integer i2
73638>>>>>>>>>                  send OnFieldSelect
73639>>>>>>>>>                end_procedure
73640>>>>>>>>>
73640>>>>>>>>>   procedure load_virtual_fields integer liFile
73642>>>>>>>>>     integer lhObj liField liMax
73642>>>>>>>>>     get FieldInf_VirtualFields_Object liFile to lhObj
73643>>>>>>>>>     if lhObj begin
73645>>>>>>>>>       get row_count of lhObj to liMax
73646>>>>>>>>>       decrement liMax
73647>>>>>>>>>       for liField from 0 to liMax
73653>>>>>>>>>>
73653>>>>>>>>>         if (piFieldActive.i(lhObj,liField)) begin
73655>>>>>>>>>           send add_item MSG_OnFieldSelect (psFieldLabel.i(lhObj,liField))
73656>>>>>>>>>           set aux_value item (item_count(self)-1) to (liField+256)
73657>>>>>>>>>         end
73657>>>>>>>>>>
73657>>>>>>>>>       loop
73658>>>>>>>>>>
73658>>>>>>>>>     end
73658>>>>>>>>>>
73658>>>>>>>>>   end_procedure
73659>>>>>>>>>
73659>>>>>>>>>   function bIncludeField integer liFile integer liField returns integer
73661>>>>>>>>>     // function_return (not(DfQuery_ExcludeField(liFile,liField)))
73661>>>>>>>>>     function_return DFTRUE
73662>>>>>>>>>   end_function
73663>>>>>>>>>
73663>>>>>>>>>   procedure fill_list.i integer liFile
73665>>>>>>>>>     integer liField liMax liType
73665>>>>>>>>>     string lsValue
73665>>>>>>>>>     send delete_data
73666>>>>>>>>>     set piFile to liFile
73667>>>>>>>>>
73667>>>>>>>>>     if liFile begin
73669>>>>>>>>>       get_attribute DF_FILE_NUMBER_FIELDS of liFile to liMax
73672>>>>>>>>>
73672>>>>>>>>>       for liField from 0 to liMax
73678>>>>>>>>>>
73678>>>>>>>>>         get_attribute DF_FIELD_NAME of liFile liField to lsValue
73681>>>>>>>>>         move (FieldInf_FieldType(liFile,liField)) to liType
73682>>>>>>>>>         if ((priv.pbDisplayOverlaps(self) or liType<>DF_OVERLAP) and liType<>DF_BINARY) begin
73684>>>>>>>>>           ifnot (StringBeginsWith(lsValue,"@")) begin
73686>>>>>>>>>             if (bIncludeField(self,liFile,liField)) begin
73688>>>>>>>>>               send add_item MSG_OnFieldSelect ""
73689>>>>>>>>>               set aux_value item (item_count(self)-1) to liField
73690>>>>>>>>>             end
73690>>>>>>>>>>
73690>>>>>>>>>           end
73690>>>>>>>>>>
73690>>>>>>>>>         end
73690>>>>>>>>>>
73690>>>>>>>>>       loop
73691>>>>>>>>>>
73691>>>>>>>>>       send InsertFieldNames
73692>>>>>>>>>       send load_virtual_fields liFile
73693>>>>>>>>>     end
73693>>>>>>>>>>
73693>>>>>>>>>   end_procedure
73694>>>>>>>>>   function iCurrentField returns integer
73696>>>>>>>>>     function_return (aux_value(self,current_item(self)))
73697>>>>>>>>>   end_function
73698>>>>>>>>>end_class // cFieldInf.Field_List
73699>>>>>>>>>
73699>>>>>>>
73699>>>>>>>object oQueryDefineAdhocIndexPn is a aps.ModalPanel label t.QryOrder.Specify
73702>>>>>>>  set locate_mode to CENTER_ON_SCREEN
73703>>>>>>>  on_key ksave_record send close_panel_ok
73704>>>>>>>  on_key kcancel send close_panel
73705>>>>>>>
73705>>>>>>>  object oQueryOrderExpression is a cQueryOrderExpression
73707>>>>>>>  end_object
73708>>>>>>>
73708>>>>>>>  property integer piResult public DFFALSE
73710>>>>>>>  object oDBMS_Files is a cFieldInf.Table_List label t.DfQuery.DBMSfiles
73713>>>>>>>    set size to 60 150
73714>>>>>>>    set label_justification_mode to JMODE_TOP
73715>>>>>>>    on_key kenter send next
73716>>>>>>>    function bIncludeFile integer liFile returns integer
73719>>>>>>>      function_return (DfQuery_ExcludeFile(liFile)<>DFQ_ALWAYS)
73720>>>>>>>    end_function
73721>>>>>>>    procedure OnNewFile integer liFile
73724>>>>>>>      send notify_filechange liFile
73725>>>>>>>    end_procedure
73726>>>>>>>  end_object // oDBMS_Files
73727>>>>>>>
73727>>>>>>>  send aps_goto_max_row
73728>>>>>>>  send make_row_space
73729>>>>>>>
73729>>>>>>>  object oDBMS_Fields is a cFieldInf.Field_List
73731>>>>>>>    set size to 72 150
73732>>>>>>>    on_key kswitch send switch
73733>>>>>>>    on_key kswitch_back send switch_back
73734>>>>>>>    on_key kEnter Send do_add_field
73735>>>>>>>    procedure OnFieldSelect
73738>>>>>>>      Send do_add_field
73739>>>>>>>    end_procedure
73740>>>>>>>    function bIncludeField integer liFile integer liField returns integer
73743>>>>>>>      function_return (not(DfQuery_ExcludeField(liFile,liField)))
73744>>>>>>>    end_function
73745>>>>>>>  end_object // oDBMS_Files
73746>>>>>>>
73746>>>>>>>  set label of (oDBMS_Fields(self)) to t.DfQuery.DBMSfields
73747>>>>>>>  set label_justification_mode of (oDBMS_Fields(self)) to JMODE_TOP
73748>>>>>>>  set label_offset of (oDBMS_Fields(self)) to 0 0
73749>>>>>>>
73749>>>>>>>  procedure notify_filechange integer file#
73752>>>>>>>    send fill_list.i to (oDBMS_Fields(self)) file#
73753>>>>>>>  end_procedure
73754>>>>>>>
73754>>>>>>>  object oLst is a cQueryOrderingGrid snap SL_RIGHT relative_to (oDBMS_Files(self))
73762>>>>>>>    set size to 137 0
73763>>>>>>>  end_object
73764>>>>>>>
73764>>>>>>>  procedure do_add_field
73767>>>>>>>    integer liFile liField
73767>>>>>>>    get iCurrentFile of (oDBMS_Files(self)) to liFile
73768>>>>>>>    get iCurrentField of (oDBMS_Fields(self)) to liField
73769>>>>>>>    send DoAddField to (oLst(self)) liFile liField
73770>>>>>>>  end_procedure
73771>>>>>>>
73771>>>>>>>  object oBtn11 is a aps.Multi_Button
73773>>>>>>>    set size to 14 50
73774>>>>>>>    on_item t.btn.move_up send MoveRowUp to (oLst(self))
73775>>>>>>>  end_object
73776>>>>>>>  object oBtn12 is a aps.Multi_Button
73778>>>>>>>    set size to 14 50
73779>>>>>>>    on_item t.btn.move_down send MoveRowDown to (oLst(self))
73780>>>>>>>  end_object
73781>>>>>>>  object oBtn13 is a aps.Multi_Button
73783>>>>>>>    set size to 14 50
73784>>>>>>>    on_item t.btn.delete send DeleteRow to (oLst(self))
73785>>>>>>>  end_object
73786>>>>>>>  send aps_locate_multi_buttons
73787>>>>>>>  send aps_goto_max_row
73788>>>>>>>  object oLine is a aps.LineControl
73790>>>>>>>  end_object
73791>>>>>>>
73791>>>>>>>  object oBtn1 is a aps.Multi_Button
73793>>>>>>>    on_item t.btn.ok send close_panel_ok
73794>>>>>>>  end_object
73795>>>>>>>  object oBtn2 is a aps.Multi_Button
73797>>>>>>>    on_item t.btn.cancel send close_panel
73798>>>>>>>  end_object
73799>>>>>>>
73799>>>>>>>  send aps_locate_multi_buttons
73800>>>>>>>  procedure close_panel_ok
73803>>>>>>>    send MoveGridToArray to (oLst(self))
73804>>>>>>>    set piResult to DFTRUE
73805>>>>>>>    send close_panel
73806>>>>>>>  end_procedure
73807>>>>>>>  set Border_Style to BORDER_THICK   // Make panel resizeable
73808>>>>>>>  procedure aps_onResize integer delta_rw# integer delta_cl#
73811>>>>>>>    integer lhFields
73811>>>>>>>//    send aps_resize (oDBMS_Fields(self)) delta_rw# 0
73811>>>>>>>    send aps_resize (oLst(self)) delta_rw# 0
73812>>>>>>>    send aps_align_by_sizing (oDBMS_Fields(self)) (oLst(self)) SL_ALIGN_BOTTOM
73813>>>>>>>    send aps_register_multi_button (oBtn11(self))
73814>>>>>>>    send aps_register_multi_button (oBtn12(self))
73815>>>>>>>    send aps_register_multi_button (oBtn13(self))
73816>>>>>>>    send aps_locate_multi_buttons
73817>>>>>>>    send aps_relocate (oLine(self)) delta_rw# 0
73818>>>>>>>    send aps_register_multi_button (oBtn1(self))
73819>>>>>>>    send aps_register_multi_button (oBtn2(self))
73820>>>>>>>    send aps_locate_multi_buttons
73821>>>>>>>    send aps_auto_size_container
73822>>>>>>>  end_procedure
73823>>>>>>>  procedure aps_beautify
73826>>>>>>>    send aps_align_inside_container_by_sizing (oLine(self)) SL_ALIGN_RIGHT
73827>>>>>>>  end_procedure
73828>>>>>>>  function iPopup.ii integer liFile integer lhQueryOrderExpression returns integer
73831>>>>>>>    integer lhExpr
73831>>>>>>>    move (oQueryOrderExpression(self)) to lhExpr
73832>>>>>>>    send DoCopyFromOtherObject to lhExpr lhQueryOrderExpression
73833>>>>>>>    set piResult to DFFALSE
73834>>>>>>>    send fill_list.i to (oDBMS_Files(self)) liFile
73835>>>>>>>    set phServer of (oLst(self)) to lhQueryOrderExpression
73836>>>>>>>    send fill_list to (oLst(self))
73837>>>>>>>    forward send popup
73839>>>>>>>    ifnot (piResult(self)) send DoCopyFromOtherObject to lhQueryOrderExpression lhExpr
73842>>>>>>>    function_return (piResult(self))
73843>>>>>>>  end_function
73844>>>>>>>end_object // oQueryDefineAdhocIndexPn
73845>>>>>Use MouseMov.utl // Procedure Mouse_MoveToObject
Including file: mousemov.utl    (C:\projects\BRS\VDFQuery\AppSrc\mousemov.utl)
73845>>>>>>>// Use MouseMov.utl // Procedure Mouse_MoveToObject
73845>>>>>>>
73845>>>>>>>procedure Mouse_MoveToObject global integer lhObject
73847>>>>>>>  integer liLoc liCol liRow liSzCol liSzRow
73847>>>>>>>
73847>>>>>>>  Get Absolute_GUIOrigin of lhObject to liLoc //
73848>>>>>>>  move (Hi(liLoc)) to liRow // row
73849>>>>>>>  move (Low(liLoc)) to liCol // col
73850>>>>>>>
73850>>>>>>>  // I found this correction somewhere in DAW classes, so I have replicated
73850>>>>>>>  // it here:
73850>>>>>>>  if (liCol>32767) move (liCol-65536) to liCol
73853>>>>>>>  if (liRow>32767) move (liRow-65536) to liRow
73856>>>>>>>
73856>>>>>>>  get GUISize of lhObject to liLoc
73857>>>>>>>  move (Hi(liLoc)/2)  to liSzRow // Strange, Hi/Low is opposite of
73858>>>>>>>  move (Low(liLoc)/2) to liSzCol // Absolute_GUIOrigin
73859>>>>>>>
73859>>>>>>>  // Set absolute_mouse_location takes horizontal before vertial.
73859>>>>>>>  // On a 1024x768 monitor 512,384 will place the mouse in the
73859>>>>>>>  // exact center (well, as close as possible since the monitor
73859>>>>>>>  // ranges are dividable by two).
73859>>>>>>>  set absolute_mouse_location to (liSzCol+liCol) (liSzRow+liRow)
73860>>>>>>>
73860>>>>>>>//// Alternative: (doesn't work)
73860>>>>>>>//
73860>>>>>>>//integer xyButton
73860>>>>>>>//handle hWnd iVoid
73860>>>>>>>//string sPoint xScreen yScreen
73860>>>>>>>//
73860>>>>>>>//Get GuiLocation of lhObject To xyButton
73860>>>>>>>//
73860>>>>>>>//ZeroType tPoint To sPoint
73860>>>>>>>//Put (Hi(xyButton)) To sPoint At tPoint.y
73860>>>>>>>//Put (Low(xyButton)) To sPoint At tPoint.x
73860>>>>>>>//
73860>>>>>>>//Get Window_Handle of lhObject To hWnd
73860>>>>>>>//
73860>>>>>>>//Move (ClientToScreen(hWnd, AddressOf(sPoint))) To iVoid
73860>>>>>>>//
73860>>>>>>>//GetBuff From sPoint At tPoint.x To xScreen
73860>>>>>>>//GetBuff From sPoint At tPoint.y To yScreen
73860>>>>>>>//set absolute_mouse_location to xScreen yScreen
73860>>>>>>>end_procedure
73861>>>>>Use Fdx2.utl     // FDX aware object for displaying a table definition
73861>>>>>Use QryFolde.pkg // Directory setup for VDFQuery and DbQuery (defs and out)
Including file: qryfolde.pkg    (C:\projects\BRS\VDFQuery\AppSrc\qryfolde.pkg)
73861>>>>>>>// Use QryFolde.pkg // Directory setup for VDFQuery and DbQuery (defs and out)
73861>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
73861>>>>>>>Use Files.utl    // Utilities for handling file related stuff (No User Interface)
73861>>>>>>>Use DfDir.nui    // Identify the location DF files and directories
Including file: dfdir.nui    (C:\projects\BRS\VDFQuery\AppSrc\dfdir.nui)
73861>>>>>>>>>// Use DfDir.nui    // Identify the location DF files and directories
73861>>>>>>>>>// OBSOLETE! Use AppFolders.nui instead
73861>>>>>>>>>
73861>>>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
73861>>>>>>>>>Use Strings.nui  // String manipulation for VDF (No User Interface)
73861>>>>>>>>>Use Files.nui    // Utilities for handling file related stuff (No User Interface)
73861>>>>>>>>>
73861>>>>>>>>>enumeration_list
73861>>>>>>>>>  define DFDIR_DFRUN_LOCATION
73861>>>>>>>>>  define DFDIR_VDF_ROOTDIR
73861>>>>>>>>>  define DFDIR_FILELIST_CFG
73861>>>>>>>>>end_enumeration_list
73861>>>>>>>>>
73861>>>>>>>>>function dfdir_location global integer liWhat returns string
73863>>>>>>>>>  string lsRval
73863>>>>>>>>>  if (liWhat=DFDIR_VDF_ROOTDIR) begin // VDF Root dir
73865>>>>>>>>>    Get_Profile_String "Defaults" "VdfRootDir" To lsRval
73868>>>>>>>>>  end
73868>>>>>>>>>>
73868>>>>>>>>>  if (liWhat=DFDIR_FILELIST_CFG) begin // Filelist.cfg
73870>>>>>>>>>    get SEQ_FindFileAlongDFPath "filelist.cfg" to lsRval
73871>>>>>>>>>  end
73871>>>>>>>>>>
73871>>>>>>>>>  if (right(lsRval,1)="\" and length(lsRval)>1) get StringLeftBut lsRval 1 to lsRval
73874>>>>>>>>>  function_return lsRval
73875>>>>>>>>>end_function
73876>>>>>>>Use WinUser.nui  // User_Windows_User_Name function
73876>>>>>>>Use Language     // Set default languange if not set by compiler command line
73876>>>>>>>Use WildCard.nui // WildCardMatch function
Including file: wildcard.nui    (C:\projects\BRS\VDFQuery\AppSrc\wildcard.nui)
73876>>>>>>>>>// Use WildCard.nui // WildCardMatch function
73876>>>>>>>>>//
73876>>>>>>>>>// This package may be used when checking strings containing wildcard
73876>>>>>>>>>// characters "*" and "?" against strings. I would not bet my life that
73876>>>>>>>>>// this is not exactly the same as undocumentet operator "matches" does.
73876>>>>>>>>>//
73876>>>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
73876>>>>>>>>>Use Strings.nui  // String manipulation for VDF
73876>>>>>>>>>
73876>>>>>>>>>// The public interface of this package is WildCardMatchPrepare and
73876>>>>>>>>>// WildCardMatch messages.
73876>>>>>>>>>//
73876>>>>>>>>>//   Use like this:
73876>>>>>>>>>//
73876>>>>>>>>>//      send WildCardMatchPrepare "*.nui"
73876>>>>>>>>>//      if (WildCardMatch("WildCard.nui")) showln "Matches"
73876>>>>>>>>>//      else showln "No Match"
73876>>>>>>>>>
73876>>>>>>>>>enumeration_list
73876>>>>>>>>>  define WCAS_THE_HARD_WAY         //
73876>>>>>>>>>  define WCAS_ALWAYS_TRUE          // *
73876>>>>>>>>>  define WCAS_EQUAL                // Sture
73876>>>>>>>>>  define WCAS_LEFT_MATCH           // Sture*
73876>>>>>>>>>  define WCAS_RIGHT_MATCH          // *Andersen
73876>>>>>>>>>  define WCAS_LEFT_AND_RIGHT_MATCH // Sture*Andersen
73876>>>>>>>>>  define WCAS_CONTAINS             // *B*
73876>>>>>>>>>end_enumeration_list
73876>>>>>>>>>enumeration_list
73876>>>>>>>>>  define WCAS_CONSTANT
73876>>>>>>>>>  define WCAS_QUESTIONMARK
73876>>>>>>>>>  define WCAS_ASTERISK
73876>>>>>>>>>end_enumeration_list
73876>>>>>>>>>
73876>>>>>>>>>class cWildCardMatcher is a cArray
73877>>>>>>>>>  procedure construct_object integer liImage
73879>>>>>>>>>    forward send construct_object liImage
73881>>>>>>>>>    // The properties defined here are used only to try to optimise
73881>>>>>>>>>    // the evaluation of lsTestValues.
73881>>>>>>>>>    property integer piAltStrategy           public WCAS_THE_HARD_WAY
73882>>>>>>>>>    // If an alternative strategy is active can we use it to accept a
73882>>>>>>>>>    // value (piAltStrategyRejectOnly=TRUE) or must we run it the hard
73882>>>>>>>>>    // way afterwards (piAltStrategyRejectOnly=FALSE)?
73882>>>>>>>>>    property integer piAltStrategyRejectOnly public DFFALSE
73883>>>>>>>>>    property string  psAltStrategyLeftValue  public ""
73884>>>>>>>>>    property string  psAltStrategyRightValue public ""
73885>>>>>>>>>  end_procedure
73886>>>>>>>>>  item_property_list
73886>>>>>>>>>    item_property integer piType.i  // 0=constant 1=? 2=*
73886>>>>>>>>>    item_property string  psValue.i // Only relevant when piType.i is 0
73886>>>>>>>>>  end_item_property_list cWildCardMatcher
#REM 73918 DEFINE FUNCTION PSVALUE.I INTEGER LIROW RETURNS STRING
#REM 73922 DEFINE PROCEDURE SET PSVALUE.I INTEGER LIROW STRING VALUE
#REM 73926 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 73930 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
73935>>>>>>>>>
73935>>>>>>>>>  procedure add_row integer liType string lsValue
73937>>>>>>>>>    integer liRow
73937>>>>>>>>>    get row_count to liRow
73938>>>>>>>>>    set piType.i  liRow to liType
73939>>>>>>>>>    set psValue.i liRow to lsValue
73940>>>>>>>>>  end_procedure
73941>>>>>>>>>
73941>>>>>>>>>  procedure DoReset
73943>>>>>>>>>    send delete_data
73944>>>>>>>>>    set piAltStrategy to WCAS_THE_HARD_WAY
73945>>>>>>>>>  end_procedure
73946>>>>>>>>>
73946>>>>>>>>>  // This procedure tries to find a optimized way to evaluate the expression
73946>>>>>>>>>  procedure DoFindShortCuts
73948>>>>>>>>>    integer liRows
73948>>>>>>>>>    get row_count to liRows
73949>>>>>>>>>    set piAltStrategy to WCAS_THE_HARD_WAY
73950>>>>>>>>>    set piAltStrategyRejectOnly to DFFALSE
73951>>>>>>>>>    if (liRows=1) begin
73953>>>>>>>>>      if (piType.i(self,0)=WCAS_ASTERISK) set piAltStrategy to WCAS_ALWAYS_TRUE
73956>>>>>>>>>      if (piType.i(self,0)=WCAS_CONSTANT) begin
73958>>>>>>>>>        set piAltStrategy to WCAS_EQUAL
73959>>>>>>>>>        set psAltStrategyLeftValue to (psValue.i(self,0))
73960>>>>>>>>>      end
73960>>>>>>>>>>
73960>>>>>>>>>    end
73960>>>>>>>>>>
73960>>>>>>>>>    else begin
73961>>>>>>>>>      if (piType.i(self,0)=WCAS_CONSTANT) begin // If leftmost is a constant
73963>>>>>>>>>        if (piType.i(self,liRows-1)=WCAS_CONSTANT) begin // if rightmost is also a constant
73965>>>>>>>>>          if (liRows=3 and piType.i(self,1)=WCAS_ASTERISK) begin
73967>>>>>>>>>            set piAltStrategy to WCAS_LEFT_AND_RIGHT_MATCH
73968>>>>>>>>>            set psAltStrategyLeftValue to (psValue.i(self,0))
73969>>>>>>>>>            set psAltStrategyRightValue to (psValue.i(self,liRows-1))
73970>>>>>>>>>          end
73970>>>>>>>>>>
73970>>>>>>>>>          else begin
73971>>>>>>>>>            set piAltStrategy to WCAS_LEFT_AND_RIGHT_MATCH
73972>>>>>>>>>            set psAltStrategyLeftValue to (psValue.i(self,0))
73973>>>>>>>>>            set psAltStrategyRightValue to (psValue.i(self,liRows-1))
73974>>>>>>>>>            set piAltStrategyRejectOnly to DFTRUE
73975>>>>>>>>>          end
73975>>>>>>>>>>
73975>>>>>>>>>        end
73975>>>>>>>>>>
73975>>>>>>>>>        else begin
73976>>>>>>>>>          if (liRows=2 and piType.i(self,1)=WCAS_ASTERISK) begin
73978>>>>>>>>>            set piAltStrategy to WCAS_LEFT_MATCH
73979>>>>>>>>>            set psAltStrategyLeftValue to (psValue.i(self,0))
73980>>>>>>>>>          end
73980>>>>>>>>>>
73980>>>>>>>>>          else begin
73981>>>>>>>>>            set piAltStrategy to WCAS_LEFT_MATCH
73982>>>>>>>>>            set psAltStrategyLeftValue to (psValue.i(self,0))
73983>>>>>>>>>            set piAltStrategyRejectOnly to DFTRUE
73984>>>>>>>>>          end
73984>>>>>>>>>>
73984>>>>>>>>>        end
73984>>>>>>>>>>
73984>>>>>>>>>      end
73984>>>>>>>>>>
73984>>>>>>>>>      else begin
73985>>>>>>>>>        if (piType.i(self,liRows-1)=WCAS_CONSTANT) begin // If rightmost is a constant
73987>>>>>>>>>          if (liRows=2 and piType.i(self,0)=WCAS_ASTERISK) begin
73989>>>>>>>>>            set piAltStrategy to WCAS_RIGHT_MATCH
73990>>>>>>>>>            set psAltStrategyRightValue to (psValue.i(self,liRows-1))
73991>>>>>>>>>          end
73991>>>>>>>>>>
73991>>>>>>>>>          else begin
73992>>>>>>>>>            set piAltStrategy to WCAS_RIGHT_MATCH
73993>>>>>>>>>            set psAltStrategyRightValue to (psValue.i(self,liRows-1))
73994>>>>>>>>>            set piAltStrategyRejectOnly to DFTRUE
73995>>>>>>>>>          end
73995>>>>>>>>>>
73995>>>>>>>>>        end
73995>>>>>>>>>>
73995>>>>>>>>>        else begin // Now we check if first and last are asterisks
73996>>>>>>>>>          if (liRows=3 and piType.i(self,0)=WCAS_ASTERISK and piType.i(self,1)=WCAS_CONSTANT and piType.i(self,2)=WCAS_ASTERISK) begin
73998>>>>>>>>>            set piAltStrategy to WCAS_CONTAINS
73999>>>>>>>>>            set psAltStrategyLeftValue to (psValue.i(self,1))
74000>>>>>>>>>          end
74000>>>>>>>>>>
74000>>>>>>>>>        end
74000>>>>>>>>>>
74000>>>>>>>>>      end
74000>>>>>>>>>>
74000>>>>>>>>>    end
74000>>>>>>>>>>
74000>>>>>>>>>  end_procedure
74001>>>>>>>>>
74001>>>>>>>>>  procedure BreakDownMask string lsMask
74003>>>>>>>>>    integer liPos liLen liType
74003>>>>>>>>>    string lsChar lsItem
74003>>>>>>>>>    send DoReset
74004>>>>>>>>>    move (replaces("**",lsMask,"*")) to lsMask // Simple reduction
74005>>>>>>>>>    move (length(lsMask)) to liLen
74006>>>>>>>>>    move "" to lsItem
74007>>>>>>>>>    for liPos from 1 to liLen
74013>>>>>>>>>>
74013>>>>>>>>>      move (mid(lsMask,1,liPos)) to lsChar
74014>>>>>>>>>      if lsChar eq "*" begin
74016>>>>>>>>>        if lsItem ne "" begin
74018>>>>>>>>>          send add_row WCAS_CONSTANT lsItem
74019>>>>>>>>>          move "" to lsItem
74020>>>>>>>>>        end
74020>>>>>>>>>>
74020>>>>>>>>>        send add_row WCAS_ASTERISK ""
74021>>>>>>>>>      end
74021>>>>>>>>>>
74021>>>>>>>>>      else if lsChar eq "?" begin
74024>>>>>>>>>        if lsItem ne "" begin
74026>>>>>>>>>          send add_row WCAS_CONSTANT lsItem
74027>>>>>>>>>          move "" to lsItem
74028>>>>>>>>>        end
74028>>>>>>>>>>
74028>>>>>>>>>        send add_row WCAS_QUESTIONMARK ""
74029>>>>>>>>>      end
74029>>>>>>>>>>
74029>>>>>>>>>      else move (lsItem+lsChar) to lsItem
74031>>>>>>>>>    loop
74032>>>>>>>>>>
74032>>>>>>>>>    if lsItem ne "" send add_row WCAS_CONSTANT lsItem
74035>>>>>>>>>    send DoFindShortCuts
74036>>>>>>>>>  end_procedure
74037>>>>>>>>>  function iMatch.is integer liRow string lsTestValue returns integer
74039>>>>>>>>>    integer lsMax liType liLen liPos
74039>>>>>>>>>    string lsItem
74039>>>>>>>>>    get row_count to lsMax
74040>>>>>>>>>    if liRow ge lsMax begin
74042>>>>>>>>>      if (lsTestValue="") function_return 1
74045>>>>>>>>>      function_return 0
74046>>>>>>>>>    end
74046>>>>>>>>>>
74046>>>>>>>>>    get piType.i liRow to liType
74047>>>>>>>>>    if liType eq WCAS_CONSTANT begin // constant
74049>>>>>>>>>      if (length(lsTestValue)) eq 0 function_return 0
74052>>>>>>>>>      get psValue.i liRow to lsItem
74053>>>>>>>>>      move (length(lsItem)) to liLen
74054>>>>>>>>>      if lsItem eq (left(lsTestValue,liLen)) function_return (iMatch.is(self,liRow+1,StringRightBut(lsTestValue,liLen)))
74057>>>>>>>>>      function_return 0
74058>>>>>>>>>    end
74058>>>>>>>>>>
74058>>>>>>>>>    if liType eq WCAS_QUESTIONMARK begin // ?
74060>>>>>>>>>      if (length(lsTestValue)) eq 0 function_return 0
74063>>>>>>>>>      function_return (iMatch.is(self,liRow+1,StringRightBut(lsTestValue,1)))
74064>>>>>>>>>    end
74064>>>>>>>>>>
74064>>>>>>>>>    if liType eq WCAS_ASTERISK begin // *
74066>>>>>>>>>      if liRow eq (lsMax-1) function_return 1
74069>>>>>>>>>      move (length(lsTestValue)) to liLen
74070>>>>>>>>>      for liPos from 0 to liLen
74076>>>>>>>>>>
74076>>>>>>>>>        if (iMatch.is(self,liRow+1,StringRightBut(lsTestValue,liPos))) function_return 1
74079>>>>>>>>>      loop
74080>>>>>>>>>>
74080>>>>>>>>>    end
74080>>>>>>>>>>
74080>>>>>>>>>    //function_return 0
74080>>>>>>>>>  end_function
74081>>>>>>>>>  function iMatch.s string lsTestValue returns integer
74083>>>>>>>>>    integer liAltStrategy liAltStrategyRejectOnly
74083>>>>>>>>>    get piAltStrategy to liAltStrategy
74084>>>>>>>>>    get piAltStrategyRejectOnly to liAltStrategyRejectOnly
74085>>>>>>>>>    if liAltStrategy eq WCAS_ALWAYS_TRUE function_return DFTRUE
74088>>>>>>>>>    if liAltStrategy eq WCAS_EQUAL       function_return (lsTestValue=psAltStrategyLeftValue(self))
74091>>>>>>>>>    if liAltStrategy eq WCAS_LEFT_MATCH begin
74093>>>>>>>>>      if liAltStrategyRejectOnly begin
74095>>>>>>>>>        ifnot (StringBeginsWith(lsTestValue,psAltStrategyLeftValue(self))) function_return DFFALSE
74098>>>>>>>>>      end
74098>>>>>>>>>>
74098>>>>>>>>>      else function_return (StringBeginsWith(lsTestValue,psAltStrategyLeftValue(self)))
74100>>>>>>>>>    end
74100>>>>>>>>>>
74100>>>>>>>>>    if liAltStrategy eq WCAS_RIGHT_MATCH begin
74102>>>>>>>>>      if liAltStrategyRejectOnly begin
74104>>>>>>>>>        ifnot (StringEndsWith(lsTestValue,psAltStrategyRightValue(self))) function_return DFFALSE
74107>>>>>>>>>      end
74107>>>>>>>>>>
74107>>>>>>>>>      else function_return (StringEndsWith(lsTestValue,psAltStrategyRightValue(self)))
74109>>>>>>>>>    end
74109>>>>>>>>>>
74109>>>>>>>>>    if liAltStrategy eq WCAS_LEFT_AND_RIGHT_MATCH begin
74111>>>>>>>>>      if liAltStrategyRejectOnly begin
74113>>>>>>>>>        ifnot (StringBeginsWith(lsTestValue,psAltStrategyLeftValue(self)) and StringEndsWith(lsTestValue,psAltStrategyRightValue(self))) function_return DFFALSE
74116>>>>>>>>>      end
74116>>>>>>>>>>
74116>>>>>>>>>      else function_return (StringBeginsWith(lsTestValue,psAltStrategyLeftValue(self)) and StringEndsWith(lsTestValue,psAltStrategyRightValue(self)))
74118>>>>>>>>>    end
74118>>>>>>>>>>
74118>>>>>>>>>    if liAltStrategy eq WCAS_CONTAINS begin
74120>>>>>>>>>      function_return (lsTestValue contains psAltStrategyLeftValue(self))
74121>>>>>>>>>    end
74121>>>>>>>>>>
74121>>>>>>>>>    function_return (iMatch.is(self,0,lsTestValue))
74122>>>>>>>>>  end_function
74123>>>>>>>>>  function iAnyWildCards returns integer
74125>>>>>>>>>    if (row_count(self)>1) function_return DFTRUE
74128>>>>>>>>>    function_return (piType.i(self,0)<>WCAS_CONSTANT)
74129>>>>>>>>>  end_function
74130>>>>>>>>>end_class // cWildCardMatcher
74131>>>>>>>>>
74131>>>>>>>>>desktop_section
74136>>>>>>>>>  object oPrivateWildCardMatch is a cWildCardMatcher NO_IMAGE
74138>>>>>>>>>  end_object // oPrivateWildCardMatch
74139>>>>>>>>>end_desktop_section
74144>>>>>>>>>
74144>>>>>>>>>procedure WildCardMatchPrepare global string lsMask
74146>>>>>>>>>  send BreakDownMask to (oPrivateWildCardMatch(self)) lsMask
74147>>>>>>>>>end_procedure
74148>>>>>>>>>
74148>>>>>>>>>function WildCardMatch global string lsTestValue returns integer
74150>>>>>>>>>  function_return (iMatch.s(oPrivateWildCardMatch(self),lsTestValue))
74151>>>>>>>>>end_function
74152>>>>>>>>>
74152>>>>>>>>>// This may be used to check if the test value was broken down into
74152>>>>>>>>>// more items indicating whether a wildcard character was actually
74152>>>>>>>>>// part of it.
74152>>>>>>>>>function WildCardBreakDownItems global returns integer
74154>>>>>>>>>  function_return (iAnyWildCards(oPrivateWildCardMatch(self)))
74155>>>>>>>>>end_function
74156>>>>>>>>>// Test source for DF 3.x (not at all object oriented)
74156>>>>>>>>>//
74156>>>>>>>>>// /Test
74156>>>>>>>>>//   Mask......: _________________
74156>>>>>>>>>//   Test value: _________________
74156>>>>>>>>>//   Result....: _________________
74156>>>>>>>>>// /*
74156>>>>>>>>>//
74156>>>>>>>>>// repeat
74156>>>>>>>>>//   accept test.1
74156>>>>>>>>>//   accept test.2
74156>>>>>>>>>//   send WildCardMatchPrepare (trim(Test.1))
74156>>>>>>>>>//   if (WildCardMatch(trim(Test.2))) move "Match!" to Test.3
74156>>>>>>>>>//   else move "No match!" to Test.3
74156>>>>>>>>>// [~key.escape] loop
74156>>>>>>>>>// abort
74156>>>>>>>>>
74156>>>>>>>>>class cSetOfMasks is a cArray
74157>>>>>>>>>  procedure construct_object integer liImage
74159>>>>>>>>>    forward send construct_object liImage
74161>>>>>>>>>    property string psName public ""
74162>>>>>>>>>  end_procedure
74163>>>>>>>>>  item_property_list
74163>>>>>>>>>    item_property string psMask.i
74163>>>>>>>>>    item_property string psDecription.i
74163>>>>>>>>>  end_item_property_list cSetOfMasks
#REM 74195 DEFINE FUNCTION PSDECRIPTION.I INTEGER LIROW RETURNS STRING
#REM 74199 DEFINE PROCEDURE SET PSDECRIPTION.I INTEGER LIROW STRING VALUE
#REM 74203 DEFINE FUNCTION PSMASK.I INTEGER LIROW RETURNS STRING
#REM 74207 DEFINE PROCEDURE SET PSMASK.I INTEGER LIROW STRING VALUE
74212>>>>>>>>>  procedure DoReset
74214>>>>>>>>>    send delete_data
74215>>>>>>>>>  end_procedure
74216>>>>>>>>>
74216>>>>>>>>>  function iFindMask.s string lsMask returns integer
74218>>>>>>>>>    integer liRow liMax
74218>>>>>>>>>    get row_count to liMax
74219>>>>>>>>>    decrement liMax
74220>>>>>>>>>    for liRow from 0 to liMax
74226>>>>>>>>>>
74226>>>>>>>>>      if (lsMask=psMask.i(self,liRow)) function_return liRow
74229>>>>>>>>>    loop
74230>>>>>>>>>>
74230>>>>>>>>>    function_return -1
74231>>>>>>>>>  end_function
74232>>>>>>>>>
74232>>>>>>>>>  procedure DoAddMask string lsMask string lsDecription
74234>>>>>>>>>    integer liRow
74234>>>>>>>>>    if (lsMask<>"" and iFindMask.s(self,lsMask)=-1) begin
74236>>>>>>>>>      get row_count to liRow
74237>>>>>>>>>      set psMask.i       liRow to lsMask
74238>>>>>>>>>      set psDecription.i liRow to lsDecription
74239>>>>>>>>>    end
74239>>>>>>>>>>
74239>>>>>>>>>  end_procedure
74240>>>>>>>>>  // This may be used for merging with another cSetOfMasks:
74240>>>>>>>>>  procedure DoImport integer lhSetOfMasks
74242>>>>>>>>>    integer liRow liMax
74242>>>>>>>>>    get row_count of lhSetOfMasks to liMax
74243>>>>>>>>>    decrement liMax
74244>>>>>>>>>    for liRow from 0 to liMax
74250>>>>>>>>>>
74250>>>>>>>>>      send DoAddMask (psMask.i(lhSetOfMasks,liRow)) (psDecription.i(lhSetOfMasks,liRow))
74251>>>>>>>>>    loop
74252>>>>>>>>>>
74252>>>>>>>>>  end_procedure
74253>>>>>>>>>  function sMasksAsString string lsSeparator returns string
74255>>>>>>>>>    integer liRow liMax
74255>>>>>>>>>    string lsRval
74255>>>>>>>>>    move "" to lsRval
74256>>>>>>>>>    get row_count to liMax
74257>>>>>>>>>    decrement liMax
74258>>>>>>>>>    for liRow from 0 to liMax
74264>>>>>>>>>>
74264>>>>>>>>>      move (lsRval+psMask.i(self,liRow)) to lsRval
74265>>>>>>>>>      if (liRow<>liMax) move (lsRval+lsSeparator) to lsRval
74268>>>>>>>>>    loop
74269>>>>>>>>>>
74269>>>>>>>>>    function_return lsRval
74270>>>>>>>>>  end_function
74271>>>>>>>>>  procedure DoCallBack integer liMsg integer lhObj
74273>>>>>>>>>    integer liRow liMax
74273>>>>>>>>>    get row_count to liMax
74274>>>>>>>>>    decrement liMax
74275>>>>>>>>>    for liRow from 0 to liMax
74281>>>>>>>>>>
74281>>>>>>>>>      send liMsg to lhObj (psMask.i(self,liRow)) (psDecription.i(self,liRow))
74282>>>>>>>>>    loop
74283>>>>>>>>>>
74283>>>>>>>>>  end_procedure
74284>>>>>>>>>end_class // cSetOfMasks
74285>>>>>>>>>
74285>>>>>>>>>class cWildCardMatcherArray is a cArray
74286>>>>>>>>>  procedure DoReset
74288>>>>>>>>>    integer liMax liItm
74288>>>>>>>>>    get item_count to liMax
74289>>>>>>>>>    decrement liMax
74290>>>>>>>>>    for liItm from 0 to liMax
74296>>>>>>>>>>
74296>>>>>>>>>      send request_destroy_object to (integer(value(self,liItm)))
74297>>>>>>>>>    loop
74298>>>>>>>>>>
74298>>>>>>>>>    send delete_data
74299>>>>>>>>>  end_procedure
74300>>>>>>>>>            procedure BreakDownMask string lsMask
74302>>>>>>>>>              integer liObj
74302>>>>>>>>>              object oWildCardMatcher is a cWildCardMatcher NO_IMAGE
74304>>>>>>>>>                send BreakDownMask lsMask
74305>>>>>>>>>                move self to liObj
74306>>>>>>>>>              end_object
74307>>>>>>>>>              set value item (item_count(self)) to liObj
74308>>>>>>>>>            end_procedure
74309>>>>>>>>>  procedure BreakDownSetOfMasks integer lhObj // An object of the cSetOfMasks class
74311>>>>>>>>>    integer liRow liMax
74311>>>>>>>>>    get row_count of lhObj to liMax
74312>>>>>>>>>    decrement liMax
74313>>>>>>>>>    for liRow from 0 to liMax
74319>>>>>>>>>>
74319>>>>>>>>>      send BreakDownMask (psMask.i(lhObj,liRow))
74320>>>>>>>>>    loop
74321>>>>>>>>>>
74321>>>>>>>>>  end_procedure
74322>>>>>>>>>  function iMatch.s string lsTestValue returns integer
74324>>>>>>>>>    integer liMax liItm
74324>>>>>>>>>    get item_count to liMax
74325>>>>>>>>>    decrement liMax
74326>>>>>>>>>    for liItm from 0 to liMax
74332>>>>>>>>>>
74332>>>>>>>>>      if (iMatch.s(integer(value(self,liItm)),lsTestValue)) function_return (liItm+1)
74335>>>>>>>>>    loop
74336>>>>>>>>>>
74336>>>>>>>>>    function_return 0
74337>>>>>>>>>  end_function
74338>>>>>>>>>  // Returns the number of items the last added mask was broken into.
74338>>>>>>>>>  function iAnyWildCards returns integer
74340>>>>>>>>>    integer liObj
74340>>>>>>>>>    get value item (item_count(self)-1) to liObj
74341>>>>>>>>>    function_return (iAnyWildCards(liObj))
74342>>>>>>>>>  end_function
74343>>>>>>>>>end_class // cWildCardMatchArray
74344>>>>>>>
74344>>>>>>>  define t.qryfolder.name.QueryDef     for "Query definitions"
74344>>>>>>>  define t.qryfolder.name.DefPostFix   for "Definitions"
74344>>>>>>>  define t.qryfolder.name.QueryOut     for "Query output"
74344>>>>>>>  define t.qryfolder.name.OutPostFix   for "Output"
74344>>>>>>>
74344>>>>>>>enumeration_list
74344>>>>>>>  define QRYFOLD_DEF_ROOT         // data\querydef
74344>>>>>>>  define QRYFOLD_OUT_ROOT         // data\queryout
74344>>>>>>>  define QRYFOLD_USERNAME_FNC
74344>>>>>>>  define QRYFOLD_USERNAME_OBJ
74344>>>>>>>  define QRYFOLD_PUBLIC_DEF
74344>>>>>>>  define QRYFOLD_CURRENT_USER_DEF
74344>>>>>>>  define QRYFOLD_CURRENT_USER_OUT
74344>>>>>>>  define QRYFOLD_DISABLE_USER_SUBFOLDERS
74344>>>>>>>end_enumeration_list
74344>>>>>>>
74344>>>>>>>desktop_section
74349>>>>>>>  object oQry_FolderSetup is a cArray
74351>>>>>>>    function bCreateDir string lsDir returns integer
74354>>>>>>>      // Attempt to create directory if it does not exists
74354>>>>>>>      integer liExists lbCreateError
74354>>>>>>>      get SEQ_FileExists lsDir to liExists
74355>>>>>>>      if (liExists=SEQIT_NONE) begin
74357>>>>>>>        get wvaWin32_CreateDirectory (ToAnsi(lsDir)) to lbCreateError
74358>>>>>>>        ifnot lbCreateError get SEQ_FileExists lsDir to liExists
74361>>>>>>>      end
74361>>>>>>>>
74361>>>>>>>      function_return (liExists=SEQIT_DIRECTORY)
74362>>>>>>>    end_function
74363>>>>>>>
74363>>>>>>>    procedure DoDefaults
74366>>>>>>>      integer liCh
74366>>>>>>>      string lsDir lsFile lsDefDir lsOutDir
74366>>>>>>>
74366>>>>>>>      get dfdir_location DFDIR_FILELIST_CFG to lsDir
74367>>>>>>>      get Files_AppendPath lsDir "vdfquery.ini" to lsFile
74368>>>>>>>      if (SEQ_FileExists(lsFile)=SEQIT_FILE) begin
74370>>>>>>>        // Config file found, read it
74370>>>>>>>        get SEQ_DirectInput lsFile to liCh
74371>>>>>>>        if (liCh>=0) begin
74373>>>>>>>          get SEQ_ReadLn liCh to lsDefDir
74374>>>>>>>          get SEQ_ReadLn liCh to lsOutDir
74375>>>>>>>          send SEQ_CloseInput liCh
74376>>>>>>>        end
74376>>>>>>>>
74376>>>>>>>      end
74376>>>>>>>>
74376>>>>>>>      else begin
74377>>>>>>>        // Config file not found, locate default directories
74377>>>>>>>        get dfdir_location DFDIR_FILELIST_CFG to lsDir
74378>>>>>>>        get Files_AppendPath lsDir t.qryfolder.name.QueryDef to lsDefDir
74379>>>>>>>        get Files_AppendPath lsDir t.qryfolder.name.QueryOut to lsOutDir
74380>>>>>>>      end
74380>>>>>>>>
74380>>>>>>>      if (bCreateDir(self,lsDefDir)) set value QRYFOLD_DEF_ROOT to lsDefDir
74383>>>>>>>      if (bCreateDir(self,lsOutDir)) set value QRYFOLD_OUT_ROOT to lsOutDir
74386>>>>>>>    end_procedure
74387>>>>>>>
74387>>>>>>>    function sQryCurrentUserName returns string
74390>>>>>>>      integer lhObj lhGet
74390>>>>>>>      string lsUser
74390>>>>>>>      send DoDefaults
74391>>>>>>>      get value item QRYFOLD_USERNAME_OBJ to lhObj
74392>>>>>>>      get value item QRYFOLD_USERNAME_FNC to lhGet
74393>>>>>>>      if (lhObj and lhGet) get lhGet of lhObj to lsUser
74396>>>>>>>      else get User_Windows_User_Name to lsUser
74398>>>>>>>      function_return lsUser
74399>>>>>>>    end_function
74400>>>>>>>
74400>>>>>>>    function sQryPublicDef returns string
74403>>>>>>>      string lsRval
74403>>>>>>>      send DoDefaults
74404>>>>>>>      get value QRYFOLD_DEF_ROOT to lsRval
74405>>>>>>>      function_return lsRval
74406>>>>>>>    end_function
74407>>>>>>>
74407>>>>>>>    function sQryCurUserDef returns string
74410>>>>>>>      integer lbOK
74410>>>>>>>      string lsRval lsUser lsDir
74410>>>>>>>      send DoDefaults
74411>>>>>>>      get value QRYFOLD_DEF_ROOT to lsDir
74412>>>>>>>      if (lsDir<>"" and integer(value(self,QRYFOLD_DISABLE_USER_SUBFOLDERS))=0) begin
74414>>>>>>>        get sQryCurrentUserName to lsUser
74415>>>>>>>        get Files_AppendPath lsDir lsUser to lsRval
74416>>>>>>>        get bCreateDir lsRval to lbOK
74417>>>>>>>        ifnot lbOK move "" to lsRval
74420>>>>>>>      end
74420>>>>>>>>
74420>>>>>>>      else move "" to lsRval
74422>>>>>>>      function_return lsRval
74423>>>>>>>    end_function
74424>>>>>>>
74424>>>>>>>    function sQryCurUserOut returns string
74427>>>>>>>      integer lbOK
74427>>>>>>>      string lsRval lsUser lsDir
74427>>>>>>>      send DoDefaults
74428>>>>>>>
74428>>>>>>>      get value QRYFOLD_OUT_ROOT to lsDir
74429>>>>>>>      if (lsDir<>"" and integer(value(self,QRYFOLD_DISABLE_USER_SUBFOLDERS))=0) begin
74431>>>>>>>        get sQryCurrentUserName to lsUser
74432>>>>>>>        move (lsUser*t.qryfolder.name.OutPostFix) to lsUser
74433>>>>>>>        get Files_AppendPath lsDir lsUser to lsRval
74434>>>>>>>        get bCreateDir lsRval to lbOK
74435>>>>>>>        ifnot lbOK move "" to lsRval
74438>>>>>>>      end
74438>>>>>>>>
74438>>>>>>>      else move "" to lsRval
74440>>>>>>>      function_return lsRval
74441>>>>>>>    end_function
74442>>>>>>>
74442>>>>>>>  end_object
74443>>>>>>>end_desktop_section
74448>>>>>>>
74448>>>>>>>procedure set Query_Folder global integer liItem string lsValue
74450>>>>>>>  set value of (oQry_FolderSetup(self)) liItem to lsValue
74451>>>>>>>end_procedure
74452>>>>>>>
74452>>>>>>>function Query_Folder global integer liItem returns string
74454>>>>>>>  if (liItem=QRYFOLD_PUBLIC_DEF)       function_return (sQryPublicDef(oQry_FolderSetup(self)))
74457>>>>>>>  if (liItem=QRYFOLD_CURRENT_USER_DEF) function_return (sQryCurUserDef(oQry_FolderSetup(self)))
74460>>>>>>>  if (liItem=QRYFOLD_CURRENT_USER_OUT) function_return (sQryCurUserOut(oQry_FolderSetup(self)))
74463>>>>>>>  function_return (value(oQry_FolderSetup(self),liItem))
74464>>>>>>>end_function
74465>>>>>>>
74465>>>>>>>object oQry_DefArray is a cArray NO_IMAGE
74467>>>>>>>  item_property_list
74467>>>>>>>    item_property string  psFile.i
74467>>>>>>>    item_property string  psTitle.i
74467>>>>>>>    item_property integer piMainFile.i
74467>>>>>>>  end_item_property_list
#REM 74507 DEFINE FUNCTION PIMAINFILE.I INTEGER LIROW RETURNS INTEGER
#REM 74512 DEFINE PROCEDURE SET PIMAINFILE.I INTEGER LIROW INTEGER VALUE
#REM 74517 DEFINE FUNCTION PSTITLE.I INTEGER LIROW RETURNS STRING
#REM 74522 DEFINE PROCEDURE SET PSTITLE.I INTEGER LIROW STRING VALUE
#REM 74527 DEFINE FUNCTION PSFILE.I INTEGER LIROW RETURNS STRING
#REM 74532 DEFINE PROCEDURE SET PSFILE.I INTEGER LIROW STRING VALUE
74538>>>>>>>  procedure AddFile string lsFile string lsFolder
74541>>>>>>>    integer liFile liChannel liRow
74541>>>>>>>    string lsTitle lsLine
74541>>>>>>>    if (WildCardMatch(lsFile)) begin
74543>>>>>>>      get row_count to liRow
74544>>>>>>>
74544>>>>>>>      get Files_AppendPath lsFolder lsFile to lsFile
74545>>>>>>>      get SEQ_DirectInput lsFile to liChannel
74546>>>>>>>      if (liChannel>=0) begin
74548>>>>>>>        readln channel liChannel lsLine
74550>>>>>>>        if (lsLine="QDF2.0") begin
74552>>>>>>>          readln liFile
74553>>>>>>>          readln lsTitle
74554>>>>>>>          set psFile.i     liRow to lsFile
74555>>>>>>>          set psTitle.i    liRow to lsTitle
74556>>>>>>>          set piMainFile.i liRow to liFile
74557>>>>>>>        end
74557>>>>>>>>
74557>>>>>>>        send SEQ_CloseInput liChannel
74558>>>>>>>      end
74558>>>>>>>>
74558>>>>>>>    end
74558>>>>>>>>
74558>>>>>>>  end_procedure
74559>>>>>>>  procedure fill_array
74562>>>>>>>    string lsFolder
74562>>>>>>>    send delete_data
74563>>>>>>>    send WildCardMatchPrepare "*.qdf"
74564>>>>>>>    get Query_Folder QRYFOLD_CURRENT_USER_DEF to lsFolder
74565>>>>>>>    send SEQ_Load_ItemsInDir lsFolder
74566>>>>>>>    send SEQ_CallBack_ItemsInDir SEQCB_FILES_ONLY MSG_AddFile self
74567>>>>>>>  end_procedure
74568>>>>>>>end_object // oQry_DefArray
74569>>>>>Use Focus.utl    // Retrieve basic information about object
74569>>>>>
74569>>>>>
74569>>>>>  Use VpeBase3 //JK: Now uses VPE 3.x
74569>>>>>
74569>>>>>// *** A few functions ****************************************************
74569>>>>>
74569>>>>>desktop_section
74574>>>>>  register_procedure DoAppendItem
74574>>>>>  register_procedure DoClear
74574>>>>>  register_procedure DoDeleteItem
74574>>>>>  register_procedure DoUppercase
74574>>>>>  register_procedure DoLowercase
74574>>>>>  register_procedure DoCopy
74574>>>>>  register_procedure DoPaste
74574>>>>>  register_procedure DoSort
74574>>>>>  object oVdfQuery_OrList_FM is a FloatingPopupMenu
74576>>>>>    send add_item msg_DoClear      "Clear all\aF5"
74577>>>>>    send add_item msg_DoDeleteItem "Delete item\aShift+F2"
74578>>>>>    send add_item msg_DoUppercase  "Uppercase all"
74579>>>>>    send add_item msg_DoLowercase  "Lowercase all"
74580>>>>>    send add_item msg_DoSort       "Sort items"
74581>>>>>    send add_item msg_DoAppendItem "Append item\aCtrl+A"
74582>>>>>    send add_item msg_NONE         ""
74583>>>>>    send add_item msg_DoCopy       "Copy\aCtrl+C"
74584>>>>>    send add_item msg_DoPaste      "Paste\aCtrl+V"
74585>>>>>  end_object
74586>>>>>end_desktop_section
74591>>>>>
74591>>>>>class vdq.orlist_grid is a aps.Grid // or-list
74592>>>>>  procedure construct_object
74594>>>>>    forward send construct_object
74596>>>>>
74596>>>>>    set line_width to 2 0
74597>>>>>    set form_margin item 0 to 30
74598>>>>>    set form_margin item 1 to 0
74599>>>>>
74599>>>>>    set CurrentCellColor     to clHighlight
74600>>>>>    set CurrentCellTextColor to clHighlightText
74601>>>>>    set CurrentRowColor      to clHighlight
74602>>>>>    set CurrentRowTextColor  to clHighlightText
74603>>>>>
74603>>>>>    set select_mode to multi_select
74604>>>>>    set auto_top_item_state to false
74605>>>>>
74605>>>>>    set gridline_mode to GRID_VISIBLE_NONE
74606>>>>>    set Header_Visible_State to DFFALSE
74607>>>>>
74607>>>>>    set size to 47 90
74608>>>>>    set p_auto_size_control_state to false
74609>>>>>    set Horz_Scroll_Bar_Visible_State to false
74610>>>>>    on_key KENTER send DoAppendOrEnter
74611>>>>>    on_key KDELETE_RECORD send DoDeleteItem
74612>>>>>    on_key KCLEAR send DoClear
74613>>>>>    on_key KEY_CTRL+KEY_A send DoAppendItem
74614>>>>>    on_key KEY_CTRL+KEY_C send DoCopy
74615>>>>>    on_key KEY_CTRL+KEY_V send DoPaste
74616>>>>>    set aps_fixed_column_width item 1 to 2
74617>>>>>  end_procedure
74618>>>>>
74618>>>>>  procedure DoSetup integer liFile integer liField
74620>>>>>    integer liType
74620>>>>>    get gl_generic_form_datatype liFile liField to liType
74621>>>>>    set form_datatype item 0 to liType
74622>>>>>  end_procedure
74623>>>>>
74623>>>>>  procedure entering // Make sure that there is at least one item on entering
74625>>>>>    ifnot (item_count(self)) begin
74627>>>>>      send add_item MSG_NONE ""
74628>>>>>      send add_item MSG_NONE ""
74629>>>>>      set item_shadow_state item (item_count(self)-1) to true
74630>>>>>    end
74630>>>>>>
74630>>>>>    forward send entering
74632>>>>>  end_procedure
74633>>>>>
74633>>>>>  procedure next
74635>>>>>    if (current_item(self)>=item_count(self)-2) send switch
74638>>>>>    else forward send next
74641>>>>>  end_procedure
74642>>>>>
74642>>>>>  procedure DoAppendOrEnter
74644>>>>>    integer liItem liMax
74644>>>>>    string lsValue
74644>>>>>    get item_count to liMax
74645>>>>>    if liMax begin
74647>>>>>      decrement liMax
74648>>>>>      get current_item to liItem
74649>>>>>      get value item liItem to lsValue
74650>>>>>      if (liItem=liMax-1) begin
74652>>>>>        if (lsValue="") send next
74655>>>>>        else send DoAppendItem
74657>>>>>      end
74657>>>>>>
74657>>>>>      else send next
74659>>>>>    end
74659>>>>>>
74659>>>>>    else send next
74661>>>>>  end_procedure
74662>>>>>
74662>>>>>  procedure item_change integer liItm1 integer liItm2 returns integer
74664>>>>>    integer liTarget liMaxItem
74664>>>>>    forward get msg_item_change liItm1 liItm2 to liTarget
74666>>>>>    if (mod(liTarget,2)) begin
74668>>>>>      if (abs(liItm1-liItm2)=1) begin
74670>>>>>        if (liItm1>>>>        else decrement liTarget
74675>>>>>      end
74675>>>>>>
74675>>>>>      else decrement liTarget
74677>>>>>    end
74677>>>>>>
74677>>>>>    get item_count to liMaxItem
74678>>>>>    decrement liMaxItem
74679>>>>>    decrement liMaxItem
74680>>>>>    if (liTarget>liMaxItem) move liMaxItem to liTarget
74683>>>>>    if (liTarget<0) move 0 to liTarget
74686>>>>>    procedure_return liTarget
74687>>>>>  end_procedure
74688>>>>>
74688>>>>>  procedure set select_value string lsValue
74690>>>>>    integer liItm liMax
74690>>>>>    string lsItem
74690>>>>>    get HowManyWords lsValue "|" to liMax
74691>>>>>    for liItm from 1 to liMax
74697>>>>>>
74697>>>>>      get ExtractWord lsValue "|" liItm to lsItem
74698>>>>>      send add_item MSG_NONE lsItem
74699>>>>>      send add_item MSG_NONE ""
74700>>>>>      set item_shadow_state item (item_count(self)-1) to true
74701>>>>>    loop
74702>>>>>>
74702>>>>>  end_procedure
74703>>>>>
74703>>>>>  function select_value returns string
74705>>>>>    integer liRow liMax liBase
74705>>>>>    string lsValue lsItem
74705>>>>>    get Grid_RowCount self to liMax
74706>>>>>    decrement liMax
74707>>>>>    for liRow from 0 to liMax
74713>>>>>>
74713>>>>>      get Grid_RowBaseItem self liRow to liBase
74714>>>>>      get value item liBase to lsItem
74715>>>>>      if (length(lsItem)<>0) begin
74717>>>>>        if (lsValue<>"") move (lsValue+"|") to lsValue
74720>>>>>        move (lsValue+lsItem) to lsValue
74721>>>>>      end
74721>>>>>>
74721>>>>>//    if liRow move (lsValue+"|") to lsValue
74721>>>>>//    move (lsValue+lsItem) to lsValue
74721>>>>>    loop
74722>>>>>>
74722>>>>>    function_return lsValue
74723>>>>>  end_function
74724>>>>>
74724>>>>>  procedure mouse_down2 integer liWin integer liCharPos
74726>>>>>    send mouse_down liWin liCharPos // Take focus
74727>>>>>    send popup to (oVdfQuery_OrList_FM(self))
74728>>>>>  end_procedure
74729>>>>>
74729>>>>>  procedure DoAppendItem
74731>>>>>    send add_item MSG_NONE ""
74732>>>>>    send add_item MSG_NONE ""
74733>>>>>    set item_shadow_state item (item_count(self)-1) to true
74734>>>>>    set current_item to (item_count(self)-2)
74735>>>>>  end_procedure
74736>>>>>  procedure DoClear
74738>>>>>    send delete_data
74739>>>>>    send DoAppendItem
74740>>>>>  end_procedure
74741>>>>>  procedure DoDeleteItem
74743>>>>>    integer liItem
74743>>>>>    if (item_count(self)) begin
74745>>>>>      send Grid_DeleteCurrentRow self
74746>>>>>    end
74746>>>>>>
74746>>>>>    ifnot (item_count(self)) send DoAppendItem
74749>>>>>  end_procedure
74750>>>>>  procedure DoUppercase
74752>>>>>    integer liMax liItem
74752>>>>>    set dynamic_update_state to FALSE
74753>>>>>    get item_count to liMax
74754>>>>>    decrement liMax
74755>>>>>    for liItem from 0 to liMax
74761>>>>>>
74761>>>>>      set value item liItem to (uppercase(value(self,liItem)))
74762>>>>>    loop
74763>>>>>>
74763>>>>>    set dynamic_update_state to TRUE
74764>>>>>  end_procedure
74765>>>>>  procedure DoLowercase
74767>>>>>    integer liMax liItem
74767>>>>>    set dynamic_update_state to FALSE
74768>>>>>    get item_count to liMax
74769>>>>>    decrement liMax
74770>>>>>    for liItem from 0 to liMax
74776>>>>>>
74776>>>>>      set value item liItem to (lowercase(value(self,liItem)))
74777>>>>>    loop
74778>>>>>>
74778>>>>>    set dynamic_update_state to TRUE
74779>>>>>  end_procedure
74780>>>>>  procedure DoCopy
74782>>>>>    integer liMax liRow liBase
74782>>>>>    direct_output channel 1 "CLIPBOARD:"
74784>>>>>    get Grid_RowCount self to liMax
74785>>>>>    decrement liMax
74786>>>>>    for liRow from 0 to liMax
74792>>>>>>
74792>>>>>      get Grid_RowBaseItem self liRow to liBase
74793>>>>>      writeln channel 1 (value(self,liBase))
74796>>>>>    loop
74797>>>>>>
74797>>>>>    close_output channel 1
74799>>>>>  end_procedure
74800>>>>>  procedure DoPaste
74802>>>>>    string lsValue
74802>>>>>    send DoClear
74803>>>>>    direct_input channel 0 "CLIPBOARD:"
74805>>>>>    while (not(seqeof))
74809>>>>>      readln channel 0 lsValue
74811>>>>>      ifnot (seqeof) begin
74813>>>>>        send add_item MSG_NONE lsValue
74814>>>>>        send add_item MSG_NONE ""
74815>>>>>        set item_shadow_state item (item_count(self)-1) to true
74816>>>>>      end
74816>>>>>>
74816>>>>>    end
74817>>>>>>
74817>>>>>    close_input channel 0
74819>>>>>  end_procedure
74820>>>>>  procedure DoSort
74822>>>>>    send Grid_SortByColumn self 0
74823>>>>>  end_procedure
74824>>>>>end_class // vdq.orlist_grid
74825>>>>>
74825>>>>>Use Query.nui    // Basic things needed for a query tool
74825>>>>>// *** Dynamic object components *****************************************
74825>>>>>//                                                 0      1    2     3     4     5     6     7
74825>>>>>DEFINE_OBJECT_GROUP OG_QuerySelectDialogElement // label# mrg# type# comp# val1# val2# file# field#
74826>>>>>  if (og_param(3)=SC_COMP_OR_LIST) begin // or-list
74828>>>>>    set p_auto_column to 0
74829>>>>>    send aps_goto_max_row
74830>>>>>    send aps_make_row_space 5
74831>>>>>    object oLabel is a aps.TextBox
74833>>>>>      procedure do_label
74836>>>>>        string label#
74836>>>>>        move (og_param(0)) to label#
74837>>>>>        // Remove ":"
74837>>>>>        if (right(label#,1)) eq ":" move (StringLeftBut(label#,1)) to label#
74840>>>>>        move (label#+" ("+DfQuery_CompModeTxt_Short(SC_COMP_OR_LIST)+"):") to label#
74841>>>>>        set label to label#
74842>>>>>      end_procedure
74843>>>>>      send do_label
74844>>>>>    end_object
74845>>>>>    object oList is a vdq.orlist_grid snap 1
74848>>>>>      move self to OG_Current_Object#
74849>>>>>      send DoSetup (og_param(6)) (og_param(7))
74850>>>>>      set select_value to (og_param(4))
74851>>>>>    end_object
74852>>>>>    send add_object_id (0-OG_Current_Object#)
74853>>>>>    send add_object_id 0
74854>>>>>
74854>>>>>    set p_auto_column to 1
74855>>>>>    send aps_goto_max_row
74856>>>>>  end
74856>>>>>>
74856>>>>>  else begin
74857>>>>>    object oVal1 is a aps.form
74859>>>>>      property integer piPopupFile   public 0
74861>>>>>      property integer piPopupField  public 0
74863>>>>>      procedure do_label
74866>>>>>        integer comp#
74866>>>>>        string label#
74866>>>>>        move (og_param(0)) to label#
74867>>>>>        move (og_param(3)) to comp#
74868>>>>>        // Remove ":"
74868>>>>>        if (right(label#,1)) eq ":" move (StringLeftBut(label#,1)) to label#
74871>>>>>        move (label#+" ("+DfQuery_CompModeTxt_Short(comp#)+"):") to label#
74872>>>>>        set label to label#
74873>>>>>      end_procedure
74874>>>>>      send do_label
74875>>>>>      set form_datatype item 0 to (og_param(2))
74876>>>>>      set form_margin item 0 to (og_param(1) min 40)
74877>>>>>      set value item 0 to (og_param(4))
74878>>>>>      set status_help item 0 to (DfQuery_CompModeTxt_Long(og_param(3)))
74879>>>>>      procedure OnSetFocus
74882>>>>>        forward send OnSetFocus
74884>>>>>        send request_status_help 1
74885>>>>>      end_procedure
74886>>>>>      move self to OG_Current_Object#
74887>>>>>      if (integer(og_param(7))<256) begin
74889>>>>>        set piPopupFile  to (integer(API_AttrValue_FIELD(DF_FIELD_RELATED_FILE,og_param(6),og_param(7))))
74890>>>>>        set piPopupField to (integer(API_AttrValue_FIELD(DF_FIELD_RELATED_FIELD,og_param(6),og_param(7))))
74891>>>>>      end
74891>>>>>>
74891>>>>>      else begin
74892>>>>>        set piPopupFile  to 0
74893>>>>>        set piPopupField to 0
74894>>>>>      end
74894>>>>>>
74894>>>>>      if (piPopupFile(self)) begin
74896>>>>>        set form_button item 0 to 1 // Manually add a prompt button
74897>>>>>        set form_button_value item 0 to "..."
74898>>>>>        on_key kprompt send form_button_notification
74899>>>>>        procedure form_button_notification integer itm#
74902>>>>>          integer rec# file# field# rfile# rfield#
74902>>>>>          string str#
74902>>>>>          get piPopupFile  to rfile#
74903>>>>>          get PromptListSelectRecord rfile# "" to rec#
74904>>>>>          if rec# begin
74906>>>>>            get piPopupField to rfield#
74907>>>>>            get_field_value rfile# rfield# to str#
74910>>>>>            set value item 0 to str#
74911>>>>>          end
74911>>>>>>
74911>>>>>          send activate
74912>>>>>        end_procedure
74913>>>>>      end
74913>>>>>>
74913>>>>>      send add_object_id OG_Current_Object#
74914>>>>>      if (og_param(3)) eq SC_COMP_NOT_BLANK set object_shadow_state to true
74917>>>>>      if (og_param(3)) eq SC_COMP_BLANK     set object_shadow_state to true
74920>>>>>    end_object
74921>>>>>    if (og_param(3)=SC_COMP_BETWEEN or og_param(3)=SC_COMP_CBETWEEN) begin
74923>>>>>      object oVal2 is a aps.form label "-" snap (if(integer(og_param(1))>15,0,sl_right))
74927>>>>>        property integer piPopupFile   public 0
74929>>>>>        property integer piPopupField  public 0
74931>>>>>        set form_datatype item 0 to (og_param(2))
74932>>>>>        set form_margin item 0 to (og_param(1) min 40)
74933>>>>>        set value item 0 to (og_param(5))
74934>>>>>        set status_help item 0 to (DfQuery_CompModeTxt_Long(og_param(3)))
74935>>>>>        procedure OnSetFocus
74938>>>>>          forward send OnSetFocus
74940>>>>>          send request_status_help 1
74941>>>>>        end_procedure
74942>>>>>        move self to OG_Current_Object#
74943>>>>>        if (integer(og_param(7))<256) begin
74945>>>>>          set piPopupFile  to (integer(API_AttrValue_FIELD(DF_FIELD_RELATED_FILE,og_param(6),og_param(7))))
74946>>>>>          set piPopupField to (integer(API_AttrValue_FIELD(DF_FIELD_RELATED_FIELD,og_param(6),og_param(7))))
74947>>>>>        end
74947>>>>>>
74947>>>>>        else begin
74948>>>>>          set piPopupFile  to 0
74949>>>>>          set piPopupField to 0
74950>>>>>        end
74950>>>>>>
74950>>>>>        if (piPopupFile(self)) begin
74952>>>>>          set form_button item 0 to 1 // Manually add a prompt button
74953>>>>>          set form_button_value item 0 to "..."
74954>>>>>          on_key kprompt send form_button_notification
74955>>>>>          procedure form_button_notification integer itm#
74958>>>>>            integer rec# file# field# rfile# rfield#
74958>>>>>            string str#
74958>>>>>            get piPopupFile  to rfile#
74959>>>>>            get PromptListSelectRecord rfile# "" to rec#
74960>>>>>            if rec# begin
74962>>>>>              get piPopupField to rfield#
74963>>>>>              get_field_value rfile# rfield# to str#
74966>>>>>              set value item 0 to str#
74967>>>>>            end
74967>>>>>>
74967>>>>>            send activate
74968>>>>>          end_procedure
74969>>>>>        end
74969>>>>>>
74969>>>>>        send add_object_id OG_Current_Object#
74970>>>>>      end_object
74971>>>>>    end
74971>>>>>>
74971>>>>>    else send add_object_id 0
74973>>>>>  end
74973>>>>>>
74973>>>>>END_DEFINE_OBJECT_GROUP // OG_QuerySelectDialogElement
74974>>>>>
74974>>>>>DEFINE_OBJECT_GROUP OG_QuerySelectDialog // caption array_id
74975>>>>>  object QueryMultiCrit is a aps.ModalPanel label (t.DfQuery.LblTab2+", "+og_param(0))
74978>>>>>    on_key key_ctrl+key_P send MSG_NONE
74979>>>>>    on_key kcancel send close_panel_cancel
74980>>>>>    set locate_mode to CENTER_ON_SCREEN
74981>>>>>    property integer pReturnValue public 0
74983>>>>>    property integer pArrayID public 0
74985>>>>>    set pArrayID to (og_param(1))
74986>>>>>    object object_ids_array is an array
74988>>>>>    end_object
74989>>>>>    procedure add_object_id integer obj#
74992>>>>>      integer arr#
74992>>>>>      move (object_ids_array(self)) to arr#
74993>>>>>      set value of arr# item (item_count(arr#)) to obj#
74994>>>>>    end_procedure
74995>>>>>    object oCont is a aps.Group
74997>>>>>      on_key ksave_record send close_panel_ok
74998>>>>>      on_key kenter send next
74999>>>>>      set p_max_column to 200 // Minimum width
75000>>>>>      send aps_tab_column_define 1 70 65 JMODE_RIGHT
75001>>>>>      procedure add_objects integer obj#
75004>>>>>        integer mrg# type# comp# crit# max# file# field#
75004>>>>>        string label# val1# val2#
75004>>>>>        get row_count of obj# to max#
75005>>>>>        for crit# from 0 to (max#-1)
75011>>>>>>
75011>>>>>          get psLabel.i  of obj# item crit# to label#
75012>>>>>          get piMargin.i of obj# item crit# to mrg#
75013>>>>>          get piType.i   of obj# item crit# to type#
75014>>>>>          get piComp.i   of obj# item crit# to comp#
75015>>>>>          get psVal1.i   of obj# item crit# to val1#
75016>>>>>          get psVal2.i   of obj# item crit# to val2#
75017>>>>>          get piFile.i   of obj# item crit# to file#
75018>>>>>          get piField.i  of obj# item crit# to field#
75019>>>>>          CREATE_OBJECT_GROUP OG_QuerySelectDialogElement label# mrg# type# comp# val1# val2# file# field#
75030>>>>>        loop
75031>>>>>>
75031>>>>>      end_procedure
75032>>>>>      send add_objects (og_param(1))
75033>>>>>    end_object
75034>>>>>    procedure close_panel_ok
75037>>>>>      integer object_ids_array# pArrayID# crit# max# obj# oFrm#
75037>>>>>      // Now we move the current values back to the array:
75037>>>>>      get pArrayID to pArrayID#
75038>>>>>      move (object_ids_array(self)) to object_ids_array#
75039>>>>>      get row_count of pArrayID# to max#
75040>>>>>      for crit# from 0 to (max#-1)
75046>>>>>>
75046>>>>>        move (value(object_ids_array#,crit#*2+0)) to oFrm#
75047>>>>>        if (oFrm#>0) begin
75049>>>>>          set psVal1.i of pArrayID# item crit# to (value(oFrm#,0))
75050>>>>>        end
75050>>>>>>
75050>>>>>        else if (oFrm#<0) begin // Oh! It's an or-list!!!
75053>>>>>          move (0-oFrm#) to oFrm#
75054>>>>>          set psVal1.i of pArrayID# item crit# to (select_value(oFrm#))
75055>>>>>        end
75055>>>>>>
75055>>>>>        move (value(object_ids_array#,crit#*2+1)) to oFrm#
75056>>>>>        if oFrm# set psVal2.i of pArrayID# item crit# to (value(oFrm#,0))
75059>>>>>      loop
75060>>>>>>
75060>>>>>      set pReturnValue to 1
75061>>>>>      send close_panel
75062>>>>>    end_procedure
75063>>>>>    procedure close_panel_cancel
75066>>>>>      set pReturnValue to 0
75067>>>>>      send close_panel
75068>>>>>    end_procedure
75069>>>>>    object oBtn1 is a aps.Multi_Button
75071>>>>>      on_item t.btn.ok send close_panel_ok
75072>>>>>    end_object
75073>>>>>    object oBtn2 is a aps.Multi_Button
75075>>>>>      on_item t.btn.cancel send close_panel_cancel
75076>>>>>    end_object
75077>>>>>    send aps_locate_multi_buttons
75078>>>>>  //procedure request_clear // not used?
75078>>>>>  //  set value of (oVal1(oCont(self))) item 0 to ""
75078>>>>>  //  set value of (oVal2(oCont(self))) item 0 to ""
75078>>>>>  //  send activate to (oVal1(oCont(self)))
75078>>>>>  //end_procedure
75078>>>>>  //function string_value integer item# returns string // Not used?
75078>>>>>  //  function_return (value(value(object_ids_array(self),item#),0))
75078>>>>>  //end_function
75078>>>>>    move self to OG_Current_Object#
75079>>>>>  end_object
75080>>>>>END_DEFINE_OBJECT_GROUP // OG_QuerySelectDialog
75081>>>>>
75081>>>>>DEFINE_OBJECT_GROUP OG_QuerySingleCrit // label# mrg# type# comp# val1# val2# liFile liFIeld
75082>>>>>  object QuerySingleCrit is a aps.ModalPanel label (t.DfQuery.SetDefaultValue+", "+DfQuery_CompModeTxt_Long(og_param(3)))
75085>>>>>    on_key key_ctrl+key_P send msg_none
75086>>>>>    on_key kcancel send close_panel_cancel
75087>>>>>    on_key kclear send request_clear
75088>>>>>    on_key kclear_all send close_panel_reset
75089>>>>>    set locate_mode to center_on_screen
75090>>>>>    property integer pReturnValue public 0
75092>>>>>    property integer piComp       public -1
75094>>>>>
75094>>>>>    object oCont is a aps.Group
75096>>>>>      on_key ksave_record send close_panel_ok
75097>>>>>      on_key kenter send next
75098>>>>>      set p_max_column to 200 // Minimum width
75099>>>>>      set piComp to (og_param(3)) // or-list ()
75100>>>>>
75100>>>>>      if (og_param(3)=SC_COMP_OR_LIST) begin // or-list
75102>>>>>        set p_auto_column to 0
75103>>>>>        send aps_goto_max_row
75104>>>>>        send aps_make_row_space 5
75105>>>>>        object oLabel is a aps.TextBox
75107>>>>>          procedure do_label
75110>>>>>            string label#
75110>>>>>            move (og_param(0)) to label#
75111>>>>>            if (right(label#,1)) eq ":" move (StringLeftBut(label#,1)) to label#
75114>>>>>            move (label#+" ("+DfQuery_CompModeTxt_Short(SC_COMP_OR_LIST)+"):") to label#
75115>>>>>            set label to label#
75116>>>>>          end_procedure
75117>>>>>          send do_label
75118>>>>>        end_object
75119>>>>>        object oList is a vdq.orlist_grid snap 1
75122>>>>>          send DoSetup (og_param(6)) (og_param(7))
75123>>>>>          set select_value to (og_param(4))
75124>>>>>        end_object
75125>>>>>
75125>>>>>        set p_auto_column to 1
75126>>>>>        send aps_goto_max_row
75127>>>>>      end
75127>>>>>>
75127>>>>>      else begin
75128>>>>>        object oVal1 is a aps.form label (og_param(0))
75131>>>>>          set form_datatype item 0 to (og_param(2))
75132>>>>>          set form_margin item 0 to (og_param(1) min 40)
75133>>>>>          set value item 0 to (og_param(4))
75134>>>>>          if (og_param(3)) eq SC_COMP_NOT_BLANK set object_shadow_state to true
75137>>>>>          if (og_param(3)) eq SC_COMP_BLANK     set object_shadow_state to true
75140>>>>>        end_object
75141>>>>>        if (og_param(3)=SC_COMP_BETWEEN or og_param(3)=SC_COMP_CBETWEEN) begin
75143>>>>>          object oVal2 is a aps.form label "-" snap (if(integer(og_param(1))>15,0,sl_right))
75147>>>>>            set form_datatype item 0 to (og_param(2))
75148>>>>>            set form_margin item 0 to (og_param(1) min 40)
75149>>>>>            set value item 0 to (og_param(5))
75150>>>>>          end_object
75151>>>>>        end
75151>>>>>>
75151>>>>>      end
75151>>>>>>
75151>>>>>    end_object // oCont
75152>>>>>    procedure close_panel_ok
75155>>>>>      set pReturnValue to 1
75156>>>>>      send close_panel
75157>>>>>    end_procedure
75158>>>>>    procedure close_panel_reset
75161>>>>>      set pReturnValue to -1
75162>>>>>      send close_panel
75163>>>>>    end_procedure
75164>>>>>    procedure close_panel_cancel
75167>>>>>      set pReturnValue to 0
75168>>>>>      send close_panel
75169>>>>>    end_procedure
75170>>>>>    object oBtn1 is a aps.Multi_Button
75172>>>>>      on_item t.btn.ok send close_panel_ok
75173>>>>>    end_object
75174>>>>>    object oBtn2 is a aps.Multi_Button
75176>>>>>      on_item t.btn.reset send close_panel_reset
75177>>>>>    end_object
75178>>>>>    object oBtn3 is a aps.Multi_Button
75180>>>>>      on_item t.btn.cancel send close_panel_cancel
75181>>>>>    end_object
75182>>>>>    send aps_locate_multi_buttons
75183>>>>>    if (og_param(3)=SC_COMP_BETWEEN or og_param(3)=SC_COMP_CBETWEEN) begin
75185>>>>>      procedure request_clear
75188>>>>>        set value of (oVal1(oCont(self))) item 0 to ""
75189>>>>>        set value of (oVal2(oCont(self))) item 0 to ""
75190>>>>>        send activate to (oVal1(oCont(self)))
75191>>>>>      end_procedure
75192>>>>>    end
75192>>>>>>
75192>>>>>    else if (og_param(3)=SC_COMP_OR_LIST) begin // or-list
75195>>>>>      procedure request_clear
75198>>>>>        send DoClear to (oList(self))
75199>>>>>        send activate to (oList(self))
75200>>>>>      end_procedure
75201>>>>>    end
75201>>>>>>
75201>>>>>    else begin
75202>>>>>      procedure request_clear
75205>>>>>        set value of (oVal1(oCont(self))) item 0 to ""
75206>>>>>        send activate to (oVal1(oCont(self)))
75207>>>>>      end_procedure
75208>>>>>    end
75208>>>>>>
75208>>>>>
75208>>>>>    function value_from returns string
75211>>>>>      string rval#
75211>>>>>      if (piComp(self)=SC_COMP_OR_LIST) get select_value of (oList(oCont(self))) to rval# // or-list
75214>>>>>      else get value of (oVal1(oCont(self))) item 0 to rval#
75216>>>>>      function_return rval#
75217>>>>>    end_function
75218>>>>>    if (og_param(3)=SC_COMP_BETWEEN or og_param(3)=SC_COMP_CBETWEEN) begin
75220>>>>>      function value_to returns string
75223>>>>>        string rval#
75223>>>>>        get value of (oVal2(oCont(self))) item 0 to rval#
75224>>>>>        function_return rval#
75225>>>>>      end_function
75226>>>>>    end
75226>>>>>>
75226>>>>>    else begin
75227>>>>>      function value_to returns string
75230>>>>>        function_return ""
75231>>>>>      end_function
75232>>>>>    end
75232>>>>>>
75232>>>>>    move self to OG_Current_Object#
75233>>>>>  end_object
75234>>>>>END_DEFINE_OBJECT_GROUP // OG_QuerySingleCrit
75235>>>>>
75235>>>>>// *** A few more functions ***********************************************
75235>>>>>
75235>>>>>register_procedure close_panel_ok
75235>>>>>
75235>>>>>desktop_section // Place object on desktop no matter where declared
75240>>>>>  object QueryCompMode_SL is a aps.ModalPanel label t.DfQuery.Operators
75243>>>>>    on_key key_ctrl+key_P send msg_none
75244>>>>>    property integer pReturnValue public 0
75246>>>>>    on_key kcancel send close_panel
75247>>>>>    object oLst is a aps.list
75249>>>>>      set size to 120 150
75250>>>>>      procedure Mouse_click integer i1 integer i2
75253>>>>>         send close_panel_ok
75254>>>>>      end_procedure
75255>>>>>      procedure add_item.ii integer current# integer aux#
75258>>>>>        send add_item msg_close_panel_ok (DfQuery_CompModeTxt_Long(aux#)+" ("+DfQuery_CompModeTxt_Short(aux#)+")") aux#
75259>>>>>        set aux_value item (item_count(self)-1) to aux#
75260>>>>>        if current# eq aux# set current_item to (item_count(self)-1)
75263>>>>>      end_procedure
75264>>>>>      procedure fill_list integer current# integer type#
75267>>>>>        send delete_data
75268>>>>>        if type# ne DF_TEXT begin
75270>>>>>          send add_item.ii current# SC_COMP_EQ
75271>>>>>          send add_item.ii current# SC_COMP_LT
75272>>>>>          send add_item.ii current# SC_COMP_LE
75273>>>>>          send add_item.ii current# SC_COMP_GE
75274>>>>>          send add_item.ii current# SC_COMP_GT
75275>>>>>          send add_item.ii current# SC_COMP_NE
75276>>>>>        end
75276>>>>>>
75276>>>>>        send add_item.ii current# SC_COMP_IN
75277>>>>>        send add_item.ii current# SC_COMP_CIN
75278>>>>>        if type# ne DF_TEXT begin
75280>>>>>          send add_item.ii current# SC_COMP_BETWEEN
75281>>>>>          send add_item.ii current# SC_COMP_CBETWEEN
75282>>>>>        end
75282>>>>>>
75282>>>>>        else begin
75283>>>>>          send add_item.ii current# SC_COMP_NOT_BLANK
75284>>>>>          send add_item.ii current# SC_COMP_BLANK
75285>>>>>        end
75285>>>>>>
75285>>>>>        if type# ne DF_TEXT begin // or-list
75287>>>>>          send add_item.ii current# SC_COMP_OR_LIST
75288>>>>>        end
75288>>>>>>
75288>>>>>      end_procedure
75289>>>>>    end_object
75290>>>>>    procedure close_panel_ok
75293>>>>>      integer obj#
75293>>>>>      move (oLst(self)) to obj#
75294>>>>>      set pReturnValue to (aux_value(obj#,current_item(obj#)))
75295>>>>>      send close_panel
75296>>>>>    end_procedure
75297>>>>>    object oBtn1 is a aps.Multi_Button
75299>>>>>      set default_state to True
75300>>>>>      on_item t.btn.ok send close_panel_ok
75301>>>>>    end_object
75302>>>>>    object oBtn2 is a aps.Multi_Button
75304>>>>>      on_item t.btn.cancel send close_panel
75305>>>>>    end_object
75306>>>>>    send aps_locate_multi_buttons
75307>>>>>  end_object
75308>>>>>end_desktop_section
75313>>>>>
75313>>>>>function VdfQuery_SelectCompMode global integer type# integer current# returns integer
75315>>>>>  integer obj#
75315>>>>>  move (QueryCompMode_SL(self)) to obj#
75316>>>>>  set pReturnValue of obj# to current#
75317>>>>>  send fill_list to (oLst(obj#)) current# type#
75318>>>>>  send popup_modal to obj#
75319>>>>>  function_return (pReturnValue(obj#))
75320>>>>>end_function
75321>>>>>
75321>>>>>function VdfQuery_field_width_cm global integer typ# integer mrg# integer caps# string font# integer fontsize# returns number
75323>>>>>  number rval# factor#
75323>>>>>  move (120/fontsize#/2.56) to factor#
75324>>>>>  move (1.0/factor#) to factor#
75325>>>>>  //move (factor#*0.8) to factor# // Un-explainable factor (0.8)
75325>>>>>  if typ# eq DF_ASCII begin
75327>>>>>    if caps# move (mrg#*factor#*1.5) to rval#
75330>>>>>    else     move (mrg#*factor#) to rval#
75332>>>>>  end
75332>>>>>>
75332>>>>>  if typ# eq DF_DATE move (10*factor#) to rval#
75335>>>>>  if typ# eq DF_BCD  move (mrg#*factor#) to rval#
75338>>>>>  function_return rval#
75339>>>>>end_function
75340>>>>>
75340>>>>>function VdfQuery_value_width_cm global string str# string font# integer fontsize# returns number
75342>>>>>  number rval#
75342>>>>>  get VdfQuery_field_width_cm DF_ASCII (length(str#)) 0 font# fontsize# to rval#
75343>>>>>  function_return rval#
75344>>>>>end_function
75345>>>>>
75345>>>>>function VdfQuery_field_margin global integer file# integer field# returns integer
75347>>>>>  integer fieldtype# len# dec# obj#
75347>>>>>  if field# lt 256 begin
75349>>>>>    get_attribute DF_FIELD_TYPE of file# field# to fieldtype#
75352>>>>>    get_attribute DF_FIELD_LENGTH of file# field# to len#
75355>>>>>    if fieldtype# eq DF_DATE move 10 to len#
75358>>>>>    if fieldtype# eq DF_BCD begin
75360>>>>>      get gl_effective_form_datatype file# field# to dec#
75361>>>>>      if dec# move (len#+1) to len#
75364>>>>>    end
75364>>>>>>
75364>>>>>  end
75364>>>>>>
75364>>>>>  else begin
75365>>>>>    get FieldInf_VirtualFields_Object file# to obj#
75366>>>>>    move (field#-256) to field#
75367>>>>>    get piFieldType.i of obj# field# to fieldtype#
75368>>>>>    get piFieldLength.i of obj# field# to len#
75369>>>>>    if fieldtype# eq DF_DATE move 10 to len#
75372>>>>>  end
75372>>>>>>
75372>>>>>  function_return len#
75373>>>>>end_function
75374>>>>>
75374>>>>>function VdfQuery_file_status_help global integer file# returns string
75376>>>>>  integer fieldtype#
75376>>>>>  string rval# str#
75376>>>>>  move "DF-name: #, Root: #" to rval#
75377>>>>>  get_attribute DF_FILE_LOGICAL_NAME of file# to str#
75380>>>>>  replace "#" in rval# with str#
75382>>>>>  get_attribute DF_FILE_ROOT_NAME of file# to str#
75385>>>>>  replace "#" in rval# with str#
75387>>>>>  function_return rval#
75388>>>>>end_function
75389>>>>>
75389>>>>>function VdfQuery_field_status_help global integer file# integer field# returns string
75391>>>>>  integer fieldtype# obj#
75391>>>>>  string rval# str#
75391>>>>>  move "# (#)" to rval#
75392>>>>>  move (FieldInf_FieldType(file#,field#)) to fieldtype#
75393>>>>>  if fieldtype# eq DF_ASCII  move "Ascii" to str#
75396>>>>>  if fieldtype# eq DF_DATE   move "Date" to str#
75399>>>>>  if fieldtype# eq DF_TEXT   move "Text" to str#
75402>>>>>  if fieldtype# eq DF_BCD    move "Number" to str#
75405>>>>>  if fieldtype# eq DF_BINARY move "Binary" to str#
75408>>>>>  if str# eq "" move "Unknown" to str#
75411>>>>>  replace "#" in rval# with str#
75413>>>>>  replace "#" in rval# with (FieldInf_field_length_string(file#,field#))
75415>>>>>  function_return rval#
75416>>>>>end_function
75417>>>>>
75417>>>>>
75417>>>>>procedure set VdfQuery_Icon global string icon_filename#
75419>>>>>  move icon_filename# to gsVdfQuery_Icon#
75420>>>>>end_procedure
75421>>>>>
75421>>>>>integer giVdfQuery_Expressions_State
75421>>>>>move DFTRUE to giVdfQuery_Expressions_State
75422>>>>>procedure set VdfQuery_Expressions_State global integer liValue
75424>>>>>  move liValue to giVdfQuery_Expressions_State
75425>>>>>end_procedure
75426>>>>>
75426>>>>>integer giVdfQuery_OldFolders_State
75426>>>>>move DFFALSE to giVdfQuery_OldFolders_State
75427>>>>>procedure set VdfQuery_OldFolders_State global integer liValue
75429>>>>>  move liValue to giVdfQuery_OldFolders_State
75430>>>>>end_procedure
75431>>>>>
75431>>>>>desktop_section // Place object on desktop no matter where declared
75436>>>>>  object oVdfQuery_SaveAs is a SaveAsDialog
75438>>>>>    set Filter_String to t.DfQuery.Filter1
75439>>>>>    set Dialog_Caption to t.DfQuery.Caption1
75440>>>>>    set OverwritePrompt_State to false
75441>>>>>    set NoChangeDir_State to true
75442>>>>>    set HideReadOnly_State To True
75443>>>>>  end_object
75444>>>>>end_desktop_section
75449>>>>>
75449>>>>>// *** Report generating **************************************************
75449>>>>>
75449>>>>>integer oReport_info#
75449>>>>>object oReport_info is an cReport_info
75451>>>>>  set pOnlyMostSignificantBreakLevel to true
75452>>>>>  property integer current_row           public 0
75454>>>>>  property integer next_current_row      public 0
75456>>>>>  property string  pDeferredHeader       public t.DfQuery.RightHeader
75458>>>>>  property string  pCurDeferredHeader    public ""
75460>>>>>  property integer pLeftMargin           public 200
75462>>>>>  property integer pRightMargin          public 2000
75464>>>>>  property integer pTopMargin            public 150
75466>>>>>  property integer pBottomMargin         public 2750
75468>>>>>  property integer pColumnHeaderRowStart public 0
75470>>>>>  property integer pTotalsOnly           public 0
75472>>>>>  property integer pLandscape            public 0
75474>>>>>  property integer pPrintCriteria        public 0
75476>>>>>  property integer pDestination          public 0 // 0:Printer 1:Preview 2:File
75478>>>>>  property integer pFileFormat           public 0 // 0:Comma 1:Line 2:Formatted 3:HTML
75480>>>>>  property integer pPageLength           public 60
75482>>>>>  property integer pLineCount            public 0
75484>>>>>  property string  pOutFileName          public ""
75486>>>>>  property string  pCurrentFileLine      public ""
75488>>>>>  property string  pHTML_TabelHdrColor   public clYellow // (RGB_Compose(192,192,64))
75490>>>>>  property integer pIncludeLabels        public 0
75492>>>>>  property integer pSemiColon            public 0
75494>>>>>  property integer pUseAnsiCharacters    public 0
75496>>>>>  property string  psTextTop             public ""
75498>>>>>  property string  psTextBottom          public ""
75500>>>>>  property integer phXMLDocumentRoot     public 0
75502>>>>>  property string  psFieldsInIndex       public ""
75504>>>>>  Property string  psFontName public ''
75506>>>>>  Property integer piFontSize public 0
75508>>>>>
75508>>>>>  property integer pbQuiet public 0
75510>>>>>
75510>>>>>  move self to oReport_info#
75511>>>>>  object oValues is an array
75513>>>>>  end_object
75514>>>>>  object oTotals is an cReportTotals
75516>>>>>  end_object
75517>>>>>  object oBatchCompanion is a cBatchCompanion
75519>>>>>  end_object
75520>>>>>  object oCriteriaTexts is an array
75522>>>>>  end_object
75523>>>>>  object oBreakInfo is an array
75525>>>>>    set delegation_mode to delegate_to_parent
75526>>>>>    property integer pMaxLogicalLevel public 0
75528>>>>>    item_property_list
75528>>>>>      item_property integer piFile.i
75528>>>>>      item_property integer piField.i
75528>>>>>      item_property integer piExprRow.i
75528>>>>>      item_property integer phExprArr.i
75528>>>>>      item_property integer piSelect.i
75528>>>>>      item_property string  psLabel.i
75528>>>>>      // If this break level is not selected this property will point to a
75528>>>>>      // level that is selected (in less significant direction):
75528>>>>>      item_property integer piTranslateLevel.i
75528>>>>>      // This property translates break level to a logical break level (since
75528>>>>>      // some physical levels may not be selected):
75528>>>>>      item_property integer piLogicalLevel.i
75528>>>>>    end_item_property_list
#REM 75583 DEFINE FUNCTION PILOGICALLEVEL.I INTEGER LIROW RETURNS INTEGER
#REM 75588 DEFINE PROCEDURE SET PILOGICALLEVEL.I INTEGER LIROW INTEGER VALUE
#REM 75593 DEFINE FUNCTION PITRANSLATELEVEL.I INTEGER LIROW RETURNS INTEGER
#REM 75598 DEFINE PROCEDURE SET PITRANSLATELEVEL.I INTEGER LIROW INTEGER VALUE
#REM 75603 DEFINE FUNCTION PSLABEL.I INTEGER LIROW RETURNS STRING
#REM 75608 DEFINE PROCEDURE SET PSLABEL.I INTEGER LIROW STRING VALUE
#REM 75613 DEFINE FUNCTION PISELECT.I INTEGER LIROW RETURNS INTEGER
#REM 75618 DEFINE PROCEDURE SET PISELECT.I INTEGER LIROW INTEGER VALUE
#REM 75623 DEFINE FUNCTION PHEXPRARR.I INTEGER LIROW RETURNS INTEGER
#REM 75628 DEFINE PROCEDURE SET PHEXPRARR.I INTEGER LIROW INTEGER VALUE
#REM 75633 DEFINE FUNCTION PIEXPRROW.I INTEGER LIROW RETURNS INTEGER
#REM 75638 DEFINE PROCEDURE SET PIEXPRROW.I INTEGER LIROW INTEGER VALUE
#REM 75643 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 75648 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 75653 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 75658 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
75664>>>>>  end_object
75665>>>>>  procedure initialize_breaks
75668>>>>>    integer current_level# level# max# oBreakInfo#
75668>>>>>    move (oBreakInfo(self)) to oBreakInfo#
75669>>>>>    set piNumberOfColumns of (oTotals(self)) to (rpt_field_count(self))
75670>>>>>    get row_count of oBreakInfo# to max#
75671>>>>>    move 0 to current_level#
75672>>>>>    for_ex level# from (max#-1) down_to 0
75679>>>>>      if (piSelect.i(oBreakInfo#,level#)) move level# to current_level#
75682>>>>>      set piTranslateLevel.i of oBreakInfo# item level# to current_level#
75683>>>>>    loop
75684>>>>>>
75684>>>>>    move 0 to current_level#
75685>>>>>    for level# from 0 to (max#-1)
75691>>>>>>
75691>>>>>      if (piSelect.i(oBreakInfo#,level#)) increment current_level#
75694>>>>>      set piLogicalLevel.i of oBreakInfo# item level# to current_level#
75695>>>>>    loop
75696>>>>>>
75696>>>>>    set pMaxLogicalLevel of oBreakInfo# to current_level#
75697>>>>>  end_procedure
75698>>>>>  procedure define_break_level integer file# integer fld# integer liExprRow integer lhExprArr integer select# string label#
75701>>>>>    integer row# oBreakInfo#
75701>>>>>    move (oBreakInfo(self)) to oBreakInfo#
75702>>>>>    get row_count of oBreakInfo# to row#
75703>>>>>    set piFile.i    of oBreakInfo# item row# to file#
75704>>>>>    set piField.i   of oBreakInfo# item row# to fld#
75705>>>>>    set piExprRow.i of oBreakInfo# item row# to liExprRow
75706>>>>>    set phExprArr.i of oBreakInfo# item row# to lhExprArr
75707>>>>>    set piSelect.i  of oBreakInfo# item row# to select#
75708>>>>>    set psLabel.i   of oBreakInfo# item row# to label#
75709>>>>>    send add_break_field file# fld# liExprRow lhExprArr
75710>>>>>  end_procedure
75711>>>>>  function sBreakField_Value.i integer level# returns string
75714>>>>>    integer file# fld# oBreakInfo# liExprRow lhExprArr
75714>>>>>    string rval# label#
75714>>>>>    move (oBreakInfo(self)) to oBreakInfo#
75715>>>>>    get piFile.i of oBreakInfo# level# to file#
75716>>>>>    if file# begin
75718>>>>>      get piField.i of oBreakInfo# level# to fld#
75719>>>>>      get FieldInf_FieldValue file# fld# to rval#
75720>>>>>    end
75720>>>>>>
75720>>>>>    else begin
75721>>>>>      get phExprArr.i of oBreakInfo# level# to lhExprArr
75722>>>>>      get piExprRow.i of oBreakInfo# level# to liExprRow
75723>>>>>      get sEvalExpression of (Query_ExprEvaluator(self)) (piExprId.i(lhExprArr,liExprRow)) to rval#
75724>>>>>    end
75724>>>>>>
75724>>>>>    if rval# eq "" move "    " to rval# // Make evident that field is empty!
75727>>>>>    else move (trim(rval#)) to rval#
75729>>>>>    move (psLabel.i(oBreakInfo#,level#)) to label#
75730>>>>>    function_return (label#+rval#)
75731>>>>>  end_function
75732>>>>>
75732>>>>>  procedure print_subheader string str# integer level#
75735>>>>>    integer vbottom#
75735>>>>>    if (pDestination(self)<>DFQ.DEST.FILE) begin // If not file
75737>>>>>       send vpe_SetAlign to oVPE# ALIGN_CENTER
75738>>>>>       send vpe_SelectFont to oVPE# "Arial" ((4-level#*2+10) max 10)
75739>>>>>       send vpe_Write to oVPE# (pLeftMargin(self)) VBOTTOM (pRightMargin(self)) VFREE ("[IO ]"+str#)
75740>>>>>       get vpe_Get of oVPE# VBOTTOM to vbottom#
75741>>>>>     //set current_row to (vbottom#+50)
75741>>>>>       set next_current_row to (vbottom#+00)
75742>>>>>     //set pColumnHeaderRowStart to (vbottom#+50)
75742>>>>>     //get pLeftMargin to pLeftMargin#
75742>>>>>    end
75742>>>>>>
75742>>>>>    else begin // File:
75743>>>>>      if (pFileFormat(self)=DFQ.FORMAT.HTML) begin
75745>>>>>        writeln channel 1 "  "
75748>>>>>        increment level#
75749>>>>>        writeln ('     '+html_DfToHtmlTable(str#)+' ')
75751>>>>>        writeln "  "
75753>>>>>      end
75753>>>>>>
75753>>>>>      if (pFileFormat(self)=DFQ.FORMAT.PRINT) begin
75755>>>>>        if level# eq 1 writeln channel 1 ""
75760>>>>>        writeln channel 1 (pad("",level#*2)+str#)
75763>>>>>      end
75763>>>>>>
75763>>>>>    end
75763>>>>>>
75763>>>>>  end_procedure
75764>>>>>  procedure print_subtotal string str# integer level#
75767>>>>>    if (pDestination(self)<>DFQ.DEST.FILE) begin // If not file
75769>>>>>     send print_totals 0 // Print totals but do not end it all!
75770>>>>>    end
75770>>>>>>
75770>>>>>    else send print_totals 0 // Print totals but do not end it all!
75772>>>>>  end_procedure
75773>>>>>
75773>>>>>  procedure Handle_SubHeader integer level#
75776>>>>>    integer oBreakInfo# fin# logical_level#
75776>>>>>    string str#
75776>>>>>    move (oBreakInfo(self)) to oBreakInfo#
75777>>>>>    move (piLogicalLevel.i(oBreakInfo#,level#)) to logical_level#
75778>>>>>    move 0 to fin#
75779>>>>>    move (sBreakField_Value.i(self,level#)) to str#
75780>>>>>    repeat
75780>>>>>>
75780>>>>>      decrement level#
75781>>>>>      move (level#<0 or piSelect.i(oBreakInfo#,level#)) to fin#
75782>>>>>      ifnot fin# ;        move (sBreakField_Value.i(self,level#)+", "+str#) to str#
75785>>>>>    until fin#
75787>>>>>    send print_subheader str# logical_level#
75788>>>>>  end_procedure
75789>>>>>  procedure Handle_SubTotal integer level#
75792>>>>>    integer oBreakInfo# logical_level#
75792>>>>>    move (oBreakInfo(self)) to oBreakInfo#
75793>>>>>    move (piLogicalLevel.i(oBreakInfo#,level#)) to logical_level#
75794>>>>>    send print_subtotal "Test" logical_level#
75795>>>>>  end_procedure
75796>>>>>  procedure SubHeader integer break_level#
75799>>>>>    integer oBreakInfo# level# max_level#
75799>>>>>    move (oBreakInfo(self)) to oBreakInfo#
75800>>>>>    get piTranslateLevel.i of oBreakInfo# item (break_level#-1) to break_level#
75801>>>>>    get row_count of oBreakInfo# to max_level#
75802>>>>>    for level# from break_level# to (max_level#-1)
75808>>>>>>
75808>>>>>      if (piSelect.i(oBreakInfo#,level#)) begin
75810>>>>>        send handle_subheader level#
75811>>>>>        send New_Level to (oTotals(self))
75812>>>>>      end
75812>>>>>>
75812>>>>>    loop
75813>>>>>>
75813>>>>>  end_procedure
75814>>>>>  procedure SubTotal integer level#
75817>>>>>    integer oBreakInfo# break_level# max_level#
75817>>>>>    move (oBreakInfo(self)) to oBreakInfo#
75818>>>>>    get piTranslateLevel.i of oBreakInfo# item (level#-1) to break_level#
75819>>>>>    get row_count of oBreakInfo# to max_level#
75820>>>>>    for_ex level# from (max_level#-1) down_to break_level#
75827>>>>>      if (piSelect.i(oBreakInfo#,level#)) begin
75829>>>>>        send handle_subtotal level#
75830>>>>>        send Drop_Level to (oTotals(self))
75831>>>>>      end
75831>>>>>>
75831>>>>>    loop
75832>>>>>>
75832>>>>>  end_procedure
75833>>>>>
75833>>>>>  procedure reset
75836>>>>>    Send reset_crit
75837>>>>>    Send reset_breaks
75838>>>>>    send delete_data to (oCriteriaTexts(self))
75839>>>>>    send delete_data to (oBreakInfo(self))
75840>>>>>    set pMaxLogicalLevel of (oBreakInfo(self)) to 0
75841>>>>>  end_procedure
75842>>>>>
75842>>>>>  procedure add_criteria_text string field_name# integer comp# string value#
75845>>>>>    integer oCriteriaTexts# liRow liMax
75845>>>>>    move (oCriteriaTexts(self)) to oCriteriaTexts#
75846>>>>>    if (field_name#<>"") begin
75848>>>>>      move (trim(field_name#)+", "+lowercase(DfQuery_CompModeTxt_Long(comp#))+": "+value#) to value#
75849>>>>>      if (pUseAnsiCharacters(self)) begin
75851>>>>>        if (pFileFormat(self)<>DFQ.FORMAT.HTML) move (StringOemToAnsi(value#)) to value#
75854>>>>>      end
75854>>>>>>
75854>>>>>      set value of oCriteriaTexts# item (item_count(oCriteriaTexts#)) to value#
75855>>>>>    end
75855>>>>>>
75855>>>>>    else begin
75856>>>>>      get Text_Format.sii value# 50 DFTRUE to liMax
75857>>>>>      decrement liMax
75858>>>>>      for liRow from 0 to liMax
75864>>>>>>
75864>>>>>        if (liRow=0) set value of oCriteriaTexts# item (item_count(oCriteriaTexts#)) to (t.DfQuery.Expression+": "+Text_FormattedLine.i(liRow))
75867>>>>>        else         set value of oCriteriaTexts# item (item_count(oCriteriaTexts#)) to ("            "+Text_FormattedLine.i(liRow))
75869>>>>>      loop
75870>>>>>>
75870>>>>>    end
75870>>>>>>
75870>>>>>  end_procedure
75871>>>>>
75871>>>>>  procedure initialize
75874>>>>>    integer liDestination grb# liFileFormat hoXML hoXMLDocumentRoot
75874>>>>>    string lsFields lsFileName
75874>>>>>    Boolean bOk
75874>>>>>    get pDestination to liDestination
75875>>>>>    get pFileFormat to liFileFormat
75876>>>>>    forward send initialize
75878>>>>>    // wp2 --- only use with with VPE or a non-viewer report, 
75878>>>>>    send batch_on to (oBatchCompanion(self)) (pReportTitle(self))
75879>>>>>    get FDX_IndexAsFields 0 (pMainFile(self)) (pOrdering(self)) to lsFields
75880>>>>>    get FDX_FieldsTranslateOverlaps 0 (pMainFile(self)) lsFields to lsFields
75881>>>>>    set psFieldsInIndex to lsFields
75882>>>>>     set pCurDeferredHeader to (pDeferredHeader(self))
75883>>>>>    if liDestination eq DFQ.DEST.FILE begin // File
75885>>>>>      get pOutFileName to lsFileName
75886>>>>>      direct_output channel 1 (StringOemToAnsi(lsFileName))
75888>>>>>      set pLineCount to 0
75889>>>>>      set pCurrentFileLine to ""
75890>>>>>      if (liFileFormat=DFQ.FORMAT.HTML) begin
75892>>>>>        send html_WriteHeader 1 (pReportTitle(self))
75893>>>>>        writeln ''
75895>>>>>        writeln ('
'+html_DfToHtmlTable(pReportTitle(self))+'
')
75897>>>>>        writeln '
'
75899>>>>>        writeln '
'
75901>>>>>      end
75901>>>>>>
75901>>>>>    end
75901>>>>>>
75901>>>>>    else begin
75902>>>>>       set ptitle of oVPE# to (pReportTitle(self))
75903>>>>>       send OpenDoc to oVPE#
75904>>>>>        if (pLandScape(self)) send Vpe_SetPageOrientation to oVPE# VORIENTATION_LANDSCAPE
75907>>>>>    end
75907>>>>>>
75907>>>>>
75907>>>>>    send reset to (oTotals(self))
75908>>>>>    set current_row to 0
75909>>>>>    set next_current_row to 0
75910>>>>>    send print_header_first_time
75911>>>>>  end_procedure
75912>>>>>
75912>>>>>  procedure print_column string value# integer align# integer start# integer width#
75915>>>>>    integer vbottom# current_row# vtop#
75915>>>>>    string CurrentFileLine#
75915>>>>>    if (pDestination(self)<>DFQ.DEST.FILE) begin // Not file
75917>>>>>       get current_row to current_row#
75918>>>>>       if current_row# eq 0 begin
75920>>>>>         get vpe_Get of oVPE# VTOPMARGIN to current_row#
75921>>>>>         set current_row to current_row#
75922>>>>>       end
75922>>>>>>
75922>>>>>       send vpe_SetAlign to oVPE# align#
75923>>>>>       send vpe_Write to oVPE# start# current_row# (start#+width#) VFREE (trim(value#))
75924>>>>>       get vpe_Get of oVPE# VBOTTOM to vbottom#
75925>>>>>       if vbottom# ge (next_current_row(self)) set next_current_row to vbottom#
75928>>>>>       if vbottom# lt current_row# begin
75930>>>>>         get vpe_Get of oVPE# VTOP to vtop#
75931>>>>>         set current_row to vtop#
75932>>>>>         set next_current_row to vbottom#
75933>>>>>       end
75933>>>>>>
75933>>>>>    end
75933>>>>>>
75933>>>>>    else begin
75934>>>>>      get pCurrentFileLine to CurrentFileLine#
75935>>>>>      if align# eq ALIGN_RIGHT move (overstrike(RightShift(value#,width#),CurrentFileLine#,start#)) to CurrentFileLine#
75938>>>>>      else move (overstrike(Pad(value#,width#),CurrentFileLine#,start#)) to CurrentFileLine#
75940>>>>>      set pCurrentFileLine to CurrentFileLine#
75941>>>>>    end
75941>>>>>>
75941>>>>>  end_procedure
75942>>>>>
75942>>>>>  procedure print_header // This is not called when file
75945>>>>>     integer vbottom# max# itm# type# file# fld# cr# pLeftMargin#
75945>>>>>     number start# width#
75945>>>>>     string str#
75945>>>>>
75945>>>>>     send vpe_SetAlign to oVPE# ALIGN_LEFT
75946>>>>>     send vpe_SelectFont to oVPE# "Arial" 16
75947>>>>>     send vpe_Write to oVPE# (pLeftMargin(self)) (pTopMargin(self)) 1500 VFREE ("[IO ]"+pReportTitle(self))
75948>>>>>     send vpe_SelectFont to oVPE# "Arial" 10
75949>>>>>
75949>>>>>     get pCurDeferredHeader to str#
75950>>>>>     send delete_data to (oValues(self))
75951>>>>>     move (replace("
",str#,vpe_GetCurrentPage(oVPE#))) to str#
75952>>>>>     send vpe_SetAlign to oVPE# ALIGN_RIGHT
75953>>>>>     send vpe_Write to oVPE# VFREE (pTopMargin(self)) (pRightMargin(self)) VFREE str#
75954>>>>>
75954>>>>>     get pColumnHeaderRowStart to vbottom#
75955>>>>>     set current_row to vbottom#
75956>>>>>     set next_current_row to vbottom#
75957>>>>>     get pLeftMargin to pLeftMargin#
75958>>>>>
75958>>>>>     get rpt_field_count to max#
75959>>>>>     for itm# from 0 to (max#-1)
75965>>>>>>
75965>>>>>       get rpt_field_file  item itm# to file#
75966>>>>>       get rpt_field_field item itm# to fld#
75967>>>>>       get rpt_field_name  item itm# to str#
75968>>>>>       get rpt_field_cr    item itm# to cr#
75969>>>>>       get rpt_field_start item itm# to start#
75970>>>>>       get rpt_field_width item itm# to width#
75971>>>>>       get rpt_field_type  item itm# to type#
75972>>>>>// EXPR       move (FieldInf_FieldType(file#,fld#)) to type#
75972>>>>>       if cr# send new_line
75975>>>>>       if (type#<>DF_TEXT and type#<>DF_BINARY) ;         send print_column ("[IO ]"+str#) (if(type#=DF_BCD,ALIGN_RIGHT,ALIGN_LEFT)) (start#*100+pLeftMargin#) (width#*100)
75978>>>>>       else ;         set value of (oValues(self)) item (item_count(oValues(self))) to str#
75980>>>>>     loop
75981>>>>>>
75981>>>>>
75981>>>>>     for itm# from 0 to (item_count(oValues(self))-1)
75987>>>>>>
75987>>>>>       get value of (oValues(self)) item itm# to str#
75988>>>>>       if str# ne "" begin
75990>>>>>         send new_line
75991>>>>>         send print_column str# ALIGN_LEFT (pLeftMargin(self)) 512
75992>>>>>       end
75992>>>>>>
75992>>>>>     loop
75993>>>>>>
75993>>>>>     send vpe_line to oVPE# (pLeftMargin(self)) VBOTTOM (pRightMargin(self)) VBOTTOM
75994>>>>>  end_procedure
75995>>>>>
75995>>>>>  procedure print_deferred_headers // Not called when file
75998>>>>>     integer max# page#
75998>>>>>     get vpe_GetCurrentPage of oVPE# to max#
75999>>>>>     set pCurDeferredHeader to (replace("",pCurDeferredHeader(self),string(max#)))
76000>>>>>     for page# from 1 to max#
76006>>>>>>
76006>>>>>       send vpe_GotoPage to oVPE# page#
76007>>>>>       send print_header
76008>>>>>     loop
76009>>>>>>
76009>>>>>  end_procedure
76010>>>>>
76010>>>>>  function sSeqFile.sii string str# integer format# integer ansi# returns string
76013>>>>>    if format# eq DFQ.FORMAT.CD move ('"'+replaces('"',str#,"'")+'"') to str#
76016>>>>>    if ansi# move (StringOemToAnsi(str#)) to str#
76019>>>>>    function_return str#
76020>>>>>  end_function
76021>>>>>
76021>>>>>  procedure print_header_first_time
76024>>>>>    integer vbottom# max# itm# type# file# fld# cr# pLeftMargin#
76024>>>>>    integer format# oValues# IncludeLabels# UseAnsiCharacters#
76024>>>>>    number start# width#
76024>>>>>    string str# field_sep#
76024>>>>>
76024>>>>>    get pCurDeferredHeader to str#
76025>>>>>    move (oValues(self)) to oValues#
76026>>>>>    send delete_data to oValues#
76027>>>>>    move (replace("",str#,string(dSysDate()))) to str#
76028>>>>>    move (replace("",str#,sSysTime())) to str#
76029>>>>>    set pCurDeferredHeader to str#
76030>>>>>
76030>>>>>    if (pDestination(self)<>DFQ.DEST.FILE) begin // If not file
76032>>>>>       send vpe_SetAlign to oVPE# ALIGN_LEFT
76033>>>>>       send vpe_SelectFont to oVPE# "Arial" 16
76034>>>>>       send vpe_Write to oVPE# (pLeftMargin(self)) (pTopMargin(self)) 1500 VFREE ("[IO ]"+pReportTitle(self))
76035>>>>>
76035>>>>>       get vpe_Get of oVPE# VBOTTOM to vbottom#
76036>>>>>       set current_row to (vbottom#+50)
76037>>>>>       set next_current_row to (vbottom#+50)
76038>>>>>       set pColumnHeaderRowStart to (vbottom#+50)
76039>>>>>       get pLeftMargin to pLeftMargin#
76040>>>>>
76040>>>>>       send vpe_SelectFont to oVPE# "Arial" 10
76041>>>>>       get rpt_field_count to max#
76042>>>>>       for itm# from 0 to (max#-1)
76048>>>>>>
76048>>>>>         get rpt_field_file  item itm# to file#
76049>>>>>         get rpt_field_field item itm# to fld#
76050>>>>>         get rpt_field_name  item itm# to str#
76051>>>>>         get rpt_field_cr    item itm# to cr#
76052>>>>>         get rpt_field_start item itm# to start#
76053>>>>>         get rpt_field_width item itm# to width#
76054>>>>>         get rpt_field_type  item itm# to type#
76055>>>>>// EXPR         move (FieldInf_FieldType(file#,fld#)) to type#
76055>>>>>         if cr# send new_line
76058>>>>>         if (type#<>DF_TEXT and type#<>DF_BINARY) ;           send print_column ("[IO ]"+str#) (if(type#=DF_BCD,ALIGN_RIGHT,ALIGN_LEFT)) (start#*100+pLeftMargin#) (width#*100)
76061>>>>>         else ;           set value of oValues# item (item_count(oValues#)) to str#
76063>>>>>       loop
76064>>>>>>
76064>>>>>
76064>>>>>       for itm# from 0 to (item_count(oValues#)-1)
76070>>>>>>
76070>>>>>         get value of oValues# item itm# to str#
76071>>>>>         if str# ne "" begin
76073>>>>>           send new_line
76074>>>>>           send print_column str# ALIGN_LEFT (pLeftMargin(self)) 512
76075>>>>>         end
76075>>>>>>
76075>>>>>       loop
76076>>>>>>
76076>>>>>
76076>>>>>       send vpe_line to oVPE# (pLeftMargin(self)) VBOTTOM (pRightMargin(self)) VBOTTOM
76077>>>>>
76077>>>>>       get vpe_Get of oVPE# VBOTTOM to vbottom#
76078>>>>>       set current_row to (vbottom#+50)
76079>>>>>       set next_current_row to (vbottom#+50)
76080>>>>>
76080>>>>>       send vpe_SetDefOutRectSP to oVPE# (pLeftMargin(self)) (vbottom#+50) (pRightMargin(self)) (pBottomMargin(self))
76081>>>>>       send vpe_Set to oVPE# VLEFTMARGIN   (pLeftMargin(self))
76082>>>>>       send vpe_Set to oVPE# VRIGHTMARGIN  (pRightMargin(self))
76083>>>>>       send vpe_Set to oVPE# VTOPMARGIN    (vbottom#+50)
76084>>>>>       send vpe_Set to oVPE# VBOTTOMMARGIN (pBottomMargin(self))
76085>>>>>       send print_text (psTextTop(self))
76086>>>>>       get vpe_Get of oVPE# VBOTTOM to vbottom#
76087>>>>>       set current_row to (vbottom#+50)
76088>>>>>       set next_current_row to (vbottom#+50)
76089>>>>>    end // if not file
76089>>>>>>
76089>>>>>    else begin
76090>>>>>      get pFileFormat to format#
76091>>>>>      if (format#=DFQ.FORMAT.PRINT) begin
76093>>>>>        move (pReportTitle(self)+" ("+string(dSysDate())+", "+sSysTime()+")") to str#
76094>>>>>        if (pUseAnsiCharacters(self)) move (StringOemToAnsi(str#)) to str#
76097>>>>>        writeln channel 1 str#
76100>>>>>        writeln ""
76102>>>>>        get psTextTop to str#
76103>>>>>        if (pUseAnsiCharacters(self)) move (StringOemToAnsi(str#)) to str#
76106>>>>>        send print_text str#
76107>>>>>        writeln ""
76109>>>>>        get rpt_field_count to max#
76110>>>>>        get pLeftMargin to pLeftMargin#
76111>>>>>        for itm# from 0 to (max#-1)
76117>>>>>>
76117>>>>>          get rpt_field_file  item itm# to file#
76118>>>>>          get rpt_field_field item itm# to fld#
76119>>>>>          get rpt_field_name  item itm# to str#
76120>>>>>          get rpt_field_cr    item itm# to cr#
76121>>>>>          get rpt_field_start item itm# to start#
76122>>>>>          get rpt_field_width item itm# to width#
76123>>>>>          get rpt_field_type  item itm# to type#
76124>>>>>// EXPR          move (FieldInf_FieldType(file#,fld#)) to type#
76124>>>>>          if cr# send new_line
76127>>>>>          if (type#<>DF_TEXT and type#<>DF_BINARY) ;            send print_column str# (if(type#=DF_BCD,ALIGN_RIGHT,ALIGN_LEFT)) (start#*100+pLeftMargin#) (width#*100)
76130>>>>>          else ;            set value of oValues# item (item_count(oValues#)) to str#
76132>>>>>        loop
76133>>>>>>
76133>>>>>
76133>>>>>        for itm# from 0 to (item_count(oValues#)-1)
76139>>>>>>
76139>>>>>          get value of oValues# item itm# to str#
76140>>>>>          if str# ne "" begin
76142>>>>>            send new_line
76143>>>>>            send print_column str# ALIGN_LEFT (pLeftMargin(self)) 512
76144>>>>>          end
76144>>>>>>
76144>>>>>        loop
76145>>>>>>
76145>>>>>        send new_line
76146>>>>>        writeln channel 1 "--------------------------------------------------------------------------"
76149>>>>>      end // if formatted
76149>>>>>>
76149>>>>>      if (format#=DFQ.FORMAT.HTML) begin
76151>>>>>        writeln channel 1 (t.DfQuery.GenerationTime+" "+string(dSysDate())+", "+sSysTime())
76154>>>>>        writeln '
'
76156>>>>>        writeln '
'
76158>>>>>        get psTextTop to str#
76159>>>>>        if (str#<>"") begin
76161>>>>>          if (pUseAnsiCharacters(self)) move (StringOemToAnsi(str#)) to str#
76164>>>>>          write str#
76165>>>>>          writeln '
'
76167>>>>>          writeln '
'
76169>>>>>        end
76169>>>>>>
76169>>>>>        writeln ""
76171>>>>>        writeln '  '
76173>>>>>        get rpt_field_count to max#
76174>>>>>        for itm# from 0 to (max#-1)
76180>>>>>>
76180>>>>>          get rpt_field_file  item itm# to file#
76181>>>>>          get rpt_field_field item itm# to fld#
76182>>>>>          get rpt_field_name  item itm# to str#
76183>>>>>          get rpt_field_type  item itm# to type#
76184>>>>>// EXPR          move (FieldInf_FieldType(file#,fld#)) to type#
76184>>>>>          if (type#<>DF_TEXT and type#<>DF_BINARY) begin
76186>>>>>            write ('    '
76190>>>>>          end
76190>>>>>>
76190>>>>>          else set value of oValues# item (item_count(oValues#)) to str#
76192>>>>>        loop
76193>>>>>>
76193>>>>>        for itm# from 0 to (item_count(oValues#)-1)
76199>>>>>>
76199>>>>>          get value of oValues# item itm# to str#
76200>>>>>          if str# ne "" begin
76202>>>>>            writeln ('    ')
76204>>>>>          end
76204>>>>>>
76204>>>>>        loop
76205>>>>>>
76205>>>>>        writeln '  '
76207>>>>>      end // HTML
76207>>>>>>
76207>>>>>      if (format#=DFQ.FORMAT.CD or format#=DFQ.FORMAT.LD) begin
76209>>>>>        get pIncludeLabels     to IncludeLabels#
76210>>>>>        if IncludeLabels# begin
76212>>>>>          if (pSemiColon(self)) move ";" to field_sep#
76215>>>>>          else move "," to field_sep#
76217>>>>>          get pUseAnsiCharacters to UseAnsiCharacters#
76218>>>>>          get rpt_field_count to max#
76219>>>>>          for itm# from 0 to (max#-1)
76225>>>>>>
76225>>>>>            get rpt_field_file  item itm# to file#
76226>>>>>            get rpt_field_field item itm# to fld#
76227>>>>>            get rpt_field_name  item itm# to str#
76228>>>>>            get rpt_field_type  item itm# to type#
76229>>>>>//            move (FieldInf_FieldType(file#,fld#)) to type#
76229>>>>>            if (type#<>DF_TEXT and type#<>DF_BINARY) begin
76231>>>>>              if format# eq DFQ.FORMAT.LD writeln channel 1 (sSeqFile.sii(self,str#,format#,UseAnsiCharacters#))
76236>>>>>              else begin
76237>>>>>                write channel 1 (sSeqFile.sii(self,str#,format#,UseAnsiCharacters#))
76239>>>>>                if (itm#<>(max#-1) or item_count(oValues#)) write field_sep#
76242>>>>>              end
76242>>>>>>
76242>>>>>            end
76242>>>>>>
76242>>>>>            else set value of oValues# item (item_count(oValues#)) to (sSeqFile.sii(self,str#,format#,UseAnsiCharacters#))
76244>>>>>          loop
76245>>>>>>
76245>>>>>          get item_count of oValues# to max#
76246>>>>>          for itm# from 0 to (max#-1)
76252>>>>>>
76252>>>>>            get value of oValues# item itm# to str#
76253>>>>>            if format# eq DFQ.FORMAT.LD writeln channel 1 str#
76258>>>>>            else begin
76259>>>>>              write channel 1 str#
76261>>>>>              if itm# ne (max#-1) write field_sep#
76264>>>>>            end
76264>>>>>>
76264>>>>>          loop
76265>>>>>>
76265>>>>>          if format# eq DFQ.FORMAT.CD writeln channel 1 ""
76270>>>>>        end
76270>>>>>>
76270>>>>>      end //
76270>>>>>>
76270>>>>>    end // if file
76270>>>>>>
76270>>>>>  end_procedure // print_header_first_time
76271>>>>>
76271>>>>>  function any_totals_at_all returns integer
76274>>>>>    integer itm# max# sum#
76274>>>>>    get rpt_field_count to max#
76275>>>>>    for itm# from 0 to (max#-1)
76281>>>>>>
76281>>>>>      get rpt_field_sum item itm# to sum#
76282>>>>>      if sum# function_return 1
76285>>>>>    loop
76286>>>>>>
76286>>>>>    function_return 0
76287>>>>>  end_function
76288>>>>>
76288>>>>>  procedure print_totals integer end_it_all#
76291>>>>>    integer vbottom# max# itm# type# file# fld# cr# pLeftMargin# sum# oCriteriaTexts#
76291>>>>>    integer precision# lhExprArr liExprRow
76291>>>>>    integer FileFormat# any_totals_at_all#
76291>>>>>    number start# width#
76291>>>>>    string str# value#
76291>>>>>    get pFileFormat to FileFormat#
76292>>>>>    move (oCriteriaTexts(self)) to oCriteriaTexts#
76293>>>>>    get any_totals_at_all to any_totals_at_all#
76294>>>>>
76294>>>>>    if (pDestination(self)<>DFQ.DEST.FILE) begin // If not file
76296>>>>>       if (any_totals_at_all# or end_it_all#) send vpe_line to oVPE# (pLeftMargin(self)) (next_current_row(self)) (pRightMargin(self)) (next_current_row(self))
76299>>>>>
76299>>>>>       get vpe_Get of oVPE# VBOTTOM to vbottom#
76300>>>>>       set current_row to (vbottom#+15)
76301>>>>>       set next_current_row to (vbottom#+15)
76302>>>>>
76302>>>>>       get pLeftMargin to pLeftMargin#
76303>>>>>       send vpe_SelectFont to oVPE# "Arial" 10
76304>>>>>
76304>>>>>       get rpt_field_count to max#
76305>>>>>       for itm# from 0 to (max#-1)
76311>>>>>>
76311>>>>>         get rpt_field_file  item itm# to file#
76312>>>>>         get rpt_field_field item itm# to fld#
76313>>>>>         get rpt_field_name  item itm# to str#
76314>>>>>         get rpt_field_cr    item itm# to cr#
76315>>>>>         get rpt_field_start item itm# to start#
76316>>>>>         get rpt_field_width item itm# to width#
76317>>>>>         get rpt_field_sum   item itm# to sum#
76318>>>>>         get rpt_field_type  item itm# to type#
76319>>>>>         get rpt_field_expr_array item itm# to lhExprArr
76320>>>>>         get rpt_field_expr_row item itm# to liExprRow
76321>>>>>// EXPR         move (FieldInf_FieldType(file#,fld#)) to type#
76321>>>>>         if cr# send new_line
76324>>>>>         if sum# begin
76326>>>>>           move (nRcl_Data.i(oTotals(self),itm#)) to value#
76327>>>>>
76327>>>>>           if file# get FieldInf_DecPoints file# fld# to precision#
76330>>>>>           else get piDecimals.i of lhExprArr liExprRow to precision#
76332>>>>>
76332>>>>>           move (NumToStr(value#,precision#)) to value#
76333>>>>>           send print_column ("[IO ]"+value#) ALIGN_RIGHT (start#*100+pLeftMargin#) (width#*100)
76334>>>>>         end
76334>>>>>>
76334>>>>>       loop
76335>>>>>>
76335>>>>>
76335>>>>>       send vpe_SetAlign to oVPE# ALIGN_LEFT
76336>>>>>
76336>>>>>       if end_it_all# begin
76338>>>>>         if (pPrintCriteria(self)) begin
76340>>>>>           get vpe_Get of oVPE# VBOTTOM to vbottom#
76341>>>>>           move (vbottom#+25) to vbottom#
76342>>>>>           ifnot (item_count(oCriteriaTexts#)) send vpe_Write to oVPE# (pLeftMargin(self)) vbottom# (pRightMargin(self)) VFREE t.DfQuery.NoSelectionCrit
76345>>>>>           else begin
76346>>>>>             send vpe_Write to oVPE# (pLeftMargin(self)) vbottom# (pRightMargin(self)) VFREE t.DfQuery.SelectionCrit
76347>>>>>             for itm# from 0 to (item_count(oCriteriaTexts#)-1)
76353>>>>>>
76353>>>>>               send vpe_Write to oVPE# (pLeftMargin(self)) VBOTTOM (pRightMargin(self))  VFREE (value(oCriteriaTexts#,itm#))
76354>>>>>             loop
76355>>>>>>
76355>>>>>           end
76355>>>>>>
76355>>>>>         end
76355>>>>>>
76355>>>>>
76355>>>>>         get vpe_Get of oVPE# VBOTTOM to vbottom#
76356>>>>>         send vpe_Write to oVPE# (pLeftMargin(self)) (vbottom#+15) (pRightMargin(self)) VFREE (t.DfQuery.LblRecords+" "+string(pRecordCount(self)))
76357>>>>>         if (pInterrupted(self)) begin
76359>>>>>           get vpe_Get of oVPE# VBOTTOM to vbottom#
76360>>>>>           send vpe_Write to oVPE# (pLeftMargin(self)) (vbottom#+15) (pRightMargin(self)) VFREE t.DfQuery.ReportCancelled
76361>>>>>         end
76361>>>>>>
76361>>>>>         if (psTextBottom(self)) ne "" begin
76363>>>>>           get vpe_Get of oVPE# VBOTTOM to vbottom#
76364>>>>>           set current_row to (vbottom#+50)
76365>>>>>           set next_current_row to (vbottom#+50)
76366>>>>>           send print_text (psTextBottom(self))
76367>>>>>         end
76367>>>>>>
76367>>>>>       end
76367>>>>>>
76367>>>>>    end
76367>>>>>>
76367>>>>>    else if (FileFormat#=DFQ.FORMAT.PRINT or FileFormat#=DFQ.FORMAT.HTML) begin
76370>>>>>      if FileFormat# eq DFQ.FORMAT.PRINT begin
76372>>>>>        send new_line
76373>>>>>        if (any_totals_at_all# or end_it_all#) writeln channel 1 "--------------------------------------------------------------------------"
76378>>>>>      end
76378>>>>>>
76378>>>>>      if FileFormat# eq DFQ.FORMAT.HTML begin
76380>>>>>        if any_totals_at_all# writeln channel 1 "  "
76385>>>>>      end
76385>>>>>>
76385>>>>>      get pLeftMargin to pLeftMargin#
76386>>>>>      get rpt_field_count to max#
76387>>>>>      for itm# from 0 to (max#-1)
76393>>>>>>
76393>>>>>        get rpt_field_file  item itm# to file#
76394>>>>>        get rpt_field_field item itm# to fld#
76395>>>>>        get rpt_field_name  item itm# to str#
76396>>>>>        get rpt_field_cr    item itm# to cr#
76397>>>>>        get rpt_field_start item itm# to start#
76398>>>>>        get rpt_field_width item itm# to width#
76399>>>>>        get rpt_field_sum   item itm# to sum#
76400>>>>>        get rpt_field_type  item itm# to type#
76401>>>>>        get rpt_field_expr_array item itm# to lhExprArr
76402>>>>>        get rpt_field_expr_row item itm# to liExprRow
76403>>>>>// EXPR       move (FieldInf_FieldType(file#,fld#)) to type#
76403>>>>>        if cr# send new_line
76406>>>>>        if sum# begin
76408>>>>>          move (nRcl_Data.i(oTotals(self),itm#)) to value#
76409>>>>>
76409>>>>>          if file# get FieldInf_DecPoints file# fld# to precision#
76412>>>>>          else get piDecimals.i of lhExprArr liExprRow to precision#
76414>>>>>          move (NumToStr(value#,precision#)) to value#
76415>>>>>
76415>>>>>          if FileFormat# eq DFQ.FORMAT.PRINT ;            send print_column value# ALIGN_RIGHT (start#*100+pLeftMargin#) (width#*100)
76418>>>>>          else ;            writeln ('    ')
76421>>>>>        end
76421>>>>>>
76421>>>>>        else begin
76422>>>>>          if FileFormat# eq DFQ.FORMAT.HTML begin
76424>>>>>            if any_totals_at_all# if type# ne DF_TEXT writeln '    '
76430>>>>>          end
76430>>>>>>
76430>>>>>        end
76430>>>>>>
76430>>>>>      loop
76431>>>>>>
76431>>>>>      if FileFormat# eq DFQ.FORMAT.HTML begin
76433>>>>>        if any_totals_at_all# writeln channel 1 "  "
76438>>>>>      end
76438>>>>>>
76438>>>>>      if end_it_all# begin
76440>>>>>        if FileFormat# eq DFQ.FORMAT.PRINT begin
76442>>>>>          send new_line
76443>>>>>          writeln (t.DfQuery.LblRecords+" "+string(pRecordCount(self)))
76445>>>>>        end
76445>>>>>>
76445>>>>>        else begin
76446>>>>>          writeln channel 1 '
')
76187>>>>>            write (html_DfToHtmlTable(str#))
76188>>>>>            writeln ''+html_DfToHtmlTable(str#)+'
'+html_DfToHtmlTable(value#)+'
'
76449>>>>>          writeln '
'
76451>>>>>          writeln (html_DfToHtmlTable(t.DfQuery.LblRecords+" "+string(pRecordCount(self)))+"
")
76453>>>>>        end
76453>>>>>>
76453>>>>>        if (pPrintCriteria(self)) begin
76455>>>>>          if FileFormat# eq DFQ.FORMAT.PRINT begin
76457>>>>>            writeln ""
76459>>>>>            ifnot (item_count(oCriteriaTexts#)) writeln t.DfQuery.NoSelectionCrit
76463>>>>>            else begin
76464>>>>>              writeln t.DfQuery.SelectionCrit
76466>>>>>              for itm# from 0 to (item_count(oCriteriaTexts#)-1)
76472>>>>>>
76472>>>>>                writeln (value(oCriteriaTexts#,itm#))
76474>>>>>              loop
76475>>>>>>
76475>>>>>            end
76475>>>>>>
76475>>>>>            writeln ""
76477>>>>>          end
76477>>>>>>
76477>>>>>          else begin
76478>>>>>            writeln "
"
76480>>>>>            ifnot (item_count(oCriteriaTexts#)) writeln (html_DfToHtmlTable(t.DfQuery.NoSelectionCrit)+'
')
76484>>>>>            else begin
76485>>>>>              writeln (html_DfToHtmlTable(t.DfQuery.SelectionCrit)+'
')
76487>>>>>              for itm# from 0 to (item_count(oCriteriaTexts#)-1)
76493>>>>>>
76493>>>>>                writeln (html_DfToHtmlTable(value(oCriteriaTexts#,itm#))+"
")
76495>>>>>              loop
76496>>>>>>
76496>>>>>            end
76496>>>>>>
76496>>>>>            writeln "
"
76498>>>>>          end
76498>>>>>>
76498>>>>>        end
76498>>>>>>
76498>>>>>        if (pInterrupted(self)) begin
76500>>>>>          if FileFormat# eq DFQ.FORMAT.PRINT writeln t.DfQuery.ReportCancelled
76504>>>>>          else writeln (html_DfToHtmlTable(t.DfQuery.ReportCancelled)+"
")
76507>>>>>        end
76507>>>>>>
76507>>>>>        if (psTextBottom(self)) ne "" begin
76509>>>>>          if FileFormat# eq DFQ.FORMAT.PRINT writeln ""
76513>>>>>          else write "
"
76515>>>>>          get psTextBottom to str#
76516>>>>>          if (pUseAnsiCharacters(self)) move (StringOemToAnsi(str#)) to str#
76519>>>>>          send print_text str#
76520>>>>>        end
76520>>>>>>
76520>>>>>      end
76520>>>>>>
76520>>>>>    end
76520>>>>>>
76520>>>>>  end_procedure
76521>>>>>
76521>>>>>  procedure New_Page
76524>>>>>    integer current_row#
76524>>>>>    if (pDestination(self)<>DFQ.DEST.FILE) begin // If not file
76526>>>>>      send vpe_PageBreak to oVPE#
76527>>>>>      get vpe_Get of oVPE# VTOPMARGIN to current_row#
76528>>>>>      set current_row to current_row#
76529>>>>>      set next_current_row to current_row#
76530>>>>>    end
76530>>>>>>
76530>>>>>  end_procedure
76531>>>>>
76531>>>>>  procedure print_text string value#
76534>>>>>    integer lines# line#
76534>>>>>     integer vbottom# current_row#
76534>>>>>     if (pDestination(self)<>DFQ.DEST.FILE) begin // If not file
76536>>>>>       send new_line
76537>>>>>       send vpe_SetAlign to oVPE# ALIGN_LEFT
76538>>>>>       send vpe_Write to oVPE# (pLeftMargin(self)) (current_row(self)) (pRightMargin(self)) VFREE ("[I ]"+value#)
76539>>>>>       get vpe_Get of oVPE# VBOTTOM to vbottom#
76540>>>>>       set current_row to vbottom#
76541>>>>>       set next_current_row to vbottom#
76542>>>>>     end
76542>>>>>>
76542>>>>>     else begin
76543>>>>>       move (Text_Format.sii(value#,74,1)) to lines#
76544>>>>>       for line# from 0 to (lines#-1)
76550>>>>>>
76550>>>>>         writeln channel 1 (Text_FormattedLine.i(line#))
76553>>>>>       loop
76554>>>>>>
76554>>>>>     end
76554>>>>>>
76554>>>>>  end_procedure
76555>>>>>
76555>>>>>  procedure new_line
76558>>>>>    integer delta#
76558>>>>>    if (pDestination(self)<>DFQ.DEST.FILE) begin // If not file
76560>>>>>       move (next_current_row(self)-current_row(self)) to delta#
76561>>>>>       if delta# lt 0 move 0 to delta#
76564>>>>>       set current_row to (next_current_row(self))
76565>>>>>       if (current_row(self)+delta#) gt (pBottomMargin(self)) ;         send New_Page
76568>>>>>    end
76568>>>>>>
76568>>>>>    else begin
76569>>>>>      writeln channel 1 (pCurrentFileLine(self))
76572>>>>>      set pCurrentFileLine to ""
76573>>>>>    end
76573>>>>>>
76573>>>>>  end_procedure
76574>>>>>
76574>>>>>  procedure record_selected
76577>>>>>    integer itm# max# file# fld# size# style# sum# len#
76577>>>>>    integer cr# type# row# next_row# pLeftMargin# grb# dec#
76577>>>>>    integer related# mainfile# TotalsOnly# liDestination FileFormat#
76577>>>>>    integer UseAnsiCharacters#
76577>>>>>    integer hoRow hoXMLDocumentRoot hoField
76577>>>>>    integer lhExprArr liExprRow
76577>>>>>    number start# width#
76577>>>>>    string font# value# field_sep# name#
76577>>>>>    forward send Record_Selected
76579>>>>>    get pDestination to liDestination
76580>>>>>    get pFileFormat  to FileFormat#
76581>>>>>    get pTotalsOnly to TotalsOnly#
76582>>>>>    get rpt_field_count to max#
76583>>>>>    get pLeftMargin to pLeftMargin#
76584>>>>>    get pUseAnsiCharacters to UseAnsiCharacters#
76585>>>>>    if (pSemiColon(self)) move ";" to field_sep#
76588>>>>>    else move "," to field_sep#
76590>>>>>    if (not(TotalsOnly#) and (liDestination<>DFQ.DEST.FILE or FileFormat#=DFQ.FORMAT.PRINT)) send new_line
76593>>>>>    send delete_data to (oValues(self))
76594>>>>>    get pMainFile to mainfile#
76595>>>>>    move 0 to related#
76596>>>>>    if (liDestination=DFQ.DEST.FILE and FileFormat#=DFQ.FORMAT.HTML and not(TotalsOnly#)) writeln channel 1 "  "
76601>>>>>    if (liDestination=DFQ.DEST.FILE and FileFormat#=DFQ.FORMAT.XML) begin
76603>>>>>      get phXMLDocumentRoot to hoXMLDocumentRoot
76604>>>>>      Get AddElement Of hoXMLDocumentRoot (API_AttrValue_FILELIST(DF_FILE_LOGICAL_NAME,mainfile#)) '' To hoRow
76605>>>>>      move DFFALSE to TotalsOnly#
76606>>>>>    end
76606>>>>>>
76606>>>>>    if (VPE.USED or liDestination=DFQ.DEST.FILE) begin // If file# or VPE
76608>>>>>      for itm# from 0 to (max#-1) // Go through the selected columns
76614>>>>>>
76614>>>>>        if (file#<>mainfile# and not(related#)) begin
76616>>>>>          relate mainfile#
76617>>>>>          move 1 to related#
76618>>>>>        end
76618>>>>>>
76618>>>>>        get rpt_field_file       item itm# to file#
76619>>>>>        get rpt_field_field      item itm# to fld#
76620>>>>>        get rpt_field_start      item itm# to start#
76621>>>>>        get rpt_field_width      item itm# to width#
76622>>>>>        get rpt_field_font       item itm# to font#
76623>>>>>        get rpt_field_fontsize   item itm# to size#
76624>>>>>        get rpt_field_fontstyle  item itm# to style#
76625>>>>>        get rpt_field_cr         item itm# to cr#
76626>>>>>        get rpt_field_sum        item itm# to sum#
76627>>>>>        get rpt_field_expr_array item itm# to lhExprArr
76628>>>>>        get rpt_field_expr_row   item itm# to liExprRow
76629>>>>>        get rpt_field_type       item itm# to type#
76630>>>>>         if liDestination ne DFQ.DEST.FILE send vpe_SelectFont to oVPE# font# size# // Only if not file
76633>>>>>        if file# move (FieldInf_FieldValue(file#,fld#)) to value#
76636>>>>>        else begin
76637>>>>>          get sEvalExpression of (Query_ExprEvaluator(self)) (piExprId.i(lhExprArr,liExprRow)) to value#
76638>>>>>        end
76638>>>>>>
76638>>>>>        move (rtrim(value#)) to value#
76639>>>>>
76639>>>>>        if sum# send Sum_Data.in to (oTotals(self)) itm# value#
76642>>>>>        if (not(TotalsOnly#) or (liDestination=DFQ.DEST.FILE and (FileFormat#<>DFQ.FORMAT.PRINT and FileFormat#<>DFQ.FORMAT.HTML))) begin
76644>>>>>          //move (FieldInf_FieldType(file#,fld#)) to type#
76644>>>>>          if cr# send new_line
76647>>>>>          if liDestination ne DFQ.DEST.FILE begin // If not file
76649>>>>>             if (type#<>DF_TEXT and type#<>DF_BINARY) begin
76651>>>>>               if type# eq DF_BCD begin
76653>>>>>                 //send obs value#
76653>>>>>
76653>>>>>                 if file# get FieldInf_DecPoints file# fld# to dec#
76656>>>>>                 else get piDecimals.i of lhExprArr liExprRow to dec#
76658>>>>>//!!!!!            showln "Value: " value#
76658>>>>>                 move (NumToStr(value#,dec#)) to value#
76659>>>>>                 //send obs value# dec#
76659>>>>>               end
76659>>>>>>
76659>>>>>               else move (replaces(" ",value#,"")) to value#
76661>>>>>               send print_column ("[IO ]"+value#) (if(type#=DF_BCD,ALIGN_RIGHT,ALIGN_LEFT)) (start#*100+pLeftMargin#) (width#*100)
76662>>>>>             end
76662>>>>>>
76662>>>>>             else set value of (oValues(self)) item (item_count(oValues(self))) to value#
76664>>>>>          end
76664>>>>>>
76664>>>>>          else begin // If file:
76665>>>>>            if (FileFormat#=DFQ.FORMAT.PRINT or FileFormat#=DFQ.FORMAT.HTML) begin
76667>>>>>
76667>>>>>              if UseAnsiCharacters# begin
76669>>>>>                if (FileFormat#<>DFQ.FORMAT.HTML) move (StringOemToAnsi(value#)) to value#
76672>>>>>              end
76672>>>>>>
76672>>>>>              if (type#<>DF_TEXT and type#<>DF_BINARY) begin
76674>>>>>                if type# eq DF_BCD begin
76676>>>>>                  if file# get FieldInf_DecPoints file# fld# to dec#
76679>>>>>                  else get piDecimals.i of lhExprArr liExprRow to dec#
76681>>>>>
76681>>>>>                  move (NumToStr(value#,dec#)) to value#
76682>>>>>                end
76682>>>>>>
76682>>>>>                if FileFormat# eq DFQ.FORMAT.HTML writeln channel 1 ('    '+html_DfToHtmlTable(value#)+'')
76687>>>>>                else send print_column value# (if(type#=DF_BCD,ALIGN_RIGHT,ALIGN_LEFT)) (start#*100+pLeftMargin#) (width#*100)
76689>>>>>              end
76689>>>>>>
76689>>>>>              else set value of (oValues(self)) item (item_count(oValues(self))) to value#
76691>>>>>            end
76691>>>>>>
76691>>>>>            else begin // DFQ.FORMAT.CD, DFQ.FORMAT.LD or DFQ.FORMAT.XML
76692>>>>>              if UseAnsiCharacters# move (StringOemToAnsi(value#)) to value#
76695>>>>>              if (FileFormat#=DFQ.FORMAT.XML) begin
76697>>>>>                get rpt_field_name item itm# to name#
76698>>>>>                move (replaces(" ",name#,"_")) to name#
76699>>>>>                Get AddElement Of hoRow name# '' To hoField
76700>>>>>                if (type#=DF_TEXT or type#=DF_BINARY) ;                   Send AddCDataSection To hoField (rtrim(value#))
76703>>>>>                else Set psText Of hoField To (rtrim(value#))
76705>>>>>                Send Destroy To hoField
76706>>>>>              end
76706>>>>>>
76706>>>>>              else begin // DFQ.FORMAT.CD or DFQ.FORMAT.LD
76707>>>>>                if (type#=DF_TEXT or type#=DF_BINARY) begin // Text or binary
76709>>>>>                  move (length(value#)) to len#
76710>>>>>                  if FileFormat# eq DFQ.FORMAT.CD begin // Comma delimited
76712>>>>>                    move (replaces('"',value#,"'")) to value#
76713>>>>>                    move ('"'+Text_CompressSubstCr(value#," ")+'"') to value#
76714>>>>>                    if itm# ne (max#-1) write (value#+field_sep#)
76717>>>>>                    else writeln value#
76720>>>>>                  end
76720>>>>>>
76720>>>>>                  else begin // Line delimited
76721>>>>>                    writeln len#
76723>>>>>                    write value#
76724>>>>>                  end
76724>>>>>>
76724>>>>>                end
76724>>>>>>
76724>>>>>                else begin // Everything but text or binary
76725>>>>>                  move (rtrim(value#)) to value#
76726>>>>>                  if FileFormat# eq DFQ.FORMAT.CD begin
76728>>>>>                    if type# eq DF_ASCII move (replaces('"',value#,"'")) to value#
76731>>>>>                    if type# ne DF_DATE move ('"'+value#+'"') to value#
76734>>>>>                    if itm# ne (max#-1) write (value#+field_sep#)
76737>>>>>                    else writeln value#
76740>>>>>                  end
76740>>>>>>
76740>>>>>                  else begin // DFQ.FORMAT.LD
76741>>>>>                    writeln value#
76743>>>>>                  end
76743>>>>>>
76743>>>>>                end
76743>>>>>>
76743>>>>>              end
76743>>>>>>
76743>>>>>            end
76743>>>>>>
76743>>>>>          end // If file
76743>>>>>>
76743>>>>>        end // IfNot TotalsOnly#
76743>>>>>>
76743>>>>>      loop
76744>>>>>>
76744>>>>>      ifnot TotalsOnly# begin
76746>>>>>        for itm# from 0 to (item_count(oValues(self))-1)
76752>>>>>>
76752>>>>>          get value of (oValues(self)) item itm# to value#
76753>>>>>          move (Text_RemoveTrailingCr(value#)) to value#
76754>>>>>          if (liDestination=DFQ.DEST.FILE and FileFormat#=DFQ.FORMAT.HTML) writeln channel 1 ('    '+html_DfToHtmlTable(value#)+'')
76759>>>>>          else begin
76760>>>>>            if value# ne "" begin
76762>>>>>              send new_line
76763>>>>>              send print_text value#
76764>>>>>            end
76764>>>>>>
76764>>>>>          end
76764>>>>>>
76764>>>>>        loop
76765>>>>>>
76765>>>>>      end
76765>>>>>>
76765>>>>>    end
76765>>>>>>
76765>>>>>    if (liDestination=DFQ.DEST.FILE and FileFormat#=DFQ.FORMAT.HTML and not(TotalsOnly#)) writeln channel 1 "  "
76770>>>>>//    if (liDestination=DFQ.DEST.FILE and FileFormat#=DFQ.FORMAT.XML) begin
76770>>>>>    if (liDestination=DFQ.DEST.FILE) begin
76772>>>>>
76772>>>>>    end
76772>>>>>>
76772>>>>>     if liDestination ne DFQ.DEST.FILE ;        send batch_update3 to (oBatchCompanion(self)) (t.DfQuery.Page+" "+string(vpe_GetCurrentPage(oVPE#)))
76775>>>>>  end_procedure // record_selected
76776>>>>>
76776>>>>>  procedure record_found
76779>>>>>    integer oSent# liDestination
76779>>>>>    get pDestination to liDestination
76780>>>>>
76780>>>>>    move (oBatchCompanion(self)) to oSent#
76781>>>>>
76781>>>>>    if (Sentinel_Running_State(oSent#)) begin
76783>>>>>
76783>>>>>      send batch_update  to oSent# (replace("#",replace("#",t.DfQuery.ReadingRecords,pScanCount(self)),pRecordCount(self)))
76784>>>>>      send batch_update2 to oSent# (FDX_FieldValues(0,pMainFile(self),psFieldsInIndex(self)))
76785>>>>>      //    (idx_field_value(oIndexAnalyzer#,pOrdering(self),1,1))
76785>>>>>      set pInterrupted to (batch_interrupt(oSent#))
76786>>>>>    end
76786>>>>>>
76786>>>>>    else begin
76787>>>>>    end
76787>>>>>>
76787>>>>>    //
76787>>>>>    //send Update_Status of oWinPrintReport "Blabla" //(replace("#",replace("#",t.DfQuery.ReadingRecords,pScanCount(self)),pRecordCount(self)))
76787>>>>>    //
76787>>>>>  end_procedure
76788>>>>>
76788>>>>>  procedure scan_ended
76791>>>>>    integer liDestination st#
76791>>>>>    get pDestination to liDestination
76792>>>>>    forward send scan_ended
76794>>>>>    send print_totals 1 // Parameter 1 makes it print number of records etc...
76795>>>>>    if liDestination ne DFQ.DEST.FILE send print_deferred_headers
76798>>>>>    send batch_off to (oBatchCompanion(self))
76799>>>>>
76799>>>>>     if liDestination eq DFQ.DEST.PRINTER send PrintDoc to oVPE#
76802>>>>>     if liDestination eq DFQ.DEST.SCREEN send PreviewDoc to oVPE#
76805>>>>>    if liDestination eq DFQ.DEST.FILE begin
76807>>>>>      if (pFileFormat(self)=DFQ.FORMAT.HTML) writeln ''
76811>>>>>      close_output channel 1
76813>>>>>      ifnot (pbQuiet(self)) begin
76815>>>>>        if (pFileFormat(self)=DFQ.FORMAT.HTML or pFileFormat(self)=DFQ.FORMAT.XML) send html_StartDoc (pOutFileName(self))
76818>>>>>        else send info_box t.DfQuery.FileCompleted t.MsgBox.Message
76820>>>>>      end
76820>>>>>>
76820>>>>>    end
76820>>>>>>
76820>>>>>//    send CloseDoc to oVPE#
76820>>>>>  end_procedure
76821>>>>>
76821>>>>>  function sXmlRootElementName string lsValue returns string
76824>>>>>    integer liPos liLen
76824>>>>>    string lsIllegal lsChar
76824>>>>>    move (" .,;:/()&%#[]{}=?+^@$\'"+'"') to lsIllegal
76825>>>>>    move (length(lsIllegal)) to liLen
76826>>>>>    for liPos from 1 to liLen
76832>>>>>>
76832>>>>>      move (mid(lsIllegal,1,liPos)) to lsChar
76833>>>>>      move (replaces(lsChar,lsValue,"")) to lsValue
76834>>>>>    loop
76835>>>>>>
76835>>>>>    function_return lsValue
76836>>>>>  end_function
76837>>>>>
76837>>>>>  procedure run
76840>>>>>    integer pLeftMargin# liDestination liFileFormat lbSaveOk
76840>>>>>    integer tmp# max# itm# pOpenOptions# vpetmp# argument_size#
76840>>>>>    integer hoXML hoXMLDocumentRoot
76840>>>>>    string metrics# lsFileName lsCurDir
76840>>>>>    string lsRootName
76840>>>>>
76840>>>>>    send initialize_breaks
76841>>>>>    get pDestination to liDestination
76842>>>>>    get pFileFormat to liFileFormat
76843>>>>>    if liDestination eq DFQ.DEST.FILE begin // File#
76845>>>>>      get pOutFileName to lsFileName
76846>>>>>      if lsFileName eq "" begin
76848>>>>>        send obs t.DfQuery.FileNameNotSpec
76849>>>>>        procedure_return // Goodbye!
76850>>>>>      end
76850>>>>>>
76850>>>>>      if (SEQ_ExtractPathFromFileName(lsFileName)="") begin
76852>>>>>        get_current_directory to lsCurDir
76853>>>>>        get SEQ_ComposeAbsoluteFileName lsCurDir lsFileName to lsFileName
76854>>>>>      end
76854>>>>>>
76854>>>>>      set pOutFileName to lsFileName
76855>>>>>
76855>>>>>      get pLeftMargin to pLeftMargin#
76856>>>>>      set pLeftMargin to 1 // First position is 1
76857>>>>>      get rpt_field_count to max#
76858>>>>>      for itm# from 0 to (max#-1)
76864>>>>>>
76864>>>>>        // Shift unit from 1/10mm to characters:
76864>>>>>        set rpt_field_start item itm# to (rpt_field_start(self,itm#)/100)
76865>>>>>        set rpt_field_width item itm# to (rpt_field_width(self,itm#)/100)
76866>>>>>      loop
76867>>>>>>
76867>>>>>      if (liFileFormat=DFQ.FORMAT.XML) begin
76869>>>>>        Object oXML Is A cXMLDOMDocument
76871>>>>>          Move Self To hoXML
76872>>>>>          Set psDocumentName To lsFileName
76873>>>>>          Get pReportTitle to lsRootName
76874>>>>>          get sXmlRootElementName lsRootName to lsRootName
76875>>>>>          if (lsRootName<>"") begin
76877>>>>>            Get CreateDocumentElement lsRootName To hoXMLDocumentRoot
76878>>>>>            Set pbPreserveWhitespace To DFFALSE
76879>>>>>            Set pbValidateOnParse To DFFALSE
76880>>>>>          end
76880>>>>>>
76880>>>>>        End_Object // oXML
76881>>>>>        If (hoXMLDocumentRoot = 0) Begin
76883>>>>>          Send Stop_Box "The XML document root could not be created.\nIt might be caused by not having the XML parser available or by an illegal 'Query title'.\nThe export routine will now be exited." "VDFQuery XML export"
76884>>>>>          Send Destroy To hoXML
76885>>>>>          Procedure_Return
76886>>>>>        End
76886>>>>>>
76886>>>>>        set phXMLDocumentRoot to hoXMLDocumentRoot
76887>>>>>      end
76887>>>>>>
76887>>>>>    end
76887>>>>>>
76887>>>>>    move oVPE# to tmp#
76888>>>>>    move (oVPE(self)) to oVPE#
76889>>>>>    get pOpenOptions of oVPE# to pOpenOptions#
76890>>>>>    if (pLandScape(self)) begin
76892>>>>>      get pLeftMargin to vpetmp#
76893>>>>>      set pLeftMargin to (pTopMargin(self))
76894>>>>>      set pTopMargin to vpetmp#
76895>>>>>      get pRightMargin to vpetmp#
76896>>>>>      set pRightMargin to (pBottomMargin(self))
76897>>>>>      set pBottomMargin to vpetmp#
76898>>>>>    end
76898>>>>>>
76898>>>>>    get_argument_size to argument_size#
76899>>>>>    // This we do to avoid having the RT crash because of default 2048:
76899>>>>>    if argument_size# lt 32767 set_argument_size 32767 // 32K-1
76902>>>>>    forward send run
76904>>>>>    set_argument_size argument_size#
76905>>>>>>
76905>>>>>    set pOpenOptions of oVPE# to pOpenOptions#
76906>>>>>    if (pLandScape(self)) begin
76908>>>>>      get pLeftMargin to vpetmp#
76909>>>>>      set pLeftMargin to (pTopMargin(self))
76910>>>>>      set pTopMargin to vpetmp#
76911>>>>>      get pRightMargin to vpetmp#
76912>>>>>      set pRightMargin to (pBottomMargin(self))
76913>>>>>      set pBottomMargin to vpetmp#
76914>>>>>    end
76914>>>>>>
76914>>>>>    move tmp# to oVPE#
76915>>>>>    if liDestination eq DFQ.DEST.FILE begin // File#
76917>>>>>      set pLeftMargin to pLeftMargin#
76918>>>>>      for itm# from 0 to (max#-1)
76924>>>>>>
76924>>>>>        set rpt_field_start item itm# to (rpt_field_start(self,itm#)*100)
76925>>>>>        set rpt_field_width item itm# to (rpt_field_width(self,itm#)*100)
76926>>>>>      loop
76927>>>>>>
76927>>>>>      if (liFileFormat=DFQ.FORMAT.XML) begin
76929>>>>>        Get SaveXMLDocument Of hoXML To lbSaveOk
76930>>>>>        Send Destroy To hoXML
76931>>>>>      end
76931>>>>>>
76931>>>>>    end
76931>>>>>>
76931>>>>>  end_procedure
76932>>>>>end_object // oReport_info
76933>>>>>
76933>>>>>// *** Main user interface section ****************************************
76933>>>>>
76933>>>>>class vdq.ComboFormAux is a aps.ComboFormAux
76934>>>>>  procedure construct_object
76936>>>>>    forward send construct_object
76938>>>>>    set combo_sort_state to false
76939>>>>>    on_key key_ctrl+key_r send request_run_report
76940>>>>>    on_key key_ctrl+key_o send Read_Report_Definition
76941>>>>>    on_key key_ctrl+key_s send Write_Report_Definition
76942>>>>>  end_procedure
76943>>>>>end_class
76944>>>>>
76944>>>>>register_procedure do_add_field
76944>>>>>register_object oTabs
76944>>>>>register_object oRun_Button
76944>>>>>
76944>>>>>desktop_section // Place object on desktop no matter where declared
76949>>>>>  object oVdfQuery_IndexAnalyzer is a cIndexAnalyzer
76951>>>>>  end_object
76952>>>>>end_desktop_section
76957>>>>>
76957>>>>>register_procedure DoFileNamesLogical
76957>>>>>register_procedure DoFileNamesUser
76957>>>>>register_procedure DoFieldNamesLogical
76957>>>>>register_procedure DoFieldNamesUser
76957>>>>>register_procedure DoAddAllFields
76957>>>>>register_procedure DoAddIndexFields
76957>>>>>register_procedure DoDisplayTableDefinition
76957>>>>>
76957>>>>>desktop_section // Place objects on desktop no matter where declared
76962>>>>>  object oVdfQuery_FileSelectTab1_FM is a FloatingPopupMenu
76964>>>>>    send add_item msg_DoFileNamesLogical       t.DfQuery.LogicalNames
76965>>>>>    send add_item msg_DoFileNamesUser          t.DfQuery.UserNames
76966>>>>>    send add_item msg_NONE                     ""
76967>>>>>    send add_item msg_DoDisplayTableDefinition (t.DfQuery.DisplayTblDef*"\aCtrl+D")
76968>>>>>  end_object
76969>>>>>  object oVdfQuery_FieldSelectTab1_FM is a FloatingPopupMenu
76971>>>>>    send add_item msg_DoFieldNamesLogical t.DfQuery.LogicalNames
76972>>>>>    send add_item msg_DoFieldNamesUser    t.DfQuery.UserNames
76973>>>>>    send add_item msg_NONE                ""
76974>>>>>    send add_item msg_DoAddAllFields      (t.DfQuery.AddAllFields*"\aCtrl+A")
76975>>>>>    send add_item msg_DoAddIndexFields    (t.DfQuery.AddIndexFields*"\aCtrl+I")
76976>>>>>  end_object
76977>>>>>
76977>>>>>  object oVdfQuery_FileSelect_FM is a FloatingPopupMenu
76979>>>>>    send add_item msg_DoFileNamesLogical  t.DfQuery.LogicalNames
76980>>>>>    send add_item msg_DoFileNamesUser     t.DfQuery.UserNames
76981>>>>>  end_object
76982>>>>>  object oVdfQuery_FieldSelect_FM is a FloatingPopupMenu
76984>>>>>    send add_item msg_DoFieldNamesLogical t.DfQuery.LogicalNames
76985>>>>>    send add_item msg_DoFieldNamesUser    t.DfQuery.UserNames
76986>>>>>  end_object
76987>>>>>end_desktop_section
76992>>>>>
76992>>>>>// The creating of OG_QueryView must be guarded by the opening of
76992>>>>>// file (og_param(0)) if not 0.
76992>>>>>DEFINE_OBJECT_GROUP OG_QueryView // file# index# subreport?
76993>>>>>
76993>>>>>  object oVDFQuery_View is a aps.View
76995>>>>>    register_procedure write_report_definition
76995>>>>>    register_procedure read_report_definition
76995>>>>>    register_procedure NewQuery
76995>>>>>    property integer pMainFile    public (og_param(0))
76997>>>>>    property integer pOrdering    public 0
76999>>>>>    property number  pColumnSpace public 0.2
77001>>>>>    property string  pFont        public ""
77003>>>>>    property integer pFontSize    public 0
77005>>>>>    property integer phForcedDD   public 0
77007>>>>>    if gsVdfQuery_Icon# ne "" set icon to gsVdfQuery_Icon#
77010>>>>>    set help_id to hlpid.VdfQuery
77011>>>>>    set Window_Style to WS_MAXIMIZEBOX 1
77012>>>>>    property integer pDestroyOnClose public (not(og_param(2)))
77014>>>>>
77014>>>>>    object oQuery_ExprArray is a Query_cExprArray
77016>>>>>    end_object
77017>>>>>    object oQueryOrderExpression is a cQueryOrderExpression
77019>>>>>      set phExprArr to (oQuery_ExprArray(self))
77020>>>>>    end_object
77021>>>>>
77021>>>>>    set p_auto_column to 1
77022>>>>>    on_key kcancel      send close_panel
77023>>>>>    on_key key_F3       send close_panel
77024>>>>>    on_key ksave_record send request_run_report
77025>>>>>    on_key key_ctrl+key_r send request_run_report
77026>>>>>    on_key key_ctrl+key_o send Read_Report_Definition
77027>>>>>    on_key key_ctrl+key_s send Write_Report_Definition
77028>>>>>    //on_key kuser2 send debug_display_string
77028>>>>>    send aps_tab_column_define 1 80 55 jmode_right
77029>>>>>
77029>>>>>    procedure DoFieldNamesLogical
77032>>>>>      broadcast recursive send FieldNamesLogical
77034>>>>>    end_procedure
77035>>>>>    procedure DoFieldNamesUser
77038>>>>>      broadcast recursive send FieldNamesUser
77040>>>>>    end_procedure
77041>>>>>    procedure DoFileNamesLogical
77044>>>>>      broadcast recursive send FileNamesLogical
77046>>>>>    end_procedure
77047>>>>>    procedure DoFileNamesUser
77050>>>>>      broadcast recursive send FileNamesUser
77052>>>>>    end_procedure
77053>>>>>
77053>>>>>    procedure Print_Report
77056>>>>>      // Cancel toolbar message
77056>>>>>    end_procedure
77057>>>>>
77057>>>>>    object oDefault_Selection_Values is an array
77059>>>>>      procedure qry_change_criteria integer crit# string val1# string val2#
77062>>>>>        set value item (crit#*2) to val1#
77063>>>>>        set value item (crit#*2+1) to val2#
77064>>>>>      end_procedure
77065>>>>>      function qry_new_criteria returns integer
77068>>>>>        integer crit#
77068>>>>>        get item_count to crit#
77069>>>>>        function_return (crit#/2 max 1)
77070>>>>>      end_function
77071>>>>>      function qry_crit_val1 integer crit# returns string
77074>>>>>        function_return (value(self,crit#*2))
77075>>>>>      end_function
77076>>>>>      function qry_crit_val2 integer crit# returns string
77079>>>>>        function_return (value(self,crit#*2+1))
77080>>>>>      end_function
77081>>>>>    end_object // oDefault_Selection_Values
77082>>>>>
77082>>>>>    object oMainFile is a vdq.ComboFormAux label t.DfQuery.MainFile abstract aft_ascii50
77086>>>>>      set entry_state item 0 to false
77087>>>>>      set allow_blank_state to true
77088>>>>>      on_key kuser send select_table
77089>>>>>
77089>>>>>      set peAnchors to (anTop+anLeft+anRight)
77090>>>>>      procedure init
77093>>>>>        integer file#
77093>>>>>        string str#
77093>>>>>        get pMainFile to file#
77094>>>>>        if file# begin
77096>>>>>          get_attribute DF_FILE_DISPLAY_NAME of file# to str#
77099>>>>>          move (rtrim(str#)) to str#
77100>>>>>        end
77100>>>>>>
77100>>>>>        else send combo_add_item str# 0
77102>>>>>        set value item 0 to str#
77103>>>>>        send delete_data
77104>>>>>        move 0 to file#
77105>>>>>        repeat
77105>>>>>>
77105>>>>>          get_attribute df_file_next_used of file# to file#
77108>>>>>          if file# begin
77110>>>>>            if (DfQuery_ExcludeFile(file#)=DFQ_FALSE) begin
77112>>>>>              get_attribute DF_FILE_DISPLAY_NAME of file# to str#
77115>>>>>              move (rtrim(str#)) to str#
77116>>>>>              ifnot (StringBeginsWith(str#,"@")) send combo_add_item str# file#
77119>>>>>            end
77119>>>>>>
77119>>>>>          end
77119>>>>>>
77119>>>>>        until file# eq 0
77121>>>>>      end_procedure
77122>>>>>      send init
77123>>>>>
77123>>>>>      property integer pbNoRecursion public 0
77125>>>>>      procedure DoSetFile integer file# integer set_main_window#
77128>>>>>        integer callfile#
77128>>>>>        string str#
77128>>>>>        ifnot (pbNoRecursion(self)) begin
77130>>>>>          set pbNoRecursion to DFTRUE
77131>>>>>          move file# to callfile#
77132>>>>>          if (DBMS_OpenFile(file#,DF_SHARE,0)) begin
77134>>>>>            set pMainFile to file#
77135>>>>>            send new_main_file to (oTabs(self))
77136>>>>>          end
77136>>>>>>
77136>>>>>          else begin
77137>>>>>            if file# error 200 "File could not be opened"
77140>>>>>            get pMainFile to file#
77141>>>>>          end
77141>>>>>>
77141>>>>>          if file# eq 0 move "" to str#
77144>>>>>          else begin
77145>>>>>            get_attribute DF_FILE_DISPLAY_NAME of file# to str#
77148>>>>>            move (rtrim(str#)) to str#
77149>>>>>          end
77149>>>>>>
77149>>>>>          if (set_main_window# or not(callfile#)) set value item 0 to str#
77152>>>>>          set pbNoRecursion to DFFALSE
77153>>>>>        end
77153>>>>>>
77153>>>>>      end_procedure
77154>>>>>
77154>>>>>      procedure OnChange
77157>>>>>        integer file#
77157>>>>>        get Combo_Current_Aux_Value to file#
77158>>>>>        send DoSetFile file# 0
77159>>>>>      end_procedure
77160>>>>>      set object_shadow_state to (og_param(2)) // Shadow if sub-report
77161>>>>>
77161>>>>>      function select_table_validate integer file# returns integer
77164>>>>>        string str#
77164>>>>>        get_attribute DF_FILE_DISPLAY_NAME of file# to str#
77167>>>>>        move (rtrim(str#)) to str#
77168>>>>>        if (StringBeginsWith(str#,"@")) function_return 0
77171>>>>>        function_return (DfQuery_ExcludeFile(file#)=0)
77172>>>>>      end_function
77173>>>>>
77173>>>>>      procedure select_table
77176>>>>>        integer file# obj#
77176>>>>>        move self to obj#
77177>>>>>        get pMainFile to file#
77178>>>>>        move (iFdxSelectOneFileValidate(0,file#,get_select_table_validate,obj#)) to file#
77179>>>>>        if file# send DoSetFile file# 1
77182>>>>>      end_procedure
77183>>>>>    end_object // oMainFile
77184>>>>>
77184>>>>>    procedure AdvancedTableOpen
77187>>>>>      send select_table to (oMainFile(self))
77188>>>>>    end_procedure
77189>>>>>
77189>>>>>    object oToolButton is a aps.ToolButton snap sl_right
77192>>>>>      set peAnchors to (anTop+anRight)
77193>>>>>      set p_extra_external_width to 10
77194>>>>>      send Add_Button ICO_STD_FIND msg_AdvancedTableOpen
77195>>>>>      send Add_ToolTip t.DfQuery.tt.AdvTableOpen
77196>>>>>      send Add_Button ICO_STD_FILEOPEN msg_Read_Report_Definition
77197>>>>>      send Add_ToolTip t.DfQuery.tt.Open
77198>>>>>      ifnot (integer(og_param(2))) begin // If not a sub-report
77200>>>>>        send Add_Button ICO_STD_FILESAVE msg_Write_Report_Definition
77201>>>>>        send Add_ToolTip t.DfQuery.tt.Save
77202>>>>>        send Add_Button ICO_STD_FILENEW msg_NewQuery
77203>>>>>        send Add_ToolTip t.DfQuery.tt.New
77204>>>>>      end
77204>>>>>>
77204>>>>>    end_object
77205>>>>>
77205>>>>>    object oTitle is a aps.Form label t.DfQuery.QueryTitle abstract aft_ascii50
77209>>>>>      set peAnchors to (anTop+anLeft+anRight)
77210>>>>>      procedure OnChange
77213>>>>>        send OnChangeMainFile
77214>>>>>      end_procedure
77215>>>>>    end_object
77216>>>>>
77216>>>>>    function report_title returns string
77219>>>>>      integer file#
77219>>>>>      string str#
77219>>>>>      get pMainFile to file#
77220>>>>>      get value of (oTitle(self)) item 0 to str#
77221>>>>>      if str# eq "" if file# get_attribute DF_FILE_DISPLAY_NAME of file# to str#
77228>>>>>      function_return (trim(str#))
77229>>>>>    end_function
77230>>>>>
77230>>>>>    procedure OnChangeMainFile
77233>>>>>      string str# caption# title#
77233>>>>>      get report_title to title#
77234>>>>>      if title# ne "" begin
77236>>>>>        move (t.DfQuery.QueryDefinition+" (#)") to caption#
77237>>>>>        replace "#" in caption# with (report_title(self))
77239>>>>>      end
77239>>>>>>
77239>>>>>      else move t.DfQuery.QueryDefinition to caption#
77241>>>>>      set label to caption#
77242>>>>>    end_procedure
77243>>>>>
77243>>>>>    set p_auto_column to 0
77244>>>>>    send aps_goto_max_row
77245>>>>>    send aps_make_row_space 4 // Insert 4 MDU
77246>>>>>    object oTabs is a aps.TabDialog
77248>>>>>      set peAnchors to (anTop+anLeft+anRight+anBottom)
77249>>>>>      object oTab1 is a aps.TabPage label t.DfQuery.LblTab1
77252>>>>>        set p_auto_column to 0
77253>>>>>
77253>>>>>        DEFINE_OBJECT_GROUP OG_QueryViewComponent // int: allow DoAddAllFields
77254>>>>>          object oDBMS_Files is a aps.list label t.DfQuery.DBMSfiles
77257>>>>>            property integer pDisplayFileNamesUser public 1
77259>>>>>            set size to 60 150
77260>>>>>            set label_justification_mode to JMODE_TOP
77261>>>>>
77261>>>>>            set Label_Shadow_Display_Mode to TBSHADOW_ON_NONE // Nicholas Herlick
77262>>>>>            set label to t.DfQuery.DBMSfiles
77263>>>>>
77263>>>>>            on_key kenter send next
77264>>>>>            on_key kswitch_back send activate to (oTitle(self))
77265>>>>>            on_key key_ctrl+key_p send OpenQueryOnParentFile
77266>>>>>            on_key kuser send toggle_display
77267>>>>>            on_key KEY_CTRL+KEY_D send DoDisplayTableDefinition
77268>>>>>            set peAnchors to (anTop+anLeft)
77269>>>>>            procedure toggle_display
77272>>>>>              set pDisplayFileNamesUser to (not(pDisplayFileNamesUser(self)))
77273>>>>>              send InsertFileNames
77274>>>>>            end_procedure
77275>>>>>
77275>>>>>            procedure OpenQueryOnParentFile
77278>>>>>              integer file# itm#
77278>>>>>              if (item_count(self)) begin
77280>>>>>                get current_item to itm#
77281>>>>>                get aux_value item itm# to file#
77282>>>>>                send CreateNewQuery file#
77283>>>>>              end
77283>>>>>>
77283>>>>>            end_procedure
77284>>>>>
77284>>>>>            procedure DoInformExpressionThingAboutAllowedTables
77287>>>>>              integer liMax liItem liFile lhQuery_ExprParser
77287>>>>>              move (Query_ExprParser(self)) to lhQuery_ExprParser
77288>>>>>              send AllowedTables_Reset to lhQuery_ExprParser
77289>>>>>              get item_count to liMax
77290>>>>>              decrement liMax
77291>>>>>              for liItem from 0 to liMax
77297>>>>>>
77297>>>>>                get aux_value item liItem to liFile
77298>>>>>                send AllowedTables_Add to lhQuery_ExprParser liFile
77299>>>>>              loop
77300>>>>>>
77300>>>>>            end_procedure
77301>>>>>
77301>>>>>            procedure DoDisplayTableDefinition
77304>>>>>              integer liFile
77304>>>>>              get aux_value item CURRENT to liFile
77305>>>>>              send FDX_ModalDisplayFileAttributes 0 liFile
77306>>>>>            end_procedure
77307>>>>>
77307>>>>>            object oSet is a set
77309>>>>>            end_object
77310>>>>>
77310>>>>>            procedure InsertFileNames
77313>>>>>              integer type#
77313>>>>>              integer itm# max# file#
77313>>>>>              string str#
77313>>>>>              get pDisplayFileNamesUser to type#
77314>>>>>              get item_count to max#
77315>>>>>              for itm# from 0 to (max#-1)
77321>>>>>>
77321>>>>>                get aux_value item itm# to file#
77322>>>>>                if type# get File_Display_Name file# to str#
77325>>>>>                else get_attribute DF_FILE_LOGICAL_NAME of file# to str#
77329>>>>>                set value item itm# to str#
77330>>>>>              loop
77331>>>>>>
77331>>>>>              set dynamic_update_state to true
77332>>>>>            end_procedure
77333>>>>>            procedure FileNamesLogical
77336>>>>>              set pDisplayFileNamesUser to false
77337>>>>>              send InsertFileNames
77338>>>>>            end_procedure
77339>>>>>            procedure FileNamesUser
77342>>>>>              set pDisplayFileNamesUser to true
77343>>>>>              send InsertFileNames
77344>>>>>            end_procedure
77345>>>>>
77345>>>>>            property integer piOgParam0 public 0
77347>>>>>            set piOgParam0 to (og_param(0))
77348>>>>>            procedure mouse_down2 integer liWin integer liCharPos
77351>>>>>              send mouse_down liWin liCharPos // Take focus
77352>>>>>              if (piOgParam0(self)) send popup to (oVdfQuery_FileSelectTab1_FM(self))
77355>>>>>              else send popup to (oVdfQuery_FileSelect_FM(self))
77357>>>>>            end_procedure
77358>>>>>
77358>>>>>            procedure add_file integer file#
77361>>>>>              integer field# max_field# rel_file#
77361>>>>>
77361>>>>>              if (DBMS_OpenFile(file#,DF_SHARE,0)) begin
77363>>>>>                get_attribute DF_FILE_NUMBER_FIELDS of file# to max_field#
77366>>>>>
77366>>>>>                if (find_element(oSet(self),file#)) eq -1 begin
77368>>>>>                  send add_element to (oSet(self)) file#
77369>>>>>                  send add_item msg_none ""
77370>>>>>                  set aux_value item (item_count(self) - 1) to file#
77371>>>>>
77371>>>>>                  for field# from 1 to max_field#
77377>>>>>>
77377>>>>>                    get_attribute DF_FIELD_RELATED_FILE of file# field# to rel_file#
77380>>>>>                    if rel_file# ne 0 begin
77382>>>>>                      if (DfQuery_ExcludeFile(file#)<>DFQ_ALWAYS) ;                        send add_file rel_file#
77385>>>>>                    end
77385>>>>>>
77385>>>>>                  loop
77386>>>>>>
77386>>>>>                end
77386>>>>>>
77386>>>>>              end
77386>>>>>>
77386>>>>>              else error 200 ("Related file could not be opened (entry: "+string(file#)+")")
77388>>>>>            end_procedure
77389>>>>>
77389>>>>>            procedure fill_list
77392>>>>>              integer file# st#
77392>>>>>
77392>>>>>              send delete_data
77393>>>>>              send delete_data to (oSet(self))
77394>>>>>
77394>>>>>              get pMainFile to file#
77395>>>>>              if file# send add_file file#
77398>>>>>              send InsertFileNames
77399>>>>>              send notify_filechange file#
77400>>>>>            end_procedure
77401>>>>>
77401>>>>>            procedure OnChangeMainFile
77404>>>>>              send fill_list
77405>>>>>            end_procedure
77406>>>>>
77406>>>>>            procedure onchange
77409>>>>>              integer file#
77409>>>>>              get aux_value item (current_item(self)) to file#
77410>>>>>              send notify_filechange file#
77411>>>>>              send request_status_help 1
77412>>>>>            end_procedure
77413>>>>>
77413>>>>>            function current_aux returns integer
77416>>>>>              function_return (aux_value(self,current_item(self)))
77417>>>>>            end_function
77418>>>>>
77418>>>>>            Function Status_Help integer itm_tmp# returns string
77421>>>>>              integer itm# aux#
77421>>>>>              string str#
77421>>>>>              if num_arguments eq 0 get current_item to itm#
77424>>>>>              //else move itm_tmp# to itm#
77424>>>>>              get aux_value item itm# to aux#
77425>>>>>              get VdfQuery_file_status_help aux# to str#
77426>>>>>              function_return str#
77427>>>>>            End_Function
77428>>>>>
77428>>>>>            procedure DoGotoFile integer liFile
77431>>>>>              integer liMax liItm
77431>>>>>              get item_count to liMax
77432>>>>>              decrement liMax
77433>>>>>              for liItm from 0 to liMax
77439>>>>>>
77439>>>>>                if (aux_value(self,liItm)=liFile) set current_item to liItm
77442>>>>>              loop
77443>>>>>>
77443>>>>>            end_procedure
77444>>>>>          end_object
77445>>>>>          send aps_goto_max_row
77446>>>>>          send make_row_space
77447>>>>>          object oDBMS_Fields is a aps.list //snap sl_down
77449>>>>>            property integer pDisplayFieldNamesUser public 1
77451>>>>>            property integer pFileNumber            public 0
77453>>>>>            set size to 75 150
77454>>>>>
77454>>>>>            on_key kswitch send switch
77455>>>>>            on_key kswitch_back send switch_back
77456>>>>>            on_key kEnter Send do_add_field
77457>>>>>            on_key kuser send toggle_display
77458>>>>>
77458>>>>>            set peAnchors to (anTop+anLeft+anBottom)
77459>>>>>            procedure toggle_display
77462>>>>>              set pDisplayFieldNamesUser to (not(pDisplayFieldNamesUser(self)))
77463>>>>>              send InsertFieldNames
77464>>>>>            end_procedure
77465>>>>>
77465>>>>>            property integer piOgParam0 public 0
77467>>>>>            set piOgParam0 to (og_param(0))
77468>>>>>            procedure mouse_down2 integer liWin integer liCharPos
77471>>>>>              send mouse_down liWin liCharPos // Take focus
77472>>>>>              if (piOgParam0(self)) send popup to (oVdfQuery_FieldSelectTab1_FM(self))
77475>>>>>              else send popup to (oVdfQuery_FieldSelect_FM(self))
77477>>>>>            end_procedure
77478>>>>>
77478>>>>>            procedure InsertFieldNames
77481>>>>>              integer type#
77481>>>>>              integer itm# max# fld# file#
77481>>>>>              string str#
77481>>>>>              get pFileNumber to file#
77482>>>>>              get pDisplayFieldNamesUser to type#
77483>>>>>              get item_count to max#
77484>>>>>              for itm# from 0 to (max#-1)
77490>>>>>>
77490>>>>>                get aux_value item itm# to fld#
77491>>>>>                if fld# lt 256 begin
77493>>>>>                  if type# get FieldInf_FieldLabel_Long file# fld# to str#
77496>>>>>                  else get_attribute DF_FIELD_NAME of file# fld# to str#
77500>>>>>                  set value item itm# to str#
77501>>>>>                end
77501>>>>>>
77501>>>>>              loop
77502>>>>>>
77502>>>>>              set dynamic_update_state to true
77503>>>>>            end_procedure
77504>>>>>
77504>>>>>            if (integer(og_param(0))) on_key key_ctrl+key_a send DoAddAllFields
77507>>>>>            if (integer(og_param(0))) on_key key_ctrl+key_i send DoAddIndexFields
77510>>>>>            procedure FieldNamesLogical
77513>>>>>              set pDisplayFieldNamesUser to false
77514>>>>>              send InsertFieldNames
77515>>>>>            end_procedure
77516>>>>>            procedure FieldNamesUser
77519>>>>>              set pDisplayFieldNamesUser to true
77520>>>>>              send InsertFieldNames
77521>>>>>            end_procedure
77522>>>>>            procedure mouse_click integer i1 integer i2
77525>>>>>               Send do_add_field
77526>>>>>            end_procedure
77527>>>>>            procedure load_virtual_fields integer file#
77530>>>>>              integer obj# fld# max#
77530>>>>>              get FieldInf_VirtualFields_Object file# to obj#
77531>>>>>              if obj# begin
77533>>>>>                get row_count of obj# to max#
77534>>>>>                for fld# from 0 to (max#-1)
77540>>>>>>
77540>>>>>                  if (piFieldActive.i(obj#,fld#)) begin
77542>>>>>                    send add_item msg_do_add_field (psFieldLabel.i(obj#,fld#))
77543>>>>>                    set aux_value item (item_count(self) - 1) to (fld#+256)
77544>>>>>                  end
77544>>>>>>
77544>>>>>                loop
77545>>>>>>
77545>>>>>              end
77545>>>>>>
77545>>>>>            end_procedure
77546>>>>>            procedure file_change integer file#
77549>>>>>              integer field# max_field# fieldtype# st#
77549>>>>>              string str#
77549>>>>>              send delete_data
77550>>>>>              set pFileNumber to file#
77551>>>>>
77551>>>>>              if file# begin
77553>>>>>                get_attribute DF_FILE_NUMBER_FIELDS of file# to max_field#
77556>>>>>
77556>>>>>                for field# from 0 to max_field#
77562>>>>>>
77562>>>>>                  get_attribute DF_FIELD_NAME of file# field# to str#
77565>>>>>                  move (FieldInf_FieldType(file#,field#)) to fieldtype#
77566>>>>>                  if (fieldtype#<>DF_OVERLAP and fieldtype#<>DF_BINARY) begin
77568>>>>>                    ifnot (StringBeginsWith(str#,"@")) begin
77570>>>>>                      ifnot (DfQuery_ExcludeField(file#,field#)) begin
77572>>>>>                        send add_item msg_do_add_field "" //str#
77573>>>>>                        set aux_value item (item_count(self)-1) to field#
77574>>>>>                      end
77574>>>>>>
77574>>>>>                    end
77574>>>>>>
77574>>>>>                  end
77574>>>>>>
77574>>>>>                loop
77575>>>>>>
77575>>>>>                send InsertFieldNames
77576>>>>>                send load_virtual_fields file#
77577>>>>>              end
77577>>>>>>
77577>>>>>            end_procedure
77578>>>>>            function current_aux returns integer
77581>>>>>              function_return (aux_value(self,current_item(self)))
77582>>>>>            end_function
77583>>>>>            function iFindField.i integer liField returns integer
77586>>>>>              integer liItm liMax
77586>>>>>              get item_count to liMax
77587>>>>>              decrement liMax
77588>>>>>              for liItm from 0 to liMax
77594>>>>>>
77594>>>>>                if (aux_value(self,liItm)=liField) function_return liItm
77597>>>>>              loop
77598>>>>>>
77598>>>>>              function_return -1 // not found
77599>>>>>            end_function
77600>>>>>            procedure DoAddIndexFields
77603>>>>>              integer liIndex liFile liMax liItm liField lbFieldAllowed
77603>>>>>              string lsFields
77603>>>>>              get current_aux of (oDBMS_Files(self)) to liFile
77604>>>>>              if liFile begin
77606>>>>>                get iFdxSelectIndex 0 liFile to liIndex
77607>>>>>                if liIndex begin
77609>>>>>                  get FDX_IndexAsFields 0 liFile liIndex to lsFields
77610>>>>>                  get FDX_FieldsTranslateOverlaps 0 liFile lsFields to lsFields
77611>>>>>                  get HowManyIntegers lsFields to liMax
77612>>>>>                  for liItm from 1 to liMax
77618>>>>>>
77618>>>>>                    get ExtractInteger lsFields liItm to liField
77619>>>>>                    if liField begin // Exclude recnum
77621>>>>>                      get iFindField.i liField to lbFieldAllowed
77622>>>>>                      if (lbFieldAllowed<>-1) begin
77624>>>>>                        send DoGotoField liField
77625>>>>>                        send do_add_field
77626>>>>>                      end
77626>>>>>>
77626>>>>>                    end
77626>>>>>>
77626>>>>>                  loop
77627>>>>>>
77627>>>>>                end
77627>>>>>>
77627>>>>>              end
77627>>>>>>
77627>>>>>            end_procedure
77628>>>>>            procedure DoAddAllFields
77631>>>>>              integer itm# max#
77631>>>>>              get item_count to max#
77632>>>>>              for itm# from 0 to (max#-1)
77638>>>>>>
77638>>>>>                if (aux_value(self,itm#)) begin // Exclude recnum
77640>>>>>                  set current_item to itm#
77641>>>>>                  send do_add_field
77642>>>>>                end
77642>>>>>>
77642>>>>>              loop
77643>>>>>>
77643>>>>>            end_procedure
77644>>>>>            Function Status_Help integer itm_tmp# returns string
77647>>>>>              integer itm# file# aux#
77647>>>>>              string str#
77647>>>>>              if num_arguments eq 0 get current_item to itm#
77650>>>>>              else move itm_tmp# to itm#
77652>>>>>              get current_aux of (oDBMS_Files(self)) to file#
77653>>>>>              get aux_value item itm# to aux#
77654>>>>>              get VdfQuery_field_status_help file# aux# to str#
77655>>>>>              function_return str#
77656>>>>>            End_Function
77657>>>>>            procedure OnChange
77660>>>>>              send request_status_help 1
77661>>>>>            end_procedure
77662>>>>>            procedure DoGotoField integer liField
77665>>>>>              integer liMax liItm
77665>>>>>              get item_count to liMax
77666>>>>>              decrement liMax
77667>>>>>              for liItm from 0 to liMax
77673>>>>>>
77673>>>>>                if (aux_value(self,liItm)=liField) set current_item to liItm
77676>>>>>              loop
77677>>>>>>
77677>>>>>            end_procedure
77678>>>>>          end_object // oDBMS_Files
77679>>>>>          set label of (oDBMS_Fields(self)) to t.DfQuery.DBMSfields
77680>>>>>          set Label_Shadow_Display_Mode of (oDBMS_Fields(self)) to TBSHADOW_ON_NONE // Nicholas Herlick
77681>>>>>          set label_justification_mode of (oDBMS_Fields(self)) to JMODE_TOP
77682>>>>>          set label_offset of (oDBMS_Fields(self)) to 0 0
77683>>>>>          procedure notify_filechange integer file#
77686>>>>>            send file_change to (oDBMS_Fields(self)) file#
77687>>>>>          end_procedure
77688>>>>>        END_DEFINE_OBJECT_GROUP
77689>>>>>        CREATE_OBJECT_GROUP OG_QueryViewComponent 1
77693>>>>>
77693>>>>>        object oGrp is a aps.Group label t.DfQuery.LblGrpPrnt snap sl_right relative_to (oDBMS_Files(self))
77702>>>>>          set p_auto_column to 0
77703>>>>>          set peAnchors to (anTop+anLeft+anRight+anBottom)
77704>>>>>          object oGrd is a aps.Grid
77706>>>>>            set peResizeColumn to rcAll
77707>>>>>            set peAnchors to (anTop+anLeft+anRight+anBottom)
77708>>>>>            on_key kenter send next
77709>>>>>            set size to 100 0
77710>>>>>            set line_width to 5 0
77711>>>>>            set form_margin item 0 to 25
77712>>>>>            set form_margin item 1 to 2
77713>>>>>            set form_margin item 2 to 2
77714>>>>>            set form_margin item 3 to 4
77715>>>>>            set form_margin item 4 to 4
77716>>>>>            set form_datatype item 0 to ascii_window
77717>>>>>            set form_datatype item 1 to ascii_window
77718>>>>>            set form_datatype item 2 to ascii_window
77719>>>>>            set form_datatype item 3 to 1
77720>>>>>            set form_datatype item 4 to 1
77721>>>>>            set header_label item 0 to t.DfQuery.LblGrdPrnt0
77722>>>>>            set header_label item 1 to t.DfQuery.LblGrdPrnt1
77723>>>>>            set header_label item 2 to t.DfQuery.LblGrdPrnt2
77724>>>>>            set header_label item 3 to t.DfQuery.LblGrdPrnt3
77725>>>>>            set header_label item 4 to t.DfQuery.LblGrdPrnt4
77726>>>>>            set Status_Help item 0 to t.DfQuery.SthGrdPrnt0
77727>>>>>            set Status_Help item 1 to t.DfQuery.SthGrdPrnt1
77728>>>>>            set Status_Help item 2 to t.DfQuery.SthGrdPrnt2
77729>>>>>            set Status_Help item 3 to t.DfQuery.SthGrdPrnt3
77730>>>>>            set Status_Help item 4 to t.DfQuery.SthGrdPrnt4
77731>>>>>            //set highlight_row_state to true
77731>>>>>            //set highlight_row_color to (rgb(0,255,255))
77731>>>>>
77731>>>>>            set CurrentCellColor     to clHighlight
77732>>>>>            set CurrentCellTextColor to clHighlightText
77733>>>>>            set CurrentRowColor      to clHighlight
77734>>>>>            set CurrentRowTextColor  to clHighlightText
77735>>>>>
77735>>>>>            set select_mode to multi_select
77736>>>>>            set auto_top_item_state to false
77737>>>>>            on_key kdelete_record send delete_row
77738>>>>>            on_key key_ctrl+key_j send calculate_offsets
77739>>>>>            on_key kswitch send switch
77740>>>>>            on_key kswitch_back send switch_back
77741>>>>>
77741>>>>>            procedure load_report_info // Title, file, fields to be printed
77744>>>>>              integer row# max# file# field# base# sum# cr# fontsize#
77744>>>>>              integer lhExprArr liExprRow
77744>>>>>              number start# width#
77744>>>>>              string name# font#
77744>>>>>              set pReportTitle of oReport_info# to (report_title(self))
77745>>>>>              set pMainFile of oReport_info# to (pMainFile(self))
77746>>>>>              set pOrdering of oReport_info# to (pOrdering(self))
77747>>>>>              set pBottomText of oReport_info# to "bottom"
77748>>>>>              send delete_data to oReport_info#
77749>>>>>              get report_fontsize to fontsize#
77750>>>>>              get report_font to font#
77751>>>>>              // wp2 - addded for wp1
77751>>>>>              set psFontName of oReport_info# to Font#
77752>>>>>              set piFontSize of oReport_info# to FontSize#
77753>>>>>
77753>>>>>              move (oQuery_ExprArray(self)) to lhExprArr
77754>>>>>
77754>>>>>              get item_count to max#
77755>>>>>
77755>>>>>              for row# from 0 to (max#/5-1)
77761>>>>>>
77761>>>>>                move (row#*5) to base#
77762>>>>>                get aux_value item base# to file#
77763>>>>>                move (low(file#)) to field#
77764>>>>>                move (hi(file#)) to file#
77765>>>>>                get value item base# to name#
77766>>>>>                get select_state item (base#+1) to sum#
77767>>>>>                get select_state item (base#+2) to cr#
77768>>>>>                get value item (base#+3) to start#
77769>>>>>                get value item (base#+4) to width#
77770>>>>>                if file# begin
77772>>>>>                  send add_field to oReport_info# file# field# name# cr# start# width# font# fontsize# sum# 0 0 0
77773>>>>>                end
77773>>>>>>
77773>>>>>                else begin
77774>>>>>                  get aux_value item (base#+1) to liExprRow
77775>>>>>                  send add_field to oReport_info# file# field# name# cr# start# width# font# fontsize# sum# 0 lhExprArr liExprRow
77776>>>>>                end
77776>>>>>>
77776>>>>>              loop
77777>>>>>>
77777>>>>>            end_procedure
77778>>>>>            function base_item returns integer
77781>>>>>              integer itm#
77781>>>>>              get current_item to itm#
77782>>>>>              function_return ((itm#/5)*5)
77783>>>>>            end_function
77784>>>>>            procedure add_row
77787>>>>>              integer base#
77787>>>>>              get item_count to base#
77788>>>>>              set dynamic_update_state to DFFALSE
77789>>>>>              send add_item msg_none ""
77790>>>>>              send add_item msg_none ""
77791>>>>>              send add_item msg_none ""
77792>>>>>              send add_item msg_none ""
77793>>>>>              send add_item msg_none ""
77794>>>>>              set dynamic_update_state to DFTRUE
77795>>>>>            end_procedure
77796>>>>>            procedure insert_row
77799>>>>>              integer base#
77799>>>>>              if (item_count(self)) begin
77801>>>>>                get base_item to base#
77802>>>>>                set dynamic_update_state to DFFALSE
77803>>>>>                send insert_item 0 "" base#
77804>>>>>                send insert_item 0 "" base#
77805>>>>>                send insert_item 0 "" base#
77806>>>>>                send insert_item 0 "" base#
77807>>>>>                send insert_item 0 "" base#
77808>>>>>                set dynamic_update_state to DFTRUE
77809>>>>>              end
77809>>>>>>
77809>>>>>              else send add_row
77811>>>>>            end_procedure
77812>>>>>            procedure delete_row
77815>>>>>              integer base#
77815>>>>>              if (item_count(self)) begin
77817>>>>>                get base_item to base#
77818>>>>>                set dynamic_update_state to DFFALSE
77819>>>>>                send delete_item base#
77820>>>>>                send delete_item base#
77821>>>>>                send delete_item base#
77822>>>>>                send delete_item base#
77823>>>>>                send delete_item base#
77824>>>>>                set dynamic_update_state to DFTRUE
77825>>>>>              end
77825>>>>>>
77825>>>>>            end_procedure
77826>>>>>
77826>>>>>            procedure do_expression integer liRow integer liBase
77829>>>>>              integer liType lhExprArr liFieldType
77829>>>>>              move (oQuery_ExprArray(self)) to lhExprArr
77830>>>>>
77830>>>>>              set aux_value item liBase to 0
77831>>>>>              set value item liBase to (psLabel.i(lhExprArr,liRow))
77832>>>>>
77832>>>>>              set aux_value item (liBase+1) to liRow
77833>>>>>
77833>>>>>              move (piType.i(lhExprArr,liRow)) to liFieldType
77834>>>>>
77834>>>>>              if liFieldType ne DF_BCD set item_shadow_state item (liBase+1) to DFTRUE
77837>>>>>              else set checkbox_item_state item (liBase+1) to DFTRUE
77839>>>>>
77839>>>>>              set checkbox_item_state item (liBase+2) to DFTRUE
77840>>>>>
77840>>>>>              if liFieldType eq DF_TEXT set item_shadow_state item (liBase+4) to DFTRUE
77843>>>>>              set current_item to liBase
77844>>>>>            end_procedure
77845>>>>>
77845>>>>>            procedure do_field integer file# integer field# integer base#
77848>>>>>              integer fieldtype#
77848>>>>>              set aux_value item base# to (file#*65536+field#)
77849>>>>>              set value item base# to (FieldInf_FieldLabel_Short(file#,field#))
77850>>>>>
77850>>>>>              move (FieldInf_FieldType(file#,field#)) to fieldtype#
77851>>>>>
77851>>>>>              if fieldtype# ne DF_BCD set item_shadow_state item (base#+1) to DFTRUE
77854>>>>>              else set checkbox_item_state item (base#+1) to DFTRUE
77856>>>>>
77856>>>>>              set checkbox_item_state item (base#+2) to DFTRUE
77857>>>>>
77857>>>>>              if fieldtype# eq DF_TEXT set item_shadow_state item (base#+4) to DFTRUE
77860>>>>>              set current_item to base#
77861>>>>>            end_procedure
77862>>>>>
77862>>>>>            procedure add_field integer file# integer field#
77865>>>>>              integer base#
77865>>>>>              get item_count to base#
77866>>>>>              send add_row
77867>>>>>              send do_field file# field# base#
77868>>>>>              set dynamic_update_state to true
77869>>>>>              send calculate_offsets
77870>>>>>            end_procedure
77871>>>>>
77871>>>>>            procedure insert_field integer file# integer field#
77874>>>>>              integer base#
77874>>>>>              get base_item to base#
77875>>>>>              send insert_row
77876>>>>>              send do_field file# field# base#
77877>>>>>              set dynamic_update_state to true
77878>>>>>              send key kuparrow
77879>>>>>            end_procedure
77880>>>>>
77880>>>>>            function bIsExprRow integer liBase returns integer
77883>>>>>              function_return (not(aux_value(self,liBase)))
77884>>>>>            end_function
77885>>>>>
77885>>>>>            procedure DoCcAdd
77888>>>>>              integer liRow lhExprArr liBase
77888>>>>>              move (oQuery_ExprArray(self)) to lhExprArr
77889>>>>>              send DoInformExpressionThingAboutAllowedTables to (oDBMS_Files(self))
77890>>>>>              get iPopup.ii of (Query_ColumnExpression(self)) lhExprArr -1 to liRow
77891>>>>>              if (liRow<>-1) begin
77893>>>>>                get item_count to liBase
77894>>>>>                send add_row
77895>>>>>                send do_expression liRow liBase
77896>>>>>                set dynamic_update_state to DFTRUE
77897>>>>>                send calculate_offsets
77898>>>>>              end
77898>>>>>>
77898>>>>>            end_procedure
77899>>>>>            procedure DoCcInsert
77902>>>>>              integer liRow lhExprArr liBase
77902>>>>>              move (oQuery_ExprArray(self)) to lhExprArr
77903>>>>>              send DoInformExpressionThingAboutAllowedTables to (oDBMS_Files(self))
77904>>>>>              get iPopup.ii of (Query_ColumnExpression(self)) lhExprArr -1 to liRow
77905>>>>>              if (liRow<>-1) begin
77907>>>>>                get base_item to liBase
77908>>>>>                send insert_row
77909>>>>>                send do_expression liRow liBase
77910>>>>>                set dynamic_update_state to DFTRUE
77911>>>>>                send calculate_offsets
77912>>>>>              end
77912>>>>>>
77912>>>>>            end_procedure
77913>>>>>
77913>>>>>            procedure DoCcEdit
77916>>>>>              integer liBase lhExprArr liExprRow liRow
77916>>>>>              if (item_count(self)) begin
77918>>>>>                get base_item to liBase
77919>>>>>                if (bIsExprRow(self,liBase)) begin
77921>>>>>                  send DoInformExpressionThingAboutAllowedTables to (oDBMS_Files(self))
77922>>>>>                  move (oQuery_ExprArray(self)) to lhExprArr
77923>>>>>                  get aux_value item (liBase+1) to liExprRow
77924>>>>>                  get iPopup.ii of (Query_ColumnExpression(self)) lhExprArr liExprRow to liRow
77925>>>>>                  if (liRow<>-1) begin
77927>>>>>                    send do_expression liRow liBase
77928>>>>>                    set dynamic_update_state to DFTRUE
77929>>>>>                    send calculate_offsets
77930>>>>>                  end
77930>>>>>>
77930>>>>>                end
77930>>>>>>
77930>>>>>              end
77930>>>>>>
77930>>>>>            end_procedure
77931>>>>>
77931>>>>>
77931>>>>>            function row_start integer row# returns number
77934>>>>>              function_return (value(self,row#*5+3))
77935>>>>>            end_function
77936>>>>>            function row_width integer row# returns number
77939>>>>>              function_return (value(self,row#*5+4))
77940>>>>>            end_function
77941>>>>>            procedure set row_start integer row# number value#
77944>>>>>              set value item (row#*5+3) to value#
77945>>>>>            end_procedure
77946>>>>>            procedure set row_width integer row# number value#
77949>>>>>              set value item (row#*5+4) to value#
77950>>>>>            end_procedure
77951>>>>>            function row_file integer row# returns integer
77954>>>>>              function_return (hi(integer(aux_value(self,row#*5))))
77955>>>>>            end_function
77956>>>>>            function row_field integer row# returns integer
77959>>>>>              function_return (low(integer(aux_value(self,row#*5))))
77960>>>>>            end_function
77961>>>>>            function row_cr integer row# returns integer
77964>>>>>              function_return (select_state(self,row#*5+2))
77965>>>>>            end_function
77966>>>>>            function row_label integer row# returns string
77969>>>>>              function_return (value(self,row#*5))
77970>>>>>            end_function
77971>>>>>            function row_expr_row integer row# returns string
77974>>>>>              function_return (integer(aux_value(self,row#*5+1)))
77975>>>>>            end_function
77976>>>>>
77976>>>>>            procedure row_change integer liRowFrom integer liRowTo
77979>>>>>              integer liFile liField
77979>>>>>              get row_file liRowTo to liFile
77980>>>>>              get row_field liRowTo to liField
77981>>>>>              if (liFile<>0) begin
77983>>>>>                send DoGotoFile to (oDBMS_Files(self)) liFile
77984>>>>>                send DoGotoField to (oDBMS_Fields(self)) liField
77985>>>>>              end
77985>>>>>>
77985>>>>>            end_procedure
77986>>>>>            procedure item_change integer liItm1 integer liItm2 returns integer
77989>>>>>              integer liRval liColumns
77989>>>>>              get Grid_Columns self to liColumns
77990>>>>>              forward get msg_item_change liItm1 liItm2 to liRval
77992>>>>>              if ((liItm1/liColumns)<>(liRval/liColumns)) send row_change (liItm1/liColumns) (liRval/liColumns)
77995>>>>>              procedure_return liRval
77996>>>>>            end_procedure
77997>>>>>
77997>>>>>
77997>>>>>            procedure MarkUsedExpressions
78000>>>>>              integer liRow liMax liExprRow liBase liFileField lhExprArr
78000>>>>>              move (oQuery_ExprArray(self)) to lhExprArr
78001>>>>>              get Grid_RowCount self to liMax
78002>>>>>              decrement liMax
78003>>>>>              for liRow from 0 to liMax
78009>>>>>>
78009>>>>>                get Grid_RowBaseItem self liRow to liBase
78010>>>>>                get aux_value item liBase to liFileField
78011>>>>>                ifnot liFileField begin
78013>>>>>                  get aux_value item (liBase+1) to liExprRow
78014>>>>>                  send CleanUp_MarkAsUsed to lhExprArr liExprRow
78015>>>>>                end
78015>>>>>>
78015>>>>>              loop
78016>>>>>>
78016>>>>>            end_procedure
78017>>>>>
78017>>>>>            procedure GetNewExpressionIDs
78020>>>>>              integer liRow liMax liExprRow liBase liFileField lhExprArr
78020>>>>>              move (oQuery_ExprArray(self)) to lhExprArr
78021>>>>>              get Grid_RowCount self to liMax
78022>>>>>              decrement liMax
78023>>>>>              for liRow from 0 to liMax
78029>>>>>>
78029>>>>>                get Grid_RowBaseItem self liRow to liBase
78030>>>>>                get aux_value item liBase to liFileField
78031>>>>>                ifnot liFileField begin
78033>>>>>                  get aux_value item (liBase+1) to liExprRow
78034>>>>>                  get pbCleanupNewRow.i of lhExprArr liExprRow to liExprRow
78035>>>>>                  set aux_value item (liBase+1) to liExprRow
78036>>>>>                end
78036>>>>>>
78036>>>>>              loop
78037>>>>>>
78037>>>>>            end_procedure
78038>>>>>
78038>>>>>            procedure calculate_offsets
78041>>>>>              integer max# row# fieldtype# mrg# file# field# fontsize#
78041>>>>>              integer printable_file# obj# liExprRow lhExprArr
78041>>>>>              number width# start# space# label_width#
78041>>>>>              string font# row_label#
78041>>>>>              move (oQuery_ExprArray(self)) to lhExprArr
78042>>>>>
78042>>>>>              get Current_Destination to printable_file#
78043>>>>>              if printable_file# eq 2 begin
78045>>>>>                get Current_FileFormat to printable_file#
78046>>>>>                if printable_file# eq DFQ.FORMAT.PRINT move 1 to printable_file#
78049>>>>>                else move 0 to printable_file#
78051>>>>>              end
78051>>>>>>
78051>>>>>              else move 0 to printable_file#
78053>>>>>
78053>>>>>              if printable_file# move 1 to space#
78056>>>>>              else get pColumnSpace to space#
78058>>>>>
78058>>>>>              move (item_count(self)/5) to max#
78059>>>>>              move (base_item(self)/5) to row#
78060>>>>>              if row# ne 0 begin
78062>>>>>                get row_width (row#-1) to width#
78063>>>>>                get row_start (row#-1) to start#
78064>>>>>                move (start#+space#) to start#
78065>>>>>              end
78065>>>>>>
78065>>>>>              else begin
78066>>>>>                move 0 to width#
78067>>>>>                move 0 to start#
78068>>>>>              end
78068>>>>>>
78068>>>>>              get report_fontsize to fontsize#
78069>>>>>              get report_font to font#
78070>>>>>              for row# from row# to (max#-1)
78076>>>>>>
78076>>>>>                get row_file row# to file#
78077>>>>>                get row_field row# to field#
78078>>>>>                if (file#=0) begin
78080>>>>>                  get row_expr_row row# to liExprRow
78081>>>>>                  move (piType.i(lhExprArr,liExprRow)) to fieldtype#
78082>>>>>                end
78082>>>>>>
78082>>>>>                else move (FieldInf_FieldType(file#,field#)) to fieldtype#
78084>>>>>                if fieldtype# ne DF_TEXT begin
78086>>>>>                  move (start#+width#) to start#
78087>>>>>                  if (row_cr(self,row#)) move 0 to start#
78090>>>>>                  if (file#=0) get piWidth.i of lhExprArr liExprRow to mrg#
78093>>>>>                  else get VdfQuery_field_margin file# field# to mrg#
78095>>>>>                  if printable_file# begin
78097>>>>>                    move mrg# to width#
78098>>>>>                    move (length(row_label(self,row#))) to label_width#
78099>>>>>                  end
78099>>>>>>
78099>>>>>                  else begin
78100>>>>>                    get VdfQuery_field_width_cm fieldtype# mrg# 0 font# fontsize# to width#
78101>>>>>                    get row_label row# to row_label#
78102>>>>>                    get VdfQuery_value_width_cm row_label# font# fontsize# to label_width#
78103>>>>>                  end
78103>>>>>>
78103>>>>>                  if label_width# gt width# move label_width# to width#
78106>>>>>                  set row_start row# to start#
78107>>>>>                  set row_width row# to width#
78108>>>>>                  move (start#+space#) to start#
78109>>>>>                end
78109>>>>>>
78109>>>>>              loop
78110>>>>>>
78110>>>>>            end_procedure
78111>>>>>
78111>>>>>            procedure OnChangeMainFile
78114>>>>>              send delete_data
78115>>>>>            end_procedure
78116>>>>>          end_object
78117>>>>>          set multi_button_size to 14 40
78118>>>>>          object oBtn1 is a aps.Multi_Button
78120>>>>>            set peAnchors to (anRight+anBottom)
78121>>>>>            on_item t.DfQuery.LblAddField send do_add_field
78122>>>>>          end_object
78123>>>>>          object oBtn2 is a aps.Multi_Button
78125>>>>>            set peAnchors to (anRight+anBottom)
78126>>>>>            on_item t.DfQuery.LblInsertField send do_insert_field
78127>>>>>          end_object
78128>>>>>          object oBtn3 is a aps.Multi_Button
78130>>>>>            set peAnchors to (anRight+anBottom)
78131>>>>>            on_item t.DfQuery.LblDeleteField send delete_row to (oGrd(self))
78132>>>>>          end_object
78133>>>>>          if giVdfQuery_Expressions_State begin
78135>>>>>            object oBtn4 is a aps.Multi_Button
78137>>>>>              set peAnchors to (anRight+anBottom)
78138>>>>>              procedure DoCcAdd
78141>>>>>                send DoCcAdd to (oGrd(self))
78142>>>>>              end_procedure
78143>>>>>              procedure DoCcInsert
78146>>>>>                send DoCcInsert to (oGrd(self))
78147>>>>>              end_procedure
78148>>>>>              procedure DoCcEdit
78151>>>>>                send DoCcEdit to (oGrd(self))
78152>>>>>              end_procedure
78153>>>>>              procedure PopupFM
78156>>>>>                integer liLoc liCol liRow liSzCol liSzRow
78156>>>>>                send Mouse_MoveToObject self
78157>>>>>                send FLOATMENU_PrepareAddItem msg_DoCcAdd    t.btn.add
78158>>>>>                send FLOATMENU_PrepareAddItem msg_DoCcInsert t.btn.insert
78159>>>>>                send FLOATMENU_PrepareAddItem msg_DoCcEdit   t.btn.edit
78160>>>>>                send popup to (FLOATMENU_Apply(self))
78161>>>>>              end_procedure
78162>>>>>              procedure OnClick
78165>>>>>                send popupFM
78166>>>>>              end_procedure
78167>>>>>              set label to t.DfQuery.Expression
78168>>>>>            end_object
78169>>>>>          end
78169>>>>>>
78169>>>>>          object oBtn5 is a aps.Multi_Button
78171>>>>>            set peAnchors to (anRight+anBottom)
78172>>>>>            set multi_button_size to 14 50
78173>>>>>            on_item t.DfQuery.LblAdjustBelow send calculate_offsets to (oGrd(self))
78174>>>>>          end_object
78175>>>>>          send aps_locate_multi_buttons
78176>>>>>        end_object
78177>>>>>        procedure do_add_field
78180>>>>>          integer file# field#
78180>>>>>          get current_aux of (oDBMS_Files(self)) to file#
78181>>>>>          get current_aux of (oDBMS_Fields(self)) to field#
78182>>>>>          send add_field to (oGrd(oGrp(self))) file# field#
78183>>>>>          send key to (oDBMS_Fields(self)) kdownarrow
78184>>>>>        end_procedure
78185>>>>>        procedure do_insert_field
78188>>>>>          integer file# field#
78188>>>>>          get current_aux of (oDBMS_Files(self)) to file#
78189>>>>>          get current_aux of (oDBMS_Fields(self)) to field#
78190>>>>>          send insert_field to (oGrd(oGrp(self))) file# field#
78191>>>>>        end_procedure
78192>>>>>        procedure add_report_field integer file# integer field#
78195>>>>>          send add_field to (oGrd(oGrp(self))) file# field#
78196>>>>>        end_procedure
78197>>>>>      end_object
78198>>>>>      object oTab2 is a aps.TabPage label t.DfQuery.LblTab2
78201>>>>>        CREATE_OBJECT_GROUP OG_QueryViewComponent 0
78205>>>>>
78205>>>>>        property integer piExprRow public -1
78207>>>>>
78207>>>>>        procedure MarkUsedExpressions
78210>>>>>          integer liExprRow
78210>>>>>          get piExprRow to liExprRow
78211>>>>>          if (liExprRow<>-1) send CleanUp_MarkAsUsed to (oQuery_ExprArray(self)) liExprRow
78214>>>>>        end_procedure
78215>>>>>
78215>>>>>        procedure GetNewExpressionIDs
78218>>>>>          integer liExprRow
78218>>>>>          get piExprRow to liExprRow
78219>>>>>          if (liExprRow<>-1) set piExprRow to (pbCleanupNewRow.i(oQuery_ExprArray(self),liExprRow))
78222>>>>>        end_procedure
78223>>>>>        register_object oGrp
78223>>>>>        procedure DoCritExpression
78226>>>>>          integer lbOk liExprRow lhExprArr
78226>>>>>          string lsExpression
78226>>>>>          move (oQuery_ExprArray(self)) to lhExprArr
78227>>>>>          get piExprRow to liExprRow
78228>>>>>          if (liExprRow=-1) begin
78230>>>>>            get row_count of lhExprArr to liExprRow
78231>>>>>            set psLongLabel.i  of lhExprArr liExprRow to (replace(":",t.DfQuery.SelectionCrit,""))
78232>>>>>            set psLabel.i      of lhExprArr liExprRow to (replace(":",t.DfQuery.SelectionCrit,""))
78233>>>>>            set piType.i       of lhExprArr liExprRow to DF_BCD
78234>>>>>            set psExpression.i of lhExprArr liExprRow to ""
78235>>>>>          end
78235>>>>>>
78235>>>>>          get psExpression.i of lhExprArr liExprRow to lsExpression
78236>>>>>
78236>>>>>          send DoInformExpressionThingAboutAllowedTables to (oDBMS_Files(oTab1(oTabs(self))))
78237>>>>>
78237>>>>>          get iPopup.sis of (Query_EditCriteriaExpression(self)) lsExpression TYPE.INTEGER t.DfQuery.SelCritExpr to lbOk
78238>>>>>          if (lbOk<>-1) begin
78240>>>>>            get psExpression of (Query_EditCriteriaExpression(self)) to lsExpression
78241>>>>>            move (trim(Text_CompressSubstCr(lsExpression,""))) to lsExpression
78242>>>>>            if (lsExpression<>"") begin
78244>>>>>              set psExpression.i of lhExprArr liExprRow to lsExpression
78245>>>>>              set piExprRow to liExprRow
78246>>>>>            end
78246>>>>>>
78246>>>>>            else set piExprRow to -1
78248>>>>>          end
78248>>>>>>
78248>>>>>          send UpdateExpressionIndicatorText to (oGrp(self))
78249>>>>>        end_procedure
78250>>>>>
78250>>>>>        object oGrp is a aps.Group label t.DfQuery.LblGrpCrit snap SL_RIGHT relative_to (oDBMS_Files(self))
78259>>>>>          set peAnchors to (anTop+anLeft+anRight+anBottom)
78260>>>>>          object oCritDialogArray is a cArray
78262>>>>>            property integer pDisplayLocked   public 0
78264>>>>>            property integer pFieldRowsPerTab public 4
78266>>>>>            item_property_list
78266>>>>>              item_property string  psLabel.i
78266>>>>>              item_property integer piMargin.i
78266>>>>>              item_property integer piType.i // Field type
78266>>>>>              item_property integer piComp.i // Comparator
78266>>>>>              item_property string  psVal1.i
78266>>>>>              item_property string  psVal2.i
78266>>>>>              item_property integer piFile.i
78266>>>>>              item_property integer piField.i
78266>>>>>            end_item_property_list
#REM 78321 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 78326 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 78331 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 78336 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
#REM 78341 DEFINE FUNCTION PSVAL2.I INTEGER LIROW RETURNS STRING
#REM 78346 DEFINE PROCEDURE SET PSVAL2.I INTEGER LIROW STRING VALUE
#REM 78351 DEFINE FUNCTION PSVAL1.I INTEGER LIROW RETURNS STRING
#REM 78356 DEFINE PROCEDURE SET PSVAL1.I INTEGER LIROW STRING VALUE
#REM 78361 DEFINE FUNCTION PICOMP.I INTEGER LIROW RETURNS INTEGER
#REM 78366 DEFINE PROCEDURE SET PICOMP.I INTEGER LIROW INTEGER VALUE
#REM 78371 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 78376 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 78381 DEFINE FUNCTION PIMARGIN.I INTEGER LIROW RETURNS INTEGER
#REM 78386 DEFINE PROCEDURE SET PIMARGIN.I INTEGER LIROW INTEGER VALUE
#REM 78391 DEFINE FUNCTION PSLABEL.I INTEGER LIROW RETURNS STRING
#REM 78396 DEFINE PROCEDURE SET PSLABEL.I INTEGER LIROW STRING VALUE
78402>>>>>            procedure add_crit_and_value string label# integer mrg# integer type# integer comp# string val1# string val2# integer file# integer field#
78405>>>>>              integer row#
78405>>>>>              get row_count to row#
78406>>>>>              set psLabel.i  item row# to label#
78407>>>>>              set piMargin.i item row# to mrg#
78408>>>>>              set piType.i   item row# to type#
78409>>>>>              set piComp.i   item row# to comp#
78410>>>>>              set psVal1.i   item row# to val1#
78411>>>>>              set psVal2.i   item row# to val2#
78412>>>>>              set piFile.i   item row# to file#
78413>>>>>              set piField.i  item row# to field#
78414>>>>>            end_procedure
78415>>>>>          end_object
78416>>>>>
78416>>>>>          set p_auto_column to 0
78417>>>>>          object oGrd is a aps.Grid
78419>>>>>            set peResizeColumn to rcAll
78420>>>>>            set peAnchors to (anTop+anLeft+anRight+anBottom)
78421>>>>>            if giVdfQuery_Expressions_State set Size to 87 0
78424>>>>>            else set Size to 100 0
78426>>>>>            set Line_Width to 3 0
78427>>>>>            set Form_Margin item 0 to 20
78428>>>>>            set Form_Margin item 1 to 2
78429>>>>>            set Form_Margin item 2 to 20
78430>>>>>            set Form_Datatype item 0 to ascii_window
78431>>>>>            set Form_Datatype item 1 to ascii_window
78432>>>>>            set Form_Datatype item 2 to ascii_window
78433>>>>>            set Header_Label item 0 to t.DfQuery.LblGrdCrit0
78434>>>>>            set Header_Label item 1 to t.DfQuery.LblGrdCrit1
78435>>>>>            set Header_Label item 2 to t.DfQuery.LblGrdCrit2
78436>>>>>            set Status_Help item 0 to t.DfQuery.SthGrdCrit0
78437>>>>>            set Status_Help item 1 to t.DfQuery.SthGrdCrit1
78438>>>>>            set Status_Help item 2 to t.DfQuery.SthGrdCrit2
78439>>>>>            set Highlight_Row_State to true
78440>>>>>//          set Highlight_Row_Color to (rgb(0,255,255))
78440>>>>>            set CurrentCellColor     to clHighlight
78441>>>>>            set CurrentCellTextColor to clHighlightText
78442>>>>>            set CurrentRowColor      to clHighlight
78443>>>>>            set CurrentRowTextColor  to clHighlightText
78444>>>>>
78444>>>>>
78444>>>>>            set Select_Mode to MULTI_SELECT
78445>>>>>            set Auto_Top_Item_State to false
78446>>>>>            on_key kdelete_record send delete_row
78447>>>>>            on_key kswitch send switch
78448>>>>>            on_key kswitch_back send switch_back
78449>>>>>
78449>>>>>            function row_count returns integer
78452>>>>>              function_return (item_count(self)/3)
78453>>>>>            end_function
78454>>>>>
78454>>>>>            procedure load_report_info // Selection criteria
78457>>>>>              integer row# max# oDSV# file# fld# comp# critidx# newcomp#
78457>>>>>              integer lbError liExprRow lhExprArr
78457>>>>>              string val1# val2#
78457>>>>>              move (oDefault_Selection_Values(self)) to oDSV#
78458>>>>>              get row_count to max#
78459>>>>>
78459>>>>>              for row# from 0 to (max#-1)
78465>>>>>>
78465>>>>>                get row_file row# to file#
78466>>>>>                get row_field row# to fld#
78467>>>>>                get row_crit row# to critidx#
78468>>>>>                get row_comp row# to comp#
78469>>>>>                get qry_crit_val1 of oDSV# critidx# to val1#
78470>>>>>                get qry_crit_val2 of oDSV# critidx# to val2#
78471>>>>>
78471>>>>>                if comp# eq SC_COMP_OR_LIST begin // or-list
78473>>>>>                  send add_criteria_orlist to oReport_info# file# fld# val1#
78474>>>>>                  send add_criteria_text to oReport_info# (value(self,row#*3+0)) comp# (replaces("|",val1#,"; "))
78475>>>>>                end
78475>>>>>>
78475>>>>>                else begin
78476>>>>>                  send add_criteria_simple to oReport_info# file# fld# comp# val1# val2#
78477>>>>>                  send add_criteria_text to oReport_info# (value(self,row#*3+0)) comp# (value(self,row#*3+2))
78478>>>>>                end
78478>>>>>>
78478>>>>>              loop
78479>>>>>>
78479>>>>>
78479>>>>>              get piExprRow to liExprRow
78480>>>>>              if (liExprRow<>-1) begin
78482>>>>>                move (oQuery_ExprArray(self)) to lhExprArr
78483>>>>>                send add_criteria_boolean_expr to oReport_info# (piExprId.i(lhExprArr,liExprRow))
78484>>>>>                send add_criteria_text to oReport_info# "" -1 (psExpression.i(lhExprArr,liExprRow))
78485>>>>>              end
78485>>>>>>
78485>>>>>
78485>>>>>        //    liExprRow lhExprArr
78485>>>>>        //
78485>>>>>        //    send DoInformExpressionThingAboutAllowedTables to (oDBMS_Files(oTab1(self)))
78485>>>>>        //
78485>>>>>        //    get psExpression to lsExpression
78485>>>>>        //    get sPrepareExpression.s of (Query_ExprParser(self)) lsExpression to lsExpression
78485>>>>>        //    if (trim(lsExpression)<>"") begin
78485>>>>>        //      get iParse_Expr.s of (Query_ExprParser(self)) lsExpression to lbError
78485>>>>>        //      // If lbError is not 0 we have to abort the query!!!
78485>>>>>        //      get piExprID of (Query_ExprParser(self)) to liExprId
78485>>>>>        //      send add_criteria_boolean_expr to oReport_info# liExprId
78485>>>>>        //        // send add_criteria_text to oReport_info# (value(self,row#*3+0)) comp# (value(self,row#*3+2))
78485>>>>>        //    end
78485>>>>>            end_procedure
78486>>>>>            function base_item returns integer
78489>>>>>              integer itm#
78489>>>>>              get current_item to itm#
78490>>>>>              function_return ((itm#/3)*3)
78491>>>>>            end_function
78492>>>>>            register_procedure do_one_value
78492>>>>>            procedure add_row
78495>>>>>              integer base#
78495>>>>>              get item_count to base#
78496>>>>>              set dynamic_update_state to false
78497>>>>>              send add_item msg_none ""
78498>>>>>              send add_item msg_none ""
78499>>>>>              send add_item msg_do_one_value ""
78500>>>>>              set dynamic_update_state to true
78501>>>>>            end_procedure
78502>>>>>            procedure insert_row
78505>>>>>              integer base#
78505>>>>>              if (item_count(self)) begin
78507>>>>>                get base_item to base#
78508>>>>>                set dynamic_update_state to false
78509>>>>>                send insert_item 0 "" base#
78510>>>>>                send insert_item 0 "" base#
78511>>>>>                send insert_item 0 "" base#
78512>>>>>                set dynamic_update_state to true
78513>>>>>              end
78513>>>>>>
78513>>>>>              else send add_row
78515>>>>>            end_procedure
78516>>>>>            procedure delete_row
78519>>>>>              integer base#
78519>>>>>              if (item_count(self)) begin
78521>>>>>                get base_item to base#
78522>>>>>                set dynamic_update_state to false
78523>>>>>                send delete_item base#
78524>>>>>                send delete_item base#
78525>>>>>                send delete_item base#
78526>>>>>                set dynamic_update_state to true
78527>>>>>              end
78527>>>>>>
78527>>>>>            end_procedure
78528>>>>>            procedure do_field integer file# integer field# integer base#
78531>>>>>              integer fieldtype# comp# type# obj#
78531>>>>>
78531>>>>>              set aux_value item base# to (file#*65536+field#)
78532>>>>>
78532>>>>>              set value item base# to (FieldInf_FieldLabel_Long(file#,field#))
78533>>>>>              set item_shadow_state item (base#+1) to true
78534>>>>>              set item_shadow_state item (base#+2) to true
78535>>>>>              set dynamic_update_state to true // Force update
78536>>>>>
78536>>>>>              move (FieldInf_FieldType(file#,field#)) to fieldtype#
78537>>>>>
78537>>>>>              get VdfQuery_SelectCompMode fieldtype# 0 to comp#
78538>>>>>
78538>>>>>              set value item (base#+1) to (DfQuery_CompModeTxt_Short(comp#))
78539>>>>>              set aux_value item (base#+1) to comp#
78540>>>>>
78540>>>>>              if fieldtype# eq DF_ASCII move ascii_window to type#
78543>>>>>              else begin
78544>>>>>                if fieldtype# eq DF_DATE move date_window to type#
78547>>>>>                else begin
78548>>>>>                  if fieldtype# eq DF_TEXT move ascii_window to type#
78551>>>>>                  else move 0 to type#
78553>>>>>                end
78553>>>>>>
78553>>>>>              end
78553>>>>>>
78553>>>>>              set value item (base#+2) to (DfQuery_CritText(self,type#,comp#,"",""))
78554>>>>>
78554>>>>>              set dynamic_update_state to true
78555>>>>>              set current_item to (base#+2)
78556>>>>>            end_procedure
78557>>>>>
78557>>>>>            procedure add_field integer file# integer field#
78560>>>>>              integer base#
78560>>>>>              get item_count to base#
78561>>>>>              send add_row
78562>>>>>              set dynamic_update_state to true
78563>>>>>              send do_field file# field# base#
78564>>>>>            end_procedure
78565>>>>>
78565>>>>>            procedure insert_field integer file# integer field#
78568>>>>>              integer base#
78568>>>>>              get base_item to base#
78569>>>>>              send insert_row
78570>>>>>              set dynamic_update_state to true
78571>>>>>              send do_field file# field# base#
78572>>>>>              send key kuparrow
78573>>>>>            end_procedure
78574>>>>>
78574>>>>>            function row_file integer row# returns integer
78577>>>>>              function_return (hi(integer(aux_value(self,row#*3))))
78578>>>>>            end_function
78579>>>>>            function row_field integer row# returns integer
78582>>>>>              function_return (low(integer(aux_value(self,row#*3))))
78583>>>>>            end_function
78584>>>>>            function row_field_type integer row# returns integer
78587>>>>>              integer file# field# fieldtype#
78587>>>>>              get row_file row# to file#
78588>>>>>              get row_field row# to field#
78589>>>>>              move (FieldInf_FieldType(file#,field#)) to fieldtype#
78590>>>>>              function_return fieldtype#
78591>>>>>            end_function
78592>>>>>            function row_label integer row# returns string
78595>>>>>              function_return (value(self,row#*3))
78596>>>>>            end_function
78597>>>>>            function row_crit integer row# returns integer
78600>>>>>              function_return (aux_value(self,row#*3+2))
78601>>>>>            end_function
78602>>>>>            function row_form_margin integer row# returns integer
78605>>>>>              integer file# field# rval#
78605>>>>>              get row_file row# to file#
78606>>>>>              get row_field row# to field#
78607>>>>>              get VdfQuery_field_margin file# field# to rval#
78608>>>>>              function_return rval#
78609>>>>>            end_function
78610>>>>>            function row_comp integer row# returns integer
78613>>>>>              function_return (aux_value(self,row#*3+1))
78614>>>>>            end_function
78615>>>>>
78615>>>>>            procedure OnChangeMainFile
78618>>>>>              send delete_data
78619>>>>>            end_procedure
78620>>>>>
78620>>>>>          //procedure DoDisplayArrayValues
78620>>>>>          //  send debug_display_array (oDefault_Selection_Values(self))
78620>>>>>          //end_procedure
78620>>>>>          //on_key kuser send DoDisplayArrayValues
78620>>>>>
78620>>>>>            procedure add_criteria_to_CritDialogArray integer row#
78623>>>>>              integer arr# obj# crit# base# type# comp# mrg# lock# cr#
78623>>>>>              integer file# field#
78623>>>>>              string val1# val2# label#
78623>>>>>              move (oCritDialogArray(self)) to arr#
78624>>>>>              move (oDefault_Selection_Values(self)) to obj#
78625>>>>>              get row_crit row# to crit#
78626>>>>>              if crit# begin
78628>>>>>                get qry_crit_val1 of obj# crit# to val1#
78629>>>>>                get qry_crit_val2 of obj# crit# to val2#
78630>>>>>              end
78630>>>>>>
78630>>>>>              get row_label row# to label#
78631>>>>>              get row_form_margin row# to mrg#
78632>>>>>              get row_field_type row# to type#
78633>>>>>              get row_comp row# to comp#
78634>>>>>              get row_file row# to file#
78635>>>>>              get row_field row# to field#
78636>>>>>
78636>>>>>              if type# eq DF_ASCII move ASCII_WINDOW to type#
78639>>>>>              else begin
78640>>>>>                if type# eq DF_DATE move DATE_WINDOW to type#
78643>>>>>                else begin
78644>>>>>                  if type# eq DF_TEXT move ASCII_WINDOW to type#
78647>>>>>                  else get FieldInf_DecPoints file# field# to type#
78649>>>>>                end
78649>>>>>>
78649>>>>>              end
78649>>>>>>
78649>>>>>              send add_crit_and_value to arr# label# mrg# type# comp# val1# val2# file# field#
78650>>>>>            end_procedure
78651>>>>>
78651>>>>>            procedure do_one_value
78654>>>>>              integer obj# crit# base# row# type# comp# mrg# CritDialogArr# liFile liField
78654>>>>>              string val1# val2# label#
78654>>>>>              if (item_count(self)) begin
78656>>>>>                move (oDefault_Selection_Values(self)) to obj#
78657>>>>>                move (oCritDialogArray(self)) to CritDialogArr#
78658>>>>>                get base_item to base#
78659>>>>>                move (base#/3) to row#
78660>>>>>                send delete_data to CritDialogArr#
78661>>>>>                send add_criteria_to_CritDialogArray row#
78662>>>>>                get psLabel.i  of CritDialogArr# item 0 to label#
78663>>>>>                get piMargin.i of CritDialogArr# item 0 to mrg#
78664>>>>>                get piType.i   of CritDialogArr# item 0 to type#
78665>>>>>                get piComp.i   of CritDialogArr# item 0 to comp#
78666>>>>>                get psVal1.i   of CritDialogArr# item 0 to val1#
78667>>>>>                get psVal2.i   of CritDialogArr# item 0 to val2#
78668>>>>>                get piFile.i   of CritDialogArr# item 0 to liFile
78669>>>>>                get piField.i  of CritDialogArr# item 0 to liField
78670>>>>>                // label# mrg# type# comp# val1# val2#
78670>>>>>                CREATE_OBJECT_GROUP OG_QuerySingleCrit PARENT (parent(aps_PanelID(self))) (label#+":") mrg# type# comp# val1# val2# liFile liField
78687>>>>>                send popup_modal to OG_Current_Object#
78688>>>>>
78688>>>>>                if (pReturnValue(OG_Current_Object#)) begin
78690>>>>>                  if (pReturnValue(OG_Current_Object#)) eq 1 begin
78692>>>>>                    get value_from of OG_Current_Object# to val1#
78693>>>>>                    get value_to of OG_Current_Object# to val2#
78694>>>>>                    get row_crit row# to crit#
78695>>>>>                    ifnot crit# get qry_new_criteria of obj# to crit#
78698>>>>>                    send qry_change_criteria to obj# crit# val1# val2#
78699>>>>>                    set aux_value item (base#+2) to crit#
78700>>>>>                    set value item (base#+2) to (DfQuery_CritText(self,type#,comp#,val1#,val2#))
78701>>>>>                  end
78701>>>>>>
78701>>>>>                  else begin // reset
78702>>>>>                    set aux_value item (base#+2) to 0
78703>>>>>                    set value item (base#+2) to ""
78704>>>>>                  end
78704>>>>>>
78704>>>>>                end
78704>>>>>>
78704>>>>>                set dynamic_update_state to true
78705>>>>>                send request_destroy_object to OG_Current_Object#
78706>>>>>              end
78706>>>>>>
78706>>>>>            end_procedure
78707>>>>>
78707>>>>>            procedure load_global_crit_array
78710>>>>>              integer row# CritDialogArr# max#
78710>>>>>              move (oCritDialogArray(self)) to CritDialogArr#
78711>>>>>              send delete_data to CritDialogArr#
78712>>>>>
78712>>>>>              get item_count to max#
78713>>>>>              move (max#/3) to max#
78714>>>>>              for row# from 0 to (max#-1)
78720>>>>>>
78720>>>>>                send add_criteria_to_CritDialogArray row#
78721>>>>>              loop
78722>>>>>>
78722>>>>>            end_procedure
78723>>>>>
78723>>>>>            procedure do_all_values
78726>>>>>              integer CritDialogArr# max# oDefault_Selection_Values# crit# row#
78726>>>>>              integer base# comp# type#
78726>>>>>              string val1# val2#
78726>>>>>              send load_global_crit_array
78727>>>>>              move (oDefault_Selection_Values(self)) to oDefault_Selection_Values#
78728>>>>>              move (oCritDialogArray(self)) to CritDialogArr#
78729>>>>>              CREATE_OBJECT_GROUP OG_QuerySelectDialog PARENT (parent(aps_PanelID(self))) (report_title(self)) CritDialogArr#
78740>>>>>              send popup_modal to OG_Current_Object#
78741>>>>>              if (pReturnValue(OG_Current_Object#)) begin
78743>>>>>                // User pressed OK. Let's get our values back:
78743>>>>>                get row_count of CritDialogArr# to max#
78744>>>>>                for row# from 0 to (max#-1)
78750>>>>>>
78750>>>>>                  move (row#*3) to base#
78751>>>>>                  get row_crit row# to crit#
78752>>>>>                  ifnot crit# get qry_new_criteria of oDefault_Selection_Values# to crit#
78755>>>>>                  set aux_value item (base#+2) to crit#
78756>>>>>                  move (psVal1.i(CritDialogArr#,row#)) to val1#
78757>>>>>                  move (psVal2.i(CritDialogArr#,row#)) to val2#
78758>>>>>                  move (piType.i(CritDialogArr#,row#)) to Type#
78759>>>>>                  move (piComp.i(CritDialogArr#,row#)) to Comp#
78760>>>>>                  send qry_change_criteria to oDefault_Selection_Values# crit# val1# val2#
78761>>>>>                  set value item (base#+2) to (DfQuery_CritText(self,type#,comp#,val1#,val2#))
78762>>>>>                loop
78763>>>>>>
78763>>>>>              end
78763>>>>>>
78763>>>>>              send request_destroy_object to OG_Current_Object#
78764>>>>>            end_procedure
78765>>>>>
78765>>>>>            Procedure Header_Mouse_Click Integer Item#
78768>>>>>              integer comp# base# fieldtype#
78768>>>>>              forward send Header_Mouse_Click Item#
78770>>>>>              if (item_count(self)) begin
78772>>>>>                if item# eq 1 begin
78774>>>>>                  get base_item to base#
78775>>>>>                  get aux_value item (base#+1) to comp#
78776>>>>>                  get row_field_type (base#/3) to fieldtype#
78777>>>>>                  get VdfQuery_SelectCompMode fieldtype# comp# to comp#
78778>>>>>                  set aux_value item (base#+1) to comp#
78779>>>>>                  set value item (base#+1) to (DfQuery_CompModeTxt_Short(comp#))
78780>>>>>                end
78780>>>>>>
78780>>>>>                if item# eq 2 send do_one_value
78783>>>>>              end
78783>>>>>>
78783>>>>>            end_procedure
78784>>>>>            procedure Request_Header_Mouse_Click
78787>>>>>              integer base#
78787>>>>>              get base_item to base#
78788>>>>>              send Header_Mouse_Click (current_item(self)-base#)
78789>>>>>            end_procedure
78790>>>>>            on_key kprompt send Request_Header_Mouse_Click
78791>>>>>            on_key kenter send Request_Header_Mouse_Click
78792>>>>>          end_object // oGrd
78793>>>>>          send aps_goto_max_row
78794>>>>>          if giVdfQuery_Expressions_State begin
78796>>>>>            object oExpressionIndicator is a Form
78798>>>>>              set peAnchors to (anLeft+anBottom)
78799>>>>>              set size to 10 100
78800>>>>>              set TextColor to clBlue
78801>>>>>              set Enabled_State to False
78802>>>>>              set Form_Border item 0 to Border_None
78803>>>>>            end_object
78804>>>>>            send aps_auto_locate_control (oExpressionIndicator(self))
78805>>>>>            send aps_align_by_sizing (oExpressionIndicator(self)) (oGrd(self)) SL_ALIGN_RIGHT
78806>>>>>          end
78806>>>>>>
78806>>>>>          procedure UpdateExpressionIndicatorText
78809>>>>>            integer liExprRow
78809>>>>>            if giVdfQuery_Expressions_State begin
78811>>>>>              get piExprRow to liExprRow
78812>>>>>              if (liExprRow<>-1) set value of (oExpressionIndicator(self)) to t.DfQuery.ExprCritAdded
78815>>>>>              else set value of (oExpressionIndicator(self)) to ""
78817>>>>>            end
78817>>>>>>
78817>>>>>          end_procedure
78818>>>>>
78818>>>>>          set multi_button_size to 14 40
78819>>>>>          object oBtn1 is a aps.Multi_Button
78821>>>>>            set peAnchors to (anRight+anBottom)
78822>>>>>            on_item t.DfQuery.LblAddField send do_add_field
78823>>>>>          end_object
78824>>>>>          object oBtn2 is a aps.Multi_Button
78826>>>>>            set peAnchors to (anRight+anBottom)
78827>>>>>            on_item t.DfQuery.LblInsertField send do_insert_field
78828>>>>>          end_object
78829>>>>>          object oBtn3 is a aps.Multi_Button
78831>>>>>            set peAnchors to (anRight+anBottom)
78832>>>>>            on_item t.DfQuery.LblDeleteField send delete_row to (oGrd(self))
78833>>>>>          end_object
78834>>>>>          if giVdfQuery_Expressions_State begin
78836>>>>>            object oBtn4 is a aps.Multi_Button
78838>>>>>              set peAnchors to (anRight+anBottom)
78839>>>>>              on_item t.DfQuery.Expression send DoCritExpression
78840>>>>>            end_object
78841>>>>>          end
78841>>>>>>
78841>>>>>          object oBtn5 is a aps.Multi_Button
78843>>>>>            set peAnchors to (anRight+anBottom)
78844>>>>>            set multi_button_size to 14 50
78845>>>>>            on_item t.DfQuery.LblDefaultValue send do_all_values to (oGrd(self))
78846>>>>>          end_object
78847>>>>>          send aps_locate_multi_buttons
78848>>>>>        end_object
78849>>>>>        procedure do_add_field
78852>>>>>          integer file# field#
78852>>>>>          get current_aux of (oDBMS_Files(self)) to file#
78853>>>>>          get current_aux of (oDBMS_Fields(self)) to field#
78854>>>>>          send add_field to (oGrd(oGrp(self))) file# field#
78855>>>>>          send activate to (oGrd(oGrp(self)))
78856>>>>>        end_procedure
78857>>>>>        procedure do_insert_field
78860>>>>>          integer file# field#
78860>>>>>          get current_aux of (oDBMS_Files(self)) to file#
78861>>>>>          get current_aux of (oDBMS_Fields(self)) to field#
78862>>>>>          send insert_field to (oGrd(oGrp(self))) file# field#
78863>>>>>          send activate to (oGrd(oGrp(self)))
78864>>>>>        end_procedure
78865>>>>>      end_object
78866>>>>>      object oTab3 is a aps.TabPage label t.DfQuery.LblTab3
78869>>>>>        set p_auto_column to 1
78870>>>>>
78870>>>>>        object oFrm is a vdq.ComboFormAux label t.DfQuery.LblPrintOrder abstract aft_ascii50
78874>>>>>          set peAnchors to (anTop+anLeft+anRight)
78875>>>>>          set entry_state item 0 to false
78876>>>>>          set combo_sort_state to false
78877>>>>>          on_key kswitch_back send activate to (oTitle(self))
78878>>>>>          send aps_tab_column_define 1 60 55 jmode_right
78879>>>>>          procedure OnChangeMainFile
78882>>>>>            integer obj# idx# forced_index# row# max#
78882>>>>>            string str# default_index#
78882>>>>>            move (oVdfQuery_IndexAnalyzer(self)) to obj#
78883>>>>>            send read_file_definition to obj# (pMainfile(self))
78884>>>>>            send idx_translate_overlaps_all to obj#
78885>>>>>            move (og_param(1)) to forced_index#
78886>>>>>            if forced_index# ge 0 begin
78888>>>>>              get idx_field_names of obj# forced_index# 1 0 to default_index#
78889>>>>>              set pOrdering to forced_index#
78890>>>>>            end
78890>>>>>>
78890>>>>>
78890>>>>>            move "" to default_index#
78891>>>>>            send Combo_Delete_Data
78892>>>>>            send combo_add_item "Recnum" 0
78893>>>>>            for idx# from 1 to 15
78899>>>>>>
78899>>>>>              get idx_field_names of obj# idx# 1 0 to str#
78900>>>>>              if str# ne "" begin
78902>>>>>                send combo_add_item str# idx#
78903>>>>>                if default_index# eq "" begin
78905>>>>>                  move str# to default_index#
78906>>>>>                  set pOrdering to idx#
78907>>>>>                end
78907>>>>>>
78907>>>>>              end
78907>>>>>>
78907>>>>>            loop
78908>>>>>>
78908>>>>>
78908>>>>>            get FieldInf_VirtualIndices_Object (pMainFile(self)) to obj#
78909>>>>>            if obj# begin
78911>>>>>              get row_count of obj# to max#
78912>>>>>              for idx# from 0 to (max#-1)
78918>>>>>>
78918>>>>>                send combo_add_item (psIndexName.i(obj#,idx#)) (idx#+256)
78919>>>>>              loop
78920>>>>>>
78920>>>>>            end
78920>>>>>>
78920>>>>>            send combo_add_item "Ad hoc index" 1023
78921>>>>>
78921>>>>>            if default_index# ne "" set value item 0 to default_index#
78924>>>>>            else set value item 0 to "Recnum"
78926>>>>>          end_procedure
78927>>>>>          procedure OnChange
78930>>>>>            integer idx#
78930>>>>>            get Combo_Current_Aux_Value to idx#
78931>>>>>            set pOrdering to idx#
78932>>>>>            send fill_break_list
78933>>>>>          end_procedure
78934>>>>>        end_object
78935>>>>>        object oAdHoc is a aps.Button snap SL_RIGHT_SPACE
78938>>>>>          set peAnchors to (anTop+anRight)
78939>>>>>          set size to 14 40
78940>>>>>          on_item "Ad hoc" send DoAdHoc
78941>>>>>        end_object
78942>>>>>        procedure DoAdHoc
78945>>>>>          integer lhQueryOrderExpression liFile liRval
78945>>>>>          move (oQueryOrderExpression(self)) to lhQueryOrderExpression
78946>>>>>          get pMainFile to liFile
78947>>>>>          get iPopup.ii of (oQueryDefineAdhocIndexPn(self)) liFile lhQueryOrderExpression to liRval
78948>>>>>          if liRval send fill_break_list
78951>>>>>        end_procedure
78952>>>>>        send aps_goto_max_row
78953>>>>>        send aps_make_row_space 4
78954>>>>>        object oGrd is a aps.Grid
78956>>>>>          set peResizeColumn to rcAll
78957>>>>>          set peAnchors to (anTop+anLeft+anRight+anBottom)
78958>>>>>          set Size to 100 0
78959>>>>>          set Line_Width to 2 0
78960>>>>>          set Form_Margin item 0 to 2
78961>>>>>          set Form_Margin item 1 to 30
78962>>>>>          set Form_Datatype item 0 to ascii_window
78963>>>>>          set Form_Datatype item 1 to ascii_window
78964>>>>>          set Header_Label item 0 to t.DfQuery.LblGrdBreak1
78965>>>>>          set Header_Label item 1 to t.DfQuery.LblGrdBreak2
78966>>>>>          set Status_Help  item 0 to t.DfQuery.SthGrdBreak0
78967>>>>>          set Status_Help  item 1 to t.DfQuery.SthGrdBreak1
78968>>>>>          set Highlight_Row_State to DFTRUE
78969>>>>>          //set Highlight_Row_Color to (rgb(0,255,255))
78969>>>>>          set CurrentCellColor     to clHighlight
78970>>>>>          set CurrentCellTextColor to clHighlightText
78971>>>>>          set CurrentRowColor      to clHighlight
78972>>>>>          set CurrentRowTextColor  to clHighlightText
78973>>>>>
78973>>>>>
78973>>>>>          set Select_Mode to multi_select
78974>>>>>          set Auto_Top_Item_State to DFFALSE
78975>>>>>          on_key kswitch send switch
78976>>>>>          on_key kswitch_back send switch_back
78977>>>>>          procedure fill_list
78980>>>>>            integer idx# seg# max# obj# field# file# base#
78980>>>>>            move (oVdfQuery_IndexAnalyzer(self)) to obj#
78981>>>>>            send delete_data
78982>>>>>            get pMainFile to file#
78983>>>>>            set dynamic_update_state to DFFALSE
78984>>>>>            get pOrdering to idx#
78985>>>>>            if idx# lt 256 begin
78987>>>>>              get idx_max_segment of obj# idx# to max#
78988>>>>>              for seg# from 1 to (max#-1) // Exclude the least significant segment
78994>>>>>>
78994>>>>>                get idx_segment of obj# idx# seg# to field#
78995>>>>>                get item_count to base#
78996>>>>>                send add_item MSG_none ""
78997>>>>>                set aux_value item base# to (file#*65536+field#)
78998>>>>>                set checkbox_item_state item base# to DFTRUE
78999>>>>>                send add_item MSG_none (FieldInf_FieldLabel_Long(file#,field#)+": ")
79000>>>>>              loop
79001>>>>>>
79001>>>>>            end
79001>>>>>>
79001>>>>>            else begin
79002>>>>>              if (idx#=1023) begin // Ad hoc
79004>>>>>                move (oQueryOrderExpression(self)) to obj#
79005>>>>>                get row_count of obj# to max#
79006>>>>>                for seg# from 0 to (max#-1) // Do not exclude the least significant segment
79012>>>>>>
79012>>>>>                  get piFile.i of obj# seg# to file#
79013>>>>>                  get piField.i of obj# seg# to field#
79014>>>>>                  get item_count to base#
79015>>>>>                  send add_item msg_none ""
79016>>>>>                  set aux_value item base# to (file#*65536+field#)
79017>>>>>                  set checkbox_item_state item base# to DFTRUE
79018>>>>>                  send add_item msg_none (sSegmentName(obj#,seg#)+": ")
79019>>>>>                loop
79020>>>>>>
79020>>>>>              end
79020>>>>>>
79020>>>>>              else begin
79021>>>>>                move (idx#-256) to idx#
79022>>>>>                get FieldInf_VirtualIndex_Object file# idx# to obj#
79023>>>>>                if obj# begin
79025>>>>>                  get row_count of obj# to max#
79026>>>>>                  for seg# from 0 to (max#-2) // Exclude the least significant segment
79032>>>>>>
79032>>>>>                    get piField.i of obj# seg# to field#
79033>>>>>                    get item_count to base#
79034>>>>>                    send add_item msg_none ""
79035>>>>>                    set aux_value item base# to (file#*65536+field#)
79036>>>>>                    set checkbox_item_state item base# to DFTRUE
79037>>>>>                    send add_item msg_none (sSegmentName(obj#,seg#)+": ")
79038>>>>>                  loop
79039>>>>>>
79039>>>>>                end
79039>>>>>>
79039>>>>>              end
79039>>>>>>
79039>>>>>            end
79039>>>>>>
79039>>>>>            set dynamic_update_state to DFTRUE
79040>>>>>          end_procedure
79041>>>>>          procedure OnChangeMainFile
79044>>>>>            set object_shadow_state of (oAdHoc(self)) to DFTRUE
79045>>>>>            send fill_list
79046>>>>>          end_procedure
79047>>>>>        end_object
79048>>>>>        send aps_goto_max_row
79049>>>>>        send aps_make_row_space 4
79050>>>>>        object oFrm2 is a vdq.ComboFormAux label t.DfQuery.LblSearchOrder abstract aft_ascii50
79054>>>>>          set peAnchors to (anLeft+anRight+anBottom)
79055>>>>>          set entry_state item 0 to false
79056>>>>>          set combo_sort_state to false
79057>>>>>          send aps_tab_column_define 1 60 55 jmode_right
79058>>>>>          procedure OnChangeMainFile
79061>>>>>            integer obj# idx# forced_index# row# max#
79061>>>>>            string str# default_index#
79061>>>>>            move (oVdfQuery_IndexAnalyzer(self)) to obj#
79062>>>>>            send read_file_definition to obj# (pMainfile(self))
79063>>>>>            send idx_translate_overlaps_all to obj#
79064>>>>>            move (og_param(1)) to forced_index#
79065>>>>>            if forced_index# ge 0 begin
79067>>>>>              get idx_field_names of obj# forced_index# 1 0 to default_index#
79068>>>>>              set pOrdering to forced_index#
79069>>>>>            end
79069>>>>>>
79069>>>>>
79069>>>>>            move "" to default_index#
79070>>>>>            send Combo_Delete_Data
79071>>>>>            send combo_add_item "Recnum" 0
79072>>>>>            for idx# from 1 to 15
79078>>>>>>
79078>>>>>              get idx_field_names of obj# idx# 1 0 to str#
79079>>>>>              if str# ne "" begin
79081>>>>>                send combo_add_item str# idx#
79082>>>>>                if default_index# eq "" begin
79084>>>>>                  move str# to default_index#
79085>>>>>                  set pOrdering to idx#
79086>>>>>                end
79086>>>>>>
79086>>>>>              end
79086>>>>>>
79086>>>>>            loop
79087>>>>>>
79087>>>>>            if default_index# ne "" set value item 0 to default_index#
79090>>>>>            else set value item 0 to "Recnum"
79092>>>>>            set object_shadow_state to DFTRUE
79093>>>>>          end_procedure
79094>>>>>          function iIndex returns integer
79097>>>>>            integer idx#
79097>>>>>            get Combo_Current_Aux_Value to idx#
79098>>>>>            function_return idx#
79099>>>>>          end_function
79100>>>>>        end_object // oFrm
79101>>>>>        procedure fill_break_list
79104>>>>>          integer order#
79104>>>>>          get pOrdering to order#
79105>>>>>          set object_shadow_state of (oFrm2(self)) to (order#<256)
79106>>>>>          send fill_list to (oGrd(self))
79107>>>>>          set object_shadow_state of (oAdHoc(self)) to (order#<>1023)
79108>>>>>        end_procedure
79109>>>>>        procedure load_report_info // Index and breaks
79112>>>>>          integer row# max# itm# obj# new_max# index# file# field# lhExprArr
79112>>>>>          get pMainFile to file#
79113>>>>>          set pMainFile of oReport_Info# to file#
79114>>>>>          move (oQuery_ExprArray(self)) to lhExprArr
79115>>>>>          move (pOrdering(self)) to index#
79116>>>>>          if index# ge 256 begin
79118>>>>>            set pCustom_Sort_State of oReport_Info# to true
79119>>>>>            if index# eq 1023 set pCustom_Sort_Object of oReport_Info# to (oQueryOrderExpression(self))
79122>>>>>            else set pCustom_Sort_Object of oReport_Info# to (FieldInf_VirtualIndex_Object(file#,index#-256))
79124>>>>>            set pOrdering of oReport_Info# to (iIndex(oFrm2(self)))
79125>>>>>          end
79125>>>>>>
79125>>>>>          else begin
79126>>>>>            set pCustom_Sort_State of oReport_Info# to false
79127>>>>>            set pCustom_Sort_Object of oReport_Info# to 0
79128>>>>>            set pOrdering of oReport_Info# to index#
79129>>>>>          end
79129>>>>>>
79129>>>>>          move (oGrd(self)) to obj#
79130>>>>>          move (item_count(obj#)/2) to max#
79131>>>>>          move -1 to new_max#
79132>>>>>          for row# from 0 to (max#-1)
79138>>>>>>
79138>>>>>            move (row#*2) to itm#
79139>>>>>            if (select_state(obj#,itm#)) move row# to new_max#
79142>>>>>          loop
79143>>>>>>
79143>>>>>
79143>>>>>          for row# from 0 to new_max#
79149>>>>>>
79149>>>>>            move (row#*2) to itm#
79150>>>>>            get aux_value of obj# item itm# to file#
79151>>>>>            move (low(file#)) to field#
79152>>>>>            move (hi(file#)) to file#
79153>>>>>            send define_break_level to oReport_Info# file# field# (aux_value(obj#,itm#+1)) lhExprArr (select_state(obj#,itm#)) (value(obj#,itm#+1))
79154>>>>>          loop
79155>>>>>>
79155>>>>>        end_procedure
79156>>>>>        procedure aps_beautify
79159>>>>>          send aps_align_inside_container_by_moving (oGrd(self)) SL_ALIGN_CENTER
79160>>>>>        end_procedure
79161>>>>>      end_object
79162>>>>>      object oTab4 is a aps.TabPage label t.DfQuery.Texts
79165>>>>>        set p_auto_column to 0
79166>>>>>        object oLblTopText is a aps.TextBox
79168>>>>>          set peAnchors to (anTop+anLeft)
79169>>>>>          set fixed_size to 10 50
79170>>>>>          set justification_mode to JMODE_RIGHT
79171>>>>>          set label to (t.DfQuery.TextBefore+":")
79172>>>>>        end_object
79173>>>>>        object oEditTop is a aps.Edit
79175>>>>>          set peAnchors to (anTop+anLeft+anRight)
79176>>>>>          set size to 67 100
79177>>>>>        end_object
79178>>>>>        send aps_goto_max_row
79179>>>>>        object oLblButtomText is a aps.TextBox
79181>>>>>          set peAnchors to (anTop+anLeft)
79182>>>>>          set fixed_size to 10 50
79183>>>>>          set justification_mode to JMODE_RIGHT
79184>>>>>          set label to (t.DfQuery.TextAfter+":")
79185>>>>>        end_object
79186>>>>>        object oEditBottom is a aps.Edit
79188>>>>>          set peAnchors to (anTop+anLeft+anRight+anBottom)
79189>>>>>          set size to 67 100
79190>>>>>        end_object
79191>>>>>        procedure aps_beautify
79194>>>>>          send aps_align_inside_container_by_sizing (oEditTop(self)) SL_ALIGN_RIGHT
79195>>>>>          send aps_align_inside_container_by_sizing (oEditBottom(self)) SL_ALIGN_RIGHT
79196>>>>>        end_procedure
79197>>>>>      end_object
79198>>>>>      object oTab5 is a aps.TabPage label t.DfQuery.LblTab5
79201>>>>>        set p_auto_column to 1
79202>>>>>        on_key kswitch_back send activate to (oTitle(self))
79203>>>>>        send aps_tab_column_define 1 60 55 jmode_right
79204>>>>>        send aps_tab_column_define 2 220 55 jmode_right
79205>>>>>        object oFont is a aps.ComboForm label t.DfQuery.LblFont abstract aft_ascii25
79209>>>>>          set combo_sort_state to false
79210>>>>>          set entry_state item 0 to false
79211>>>>>          send Combo_Add_Item "Arial"
79212>>>>>          send Combo_Add_Item "Courier New"
79213>>>>>          send Combo_Add_Item "Times New Roman"
79214>>>>>          set value item 0 to "Times New Roman"
79215>>>>>          set pFont to "Times New Roman"
79216>>>>>          procedure OnChange
79219>>>>>            string str#
79219>>>>>            move (value(self,0)) to str#
79220>>>>>            set pFont to str#
79221>>>>>          end_procedure
79222>>>>>        end_object
79223>>>>>        object oFontSize is a aps.ComboForm abstract aft_numeric2.0 snap sl_right
79227>>>>>          set combo_sort_state to false
79228>>>>>          set entry_state item 0 to false
79229>>>>>          send Combo_Add_Item "8"
79230>>>>>          send Combo_Add_Item "10"
79231>>>>>          send Combo_Add_Item "12"
79232>>>>>          send Combo_Add_Item "14"
79233>>>>>          set value item 0 to 12
79234>>>>>          set pFontSize to 12
79235>>>>>          procedure OnChange
79238>>>>>            integer sz#
79238>>>>>            move (value(self,0)) to sz#
79239>>>>>            set pFontSize to sz#
79240>>>>>          end_procedure
79241>>>>>        end_object
79242>>>>>        object oPrintCriteria is a aps.CheckBox label t.DfQuery.LblIncludeCrit
79245>>>>>          set select_state item 0 to true
79246>>>>>        end_object
79247>>>>>        object oUseAnsiCharacters is a aps.CheckBox label t.DfQuery.UseAnsi snap 2
79251>>>>>          set object_shadow_state to true
79252>>>>>        end_object
79253>>>>>        object oPrintTotalsOnly is a aps.CheckBox label t.DfQuery.LblPrintTotals
79256>>>>>        end_object
79257>>>>>        object oIncludeLabels is a aps.CheckBox label t.DfQuery.InclNames snap 2
79261>>>>>          set object_shadow_state to true
79262>>>>>        end_object
79263>>>>>        object oOrientation is a aps.CheckBox label t.DfQuery.LblLandscape
79266>>>>>        end_object
79267>>>>>        object oSemiColon is a aps.CheckBox label t.DfQuery.Semicolon snap 2
79271>>>>>          set object_shadow_state to true
79272>>>>>        end_object
79273>>>>>        set p_auto_column to 0
79274>>>>>        send aps_goto_max_row
79275>>>>>        object oGrp1 is a aps.Group label t.DfQuery.ReportDest
79278>>>>>          set peAnchors to (anTop+anLeft+anRight)
79279>>>>>          set p_auto_column to 0
79280>>>>>          object oRad is a aps.RadioContainer
79282>>>>>            object oRad1 is a aps.Radio label t.DfQuery.Dest_Printer
79285>>>>>            end_object
79286>>>>>            object oRad2 is a aps.Radio label t.DfQuery.Dest_Preview snap sl_right
79290>>>>>            end_object
79291>>>>>            object oRad3 is a aps.Radio label t.DfQuery.Dest_File snap sl_right
79295>>>>>            end_object
79296>>>>>            set current_radio to 1 // Preview
79297>>>>>            procedure notify_select_state integer to# integer from#
79300>>>>>              send auto_shade_objects
79301>>>>>            end_procedure
79302>>>>>          end_object
79303>>>>>          object oFrm1 is a aps.Form snap SL_RIGHT_SPACE abstract AFT_ASCII80
79307>>>>>            set peAnchors to (anTop+anLeft+anRight)
79308>>>>>            set p_extra_internal_width to -250 // We don't want the form to be 80 characters wide
79309>>>>>            set form_button item 0 to 1           // Manually add a prompt button
79310>>>>>            set form_button_value item 0 to "..." //              "
79311>>>>>            set object_shadow_state to true
79312>>>>>            on_key kprompt send form_button_notification
79313>>>>>            procedure form_button_notification integer itm#
79316>>>>>              integer obj#
79316>>>>>              string str# lsStartDir
79316>>>>>              move (oVdfQuery_SaveAs(self)) to obj#
79317>>>>>              get Query_Folder QRYFOLD_CURRENT_USER_OUT to lsStartDir
79318>>>>>              set Initial_Folder of obj# to lsStartDir
79319>>>>>              if (Show_Dialog(obj#)) set value item 0 to (File_Name(obj#))
79322>>>>>            end_procedure
79323>>>>>          end_object
79324>>>>>          object oCf1 is a vdq.ComboFormAux snap SL_RIGHT
79327>>>>>            set peAnchors to (anTop+anRight)
79328>>>>>            set form_margin item 0 to 12
79329>>>>>            set entry_state item 0 to false
79330>>>>>            send combo_add_item t.DfQuery.FileFormatCD DFQ.FORMAT.CD
79331>>>>>            send combo_add_item t.DfQuery.FileFormatLD DFQ.FORMAT.LD
79332>>>>>            send combo_add_item t.DfQuery.FileFormatPR DFQ.FORMAT.PRINT
79333>>>>>            send combo_add_item "HTML"                 DFQ.FORMAT.HTML
79334>>>>>            send combo_add_item "XML"                  DFQ.FORMAT.XML
79335>>>>>            set object_shadow_state to true
79336>>>>>            procedure OnChange
79339>>>>>              send auto_shade_objects
79340>>>>>            end_procedure
79341>>>>>          end_object
79342>>>>>          procedure auto_shade_objects
79345>>>>>            integer rad# format# print_or_html# print_or_xml#
79345>>>>>            get current_radio of (oRad(self)) to rad#
79346>>>>>            move (rad#<>2) to rad# // Not file!
79347>>>>>            set object_shadow_state of (oCf1(self)) to rad#
79348>>>>>            set object_shadow_state of (oFrm1(self)) to rad#
79349>>>>>            set object_shadow_state of (oFont(self)) to (not(rad#))
79350>>>>>            set object_shadow_state of (oFontSize(self)) to (not(rad#))
79351>>>>>            get Combo_Current_Aux_Value of (oCf1(self)) to format#
79352>>>>>            move (format#=DFQ.FORMAT.PRINT or format#=DFQ.FORMAT.HTML) to print_or_html# //
79353>>>>>            move (format#=DFQ.FORMAT.XML) to print_or_xml# //
79354>>>>>            set object_shadow_state of (oPrintCriteria(self)) to (not(print_or_html# or rad#))
79355>>>>>            set object_shadow_state of (oPrintTotalsOnly(self)) to (not(print_or_html# or rad#))
79356>>>>>            set object_shadow_state of (oOrientation(self)) to (not(rad#)) // (not(print_or_html# or rad#))
79357>>>>>            set object_shadow_state of (oUseAnsiCharacters(self)) to (rad# or (format#=DFQ.FORMAT.HTML))
79358>>>>>            set object_shadow_state of (oIncludeLabels(self)) to (rad# or print_or_html# or print_or_xml#)
79359>>>>>            set object_shadow_state of (oSemiColon(self)) to (rad# or not(format#=DFQ.FORMAT.CD))
79360>>>>>          end_procedure
79361>>>>>        end_object // oGrp1
79362>>>>>        procedure load_report_info // Destination, totals only, and much more
79365>>>>>          string lsOutFileName lsStartDir
79365>>>>>          set pPrintCriteria      of oReport_Info# to (select_state(oPrintCriteria(self),0))
79366>>>>>          set pTotalsOnly         of oReport_Info# to (select_state(oPrintTotalsOnly(self),0))
79367>>>>>          set pLandscape          of oReport_Info# to (select_state(oOrientation(self),0))
79368>>>>>          set pDestination        of oReport_Info# to (current_radio(oRad(oGrp1(self))))
79369>>>>>          set pFileFormat         of oReport_Info# to (Combo_Current_Aux_Value(oCf1(oGrp1(self))))
79370>>>>>          //set pOutFileName        of oReport_Info# to (value(oFrm1(oGrp1(self)),0))
79370>>>>>
79370>>>>>          get value of (oFrm1(oGrp1(self))) item 0 to lsOutFileName
79371>>>>>          if (lsOutFileName<>"") begin
79373>>>>>            ifnot (lsOutFileName contains sysconf(SYSCONF_DIR_SEPARATOR) or lsOutFileName contains ":") begin
79375>>>>>              get Query_Folder QRYFOLD_CURRENT_USER_OUT to lsStartDir
79376>>>>>              if (lsStartDir<>"") get Files_AppendPath lsStartDir lsOutFileName to lsOutFileName
79379>>>>>            end
79379>>>>>>
79379>>>>>          end
79379>>>>>>
79379>>>>>          set pOutFileName        of oReport_Info# to lsOutFileName
79380>>>>>
79380>>>>>          set pSemiColon          of oReport_Info# to (select_state(oSemiColon(self),0))
79381>>>>>          set pIncludeLabels      of oReport_Info# to (select_state(oIncludeLabels(self),0))
79382>>>>>          set pUseAnsiCharacters  of oReport_Info# to (not(object_shadow_state(oUseAnsiCharacters(self))) and select_state(oUseAnsiCharacters(self),0))
79383>>>>>          if (pFileFormat(oReport_Info#)=DFQ.FORMAT.HTML) set pUseAnsiCharacters of oReport_Info# to DFTRUE
79386>>>>>          set psTextTop           of oReport_Info# to (Text_EditObjectValue(oEditTop(oTab4(oTabs(self)))))
79387>>>>>          set psTextBottom        of oReport_Info# to (Text_EditObjectValue(oEditBottom(oTab4(oTabs(self)))))
79388>>>>>        end_procedure
79389>>>>>      //object oOpen_Button is a aps.Multi_Button
79389>>>>>      //  set peAnchors to (anBottom+anRight)
79389>>>>>      //  on_item t.btn.open send read_report_definition
79389>>>>>      //end_object
79389>>>>>      //object oSave_Button is a aps.Multi_Button
79389>>>>>      //  set peAnchors to (anBottom+anRight)
79389>>>>>      //  set object_shadow_state to (og_param(2))
79389>>>>>      //  on_item t.btn.save send write_report_definition
79389>>>>>      //end_object
79389>>>>>      //send aps_locate_multi_buttons
79389>>>>>        procedure aps_beautify
79392>>>>>          send aps_align_inside_container_by_sizing (oGrp1(self)) sl_align_right
79393>>>>>      //  send aps_auto_locate_control (oSave_Button(self)) SL_LOWER_RIGHT_CORNER
79393>>>>>      //  send aps_auto_locate_control (oOpen_Button(self)) SL_LEFT (oSave_Button(self))
79393>>>>>        end_procedure
79394>>>>>      end_object // oTab5
79395>>>>>      procedure new_main_file
79398>>>>>        send OnChangeMainFile
79399>>>>>        if (pMainFile(self)) begin
79401>>>>>          set object_shadow_state of (oTabs(self)) to false
79402>>>>>          set object_shadow_state of (oRun_Button(self)) to false
79403>>>>>          send OnChangeMainFile to (oGrd(oGrp(oTab1(self))))
79404>>>>>          send OnChangeMainFile to (oGrd(oGrp(oTab2(self))))
79405>>>>>          send OnChangeMainFile to (oDBMS_Files(oTab1(self)))
79406>>>>>          send OnChangeMainFile to (oDBMS_Files(oTab2(self)))
79407>>>>>          send OnChangeMainFile to (oFrm(oTab3(self)))
79408>>>>>          send OnChangeMainFile to (oFrm2(oTab3(self)))
79409>>>>>          send OnChangeMainFile to (oGrd(oTab3(self)))
79410>>>>>        end
79410>>>>>>
79410>>>>>        else begin
79411>>>>>          set object_shadow_state of (oTabs(self)) to true
79412>>>>>          set object_shadow_state of (oRun_Button(self)) to true
79413>>>>>        end
79413>>>>>>
79413>>>>>      end_procedure
79414>>>>>      function anything_to_lose returns integer
79417>>>>>        integer rval#
79417>>>>>        function_return 1
79418>>>>>      end_function
79419>>>>>    end_object // oTabs
79420>>>>>
79420>>>>>    procedure Add_Field integer iFile integer iField
79423>>>>>      send add_field to (oGrd(oGrp(oTab1(oTabs(self))))) iFile iField
79424>>>>>    end_procedure
79425>>>>>
79425>>>>>    procedure force_DD integer lhDD
79428>>>>>      set phForcedDD to lhDD
79429>>>>>      send DoSetFile of oMainFile (main_file(lhDD)) 1
79430>>>>>      set enabled_state of oMainFile to FALSE
79431>>>>>      set Button_Shadow_State of (oTab2(oTabs(self))) to TRUE
79432>>>>>      set Button_Shadow_State of (oTab3(oTabs(self))) to TRUE
79433>>>>>    end_procedure
79434>>>>>
79434>>>>>    function report_font returns string
79437>>>>>      function_return (pFont(self))
79438>>>>>    end_function
79439>>>>>    function report_fontsize returns integer
79442>>>>>      function_return (pFontSize(self))
79443>>>>>    end_function
79444>>>>>
79444>>>>>    function Current_Destination returns integer
79447>>>>>      function_return (current_radio(oRad(oGrp1(oTab5(oTabs(self))))))
79448>>>>>    end_function
79449>>>>>
79449>>>>>    function Current_FileFormat returns integer
79452>>>>>      function_return (Combo_Current_Aux_Value(oCf1(oGrp1(oTab5(oTabs(self))))))
79453>>>>>    end_function
79454>>>>>
79454>>>>>    procedure go_tab1
79457>>>>>      send Request_Switch_to_Tab to (oTabs(self)) 0 3
79458>>>>>    end_procedure
79459>>>>>    procedure go_tab2
79462>>>>>      send Request_Switch_to_Tab to (oTabs(self)) 1 3
79463>>>>>    end_procedure
79464>>>>>    procedure go_tab3
79467>>>>>      send Request_Switch_to_Tab to (oTabs(self)) 2 3
79468>>>>>    end_procedure
79469>>>>>    procedure go_Tab4
79472>>>>>      send Request_Switch_to_Tab to (oTabs(self)) 3 3
79473>>>>>    end_procedure
79474>>>>>    procedure go_Tab5
79477>>>>>      send Request_Switch_to_Tab to (oTabs(self)) 4 3
79478>>>>>    end_procedure
79479>>>>>
79479>>>>>    procedure DoCritValueDialog
79482>>>>>      send do_all_values to (oGrd(oGrp(oTab2(oTabs(self)))))
79483>>>>>    end_procedure
79484>>>>>
79484>>>>>    procedure request_run_report
79487>>>>>      integer lhExprArr lbInterpretOK
79487>>>>>      if (pMainFile(self)) begin
79489>>>>>        send reset to oReport_Info#
79490>>>>>        send CleanUpExpressions // Remove expressions not used
79491>>>>>
79491>>>>>        send DoInformExpressionThingAboutAllowedTables to (oDBMS_Files(oTab1(oTabs(self))))
79492>>>>>        move (oQuery_ExprArray(self)) to lhExprArr
79493>>>>>        get iInterpretAll of lhExprArr to lbInterpretOK
79494>>>>>
79494>>>>>        if lbInterpretOK begin
79496>>>>>          send load_report_info to (oGrd(oGrp(oTab1(oTabs(self)))))
79497>>>>>          send load_report_info to (oGrd(oGrp(oTab2(oTabs(self)))))
79498>>>>>          send load_report_info to (oTab3(oTabs(self)))
79499>>>>>          send load_report_info to (oTab5(oTabs(self)))
79500>>>>>          set phDataSetObject of oReport_Info# to (phForcedDD(self))
79501>>>>>          send run to oReport_Info#
79502>>>>>          set phDataSetObject of oReport_Info# to 0
79503>>>>>        end
79503>>>>>>
79503>>>>>        else send DisplayErrors to lhExprArr
79505>>>>>      end
79505>>>>>>
79505>>>>>    end_procedure
79506>>>>>
79506>>>>>    object oRun_Button is a aps.Multi_Button
79508>>>>>      set peAnchors to (anBottom+anRight)
79509>>>>>      on_item t.DfQuery.Run send request_run_report
79510>>>>>    end_object
79511>>>>>    object oBtn2 is a aps.Multi_Button
79513>>>>>      set peAnchors to (anBottom+anRight)
79514>>>>>      on_item t.btn.close send close_panel
79515>>>>>    end_object
79516>>>>>    send aps_locate_multi_buttons
79517>>>>>
79517>>>>>    procedure aps_beautify
79520>>>>>      send aps_beautify to (oTab3(oTabs(self)))
79521>>>>>      send aps_beautify to (oTab4(oTabs(self)))
79522>>>>>      send aps_beautify to (oTab5(oTabs(self)))
79523>>>>>      send aps_align_inside_container_by_moving (oToolButton(self)) sl_align_right
79524>>>>>    end_procedure
79525>>>>>
79525>>>>>    procedure Close_Panel
79528>>>>>      forward send Close_Panel
79530>>>>>      if (pDestroyOnClose(self)) send Deferred_Request_Destroy_Object
79533>>>>>    end_procedure
79534>>>>>
79534>>>>>    procedure Close_Query_View // Meant to be broadcasted by somebody that needs to close all queries
79537>>>>>      set delegation_mode to DELEGATE_TO_PARENT
79538>>>>>      send close_panel
79539>>>>>    end_procedure
79540>>>>>
79540>>>>>    procedure CleanUpExpressions // Remove expressions not used
79543>>>>>      integer lhExprArr
79543>>>>>      move (oQuery_ExprArray(self)) to lhExprArr
79544>>>>>      send CleanUp_Prepare to lhExprArr
79545>>>>>      send MarkUsedExpressions to (oGrd(oGrp(oTab1(oTabs(self)))))
79546>>>>>      send MarkUsedExpressions to (oTab2(oTabs(self)))
79547>>>>>      send MarkUsedExpressions to (oQueryOrderExpression(self))
79548>>>>>      send CleanUp_CalcNewRow to lhExprArr
79549>>>>>      send GetNewExpressionIDs to (oGrd(oGrp(oTab1(oTabs(self)))))
79550>>>>>      send GetNewExpressionIDs to (oTab2(oTabs(self)))
79551>>>>>      send GetNewExpressionIDs to (oQueryOrderExpression(self))
79552>>>>>      send CleanUp_Purge to lhExprArr
79553>>>>>    end_procedure
79554>>>>>
79554>>>>>    procedure write_deffile_channel integer liChannel
79557>>>>>      integer liFile liIndex liFontSize
79557>>>>>      integer        liIndex2                                                 // 07/07/2004
79557>>>>>      integer lbPrintCriteria lbTotalsOnly
79557>>>>>      integer liDestination liFileFormat lhTab5 orientation# lbAnsi lbPrintLabels lbSemicolon
79557>>>>>      string lsFileName lsTitle lsFont lsValue
79557>>>>>      send CleanUpExpressions // Remove expressions not used
79558>>>>>      move (oTab5(oTabs(self))) to lhTab5
79559>>>>>      writeln channel liChannel "QDF2.0"
79562>>>>>      get pMainFile to liFile
79563>>>>>      get value of (oTitle(self)) item 0        to lsTitle
79564>>>>>      move (Combo_Current_Aux_Value(oFrm(oTab3(oTabs(self)))))  to liIndex
79565>>>>>      move (Combo_Current_Aux_Value(oFrm2(oTab3(oTabs(self))))) to liIndex2   // 07/07/2004
79566>>>>>      move (Value(oFont(oTab5(oTabs(self))),0))           to lsFont
79567>>>>>      move (Value(oFontSize(oTab5(oTabs(self))),0))       to liFontSize
79568>>>>>      move (select_state(oPrintCriteria(lhTab5),0))       to lbPrintCriteria
79569>>>>>      move (select_state(oPrintTotalsOnly(lhTab5),0))     to lbTotalsOnly
79570>>>>>      move (select_state(oOrientation(lhTab5),0))         to orientation#
79571>>>>>      move (select_state(oUseAnsiCharacters(lhTab5),0))   to lbAnsi
79572>>>>>      move (select_state(oIncludeLabels(lhTab5),0))       to lbPrintLabels
79573>>>>>      move (select_state(oSemicolon(lhTab5),0))           to lbSemicolon
79574>>>>>      move (current_radio(oRad(oGrp1(lhTab5))))           to liDestination
79575>>>>>      move (Combo_Current_Aux_Value(oCf1(oGrp1(lhTab5)))) to liFileFormat
79576>>>>>      move (value(oFrm1(oGrp1(lhTab5)),0))                to lsFileName
79577>>>>>      writeln liFile
79579>>>>>      writeln lsTitle
79581>>>>>// 07/07/2004
79581>>>>>//    writeln liIndex
79581>>>>>      if (liIndex < 256) move liIndex to liIndex2   // AdHoc is 1023,  256+ are virtual indices
79584>>>>>      writeln liIndex "," liIndex2
79588>>>>>// 07/07/2004  end
79588>>>>>      writeln lsFont
79590>>>>>      writeln liFontSize
79592>>>>>      writeln lbPrintCriteria
79594>>>>>      writeln lbTotalsOnly
79596>>>>>      writeln orientation#
79598>>>>>      writeln lbAnsi
79600>>>>>      writeln lbPrintLabels
79602>>>>>      writeln lbSemicolon
79604>>>>>      writeln liDestination
79606>>>>>      writeln liFileFormat
79608>>>>>      writeln lsFileName
79610>>>>>      send SEQ_WriteGridItems  liChannel (oGrd(oGrp(oTab1(oTabs(self)))))
79611>>>>>      send SEQ_WriteGridItems  liChannel (oGrd(oGrp(oTab2(oTabs(self)))))
79612>>>>>      send SEQ_WriteArrayItems liChannel (oDefault_Selection_Values(self))
79613>>>>>      send SEQ_WriteGridItems  liChannel (oGrd(oTab3(oTabs(self))))
79614>>>>>      move (Text_EditObjectValue(oEditTop(oTab4(oTabs(self))))) to lsValue
79615>>>>>      writeln (length(lsValue))
79617>>>>>      write lsValue
79618>>>>>      move (Text_EditObjectValue(oEditBottom(oTab4(oTabs(self))))) to lsValue
79619>>>>>      writeln (length(lsValue))
79621>>>>>      write lsValue
79622>>>>>      writeln (piExprRow(oTab2(oTabs(self))))
79624>>>>>      send SEQ_Write to (oQuery_ExprArray(self)) liChannel
79625>>>>>      send SEQ_Write to (oQueryOrderExpression(self)) liChannel
79626>>>>>    end_procedure
79627>>>>>
79627>>>>>    procedure Write_Report_Definition
79630>>>>>      integer liChannel
79630>>>>>      string lsFileName lsStartDir
79630>>>>>      if giVdfQuery_OldFolders_State get Query_Folder QRYFOLD_PUBLIC_DEF to lsStartDir
79633>>>>>      else get Query_Folder QRYFOLD_CURRENT_USER_DEF to lsStartDir
79635>>>>>      if (lsStartDir<>"") ;           get SEQ_SelectOutFileStartDir t.DfQuery.SaveFileCaption t.DfQuery.FileFilter lsStartDir to lsFileName
79638>>>>>      else get SEQ_SelectOutFile t.DfQuery.SaveFileCaption t.DfQuery.FileFilter to lsFileName
79640>>>>>
79640>>>>>      //move (SEQ_SelectOutFile(t.DfQuery.SaveFileCaption,t.DfQuery.FileFilter)) to lsFileName
79640>>>>>      if lsFileName ne "" begin
79642>>>>>        get SEQ_DirectOutput lsFileName to liChannel
79643>>>>>        if (liChannel>-1) begin
79645>>>>>          send write_deffile_channel liChannel
79646>>>>>          send SEQ_CloseOutput liChannel
79647>>>>>        end
79647>>>>>>
79647>>>>>      end
79647>>>>>>
79647>>>>>    end_procedure
79648>>>>>
79648>>>>>    procedure load_deffile_channel integer channel#
79651>>>>>      integer file# ordering# font_size# ansi# labels# len# semicolon#
79651>>>>>      integer       SearchOrder#  // 07/07/2004
79651>>>>>      integer crit_in_report# totals_only#
79651>>>>>      integer liDestination file_format# oTab5# open# orientation#
79651>>>>>      string  title# font# str# version# fn#
79651>>>>>      readln str#
79652>>>>>      if (str#="QDF1.0" or str#="QDF1.1" or str#="QDF1.3" or str#="QDF1.4" or str#="QDF2.0") begin
79654>>>>>        move str# to version#
79655>>>>>        move (oTab5(oTabs(self))) to oTab5#
79656>>>>>        readln channel channel# file#
79658>>>>>        move (DBMS_IsOpenFile(file#)) to open#
79659>>>>>        ifnot open# begin
79661>>>>>          if (DBMS_CanOpenFile(file#)) move (DBMS_OpenFile(file#,DF_SHARE,0)) to open#
79664>>>>>          else error 200 "File could not be opened"
79666>>>>>        end
79666>>>>>>
79666>>>>>        if open# begin
79668>>>>>          set pMainFile to file#
79669>>>>>          send new_main_file to (oTabs(self))
79670>>>>>          readln title#
79671>>>>>// 07/07/2004
79671>>>>>//        readln ordering#
79671>>>>>          readln ordering# SearchOrder#
79673>>>>>          if (ordering# = 1023) begin     // 1023 is AdHoc index
79675>>>>>             if (SearchOrder# = 0) move 1 to SearchOrder#
79678>>>>>          end
79678>>>>>>
79678>>>>>          if (ordering# < 256) begin      // 256+ are virtual indices
79680>>>>>             if (SearchOrder# = 0) move ordering# to SearchOrder#
79683>>>>>          end
79683>>>>>>
79683>>>>>// 07/07/2004 end
79683>>>>>          readln font#                  // eg Times Roman
79684>>>>>          readln font_size#
79685>>>>>          readln crit_in_report#
79686>>>>>          readln totals_only#
79687>>>>>          if version# ne "QDF1.0" readln orientation#
79690>>>>>          else move 0 to orientation#
79692>>>>>          if version# ge "QDF1.4" begin
79694>>>>>            readln ansi#
79695>>>>>            readln labels#
79696>>>>>            readln semicolon#
79697>>>>>          end
79697>>>>>>
79697>>>>>          else begin
79698>>>>>            move 0 to ansi#
79699>>>>>            move 0 to labels#
79700>>>>>          end
79700>>>>>>
79700>>>>>          readln liDestination
79701>>>>>          readln file_format#
79702>>>>>          readln fn#
79703>>>>>          set Combo_Current_Aux_Value of (oMainFile(self)) to file#
79704>>>>>          send SEQ_ReadGridItems channel# (oGrd(oGrp(oTab1(oTabs(self)))))
79705>>>>>          send SEQ_ReadGridItems channel# (oGrd(oGrp(oTab2(oTabs(self)))))
79706>>>>>          send SEQ_ReadArrayItems channel# (oDefault_Selection_Values(self))
79707>>>>>          set value of (oTitle(self)) item 0 to title#
79708>>>>>          set Combo_Current_Aux_Value of (oFrm(oTab3(oTabs(self)))) to ordering#
79709>>>>>          send OnChange to (oFrm(oTab3(oTabs(self))))
79710>>>>>// 07/07/2004
79710>>>>>          set Combo_Current_Aux_Value of (oFrm2(oTab3(oTabs(self)))) to SearchOrder#
79711>>>>>          send OnChange to (oFrm2(oTab3(oTabs(self))))
79712>>>>>// 07/07/2004 end
79712>>>>>          set value of (oFont(oTab5#)) to font#
79713>>>>>          send onchange to (oFont(oTab5#))
79714>>>>>          set value of (oFontSize(oTab5#)) to font_size#
79715>>>>>          send onchange to (oFontSize(oTab5#))
79716>>>>>          set select_state of (oPrintCriteria(oTab5#)) item 0 to crit_in_report#
79717>>>>>          set select_state of (oPrintTotalsOnly(oTab5#)) item 0 to totals_only#
79718>>>>>          set select_state of (oOrientation(oTab5#)) item 0 to orientation#
79719>>>>>          set select_state of (oUseAnsiCharacters(oTab5#)) item 0 to ansi#
79720>>>>>          set select_state of (oIncludeLabels(oTab5#)) item 0 to labels#
79721>>>>>          set select_state of (oSemiColon(oTab5#)) item 0 to semicolon#
79722>>>>>          set current_radio of (oRad(oGrp1(oTab5#))) to liDestination
79723>>>>>          set Combo_Current_Aux_Value of (oCf1(oGrp1(oTab5#))) to file_format#
79724>>>>>          set value of (oFrm1(oGrp1(oTab5#))) item 0 to fn#
79725>>>>>          send auto_shade_objects to (oGrp1(oTab5#))
79726>>>>>          if version# ge "QDF1.3" send SEQ_ReadGridItems channel# (oGrd(oTab3(oTabs(self))))
79729>>>>>          if version# ge "QDF2.0" begin
79731>>>>>            readln len#
79732>>>>>            read_block str# len#
79733>>>>>            send Text_SetEditObjectValue (oEditTop(oTab4(oTabs(self)))) str#
79734>>>>>            readln len#
79735>>>>>            read_block str# len#
79736>>>>>            send Text_SetEditObjectValue (oEditBottom(oTab4(oTabs(self)))) str#
79737>>>>>            set piExprRow of (oTab2(oTabs(self))) to (SEQ_ReadLn(channel#))
79738>>>>>            send SEQ_Read to (oQuery_ExprArray(self)) channel#
79739>>>>>            send SEQ_Read to (oQueryOrderExpression(self)) channel#
79740>>>>>//            send OnChange to (oFrm(oTab3(oTabs(self))))
79740>>>>>          end
79740>>>>>>
79740>>>>>          send UpdateExpressionIndicatorText to (oGrp(oTab2(oTabs(self))))
79741>>>>>        end
79741>>>>>>
79741>>>>>      end
79741>>>>>>
79741>>>>>      else send obs t.DfQuery.IncompDefFile
79743>>>>>    end_procedure
79744>>>>>
79744>>>>>    procedure load_deffile string lsFileName
79747>>>>>      integer liChannel
79747>>>>>      if lsFileName ne "" begin
79749>>>>>        get SEQ_DirectInput lsFileName to liChannel
79750>>>>>        if (liChannel>=0) begin
79752>>>>>          send load_deffile_channel liChannel
79753>>>>>          send SEQ_CloseInput liChannel
79754>>>>>        end
79754>>>>>>
79754>>>>>        else send obs "Query definition file not found" ("("+lsFileName+")")
79756>>>>>      end
79756>>>>>>
79756>>>>>    end_procedure
79757>>>>>
79757>>>>>    procedure Read_Report_Definition
79760>>>>>      string lsDefFile lsStartDir
79760>>>>>      if giVdfQuery_OldFolders_State get Query_Folder QRYFOLD_PUBLIC_DEF to lsStartDir
79763>>>>>      else get Query_Folder QRYFOLD_CURRENT_USER_DEF to lsStartDir
79765>>>>>      if (lsStartDir<>"") ;           get SEQ_SelectFileStartDir t.DfQuery.OpenFileCaption t.DfQuery.FileFilter lsStartDir to lsDefFile
79768>>>>>      else get SEQ_SelectFile t.DfQuery.OpenFileCaption t.DfQuery.FileFilter to lsDefFile
79770>>>>>      if lsDefFile ne "" send load_deffile lsDefFile
79773>>>>>    end_procedure
79774>>>>>
79774>>>>>    procedure NewQuery
79777>>>>>      send Activate_Query_Vw
79778>>>>>    end_procedure
79779>>>>>
79779>>>>>    set Border_Style to BORDER_THICK   // Make panel resizeable
79780>>>>>    send new_main_file to (oTabs(self))
79781>>>>>    move self to OG_Current_Object#
79782>>>>>
79782>>>>>  end_object // oVDFQuery_View
79783>>>>>  set piMinSize of OG_Current_Object# to (hi(size(OG_Current_Object#))) (low(size(OG_Current_Object#)))
79784>>>>>END_DEFINE_OBJECT_GROUP // OG_QueryView
79785>>>>>
79785>>>>>procedure CreateNewQuery integer tmpfile# string tmp_deffile#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
79787>>>>>  integer File# Self# Client_ID#
79787>>>>>  string deffile#
79787>>>>>  move self to Self#
79788>>>>>  move (Client_ID(Self#)) to Client_ID#
79789>>>>>  if num_arguments begin
79791>>>>>    move tmpfile# to file#
79792>>>>>    if num_arguments gt 1 move tmp_deffile# to deffile#
79795>>>>>    else move "" to deffile#
79797>>>>>  end
79797>>>>>>
79797>>>>>  else begin
79798>>>>>    move 0 to file#
79799>>>>>    move "" to deffile#
79800>>>>>  end
79800>>>>>>
79800>>>>>  if Client_ID# begin
79802>>>>>    CREATE_OBJECT_GROUP OG_QueryView PARENT Client_ID# file# -1 0
79814>>>>>    send popup to OG_Current_Object#
79815>>>>>    if (not(file#) and deffile#<>"") send load_deffile to OG_Current_Object# deffile#
79818>>>>>  end
79818>>>>>>
79818>>>>>  else error 666 "ClientArea not found!"
79820>>>>>end_procedure
79821>>>>>
79821>>>>>procedure Activate_Query_Vw string tmp_deffile#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
79823>>>>>  string deffile#
79823>>>>>  if num_arguments move tmp_deffile# to deffile#
79826>>>>>  else move "" to deffile#
79828>>>>>  send CreateNewQuery 0 deffile# // 0 means: create view with no file selected
79829>>>>>end_procedure
79830>>>>>
79830>>>>>procedure Request_CreateNewQuery
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
79832>>>>>  integer file# focus# dm# svr# Self# Client_ID#
79832>>>>>  move self to Self#
79833>>>>>  move (Client_ID(Self#)) to Client_ID#
79834>>>>>  if Client_ID# begin
79836>>>>>    move (focus(desktop)) to focus#
79837>>>>>    //JK - 2000/05/22:
79837>>>>>    // Changed following line to disallow access from modal panels
79837>>>>>    if ((focus# > desktop) and not(modal_state(focus#))) begin
79839>>>>>      get delegation_mode of focus# to dm#
79840>>>>>      set delegation_mode of focus# to no_delegate_or_error
79841>>>>>      get server of focus# to svr#
79842>>>>>      set delegation_mode of focus# to dm#
79843>>>>>      if svr# get main_file of svr# to file#
79846>>>>>      CREATE_OBJECT_GROUP OG_QueryView PARENT Client_ID# file# -1 0
79858>>>>>      send popup to OG_Current_Object#
79859>>>>>    end
79859>>>>>>
79859>>>>>    //JK - 2000/05/22:
79859>>>>>    // Added following line
79859>>>>>    else send stop_box "VdfQuery is not available from here!"
79861>>>>>  end
79861>>>>>>
79861>>>>>  else error 666 "ClientArea not found!"
79863>>>>>end_procedure
79864>>>>>
79864>>>>>function iCreateSubQueryView global integer file# integer ordering# returns integer
79866>>>>>  integer self# Client_ID# rval#
79866>>>>>  move self to Self#
79867>>>>>  move (Client_ID(Self#)) to Client_ID#
79868>>>>>  if Client_ID# begin
79870>>>>>    CREATE_OBJECT_GROUP OG_QueryView PARENT Client_ID# file# ordering# 1
79882>>>>>    move OG_Current_Object# to rval#
79883>>>>>  end
79883>>>>>>
79883>>>>>  else error 666 "ClientArea not found!"
79885>>>>>  function_return rval#
79886>>>>>end_function
79887>>>>>
79887>>>>>function iCreateQueryView global returns integer
79889>>>>>  integer self# Client_ID# rval#
79889>>>>>  move self to Self#
79890>>>>>  move (Client_ID(Self#)) to Client_ID#
79891>>>>>  if Client_ID# begin
79893>>>>>    CREATE_OBJECT_GROUP OG_QueryView PARENT Client_ID# 0 -1 0
79905>>>>>    move OG_Current_Object# to rval#
79906>>>>>  end
79906>>>>>>
79906>>>>>  else error 666 "ClientArea not found!"
79908>>>>>  function_return rval#
79909>>>>>end_function
79910>>>>>
79910>>>>>class cVdfQueryLauncher is a cArray
79911>>>>>  procedure construct_object
79913>>>>>    forward send construct_object
79915>>>>>    property integer piVDFQueryObject public 0
79916>>>>>  end_procedure
79917>>>>>  procedure DoCreateQuery
79919>>>>>    set piVDFQueryObject to (iCreateQueryView())
79920>>>>>  end_procedure
79921>>>>>  procedure DoSaveDefinition string fn#
79923>>>>>    integer liChannel
79923>>>>>    get SEQ_DirectOutput fn# to liChannel
79924>>>>>    if (liChannel>=0) begin
79926>>>>>      send write_deffile_channel to (piVDFQueryObject(self)) liChannel
79927>>>>>      send SEQ_CloseOutput liChannel
79928>>>>>    end
79928>>>>>>
79928>>>>>  end_procedure
79929>>>>>  procedure DoReadDefinition string fn#
79931>>>>>    send load_deffile to (piVDFQueryObject(self)) fn#
79932>>>>>  end_procedure
79933>>>>>  procedure DoRunQuery
79935>>>>>    send request_run_report to (piVDFQueryObject(self))
79936>>>>>  end_procedure
79937>>>>>  procedure DoSelectionDialog
79939>>>>>    send DoCritValueDialog to (piVDFQueryObject(self))
79940>>>>>  end_procedure
79941>>>>>  procedure DoPopup
79943>>>>>    send popup to (piVDFQueryObject(self))
79944>>>>>  end_procedure
79945>>>>>  procedure DoDestroyQuery
79947>>>>>    send request_destroy_object to (piVDFQueryObject(self))
79948>>>>>    set piVDFQueryObject to 0
79949>>>>>  end_procedure
79950>>>>>  procedure DoAddField integer iFile integer iField
79952>>>>>    send Add_Field of (piVDFQueryObject(self)) iFile iField
79953>>>>>  end_procedure
79954>>>>>  procedure DoSetLandscape integer lbState
79956>>>>>    integer hObj
79956>>>>>    get piVDFQueryObject to hObj
79957>>>>>    set select_state of (oOrientation(oTab5(oTabs(hObj)))) item 0 to lbState
79958>>>>>  end_procedure
79959>>>>>  procedure set CriteriaValue integer row# string value1# string value2#
79961>>>>>    integer obj#
79961>>>>>    string tmp#
79961>>>>>    get row_crit of (oGrd(oGrp(oTab2(oTabs(piVDFQueryObject(self)))))) row# to row#
79962>>>>>    move (oDefault_Selection_Values(piVDFQueryObject(self))) to obj#
79963>>>>>    if num_arguments eq 2 move "" to tmp#
79966>>>>>    else move value2# to tmp#
79968>>>>>    set value of obj# item (row#*2) to value1#
79969>>>>>    set value of obj# item (row#*2+1) to tmp#
79970>>>>>  end_procedure
79971>>>>>  procedure set QueryTitle string str#
79973>>>>>    set value of (oTitle(piVDFQueryObject(self))) item 0 to str#
79974>>>>>  end_procedure
79975>>>>>  // Pepe
79975>>>>>  procedure AutoSetup_dbGrid
79977>>>>>    boolean lbModal
79977>>>>>    integer lhDD lhDEO liMax liColumn liFile liField
79977>>>>>    send Focus_Analyze_Focus
79978>>>>>    get Focus_Info FOCUS_DEO_MODAL to lbModal
79979>>>>>    ifnot lbModal begin
79981>>>>>      get Focus_Info FOCUS_DD to lhDD
79982>>>>>      if lhDD begin
79984>>>>>        get Focus_Info FOCUS_DEO_ID to lhDEO
79985>>>>>        if (base_class(lhDEO)=LIST_CLASS) begin
79987>>>>>          send DoCreateQuery
79988>>>>>          send force_DD of (piVDFQueryObject(self)) lhDD
79989>>>>>          set QueryTitle to ""
79990>>>>>          get Grid_Columns lhDEO to liMax
79991>>>>>          decrement liMax
79992>>>>>          for liColumn from 0 to liMax
79998>>>>>>
79998>>>>>            get data_file of lhDEO liColumn to liFile
79999>>>>>            if (liFile<>0) begin
80001>>>>>              get data_field of lhDEO liColumn to liField
80002>>>>>              send DoAddField liFile liField
80003>>>>>            end
80003>>>>>>
80003>>>>>          loop
80004>>>>>>
80004>>>>>          send DoSetLandscape TRUE // <---Pepe's line
80005>>>>>          send DoPopup
80006>>>>>          send DoRunQuery
80007>>>>>        end
80007>>>>>>
80007>>>>>        else error 203 "Only works with dbList and dbGrid classes"
80009>>>>>      end
80009>>>>>>
80009>>>>>      else error 202 "DD object not found"
80011>>>>>    end
80011>>>>>>
80011>>>>>    else error 201 "Not available from within a modal panel"
80013>>>>>  end_procedure
80014>>>>>end_class // cVdfQueryLauncher
80015>>>>>
80015>>>>>//procedure AutoLaunchGridQuery
80015>>>>>//end_procedure
80015>>>>>
80015>>>>>register_object oGridQueryLauncher
80015>>>>>procedure AutoLaunchGridQuery for AppClientArea
80017>>>>>  ifnot (oGridQueryLauncher(self)) begin
80019>>>>>    object oGridQueryLauncher is a cVdfQueryLauncher
80021>>>>>    end_object
80022>>>>>  end
80022>>>>>>
80022>>>>>  send AutoSetup_dbGrid of oGridQueryLauncher
80023>>>>>end_procedure
80024>
80024>use OpenStat.pkg
Including file: openstat.pkg    (C:\projects\BRS\VDFQuery\AppSrc\openstat.pkg)
80024>>>// Use OpenStat.pkg // Call DFMatrix, Display open tables ...
80024>>>
80024>>>Use OpenStat.nui // cTablesOpenStatus class (formely cFileAllFiles)
80024>>>Use Files.nui    // Utilities for handling file related stuff
80024>>>Use MsgBox.utl   // obs procedure
80024>>>Use GridUtil.utl // Grid and List utilities
80024>>>Use Version.nui
80024>>>Use DBMS.nui     // Basic DBMS functions (No User Interface)
80024>>>Use FieldInf     // Global field info objects and abstract field types
80024>>>
80024>>>
80024>>>    define OpenStat.PrgExt for "exe" // VDF 8 and on
80024>>>
80024>>>procedure OpenStat.Chain_Wait global string program# string parameters# integer lbDontWait
80026>>>  string path# prg_fn#
80026>>>  move (program#+"."+OpenStat.PrgExt) to prg_fn#
80027>>>  get SEQ_FindFileAlongDFPath prg_fn# to path#
80028>>>  if path# ne "" begin
80030>>>    move (SEQ_ComposeAbsoluteFileName(prg_fn#,path#)) to program#
80031>>>    send OpenStat_RegisterFiles
80032>>>    send OpenStat_CloseAllFiles
80033>>>
80033>>>    runprogram background (trim(prg_fn#*parameters#))
80034>>>    send OpenStat_RestoreFiles
80035>>>  end
80035>>>>
80035>>>  else send obs (replace("#",t.OpenStat.PrgNotFound,prg_fn#))
80037>>>end_procedure
80038>>>
80038>>>procedure OpenStat.Chain_DFMatrix global
80040>>>  send OpenStat.Chain_Wait "Dfm" "" DFFALSE
80041>>>end_procedure
80042>>>
80042>>>procedure OpenStat.Chain_DbExplor global
80044>>>  send OpenStat.Chain_Wait "DbExplor" "noworkspace" DFFALSE
80045>>>end_procedure
80046>>>
80046>>>procedure OpenStat.Chain_DbBuilder global
80048>>>  send OpenStat.Chain_Wait "DbBldr" "" DFTRUE
80049>>>end_procedure
80050>>>
80050>>>object oOpenStatTableLocations is a aps.ModalPanel label t.OpenStat.LocOpenFiles
80053>>>  set locate_mode to center_on_screen
80054>>>  set Border_Style to BORDER_THICK   // Make panel resizeable
80055>>>  set pMinimumSize to 80 0
80056>>>  on_key kcancel send close_panel
80057>>>  object oGrd is a aps.grid
80059>>>    set size to 205 0
80060>>>    set gridline_mode to GRID_VISIBLE_NONE
80061>>>    send GridPrepare_AddColumn "#" AFT_ASCII3
80062>>>    send GridPrepare_AddColumn t.OpenStat.UserName AFT_ASCII20
80063>>>    send GridPrepare_AddColumn t.OpenStat.Location AFT_ASCII50
80064>>>    send GridPrepare_AddColumn t.OpenStat.Driver   AFT_ASCII12
80065>>>    send GridPrepare_Apply self
80066>>>    set select_mode to no_select
80067>>>    set peAnchors to (anTop+anLeft+anRight+anBottom)
80068>>>    Set peResizeColumn to rcSelectedColumn // make sure mode is correct
80069>>>    Set piResizeColumn to 2
80070>>>
80070>>>    procedure fill_list
80073>>>      integer file# itm# max# type# lbIsOpenedAs
80073>>>      string str# cur_dir# driver#
80073>>>      get_current_directory to cur_dir#
80074>>>      send cursor_wait to (cursor_control(self))
80075>>>      send delete_data
80076>>>      move 0 to file#
80077>>>      repeat
80077>>>>
80077>>>        get_attribute DF_FILE_NEXT_OPENED of file# to file#
80080>>>        if file# begin
80082>>>          send add_item msg_none (string(file#))
80083>>>          send add_item msg_none (File_Display_Name(file#))
80084>>>          get_attribute DF_FILE_DRIVER of file# to driver#
80087>>>          get DBMS_DriverNameToType driver# to type#
80088>>>          get DBMS_TablePath file# to str#
80089>>>          send add_item msg_none (uppercase(str#))
80090>>>          send add_item msg_none ("("+DBMS_Driver_UserName(type#)+")")
80091>>>        end
80091>>>>
80091>>>      until file# eq 0
80093>>>      get item_count to max#
80094>>>      for itm# from 0 to (max#-1)
80100>>>>
80100>>>        set entry_state item itm# to false
80101>>>      loop
80102>>>>
80102>>>      send cursor_ready to (cursor_control(self))
80103>>>    end_procedure
80104>>>  end_object
80105>>>  object oBtn is a aps.Multi_Button
80107>>>    set peAnchors to (anRight+anBottom)
80108>>>    on_item t.btn.close send close_panel
80109>>>  end_object
80110>>>  send aps_locate_multi_buttons
80111>>>  procedure popup
80114>>>    send fill_list to (oGrd(self))
80115>>>    forward send popup
80117>>>  end_procedure
80118>>>end_object // oOpenStatTableLocations
80119>>>send aps_SetMinimumDialogSize (oOpenStatTableLocations(self))
80120>>>
80120>>>
80120>>>procedure OpenStat.DisplayFileLocations global
80122>>>  send popup to (oOpenStatTableLocations(self))
80123>>>end_procedure
80124>>>
80124>Use Login.utl
Including file: login.utl    (C:\projects\BRS\VDFQuery\AppSrc\login.utl)
80124>>>// Use Login.utl    // DBMS_GetDriverLogin function
80124>>>Use Driver.nui   // This package is used to load a driver DLL
Including file: driver.nui    (C:\projects\BRS\VDFQuery\AppSrc\driver.nui)
80124>>>>>// Use Driver.nui   // This package is used to load a driver DLL
80124>>>>>
80124>>>>>Use Files.nui    // Utilities for handling file related stuff (No User Interface)
80124>>>>>Use DBMS.nui     // Basic DBMS functions (No User Interface)
80124>>>>>Use API_Attr.nui // Functions for querying API attributes (No User Interface)
80124>>>>>
80124>>>>>function DRV_LoadDriverByName global string lsDriverName returns integer
80126>>>>>  string lsDriverFile lsDir
80126>>>>>  move (lsDriverName+".DLL") to lsDriverFile
80127>>>>>  if (SEQ_FileExists(lsDriverFile)<>SEQIT_FILE) begin
80129>>>>>    // What? Driver not found? We'll have to look for it then:
80129>>>>>    move (SEQ_FindFileAlongDFPath(lsDriverFile)) to lsDir
80130>>>>>    // What? Not found again? We'll look along the EXE search path then:
80130>>>>>    if lsDir eq "" move (SEQ_FindFileAlongPath(API_OtherAttr_Value(OA_PATH),lsDriverFile)) to lsDir
80133>>>>>    if lsDir eq "" function_return 0 // If we didn't find it it doesn't exist! Goodbye!
80136>>>>>    move (SEQ_ComposeAbsoluteFileName(lsDir,lsDriverName)) to lsDriverName
80137>>>>>  end
80137>>>>>>
80137>>>>>  load_driver lsDriverName
80138>>>>>  function_return 1
80139>>>>>end_function // DRV_LoadDriverByName
80140>>>>>
80140>>>>>function DRV_LoadDriverByType global integer liType returns integer
80142>>>>>  string lsDriverName
80142>>>>>  get DBMS_TypeToDriverName liType to lsDriverName
80143>>>>>  function_return (DRV_LoadDriverByName(lsDriverName))
80144>>>>>end_function // DRV_LoadDriverByType
80145>>>// Marcelo Nachbar da Silva [nachbar@mertechdata.com]
80145>>>
80145>>>Use Language    // Set default languange if not set by compiler command line
80145>>>Use Seq_Chnl    // Defines global sequential device management operations (DAW)
80145>>>use buttons.utl
80145>>>use dbms.utl
80145>>>use files.utl
80145>>>
80145>>>
80145>>>use aps
80145>>>class cDriverComboForm is a aps.ComboFormAux
80146>>>  procedure construct_object integer img#
80148>>>    forward send construct_object img#
80150>>>    set p_abstract to aft_ascii20
80151>>>    set entry_state item 0 to false
80152>>>    on_key kenter send next
80153>>>  end_procedure
80154>>>  procedure fill_list
80156>>>    integer id#
80156>>>    send Combo_Delete_Data
80157>>>    for id# from (DBMS_DRIVER_DATAFLEX+1) to (DBMS_DRIVER_MAX-1)
80163>>>>
80163>>>      if (DBMS_TypeToDriverName(id#)) ne "Unknown" begin
80165>>>        send combo_add_item (DBMS_Driver_UserName(id#)) id#
80166>>>      end
80166>>>>
80166>>>    loop
80167>>>>
80167>>>  end_procedure
80168>>>  procedure end_construct_object
80170>>>    send fill_list
80171>>>    forward send end_construct_object
80173>>>  end_procedure
80174>>>end_class // cDriverComboForm
80175>>>
80175>>>object oDriverLogin is a aps.TopMostModalPanel label "Login"
80178>>>  set p_left_margin   to 5
80179>>>  set p_right_margin  to 20
80180>>>  set p_top_margin    to 10
80181>>>  set p_bottom_margin to 10
80182>>>  set locate_mode to CENTER_ON_SCREEN
80183>>>  on_key ksave_record send close_panel_ok
80184>>>  on_key kcancel send close_panel
80185>>>  on_key kuser send DoLoadDriver
80186>>>  property integer piResult public 0
80188>>>  property string psDriverFileName public ""
80190>>>  send aps_init
80191>>>  set p_auto_column to 1
80192>>>  send tab_column_define 1 50 45 jmode_right // Default column setting
80193>>>  object oFrm0 is a cDriverComboForm label "Driver:"
80196>>>  end_object
80197>>>  object oFrm1 is a aps.Form label "Server:" abstract aft_ascii20
80201>>>    on_key kenter send next
80202>>>  end_object
80203>>>  object oFrm2 is a aps.Form label "User:" abstract aft_ascii20
80207>>>    on_key kenter send next
80208>>>  end_object
80209>>>  object oFrm3 is a aps.Form label "Password:" abstract aft_ascii20
80213>>>    set password_state item 0 to true
80214>>>    on_key kenter send next
80215>>>  end_object
80216>>>  object oSavePW is a aps.checkbox label "Save password"
80219>>>    on_key kenter send next
80220>>>  end_object
80221>>>  object oBtn1 is a aps.Multi_Button
80223>>>    on_item t.btn.ok send close_panel_ok
80224>>>  end_object
80225>>>  object oBtn2 is a aps.Multi_Button
80227>>>    on_item t.btn.cancel send close_panel
80228>>>  end_object
80229>>>  procedure DoLoadDriver
80232>>>    integer liDriverType
80232>>>    move (Combo_Current_Aux_Value(oFrm0(self))) to liDriverType
80233>>>    if (DRV_LoadDriverByType(liDriverType)) send obs "Driver loaded"
80236>>>    else send obs "Driver could not be found." "(and therefore it could not be loaded)"
80238>>>  end_procedure
80239>>>  send aps_locate_multi_buttons
80240>>>  procedure close_panel_ok
80243>>>    integer ch#
80243>>>    string fn#
80243>>>    get psDriverFileName to fn#
80244>>>    get SEQ_DirectOutput fn# to ch#
80245>>>    if (ch#>=0) begin
80247>>>      writeln (value(oFrm1(self),0))
80249>>>      writeln (value(oFrm2(self),0))
80251>>>      if (select_state(oSavePW(self),0)) writeln (value(oFrm3(self),0))
80255>>>      else writeln ""
80258>>>      close_output channel ch#
80260>>>      send Seq_Release_Channel ch#
80261>>>      set piResult to 1
80262>>>      send close_panel
80263>>>    end
80263>>>>
80263>>>  end_procedure
80264>>>  procedure reset
80267>>>    integer ch#
80267>>>    string fn# str#
80267>>>    set value of (oFrm1(self)) item 0 to ""
80268>>>    set value of (oFrm2(self)) item 0 to ""
80269>>>    set value of (oFrm3(self)) item 0 to ""
80270>>>    set select_state of (oSavePW(self)) item 0 to 0
80271>>>    get psDriverFileName to fn#
80272>>>    get SEQ_DirectInput fn# to ch#
80273>>>    if (ch#>=0) begin
80275>>>      readln str#
80276>>>      set value of (oFrm1(self)) item 0 to str#
80277>>>      readln str#
80278>>>      set value of (oFrm2(self)) item 0 to str#
80279>>>      readln str#
80280>>>      set value of (oFrm3(self)) item 0 to str#
80281>>>      if str# ne "" set select_state of (oSavePW(self)) item 0 to 1
80284>>>      close_input channel ch#
80286>>>      send Seq_Release_Channel ch#
80287>>>      //nd close_panel
80287>>>    end
80287>>>>
80287>>>  end_procedure
80288>>>  function iLogin.i integer driver# returns integer
80291>>>    string username# filename#
80291>>>    set piResult to 0
80292>>>    if driver# begin
80294>>>      get DBMS_TypeToDriverName driver# to filename#
80295>>>      get DBMS_Driver_UserName driver# to username#
80296>>>    end
80296>>>>
80296>>>    else move "drvlogin" to filename#
80298>>>    set psDriverFileName to (lowercase(filename#+".ini"))
80299>>>    if driver# begin
80301>>>      set object_shadow_state of (oFrm0(self)) to true
80302>>>      set value of (oFrm0(self)) to (DBMS_Driver_UserName(driver#))
80303>>>    end
80303>>>>
80303>>>    else set object_shadow_state of (oFrm0(self)) to false
80305>>>    set label to ("Login: "+username#)
80306>>>    send reset
80307>>>    send popup
80308>>>    function_return (piResult(self))
80309>>>  end_function
80310>>>end_object
80311>>>
80311>>>function DBMS_GetDriverLogin global integer driver# returns integer
80313>>>  integer rval#
80313>>>  get iLogin.i of (oDriverLogin(self)) driver# to rval#
80314>>>  function_return rval#
80315>>>end_function
80316>>>
80316>>>function DBMS_GetDriverLoginDriverID global returns integer
80318>>>  function_return (Combo_Current_Aux_Value(oFrm0(oDriverLogin(self))))
80319>>>end_function
80320>>>function DBMS_GetDriverLoginServer global returns string
80322>>>  function_return (value(oFrm1(oDriverLogin(self)),0))
80323>>>end_function
80324>>>function DBMS_GetDriverLoginUserID global returns string
80326>>>  function_return (value(oFrm2(oDriverLogin(self)),0))
80327>>>end_function
80328>>>function DBMS_GetDriverLoginPassWord global returns string
80330>>>  function_return (value(oFrm3(oDriverLogin(self)),0))
80331>>>end_function
80332>>>
80332>>>//get DBMS_GetDriverLogin DBMS_DRIVER_ORACLE to windowindex
80332>>>//get DBMS_GetDriverLogin 0 to windowindex
80332>>>//if windowindex begin
80332>>>//  showln (DBMS_GetDriverLoginServer())
80332>>>//  showln (DBMS_GetDriverLoginUserID())
80332>>>//  showln (DBMS_GetDriverLoginPassWord())
80332>>>//  inkey windowindex
80332>>>//end
80332>
80332>Use SelectWorkspace.dg
Including file: SelectWorkspace.dg    (C:\Programmer\Visual DataFlex 12.0\Pkg\SelectWorkspace.dg)
80332>>>// Register all objects
80332>>>Register_Object oBrowse
80332>>>Register_Object oCancel
80332>>>Register_Object oCurrentWorkspace
80332>>>Register_Object oCurrentWorkspace_lb
80332>>>Register_Object oDescription
80332>>>Register_Object oHelp
80332>>>Register_Object oImages
80332>>>Register_Object oIni
80332>>>Register_Object oLineControl2
80332>>>Register_Object oName
80332>>>Register_Object oOpenDialog
80332>>>Register_Object oOrderBy
80332>>>Register_Object oSections
80332>>>Register_Object oSelect
80332>>>Register_Object oSelectedWorkspace
80332>>>Register_Object oSelectNewWorkspace_lb
80332>>>Register_Object oSelectWorkspace
80332>>>Register_Object oWorkspaces
80332>>>Register_Object oWorkspacesList
80332>>>
80332>>>
80332>>>
80332>>>//  Returns 0 if user press cancel
80332>>>//  Returns 1 if a new WS was created
80332>>>//
80332>>>External_Function32 StartDFWSWizard "StartDFWSWizard" DFWSWIZ.DLL Handle MyHnd Returns Integer
80333>>>
80333>>>// Change types Supported.
80333>>>Enum_list
80333>>>   Define WSNotChanged    // no change that we know of
80333>>>   Define WSNewWorkSpace  // selected New WS, No known editing
80333>>>   Define WSModified      // We may have edited, should be reinitialized
80333>>>End_Enum_list
80333>>>
80333>>>Procedure SetCurrentUserWorkspace GLOBAL String sWorkspace
80335>>>    Handle hoRegistry
80335>>>    Integer iError
80335>>>
80335>>>    Get Create U_cRegistry To hoRegistry
80336>>>
80336>>>    Get CreateKey of hoRegistry "SOFTWARE\Data Access Worldwide\Visual DataFlex\12.0\Workspaces" To iError
80337>>>    If (iError =0) Begin
80339>>>        Send WriteString of hoRegistry "Current Workspace" sWorkspace
80340>>>        Send CloseKey of hoRegistry
80341>>>    End
80341>>>>
80341>>>
80341>>>    Send Destroy of hoRegistry
80342>>>End_Procedure
80343>>>
80343>>>Function GetCurrentUserWorkspace GLOBAL Returns String
80345>>>    Handle hoRegistry
80345>>>    String sWorkspace
80345>>>    Boolean bOpened
80345>>>
80345>>>    Get Create U_cRegistry To hoRegistry
80346>>>
80346>>>    Get OpenKey of hoRegistry "SOFTWARE\Data Access Worldwide\Visual DataFlex\12.0\Workspaces" To bOpened
80347>>>    If bOpened Begin
80349>>>        If (ValueExists(hoRegistry, "Current Workspace")) Get ReadString of hoRegistry "Current Workspace" To sWorkspace
80352>>>        Send CloseKey of hoRegistry
80353>>>    End
80353>>>>
80353>>>
80353>>>    Send Destroy of hoRegistry
80354>>>    Function_Return sWorkspace
80355>>>End_Function
80356>>>
80356>>>
80356>>>Use Windows.pkg
80356>>>Use DfTreeVw.pkg
80356>>>Use dfRadio.pkg
Including file: Dfradio.pkg    (C:\Programmer\Visual DataFlex 12.0\Pkg\Dfradio.pkg)
80356>>>>>Use windows.pkg // this now lives here. (you don't need to ever use this). 
80356>>>>>
80356>>>Use DfLine.Pkg
80356>>>Use File_dlg.Pkg
80356>>>
80356>>>
80356>>>
80356>>>Object oSelectWorkspace is a ModalPanel
80358>>>
80358>>>    On_Key kCancel Send Close_Panel
80359>>>    Property Integer pbSortByName True
80361>>>    
80361>>>    Property String  psWorkspaceSelected // what is the Name of the newly-selected Workspace
80363>>>    Property String  psOriginalWorkspace // what was the Name of Workspace when the dialog was displayed?
80365>>>    Property Boolean pbChangeSystemCurrent
80367>>>    Property Boolean pbResult
80369>>>    Property String  psCurrentWorkspaceDescription // description of Current Workspace at start of dialog
80371>>>    
80371>>>    Set Locate_Mode To CENTER_ON_SCREEN
80372>>>    
80372>>>    Object oWorkspacesList is an Array
80374>>>        Procedure DoAddWorkspace String sName String sDescription String sPath
80377>>>            Set Value (Item_Count(self)) To sName
80378>>>            Set Value (Item_Count(self)) To sDescription
80379>>>            Set Value (Item_Count(self)) To sPath
80380>>>        End_Procedure
80381>>>    End_Object
80382>>>    
80382>>>    Function GetVdfRootDir Returns String
80385>>>        String sVdfRootDir
80385>>>    
80385>>>        Get_Profile_String "Defaults" "VDFRootDir" To sVDFRootDir
80388>>>        If (Right(sVDFRootDir,1) = "\") Begin
80390>>>            Left sVDFRootDir To sVDFRootDir (Length(sVDFRootDir)-1)
80392>>>>
80392>>>        End
80392>>>>
80392>>>    
80392>>>        Function_Return sVdfRootDir
80393>>>    End_Function
80394>>>    
80394>>>
80394>>>    Set Border_Style to Border_Thick
80395>>>    Set Minimize_Icon to FALSE
80396>>>    Set Label to "C_$SelectWorkspace"
80397>>>    Set Location to 2 3
80398>>>    Set Size to 244 275
80399>>>    Set piMinSize to 244 275
80400>>>
80400>>>
80400>>>
80400>>>
80400>>>    Object oImages is a cImageList
80402>>>
80402>>>        //Set Focus_Mode To NonFocusable
80402>>>
80402>>>
80402>>>        Procedure OnCreate
80405>>>            Integer iVoid
80405>>>             Get AddTransparentImage "WorkspaceSelector.bmp" clFuchsia To iVoid
80406>>>        End_Procedure
80407>>>
80407>>>    End_Object    // oImages
80408>>>
80408>>>    Object oWorkspaces is a TreeView
80410>>>
80410>>>        Set TreeSortedState To True
80411>>>        
80411>>>        
80411>>>        Procedure DoShowWorkspaces
80414>>>            Integer iVOid iWorkspace
80414>>>            Handle hoSections
80414>>>            String sWorkspace sDescription sPath
80414>>>        
80414>>>            Move oSections To hoSections
80415>>>        
80415>>>            Send DoDeleteItem 0 // remove all items
80416>>>        
80416>>>            Send Delete_Data of hoSections
80417>>>            Send Delete_Data of oWorkspacesList // remove list of Names&Descriptions
80418>>>        
80418>>>            Object oIni is a cIniFile
80420>>>                // JVH - [VDF 8.3] cIniFile does not currently support delegation so
80420>>>                // the call to GetVdfRootDir must explicitly delegate to oSelectWorkspaces
80420>>>                // Set psFilename To (GetVdfRootDir(Self) +"\bin\Workspaces.ini")
80420>>>                Set psFilename To (GetVdfRootDir(oSelectWorkspace) + "\bin\Workspaces.ini")
80421>>>        
80421>>>                Send ReadSections hoSections
80422>>>        
80422>>>                For iWorkspace from 0 to (Item_Count(hoSections) -1)
80428>>>>
80428>>>                    Get Value of hoSections iWorkspace To sWorkspace
80429>>>                    Get ReadString sWorkspace "Description" "" To sDescription
80430>>>                    Get ReadString sWorkspace "Path" ""        To sPath
80431>>>        
80431>>>                    // JVH - [VDF 8.3] cIniFile does not currently support delegation so
80431>>>                    // the we must explicitly delegate to oSelectWorkspaces
80431>>>                    If (Uppercase(sWorkspace) = Uppercase(psOriginalWorkspace(oSelectWorkspace))) Set psCurrentWorkspaceDescription of oSelectWorkspace To sDescription
80434>>>        
80434>>>                    Send DoAddWorkspace of oWorkspacesList sWorkspace sDescription sPath // store the Name, Description & Path
80435>>>        
80435>>>                    If (pbSortByName(parent(self))) Delegate Get AddHierarchy 0 sWorkspace   To iVoid
80439>>>                    Else                            Delegate Get AddHierarchy 0 sDescription To iVoid
80442>>>                Loop
80443>>>>
80443>>>            End_Object
80444>>>        
80444>>>            Send Destroy of oIni
80445>>>        
80445>>>            Send DoShowCurrentWorkspace of oCurrentWorkspace
80446>>>        End_Procedure  // DoShowWorkspaces
80447>>>        
80447>>>        
80447>>>        Set ImageListObject To (oImages(self))
80448>>>        
80448>>>        Function IsWorkspace Handle hItem Returns Integer
80451>>>            Function_Return (ItemChildCount(self, hItem) =0)
80452>>>        End_Function
80453>>>        
80453>>>        Procedure OnCreateTree
80456>>>            Send DoShowWorkspaces
80457>>>        End_Procedure
80458>>>        
80458>>>
80458>>>        Set peAnchors to anAll
80459>>>        Set Size to 151 197
80460>>>        Set Location to 56 5
80461>>>        Set pbFullRowSelect to TRUE
80462>>>        Set TreeRetainSelState to TRUE
80463>>>
80463>>>                
80463>>>        Procedure OnWorkspaceSelected Handle hItem
80466>>>            Integer iItem
80466>>>        
80466>>>            Get ItemData hItem To iItem
80467>>>            Set psWorkspaceSelected To (Value(oWorkspacesList(self), iItem*3))
80468>>>            Send Stop_Modal_Ui //Close_Panel
80469>>>        End_Procedure  // OnWorkspaceSelected
80470>>>        
80470>>>        
80470>>>        Procedure OnItemDblClick Handle hItem
80473>>>            Set pbResult To True
80474>>>            Send DoWorkspaceSelected
80475>>>        End_Procedure
80476>>>        
80476>>>        
80476>>>        Procedure DoWorkspaceSelected
80479>>>            Handle hItem
80479>>>            Get CurrentTreeItem To hItem
80480>>>            If (IsWorkspace(self, hItem)) Send OnWorkspaceSelected hItem
80483>>>        End_Procedure  // DoWorkspaceSelected
80484>>>        
80484>>>        
80484>>>        Procedure OnItemChanged Handle hItemNew Handle hItemOld
80487>>>            Boolean bWorkspace
80487>>>            Integer iItem
80487>>>            String sName sDescription
80487>>>        
80487>>>            Get IsWorkspace hItemNew To bWorkspace
80488>>>        
80488>>>            Set Enabled_State of oSelect To bWorkspace
80489>>>        
80489>>>            If bWorkspace Begin
80491>>>                Get ItemData hItemNew To iItem
80492>>>                Get Value of oWorkspacesList (iItem *3)    To sName
80493>>>                Get Value of oWorkspacesList (iItem *3 +1) To sDescription
80494>>>        
80494>>>                Set value of oSelectedWorkspace To (sDescription * "- [" +sName +"]")
80495>>>            End
80495>>>>
80495>>>            Else Set value of oSelectedWorkspace To ("<" + C_$NoneSelected + ">")
80497>>>        End_Procedure
80498>>>        
80498>>>        Function AddHierarchy Handle hiParent String sHierarchy Returns Handle
80501>>>            // Returns item-handle that was added. 0=not added (already exists)
80501>>>            Integer iPos bMoreLevels bFound icItem
80501>>>            Handle hiLevel hiSearch hoWorkspaces
80501>>>            String sLevel sSearchLabel
80501>>>        
80501>>>            Move oWorkspacesList To hoWorkspaces
80502>>>        
80502>>>            // treat the ".." as a literal "." in a label and not as a "double delimeter"
80502>>>            //Move (Replaces("..", sHierarchy, character(8))) To sHierarchy
80502>>>        
80502>>>        
80502>>>            Pos "." in sHierarchy to iPos
80504>>>>
80504>>>            If iPos Begin
80506>>>                Move (Left(sHierarchy, iPos -1)) To sLevel
80507>>>                Move (Right(sHierarchy, length(sHierarchy) - iPos)) To sHierarchy
80508>>>                Move (True) To bMoreLevels
80509>>>            End
80509>>>>
80509>>>            Else Begin // no more levels
80510>>>                Move sHierarchy To sLevel
80511>>>                Move (False) To bMoreLevels
80512>>>            End
80512>>>>
80512>>>        
80512>>>            Move (Replaces(character(8), sLevel, ".")) To sLevel
80513>>>        
80513>>>            Get ChildItem hiParent To hiSearch
80514>>>        
80514>>>            Repeat
80514>>>>
80514>>>                Get ItemLabel hiSearch To sSearchLabel
80515>>>                If (Uppercase(sSearchLabel) = Uppercase(sLevel)) Begin
80517>>>                    Move (True) To bFound
80518>>>                End
80518>>>>
80518>>>                Else Get NextSiblingItem hiSearch To hiSearch
80520>>>            Until (hiSearch =0 or bFound)
80522>>>        
80522>>>        
80522>>>            If (bFound = 0) Begin
80524>>>                Get Item_Count of hoWorkspaces To icItem
80525>>>                Get AddTreeItem sLevel hiParent (icItem /3 -1) (bMoreLevels=0) (bMoreLevels=0) To hiLevel
80526>>>                If (Value(hoWorkspaces, icItem-3) = psWorkspaceSelected(self)) Set CurrentTreeItem To hiLevel
80529>>>                If bMoreLevels Get AddHierarchy hiLevel sHierarchy To hiLevel // recurse and ignore the result
80532>>>            End
80532>>>>
80532>>>            Else If bMoreLevels Get AddHierarchy hiSearch sHierarchy To hiLevel // recurse and ignore the result
80536>>>        
80536>>>            Function_Return hiLevel
80537>>>        End_Function
80538>>>
80538>>>    End_Object    // oWorkspaces
80539>>>
80539>>>    Object oSelect is a Button
80541>>>        Set Label to "C_$Select"
80542>>>        Set Location to 137 216
80543>>>        Set peAnchors to anBottomRight
80544>>>        Set Default_State to TRUE
80545>>>
80545>>>        Set Label to C_$Select
80546>>>        
80546>>>        Procedure OnClick
80549>>>            Set pbResult To True
80550>>>            Send DoWorkspaceSelected of oWorkspaces
80551>>>        End_Procedure // OnClick
80552>>>
80552>>>    End_Object    // oSelect
80553>>>
80553>>>    Object oBrowse is a Button
80555>>>        Set Label to "C_$Browse"
80556>>>        Set Location to 155 216
80557>>>        Set peAnchors to anBottomRight
80558>>>
80558>>>        Set Label to C_$Browse
80559>>>        
80559>>>        Function DoStripExtension String sFile Returns String
80562>>>            // Description
80562>>>            // -----------
80562>>>            //  Returns a filename without its extension.
80562>>>            //  e.g. C:\TMP\STUFF.TXT will become C:\TMP\STUFF
80562>>>            //
80562>>>            Integer iPos
80562>>>        
80562>>>            If Not '.' In sFile Function_Return sFile //optimized
80565>>>        
80565>>>            Move (Length(sFile)) To iPos
80566>>>            While (iPos >0)
80570>>>                If (Mid(sFile, 1, iPos)) eq '.' break
80573>>>                Decrement iPos
80574>>>            Loop
80575>>>>
80575>>>        
80575>>>            Function_Return (Left(sFile, iPos -1))
80576>>>        End_Function  // StripExtension
80577>>>        
80577>>>        
80577>>>        Procedure OnClick
80580>>>            // Description
80580>>>            // -----------
80580>>>            // use the open file dialog to select a workspace .ws file. If the selected file is
80580>>>            // registered, then open the workspace. If it is not registered, then offer to register
80580>>>            // it before opening it....
80580>>>            Boolean bFileSelected bFound
80580>>>            String  sWorkspaceFile
80580>>>            String  sWorkspaceName
80580>>>            String  sTestName
80580>>>            String  sVDFRootDir sWsRegCommand
80580>>>            Integer iWorkspace  icWorkspace
80580>>>            Integer eRetVal
80580>>>        
80580>>>            Get Show_Dialog of oOpenDialog To bFileSelected
80581>>>        
80581>>>            If (bFileSelected) Begin
80583>>>                // get the full path & filename....
80583>>>                Get File_Name  of oOpenDialog To sWorkspaceFile
80584>>>        
80584>>>                // determine the workspace name by removing the file
80584>>>                // extension from the filename....
80584>>>                Get File_Title of oOpenDialog       To sWorkspaceName
80585>>>                Get DoStripExtension sWorkspaceName To sWorkspaceName
80586>>>        
80586>>>                // Test if the workspace has been registered yet...
80586>>>                Get Item_Count of oSections To icWorkspace
80587>>>                Move (0)                    To iWorkspace
80588>>>                Move (False)                To bFound
80589>>>        
80589>>>                While (Not(bFound) and iWorkspace < (icWorkspace - 1))
80593>>>                    Get String_Value of oSections iWorkspace To sTestName
80594>>>                    Move (Uppercase(sTestName) = Uppercase(sWorkspaceName)) To bFound
80595>>>                    Increment iWorkspace
80596>>>                Loop
80597>>>>
80597>>>        
80597>>>                // If the Workspace hasn't been registered, then ask
80597>>>                // if they would like to register it....
80597>>>                If (Not(bFound)) Begin
80599>>>                    // Run wsReg to register the selected workspace....
80599>>>                    Send Info_Box ("The selected workspace\n\n" + ;                                   sWorkspaceName + "\n\n" + ;                                   "Must be registered before it can be opened.\n\n" + ;                                   "The Workspace Registration utility will now be launched\n" + ;                                   "so that you can register this workspace.") "Select Workspace"
80600>>>        
80600>>>                    Get_Profile_String "Defaults" "VDFRootDir" To sVDFRootDir
80603>>>                    If (Right(sVDFRootDir,1) = "\") Left sVDFRootDir  To sVDFRootDir (Length(sVDFRootDir)-1)
80607>>>                    Move (sVDFRootDir + "\Bin\WsReg.exe ")            To sWsRegCommand
80608>>>                    Move (sWsRegCommand + '"' + sWorkspaceFile + '"') To sWsRegCommand
80609>>>                    Runprogram Wait sWsRegCommand
80610>>>                End
80610>>>>
80610>>>        
80610>>>                // Now have the workspace opened....
80610>>>                Delegate Set pbResult            To True
80612>>>                Delegate Set psWorkspaceSelected To sWorkspaceName
80614>>>                Send Stop_Modal_Ui //Close_Panel
80615>>>            End
80615>>>>
80615>>>        End_Procedure // OnClick
80616>>>
80616>>>    End_Object    // oBrowse
80617>>>
80617>>>    Object oCancel is a Button
80619>>>        Set Label to "C_$Cancel"
80620>>>        Set Location to 173 216
80621>>>        Set peAnchors to anBottomRight
80622>>>
80622>>>        Set Label to C_$Cancel
80623>>>        
80623>>>        Procedure OnClick
80626>>>            Send Close_Panel
80627>>>        End_Procedure // OnClick
80628>>>
80628>>>    End_Object    // oCancel
80629>>>
80629>>>    Object oHelp is a Button
80631>>>        Set Label to "C_$Help"
80632>>>        Set Location to 191 216
80633>>>        Set peAnchors to anBottomRight
80634>>>
80634>>>        Set Label to C_$Help
80635>>>        
80635>>>        Procedure OnClick
80638>>>            Send Help
80639>>>        End_Procedure // OnClick
80640>>>
80640>>>    End_Object    // oHelp
80641>>>
80641>>>    Object oOrderBy is a RadioGroup
80643>>>        Set Size to 57 58
80644>>>        Set Location to 53 208
80645>>>        Set peAnchors to anRight
80646>>>        Set Label to "C_$OrderBy"
80647>>>        Object oName is a Radio
80649>>>            Set Label to "C_$Name"
80650>>>            Set Size to 10 35
80651>>>            Set Location to 19 3
80652>>>
80652>>>            Set Label to C_$Name
80653>>>
80653>>>        End_Object    // oName
80654>>>
80654>>>        Object oDescription is a Radio
80656>>>            Set Label to "C_$Description"
80657>>>            Set Size to 10 52
80658>>>            Set Location to 32 3
80659>>>
80659>>>            Set Label to C_$Description
80660>>>
80660>>>        End_Object    // oDescription
80661>>>
80661>>>
80661>>>        Set Label to C_$OrderBy
80662>>>        
80662>>>        Procedure Notify_Select_State integer iToItem integer iFromItem
80665>>>            Integer iWorkspace
80665>>>            Handle hoWorkspaces
80665>>>        
80665>>>            Set pbSortByName To (iToItem =0)
80666>>>        
80666>>>            Get ItemData of oWorkspaces (CurrentTreeItem(oWorkspaces(self))) To iWorkspace
80667>>>            Set psWorkspaceSelected To (Value(oWorkspacesList(self), iWorkspace *3))
80668>>>            Set CurrentTreeItem of oWorkspaces To -1 // stops all the item-changing events
80669>>>        
80669>>>            Send DoShowWorkspaces of oWorkspaces
80670>>>        End_Procedure
80671>>>
80671>>>    End_Object    // oOrderBy
80672>>>
80672>>>    Object oCurrentWorkspace_lb is a Textbox
80674>>>        Set Label to "C_$CurrentWorkspace"
80675>>>        Set Location to 5 8
80676>>>        Set Size to 10 63
80677>>>        Set FontWeight to 800
80678>>>        Set TypeFace to "MS Sans Serif"
80679>>>
80679>>>        Set Label to C_$CurrentWorkspace
80680>>>
80680>>>    End_Object    // oCurrentWorkspace_lb
80681>>>
80681>>>    Object oCurrentWorkspace is a Textbox
80683>>>        Set Label to "oTextBox2"
80684>>>        Set Auto_Size_State to FALSE
80685>>>        Set Location to 17 5
80686>>>        Set Size to 14 261
80687>>>        Set Border_Style to Border_StaticEdge
80688>>>        Set TypeFace to "MS Sans Serif"
80689>>>        Set peAnchors to anLeftRight
80690>>>
80690>>>        Procedure DoShowCurrentWorkspace
80693>>>            String sDescription sName
80693>>>        
80693>>>            Delegate Get psOriginalWorkspace To sName
80695>>>            Delegate Get psCurrentWorkspaceDescription to sDescription
80697>>>        
80697>>>            If (sDescription = "") Move ("<" + C_$Undefined + ">") To sDescription
80700>>>            If (sName = "")        Move ("<" + C_$Undefined + ">") To sName
80703>>>        
80703>>>            Set Value To (sDescription * "- [" +sName +"]")
80704>>>        End_Procedure
80705>>>
80705>>>    End_Object    // oCurrentWorkspace
80706>>>
80706>>>    Object oLineControl2 is a LineControl
80708>>>        Set Size to 2 267
80709>>>        Set Location to 39 2
80710>>>        Set peAnchors to anLeftRight
80711>>>
80711>>>        Procedure Set GuiSize Integer cy Integer cx
80714>>>            Forward Set GuiSize To 2 cx
80716>>>        End_Procedure
80717>>>
80717>>>    End_Object    // oLineControl2
80718>>>
80718>>>    Object oSelectedWorkspace is a Textbox
80720>>>        Set Label to "C_$SelectedWorkspace"
80721>>>        Set Auto_Size_State to FALSE
80722>>>        Set Location to 212 5
80723>>>        Set Size to 14 261
80724>>>        Set Border_Style to Border_StaticEdge
80725>>>        Set TypeFace to "MS Sans Serif"
80726>>>        Set peAnchors to anBottomLeftRight
80727>>>
80727>>>        Set Label to C_$SelectedWorkspace
80728>>>
80728>>>    End_Object    // oSelectedWorkspace
80729>>>
80729>>>    Object oSelectNewWorkspace_lb is a Textbox
80731>>>        Set Label to "C_$SelectNewWorkspace"
80732>>>        Set Location to 44 8
80733>>>        Set Size to 10 78
80734>>>        Set FontWeight to 800
80735>>>        Set TypeFace to "MS Sans Serif"
80736>>>
80736>>>        Set Label to C_$SelectNewWorkspace
80737>>>
80737>>>    End_Object    // oSelectNewWorkspace_lb
80738>>>
80738>>>    Object oOpenDialog is a OpenDialog
80740>>>        Set Dialog_Caption to "Select a Workspace File"
80741>>>        Set Filter_String to "Workspace Files (*.ws)|*.ws"
80742>>>
80742>>>                
80742>>>        Procedure Default_Initial_Folder
80745>>>            // Description
80745>>>            // -----------
80745>>>            // Determine the default Initial_Folder.
80745>>>            String sDefaultWorkspacePath
80745>>>            Get_Profile_String "Defaults" "DefaultWorkspacePath" To sDefaultWorkspacePath
80748>>>            If (Right(sDefaultWorkspacePath,1) = "\") Begin
80750>>>                Left sDefaultWorkspacePath To sDefaultWorkspacePath (Length(sDefaultWorkspacePath)-1)
80752>>>>
80752>>>            End
80752>>>>
80752>>>        
80752>>>            Set Initial_Folder To sDefaultWorkspacePath
80753>>>        End_Procedure  // Default_Initial_Folder
80754>>>        
80754>>>        Send Default_Initial_Folder
80755>>>        
80755>>>
80755>>>    End_Object    // oOpenDialog
80756>>>
80756>>>    Object oSections is a Array
80758>>>
80758>>>        // This array contains the list of Workspace Names.
80758>>>        
80758>>>
80758>>>
80758>>>                
80758>>>                
80758>>>
80758>>>    End_Object    // oSections
80759>>>
80759>>>
80759>>>    Set Label to C_$SelectWorkspace
80760>>>    
80760>>>    // === PUBLIC INTERFACE ===
80760>>>    Function SelectWorkspace Returns Boolean // new WS selected?
80763>>>        Boolean bWorkspaceSelected
80763>>>        String sWorkspaceName
80763>>>    
80763>>>        Set pbResult To False
80764>>>        Get psWorkspaceName Of (phoWorkspace (ghoApplication)) To sWorkspaceName
80765>>>        If (sWorkspaceName = "") Begin
80767>>>            Get GetCurrentUserWorkspace To sWorkspaceName
80768>>>        End
80768>>>>
80768>>>        Set psOriginalWorkspace To sWorkspaceName
80769>>>        Set psWorkspaceSelected To (psOriginalWorkspace(self))
80770>>>    
80770>>>        Set Enabled_State of oHelp To (Help_Id(self)) // disable if no Help_Id set (by calling program)
80771>>>    
80771>>>        Send Popup_Modal
80772>>>    
80772>>>        Move (pbResult(self) = True and psOriginalWorkspace(self) <> psWorkspaceSelected(self)) To bWorkspaceSelected
80773>>>    
80773>>>        If bWorkspaceSelected Begin
80775>>>            If (pbChangeSystemCurrent(self)) Begin
80777>>>                Send SetCurrentUserWorkspace (psWorkspaceSelected(self))
80778>>>            End
80778>>>>
80778>>>        End
80778>>>>
80778>>>    
80778>>>        Function_Return bWorkspaceSelected
80779>>>    End_Function
80780>>>
80780>>>End_Object    // oSelectWorkspace
80781>>>
80781>>>
80781>>>
80781>>>
80781>Use WorkSpc.utl
Including file: workspc.utl    (C:\projects\BRS\VDFQuery\AppSrc\workspc.utl)
80781>>>// Use WorkSpc.utl  // cWorkSpace class (that features function sMakePath)
80781>>>                    // and object oAllWorkspaces that reads all WS paths
80781>>>
80781>>>
80781>>>Use Base.utl     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
80781>>>Use Version.nui
80781>>>
80781>>>Use cApplication.pkg
80781>>>Use SelectWorkspace.dg
80781>>>
80781>>>desktop_section
80786>>>  object oAllWorkspaces is a cArray
80788>>>    property string psCurrentMakePath public "" // Common to all WS
80790>>>    object oWorkSpaceTmp is a cWorkSpace
80792>>>    //procedure set kenter_next_state integer bNext
80792>>>    //end_procedure
80792>>>    //function kenter_next_state returns integer
80792>>>    //end_function
80792>>>    end_object
80793>>>    item_property_list
80793>>>      item_property string psKeyName.i
80793>>>      item_property string psName.i
80793>>>      item_property string psDataPath.i
80793>>>      item_property string psBitMapPath.i
80793>>>      item_property string psHelpPath.i
80793>>>      item_property string psAppSrcPath.i
80793>>>      item_property string psDDSrcPath.i
80793>>>      item_property string psProgramPath.i
80793>>>      item_property string psSystemDfPath.i
80793>>>      item_property string psFileListPath.i
80793>>>      item_property string psMakePath.i
80793>>>      // Since the SystemMakePath is the same for all WS we also provide
80793>>>      // the WS specific part of the MakePath:
80793>>>      item_property string psMakePathNoSysPath.i
80793>>>    end_item_property_list
#REM 80860 DEFINE FUNCTION PSMAKEPATHNOSYSPATH.I INTEGER LIROW RETURNS STRING
#REM 80865 DEFINE PROCEDURE SET PSMAKEPATHNOSYSPATH.I INTEGER LIROW STRING VALUE
#REM 80870 DEFINE FUNCTION PSMAKEPATH.I INTEGER LIROW RETURNS STRING
#REM 80875 DEFINE PROCEDURE SET PSMAKEPATH.I INTEGER LIROW STRING VALUE
#REM 80880 DEFINE FUNCTION PSFILELISTPATH.I INTEGER LIROW RETURNS STRING
#REM 80885 DEFINE PROCEDURE SET PSFILELISTPATH.I INTEGER LIROW STRING VALUE
#REM 80890 DEFINE FUNCTION PSSYSTEMDFPATH.I INTEGER LIROW RETURNS STRING
#REM 80895 DEFINE PROCEDURE SET PSSYSTEMDFPATH.I INTEGER LIROW STRING VALUE
#REM 80900 DEFINE FUNCTION PSPROGRAMPATH.I INTEGER LIROW RETURNS STRING
#REM 80905 DEFINE PROCEDURE SET PSPROGRAMPATH.I INTEGER LIROW STRING VALUE
#REM 80910 DEFINE FUNCTION PSDDSRCPATH.I INTEGER LIROW RETURNS STRING
#REM 80915 DEFINE PROCEDURE SET PSDDSRCPATH.I INTEGER LIROW STRING VALUE
#REM 80920 DEFINE FUNCTION PSAPPSRCPATH.I INTEGER LIROW RETURNS STRING
#REM 80925 DEFINE PROCEDURE SET PSAPPSRCPATH.I INTEGER LIROW STRING VALUE
#REM 80930 DEFINE FUNCTION PSHELPPATH.I INTEGER LIROW RETURNS STRING
#REM 80935 DEFINE PROCEDURE SET PSHELPPATH.I INTEGER LIROW STRING VALUE
#REM 80940 DEFINE FUNCTION PSBITMAPPATH.I INTEGER LIROW RETURNS STRING
#REM 80945 DEFINE PROCEDURE SET PSBITMAPPATH.I INTEGER LIROW STRING VALUE
#REM 80950 DEFINE FUNCTION PSDATAPATH.I INTEGER LIROW RETURNS STRING
#REM 80955 DEFINE PROCEDURE SET PSDATAPATH.I INTEGER LIROW STRING VALUE
#REM 80960 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 80965 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
#REM 80970 DEFINE FUNCTION PSKEYNAME.I INTEGER LIROW RETURNS STRING
#REM 80975 DEFINE PROCEDURE SET PSKEYNAME.I INTEGER LIROW STRING VALUE
80981>>>
80981>>>    procedure private.add_workspace string sWorkspace string sDescription string sPath
80984>>>      integer lhObj liRow liStatus
80984>>>      move (oWorkSpaceTmp(self)) to lhObj
80985>>>      send DoClearPaths to lhObj
80986>>>      get OpenWorkSpace of lhObj sWorkspace to liStatus
80987>>>      if (liStatus=WSWORKSPACEOPENED) begin
80989>>>        get row_count to liRow
80990>>>        set psKeyName.i      liRow to sWorkspace
80991>>>        set psName.i         liRow to sDescription
80992>>>        set psDataPath.i     liRow to (psDataPath(lhObj))
80993>>>        set psBitMapPath.i   liRow to (psBitmapPath(lhObj))
80994>>>        set psHelpPath.i     liRow to (psHelpPath(lhObj))
80995>>>        set psAppSrcPath.i   liRow to (psAppSrcPath(lhObj))
80996>>>        set psDDSrcPath.i    liRow to (psDdSrcPath(lhObj))
80997>>>        set psProgramPath.i  liRow to sPath
80998>>>        set psSystemDfPath.i liRow to (psSystemDfPath(lhObj))
80999>>>        set psFileListPath.i liRow to (psFileList(lhObj))
81000>>>        set psMakePathNoSysPath.i liRow to (psAppSrcPath(lhObj)+";"+sPath+";"+psDataPath(lhObj)+";"+psDdSrcPath(lhObj)+";"+psHelpPath(lhObj))
81001>>>        set psMakePath.i     liRow to (psMakePathNoSysPath.i(self,liRow)+";"+psSystemMakePath(lhObj))
81002>>>      end
81002>>>>
81002>>>    end_procedure
81003>>>
81003>>>    procedure ReadAllWorkspaces global // Public
81005>>>
81005>>>      Integer iVOid iWorkspace
81005>>>      Handle hoSections
81005>>>      String sWorkspace sDescription sPath
81005>>>      String sVdfRootDir
81005>>>
81005>>>      Get_Profile_String "Defaults" "VDFRootDir" To sVDFRootDir
81008>>>      If (Right(sVDFRootDir,1) = "\") Left sVDFRootDir To sVDFRootDir (Length(sVDFRootDir)-1)
81012>>>
81012>>>      send delete_data
81013>>>
81013>>>      Object oSections is an cArray
81015>>>        Move self To hoSections
81016>>>      End_Object
81017>>>
81017>>>      Object oIni is a cIniFile
81019>>>        Set psFilename To (sVDFRootDir+"\bin\Workspaces.ini")
81020>>>
81020>>>        Send ReadSections hoSections
81021>>>
81021>>>        For iWorkspace from 0 to (Item_Count(hoSections) -1)
81027>>>>
81027>>>          Get Value of hoSections iWorkspace To sWorkspace
81028>>>          Get ReadString sWorkspace "Description" "" To sDescription
81029>>>          Get ReadString sWorkspace "Path" ""        To sPath
81030>>>          send private.add_workspace sWorkspace sDescription sPath
81031>>>        Loop
81032>>>>
81032>>>      End_Object
81033>>>    end_procedure
81034>>>  end_object // oAllWorkspaces
81035>>>end_desktop_section
81040>>>
81040>>>function WorkSpc_SelectWS global returns string
81042>>>  integer lhObj
81042>>>  move (oSelectWorkspace(self)) to lhObj
81043>>>  Set pbResult of lhObj To DFFALSE
81044>>>  send popup to lhObj
81045>>>  if (pbResult(lhObj)) function_return (psWorkspaceSelected(lhObj))
81048>>>  else function_return ""
81050>>>end_function
81051>>>
81051>register_object Main
81051>register_object Client_Area
81051>Procedure Do_Select_WorkSpace
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
81053>  integer hoWorkspace eOpened
81053>  string sWorkspace
81053>  Get phoWorkspace of ghoApplication to hoWorkspace
81054>  Get SelectRecentWorkspaceFile of WsFunctions to sWorkspace
81055> 
81055>  //get WorkSpc_SelectWS to sWorkspace
81055>  If (sWorkspace<>"") Begin
81057>    Send DoClearPaths of hoWorkspace
81058>    //Get OpenWorkspace of hoWorkspace sWorkspace to eOpened
81058>    Get OpenWorkspace of WsFunctions sWorkspace to eOpened
81059>    If (eOpened <> WSWORKSPACEOPENED) Begin
81061>      send stop_box "The selected workspace is invalid."
81062>    End
81062>    broadcast recursive send Close_Query_View to desktop
81064>    broadcast recursive send delete_fieldinfo_data to desktop // Clears some arrays in fieldinf.pkg
81066>    send OpenStat_CloseAllFiles
81067>    send Open_A_View_Please to (Client_Area(Main(Self)))
81068>  End
81068>end_procedure
81069>
81069>Object Main is a Panel
81071>  set label to "DBQuery" // "Rapportgenerator"
81072>  DFCreate_Menu Main_Menu
81075>    DFCreate_Menu "&File" FilePullDown is a ViewPopupMenu
81079>      on_item "Sort"             send Activate_Sort_Vw
81080>      on_item "New Query"        send Activate_Query_Vw
81081>      on_item ""                 send none
81082>      on_item "Select workspace" send Do_Select_WorkSpace
81083>      on_item ""                 send none
81084>      on_item "Login"            send DoLogin
81085>      on_item "Display open"     send OpenStat.DisplayFileLocations
81086>      on_item ""                 send none
81087>      on_item "Exit \aAlt+F4"    send exit_application
81088>    End_Menu
Including file: Win_pm.inc    (C:\Programmer\Visual DataFlex 12.0\Pkg\Win_pm.inc)
81090>>//************************************************************************
81090>>//
81090>>//* Copyright (c) 1997 Data Access Corporation, Miami Florida,
81090>>//* All rights reserved.
81090>>//* DataFlex is a registered trademark of Data Access Corporation.
81090>>//*
81090>>//*
81090>>//*  Module Name:
81090>>//*      WIN_PM.INC
81090>>//*
81090>>//*  Creator:
81090>>//*        JJT
81090>>//*
81090>>//*  Date:
81090>>//*      4/25/96
81090>>//*
81090>>//*  Purpose:
81090>>//*       Creates a WINDAF WINDOW pulldown menu. This menu lists
81090>>//*       all active views in a program with a check next to the
81090>>//*       current focus view.
81090>>//*
81090>>//*************************************************************************
81090>>// 01/29/97 JJT - removed work area scroll bar (until they work)
81090>>//
81090>>// 10/14/97 JJT - Added views to window pulldown. All views (and reports) will appear
81090>>//                See OnInitMenu
81090>>//
81090>>//
81090>>DFCreate_Menu "&Window" Window_Menu
81094>>    Set select_mode to Multi_Select
81095>>    // normal number of items in pulldown (w/ no active views)
81095>>    property integer std_item_count public 0
81097>>
81097>>    DFCreate_Menu "&Display_Options" Display_Options_Menu
81101>>        Set select_mode to Multi_Select
81102>>        On_Item "&Tool-bar"               send Toggle_ToolBar   To self
81103>>        On_Item "&Status-bar"             send Toggle_StatusBar To self 
81104>>        On_Item "&Auto Arrange Icons"     send Toggle_Auto_Arrange_Icons To self    
81105>>        //On_Item "&Work Area Scroll bars"  send Toggle_Client_Scrollbar_state to self
81105>>
81105>>
81105>>        //  When ever the menu [pulldown] is initialized, check/set
81105>>        //  the state of its items.
81105>>        //
81105>>        Procedure OnInitMenu
81108>>            integer bState
81108>>
81108>>            Get ToolBar_State to bState
81109>>            Set Select_State Item 0 to bState
81110>>            if  bState   Set Status_Help Item 0 To 'Remove the Tool-bar'
81113>>            Else         Set Status_Help Item 0 to 'Add the Tool-bar'
81115>>
81115>>            Get Statusbar_State to bState
81116>>            Set Select_State Item 1 to bState
81117>>            if  bState  Set Status_Help Item 1 To 'Remove the Status-bar'
81120>>            Else        Set Status_Help Item 1 to 'Add the Status-bar'
81122>>
81122>>            Get Auto_Arrange_Icons_State to bState
81123>>            Set Select_State Item 2 to bState
81124>>            if  bState  Set Status_Help Item 2 To "Don't automatically arrange the icons"
81127>>            Else        Set Status_Help Item 2 to 'Automatically arrange the icons when re-sizing the Application'
81129>>
81129>>            //Get Client_Scrollbar_State to bState
81129>>            //Set Select_State Item 3 to bState
81129>>            //if  bState  Set Status_Help Item 3 To "Display scroll bars when windows do not fit within the work area."
81129>>            //Else        Set Status_Help Item 3 to "Never display scroll bars in the work area."
81129>>
81129>>        End_procedure
81130>>
81130>>
81130>>    End_Pull_Down
81132>>    //Set Status_Help to "Set tool-bar, status-bar, scroll-bar, and icon display options"
81132>>    Set Status_Help to "Set tool-bar, status-bar, and icon display options"
81133>>
81133>>    On_Item ""
81134>>
81134>>    On_Item "&Cascade" send Cascade_Windows To self
81135>>        Set Status_Help To 'Cascade all open Windows/Views'
81136>>
81136>>    On_Item "Tile &Horizontally" send Tile_Windows_Horizontal To self
81137>>        Set Status_Help To 'Tile all open Windows/Views horizontally'
81138>>
81138>>    On_Item "Tile &Vertically" send Tile_Windows_Vertical To self
81139>>        Set Status_Help To 'Tile all open Windows/Views vertically'
81140>>
81140>>    On_Item ""
81141>>
81141>>    On_Item "&Minimize all Windows" send Minimize_all_Windows To self
81142>>        Set Status_Help To 'Minimize all open Windows/Views'
81143>>
81143>>    On_Item "&Restore all Windows" send Restore_all_Windows To self
81144>>        Set Status_Help To 'Restore all open Windows/Views to normal screen display mode'
81145>>
81145>>    On_Item ""
81146>>
81146>>    On_Item "Arrange &Icons" send Arrange_Icons         To self
81147>>        Set Status_Help To 'Arrange the icons at the bottom'
81148>>
81148>>    // set this to the number of items in the menu with no views.
81148>>    Set Std_item_count to (item_count(self))
81149>>
81149>>    // add all active views to the end of the menu
81149>>    Procedure OnInitMenu
81152>>        integer iStdCnt iNumCnt hVw hCl iCount
81152>>        string sLbl
81152>>        //*** Remove all old view items
81152>>        Get Item_count     to iNumCnt
81153>>        get Std_item_count to iStdCnt
81154>>        For iCount from 1  to (iNumCnt - iStdCnt)
81160>>>
81160>>            Send Delete_item iStdCnt
81161>>        Loop
81162>>>
81162>>
81162>>        Move iStdcnt to iNumCnt
81163>>        get Client_id to hCl // object id of client area
81164>>        If hCl Begin
81166>>           Get Next_Mdi_Dialog of hcl TRUE to hVw // find first view
81167>>           While hVw
81171>>              if (Active_state(hVw)) Begin
81173>>                 if iNumCnt eq iStdCnt Begin // if first view, add separator
81175>>                    send add_item 0 ''
81176>>                    increment iNumCnt
81177>>                 end
81177>>>
81177>>                 Get Label of hVw to sLbl // caption bar (name) of view
81178>>                 // note that all views understand the message activate_view.
81178>>                 send add_item msg_activate_view sLbl // set message, value and destination
81179>>                 set aux_value item iNumcnt to hVw
81180>>                 // if this is the focus view, mark it.
81180>>                 If (current_scope(desktop)=hVw and View_mode(hVw)<>VIEWMODE_ICONIZE) ;                     set select_state item iNumCnt to True
81183>>                 // create status help
81183>>                 Set Status_help item iNumCnt to ("Make this view (" - trim(sLbl) - ") the active window.")
81184>>                 increment iNumCnt
81185>>              end
81185>>>
81185>>              Get Next_Mdi_Dialog of hcl FALSE to hVw // find next
81186>>           End
81187>>>
81187>>        End
81187>>>
81187>>    End_Procedure // OnInitMenu
81188>>
81188>>End_Pull_Down
81190>>Set Status_Help to "Display Current Views and set other display options."
81191>  End_Menu
81193>
81193>  Object Client_Area IS A AppClientArea
81195>    procedure Open_A_View_Please
81198>      send Activate_Query_Vw
81199>    end_procedure
81200>    procedure DoLogin
81203>      get DBMS_GetDriverLogin 0 to windowindex
81204>    end_procedure
81205>    Use VdfQuery.rv // VDFQuery
Including file: vdfquery.rv    (C:\projects\BRS\VDFQuery\AppSrc\vdfquery.rv)
81205>>>
81205>>>integer gIdontCare
81205>>>
81205>>>move self to gIdontCare
81206>>>move Desktop to self
81207>>>
81207>>>use vdfquery.utl
81207>>>
81207>>>
81207>>>
81207>>>
81207>>>
81207>>>move gIdontCare to self
81208>     move self to glMainClientId#
81209>    // This is used here simply to make sure that the packages
81209>    // will be in the upload. You may comment the next line to
81209>    // save size on the compiled file.
81209>    Use VdfSort.vw  // Reindexing routines
Including file: vdfsort.vw    (C:\projects\BRS\VDFQuery\AppSrc\vdfsort.vw)
81209>>>// This can be used as a view in an IDE program.
81209>>>// This is added to a workspace by registering it as an
81209>>>// external component. When registered, it should be added
81209>>>// as a report view and its object name should be defined as
81209>>>// Sort_Vw
81209>>>//
81209>>>Use VdfSort.utl // send Activate_Sort_Vw
Including file: vdfsort.utl    (C:\projects\BRS\VDFQuery\AppSrc\vdfsort.utl)
81209>>>>>//**********************************************************************
81209>>>>>// use VdfSort.utl  // DFSORT for Visual DataFlex
81209>>>>>//
81209>>>>>// By Sture Andersen & Finn Kristensen
81209>>>>>//
81209>>>>>// Create: Sat  29-11-1997
81209>>>>>// Update: Thu  18-12-1997 - Argument for Info_Box is now gradually built, to
81209>>>>>//                           avoid violation of maximum line length (DFCOMP).
81209>>>>>//         Mon  22-12-1997 - Changed to work with files opened with the AS
81209>>>>>//                           clause.
81209>>>>>//         Mon  03-08-1998 - Now possible to specify reindex options
81209>>>>>//         Wed  20-01-1999 - Now displays file definitions if filedef.pkg
81209>>>>>//                           was used prior to using this package.
81209>>>>>//         Mon  15-03-1999 - Message VdfSort_RestoreOpenFiles is sent to
81209>>>>>//                           all objects after VdfSort is finished.
81209>>>>>//         Sun  18-04-1999 - 'chain wait "dbbldr noworkspace"' changed to
81209>>>>>//                           'runprogram wait "dfrun dbbldr"'.
81209>>>>>//         Wed  05-05-1999 - CleanUp code added
81209>>>>>//                         - Tampering with profile string "DEFAULTS"
81209>>>>>//                           "dbAdminMode" has been removed from the code.
81209>>>>>//         Thu  13-05-1999 - Cleanup code finished. Call to dbbldr removed.
81209>>>>>//         Mon  13-12-1999 - Changed the calling of procedure
81209>>>>>//                           DBMS_Callback_FilelistEntries according to
81209>>>>>//                           directions given by Bo Lincoln
81209>>>>>//         Wed  01-02-2000 - Define instead of #REPLACE
81209>>>>>//**********************************************************************
81209>>>>>
81209>>>>>Use Language.pkg // Default language setup
81209>>>>>//Use FileList.utl // Filelist.cfg utilities
81209>>>>>Use Output.utl   // Basic sequential output service
81209>>>>>Use Files.utl    // Utilities for handling file related stuff
81209>>>>>Use Strings.nui  // String manipulation for VDF
81209>>>>>Use OpenStat.pkg // Call DFMatrix, Display open tables ...
81209>>>>>Use OpenStat.nui // cTablesOpenStatus class (formely cFileAllFiles) (No User Interface)
81209>>>>>Use Fdx3.utl     // FDX aware cFileList_List selector class
Including file: fdx3.utl    (C:\projects\BRS\VDFQuery\AppSrc\fdx3.utl)
81209>>>>>>>//**********************************************************************
81209>>>>>>>// Use Fdx3.utl     // FDX aware cFileList_List selector class
81209>>>>>>>//
81209>>>>>>>// By Sture Andersen
81209>>>>>>>//
81209>>>>>>>// Create: Sun  16-01-2000
81209>>>>>>>// Update:
81209>>>>>>>//
81209>>>>>>>//**********************************************************************
81209>>>>>>>
81209>>>>>>>Use Fdx_Attr.nui // FDX compatible attribute functions
81209>>>>>>>Use DBMS.utl     // Basic DBMS functions
81209>>>>>>>Use Strings.nui  // String manipulation for VDF
81209>>>>>>>Use FieldInf     // Global field info objects
81209>>>>>>>Use Fdx2.utl     // FDX aware object for displaying a table definiton
81209>>>>>>>Use Files.utl    // Utilities for handling file related stuff
81209>>>>>>>Use FDX.nui      // cFDX class
Including file: fdx.nui    (C:\projects\BRS\VDFQuery\AppSrc\fdx.nui)
81209>>>>>>>>>//**********************************************************************
81209>>>>>>>>>// Use FDX.nui      // cFDX class
81209>>>>>>>>>//
81209>>>>>>>>>// By Sture Andersen
81209>>>>>>>>>//
81209>>>>>>>>>// Create: Mon  13-12-1999
81209>>>>>>>>>// Update: Sun  16-01-2000
81209>>>>>>>>>//         Tue  08-02-2000 - cFdxFileRelations class added
81209>>>>>>>>>//         Sat  18-03-2000 - Added function iNextFileThatCanOpen
81209>>>>>>>>>//         Wed  28-02-2001 - Added function sAliasFiles.i
81209>>>>>>>>>//
81209>>>>>>>>>//**********************************************************************
81209>>>>>>>>>
81209>>>>>>>>>Use API_Attr.nui // Database API attribute characteristics
81209>>>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
81209>>>>>>>>>Use Files.nui    // Utilities for handling file related stuff
81209>>>>>>>>>Use DBMS.nui     // Basic DBMS functions
81209>>>>>>>>>Use Dates.nui    // Date manipulation for VDF and DF3.2
81209>>>>>>>>>Use Strings.nui  // String manipulation for VDF
81209>>>>>>>>>Use Mapper.nui   // Classes for (field) mapping
Including file: mapper.nui    (C:\projects\BRS\VDFQuery\AppSrc\mapper.nui)
81209>>>>>>>>>>>// Use Mapper.nui   // Classes for (field) mapping
81209>>>>>>>>>>>Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
81209>>>>>>>>>>>
81209>>>>>>>>>>>class cMapObject is a cArray
81210>>>>>>>>>>>  procedure construct_object integer liImage
81212>>>>>>>>>>>    forward send construct_object liImage
81214>>>>>>>>>>>    property string psTitle public ""
81215>>>>>>>>>>>  end_procedure
81216>>>>>>>>>>>  item_property_list
81216>>>>>>>>>>>    item_property integer piIdentifier.i
81216>>>>>>>>>>>    item_property string  psName.i
81216>>>>>>>>>>>    item_property string  psExtraInfo.i
81216>>>>>>>>>>>  end_item_property_list cMapObject
#REM 81251 DEFINE FUNCTION PSEXTRAINFO.I INTEGER LIROW RETURNS STRING
#REM 81255 DEFINE PROCEDURE SET PSEXTRAINFO.I INTEGER LIROW STRING VALUE
#REM 81259 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 81263 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
#REM 81267 DEFINE FUNCTION PIIDENTIFIER.I INTEGER LIROW RETURNS INTEGER
#REM 81271 DEFINE PROCEDURE SET PIIDENTIFIER.I INTEGER LIROW INTEGER VALUE
81276>>>>>>>>>>>  procedure DoAddItem integer liIdentifier string lsName string lsExtraInfo
81278>>>>>>>>>>>    integer liRow
81278>>>>>>>>>>>    get row_count to liRow
81279>>>>>>>>>>>    set piIdentifier.i liRow to liIdentifier
81280>>>>>>>>>>>    set psName.i   liRow to lsName
81281>>>>>>>>>>>    set psExtraInfo.i  liRow to lsExtraInfo
81282>>>>>>>>>>>  end_procedure
81283>>>>>>>>>>>  function iFindName.s string lsName returns integer
81285>>>>>>>>>>>    integer liMax liRow
81285>>>>>>>>>>>    get row_count to liMax
81286>>>>>>>>>>>    move (uppercase(lsName)) to lsName
81287>>>>>>>>>>>    decrement liMax
81288>>>>>>>>>>>    for liRow from 0 to liMax
81294>>>>>>>>>>>>
81294>>>>>>>>>>>      if (uppercase(psName.i(self,liRow))=lsName) function_return liRow
81297>>>>>>>>>>>    loop
81298>>>>>>>>>>>>
81298>>>>>>>>>>>    function_return -1
81299>>>>>>>>>>>  end_function
81300>>>>>>>>>>>  function iFindIdentifier.i integer liIdent returns integer
81302>>>>>>>>>>>    integer liMax liRow
81302>>>>>>>>>>>    get row_count to liMax
81303>>>>>>>>>>>    decrement liMax
81304>>>>>>>>>>>    for liRow from 0 to liMax
81310>>>>>>>>>>>>
81310>>>>>>>>>>>      if (piIdentifier.i(self,liRow)=liIdent) function_return liRow
81313>>>>>>>>>>>    loop
81314>>>>>>>>>>>>
81314>>>>>>>>>>>    function_return -1
81315>>>>>>>>>>>  end_function
81316>>>>>>>>>>>  procedure DoReset
81318>>>>>>>>>>>    send delete_data
81319>>>>>>>>>>>  end_procedure
81320>>>>>>>>>>>end_class // cMapObject
81321>>>>>>>>>>>
81321>>>>>>>>>>>class cMapper is a cArray
81322>>>>>>>>>>>  procedure construct_object integer liImage
81324>>>>>>>>>>>    forward send construct_object liImage
81326>>>>>>>>>>>    property integer piMapMode public 0 // 0=Random, 1=Sequential
81327>>>>>>>>>>>    property integer phObject1 public 0
81328>>>>>>>>>>>    property integer phObject2 public 0
81329>>>>>>>>>>>    property string  psTitle1  public ""
81330>>>>>>>>>>>    property string  psTitle2  public ""
81331>>>>>>>>>>>    property string  psTitle3  public ""
81332>>>>>>>>>>>    object oTmpArray is a cArray
81334>>>>>>>>>>>    end_object
81335>>>>>>>>>>>    object oPushStatus is a cArray
81337>>>>>>>>>>>    end_object
81338>>>>>>>>>>>    object oFastMap is a cArray
81340>>>>>>>>>>>    end_object
81341>>>>>>>>>>>    property integer pbFastMapState public DFFALSE
81342>>>>>>>>>>>  end_procedure
81343>>>>>>>>>>>  procedure DoPushStatus
81345>>>>>>>>>>>    send Clone_Array self (oPushStatus(self))
81346>>>>>>>>>>>  end_procedure
81347>>>>>>>>>>>  procedure DoPopStatus
81349>>>>>>>>>>>    send Clone_Array (oPushStatus(self)) self
81350>>>>>>>>>>>  end_procedure
81351>>>>>>>>>>>  item_property_list
81351>>>>>>>>>>>    item_property integer piItem1.i
81351>>>>>>>>>>>    item_property integer piItem2.i
81351>>>>>>>>>>>  end_item_property_list cMapper
#REM 81383 DEFINE FUNCTION PIITEM2.I INTEGER LIROW RETURNS INTEGER
#REM 81387 DEFINE PROCEDURE SET PIITEM2.I INTEGER LIROW INTEGER VALUE
#REM 81391 DEFINE FUNCTION PIITEM1.I INTEGER LIROW RETURNS INTEGER
#REM 81395 DEFINE PROCEDURE SET PIITEM1.I INTEGER LIROW INTEGER VALUE
81400>>>>>>>>>>>  function piIdent1.i integer liRow returns integer
81402>>>>>>>>>>>    function_return (piIdentifier.i(phObject1(self),piItem1.i(self,liRow)))
81403>>>>>>>>>>>  end_function
81404>>>>>>>>>>>  function piIdent2.i integer liRow returns integer
81406>>>>>>>>>>>    function_return (piIdentifier.i(phObject2(self),piItem2.i(self,liRow)))
81407>>>>>>>>>>>  end_function
81408>>>>>>>>>>>  procedure DoReset
81410>>>>>>>>>>>    send delete_data
81411>>>>>>>>>>>    set pbFastMapState to DFFALSE
81412>>>>>>>>>>>  end_procedure
81413>>>>>>>>>>>  function iFindItem2Row integer liItem2 returns integer
81415>>>>>>>>>>>    integer liMax liRow
81415>>>>>>>>>>>    get row_count to liMax
81416>>>>>>>>>>>    decrement liMax
81417>>>>>>>>>>>    for liRow from 0 to liMax
81423>>>>>>>>>>>>
81423>>>>>>>>>>>      if (piItem2.i(self,liRow)=liItem2) function_return liRow
81426>>>>>>>>>>>    loop
81427>>>>>>>>>>>>
81427>>>>>>>>>>>    function_return -1
81428>>>>>>>>>>>  end_function
81429>>>>>>>>>>>  procedure DoBuildFastMap
81431>>>>>>>>>>>    integer lhFastMap liRow liMax liIdent1 liIdent2
81431>>>>>>>>>>>    move (oFastMap(self)) to lhFastMap
81432>>>>>>>>>>>    send delete_data to lhFastMap
81433>>>>>>>>>>>    get row_count to liMax
81434>>>>>>>>>>>    decrement liMax
81435>>>>>>>>>>>    for liRow from 0 to liMax
81441>>>>>>>>>>>>
81441>>>>>>>>>>>      get piItem1.i liRow to liIdent1
81442>>>>>>>>>>>      get piItem2.i liRow to liIdent2
81443>>>>>>>>>>>      set value of lhFastMap liIdent1 to (liIdent2+1)
81444>>>>>>>>>>>    loop
81445>>>>>>>>>>>>
81445>>>>>>>>>>>    set pbFastMapState to DFTRUE
81446>>>>>>>>>>>  end_procedure
81447>>>>>>>>>>>  function iIdent1MapsTo.i integer liIdent1 returns integer
81449>>>>>>>>>>>    function_return (integer(value(oFastMap(self),liIdent1))-1)
81450>>>>>>>>>>>  end_function
81451>>>>>>>>>>>  procedure DoAddMap integer liIdent1 integer liIdent2
81453>>>>>>>>>>>    integer liRow liRow1 liRow2
81453>>>>>>>>>>>
81453>>>>>>>>>>>    get iFindIdentifier.i of (phObject1(self)) liIdent1 to liRow1
81454>>>>>>>>>>>    get iFindIdentifier.i of (phObject2(self)) liIdent2 to liRow2
81455>>>>>>>>>>>
81455>>>>>>>>>>>    get iFindItem2Row liRow2 to liRow
81456>>>>>>>>>>>    if liRow eq -1 get row_count to liRow
81459>>>>>>>>>>>
81459>>>>>>>>>>>    set piItem1.i liRow to liRow1
81460>>>>>>>>>>>    set piItem2.i liRow to liRow2
81461>>>>>>>>>>>    set pbFastMapState to DFFALSE
81462>>>>>>>>>>>  end_procedure
81463>>>>>>>>>>>  procedure DoClearMap integer liIdent2
81465>>>>>>>>>>>    integer liRow liRow2
81465>>>>>>>>>>>    get iFindIdentifier.i of (phObject2(self)) liIdent2 to liRow2
81466>>>>>>>>>>>    get iFindItem2Row liRow2 to liRow
81467>>>>>>>>>>>    if liRow ne -1 begin
81469>>>>>>>>>>>      send delete_row liRow
81470>>>>>>>>>>>      set pbFastMapState to DFFALSE
81471>>>>>>>>>>>    end
81471>>>>>>>>>>>>
81471>>>>>>>>>>>  end_procedure
81472>>>>>>>>>>>            // Puts a 1 in each position in oTmpArray that is mapped
81472>>>>>>>>>>>            procedure MarkMappedItems1
81474>>>>>>>>>>>              integer lhTmpArray liRow liMax
81474>>>>>>>>>>>              move (oTmpArray(self)) to lhTmpArray
81475>>>>>>>>>>>              send delete_data to lhTmpArray
81476>>>>>>>>>>>              get row_count to liMax
81477>>>>>>>>>>>              decrement liMax
81478>>>>>>>>>>>              for liRow from 0 to liMax
81484>>>>>>>>>>>>
81484>>>>>>>>>>>                set value of lhTmpArray item (piItem1.i(self,liRow)) to (piItem2.i(self,liRow)+1)
81485>>>>>>>>>>>              loop
81486>>>>>>>>>>>>
81486>>>>>>>>>>>            end_procedure
81487>>>>>>>>>>>            // Puts a 1 in each position in oTmpArray that is mapped
81487>>>>>>>>>>>            procedure MarkMappedItems2
81489>>>>>>>>>>>              integer lhTmpArray liRow liMax
81489>>>>>>>>>>>              move (oTmpArray(self)) to lhTmpArray
81490>>>>>>>>>>>              send delete_data to lhTmpArray
81491>>>>>>>>>>>              get row_count to liMax
81492>>>>>>>>>>>              decrement liMax
81493>>>>>>>>>>>              for liRow from 0 to liMax
81499>>>>>>>>>>>>
81499>>>>>>>>>>>                set value of lhTmpArray item (piItem2.i(self,liRow)) to (piItem1.i(self,liRow)+1)
81500>>>>>>>>>>>              loop
81501>>>>>>>>>>>>
81501>>>>>>>>>>>            end_procedure
81502>>>>>>>>>>>  procedure DoCallback_UnmappedItems1 integer liMsg integer lhObj
81504>>>>>>>>>>>    integer lhTmpArray liRow liMax lhObj1
81504>>>>>>>>>>>    send MarkMappedItems1
81505>>>>>>>>>>>    move (oTmpArray(self)) to lhTmpArray
81506>>>>>>>>>>>    get phObject1 to lhObj1
81507>>>>>>>>>>>    get row_count of lhObj1 to liMax
81508>>>>>>>>>>>    decrement liMax
81509>>>>>>>>>>>    for liRow from 0 to liMax
81515>>>>>>>>>>>>
81515>>>>>>>>>>>      ifnot (integer(value(lhTmpArray,liRow))) send liMsg to lhObj (piIdentifier.i(lhObj1,liRow)) (psName.i(lhObj1,liRow)) (psExtraInfo.i(lhObj1,liRow))
81518>>>>>>>>>>>    loop
81519>>>>>>>>>>>>
81519>>>>>>>>>>>  end_procedure
81520>>>>>>>>>>>  procedure DoCallback_UnmappedItems2 integer liMsg integer lhObj
81522>>>>>>>>>>>    integer lhTmpArray liRow liMax lhObj2
81522>>>>>>>>>>>    send MarkMappedItems2
81523>>>>>>>>>>>    move (oTmpArray(self)) to lhTmpArray
81524>>>>>>>>>>>    get phObject2 to lhObj2
81525>>>>>>>>>>>    get row_count of lhObj2 to liMax
81526>>>>>>>>>>>    decrement liMax
81527>>>>>>>>>>>    for liRow from 0 to liMax
81533>>>>>>>>>>>>
81533>>>>>>>>>>>      ifnot (integer(value(lhTmpArray,liRow))) send liMsg to lhObj (piIdentifier.i(lhObj2,liRow)) (psName.i(lhObj2,liRow)) (psExtraInfo.i(lhObj2,liRow))
81536>>>>>>>>>>>    loop
81537>>>>>>>>>>>>
81537>>>>>>>>>>>  end_procedure
81538>>>>>>>>>>>  procedure DoCallback_AllItems1 integer liMsg integer lhObj
81540>>>>>>>>>>>    integer lhTmpArray liRow liMax lhObj1 lhObj2 liMapRow
81540>>>>>>>>>>>    send MarkMappedItems1
81541>>>>>>>>>>>    move (oTmpArray(self)) to lhTmpArray
81542>>>>>>>>>>>    get phObject1 to lhObj1
81543>>>>>>>>>>>    get phObject2 to lhObj2
81544>>>>>>>>>>>    get row_count of lhObj1 to liMax
81545>>>>>>>>>>>    decrement liMax
81546>>>>>>>>>>>    for liRow from 0 to liMax
81552>>>>>>>>>>>>
81552>>>>>>>>>>>      get value of lhTmpArray liRow to liMapRow
81553>>>>>>>>>>>      ifnot liMapRow send liMsg to lhObj (piIdentifier.i(lhObj1,liRow)) (psName.i(lhObj1,liRow)) (psExtraInfo.i(lhObj1,liRow)) DFFALSE 0 "" ""
81556>>>>>>>>>>>      else begin
81557>>>>>>>>>>>        decrement liMapRow
81558>>>>>>>>>>>        send liMsg to lhObj (piIdentifier.i(lhObj1,liRow)) (psName.i(lhObj1,liRow)) (psExtraInfo.i(lhObj1,liRow)) DFTRUE (piIdentifier.i(lhObj2,liMapRow)) (psName.i(lhObj2,liMapRow)) (psExtraInfo.i(lhObj2,liMapRow))
81559>>>>>>>>>>>      end
81559>>>>>>>>>>>>
81559>>>>>>>>>>>    loop
81560>>>>>>>>>>>>
81560>>>>>>>>>>>  end_procedure
81561>>>>>>>>>>>  procedure DoCallback_AllItems2 integer liMsg integer lhObj
81563>>>>>>>>>>>    integer lhTmpArray liRow liMax lhObj1 lhObj2 liMapRow
81563>>>>>>>>>>>    send MarkMappedItems2
81564>>>>>>>>>>>    move (oTmpArray(self)) to lhTmpArray
81565>>>>>>>>>>>    get phObject1 to lhObj1
81566>>>>>>>>>>>    get phObject2 to lhObj2
81567>>>>>>>>>>>    get row_count of lhObj2 to liMax
81568>>>>>>>>>>>    decrement liMax
81569>>>>>>>>>>>    for liRow from 0 to liMax
81575>>>>>>>>>>>>
81575>>>>>>>>>>>      get value of lhTmpArray liRow to liMapRow
81576>>>>>>>>>>>      ifnot liMapRow send liMsg to lhObj (piIdentifier.i(lhObj2,liRow)) (psName.i(lhObj2,liRow)) (psExtraInfo.i(lhObj2,liRow)) DFFALSE 0 "" ""
81579>>>>>>>>>>>      else begin
81580>>>>>>>>>>>        decrement liMapRow
81581>>>>>>>>>>>        send liMsg to lhObj (piIdentifier.i(lhObj2,liRow)) (psName.i(lhObj2,liRow)) (psExtraInfo.i(lhObj2,liRow)) DFTRUE (piIdentifier.i(lhObj1,liMapRow)) (psName.i(lhObj1,liMapRow)) (psExtraInfo.i(lhObj1,liMapRow))
81582>>>>>>>>>>>      end
81582>>>>>>>>>>>>
81582>>>>>>>>>>>    loop
81583>>>>>>>>>>>>
81583>>>>>>>>>>>  end_procedure
81584>>>>>>>>>>>  procedure DoAutoMapName_Help integer liIdent2 string lsName string lsExtra
81586>>>>>>>>>>>    integer lhObj1 liIdent1 liRow1
81586>>>>>>>>>>>    get phObject1 to lhObj1
81587>>>>>>>>>>>    get iFindName.s of lhObj1 lsName to liRow1
81588>>>>>>>>>>>    if (liRow1=-1) begin
81590>>>>>>>>>>>      // If we didn't find a match, we try one more time by
81590>>>>>>>>>>>      // replacing _ characters for spaces:
81590>>>>>>>>>>>      move (replaces("_",lsName," ")) to lsName
81591>>>>>>>>>>>      get iFindName.s of lhObj1 lsName to liRow1
81592>>>>>>>>>>>    end
81592>>>>>>>>>>>>
81592>>>>>>>>>>>    if (liRow1>-1) begin
81594>>>>>>>>>>>      get piIdentifier.i of lhObj1 liRow1 to liIdent1
81595>>>>>>>>>>>      send DoAddMap liIdent1 liIdent2
81596>>>>>>>>>>>    end
81596>>>>>>>>>>>>
81596>>>>>>>>>>>  end_procedure
81597>>>>>>>>>>>  procedure DoAutoMapName
81599>>>>>>>>>>>    send DoCallback_UnmappedItems2 msg_DoAutoMapName_Help self
81600>>>>>>>>>>>  end_procedure
81601>>>>>>>>>>>end_class // cMapper
81602>>>>>>>>>
81602>>>>>>>>>define FILELIST_MAX_ENTRY   for 4095
81602>>>>>>>>>define t.fdx.attr_not_avail for "ATTRIBUTE NOT AVAILABLE"
81602>>>>>>>>>
81602>>>>>>>>>class cFdxMonitoredAttributes is a cArray
81603>>>>>>>>>  procedure construct_object integer liImage
81605>>>>>>>>>    forward send construct_object liImage
81607>>>>>>>>>    property integer piLowIndex public 65536
81608>>>>>>>>>    property integer piHighIndex public -1
81609>>>>>>>>>  end_procedure
81610>>>>>>>>>  item_property_list
81610>>>>>>>>>    item_property integer piMonitored.i // Is the attribute monitored?
81610>>>>>>>>>    item_property integer piAttrIndex.i // Translate to index used in the subset of attributes
81610>>>>>>>>>  end_item_property_list cFdxMonitoredAttributes
#REM 81642 DEFINE FUNCTION PIATTRINDEX.I INTEGER LIROW RETURNS INTEGER
#REM 81646 DEFINE PROCEDURE SET PIATTRINDEX.I INTEGER LIROW INTEGER VALUE
#REM 81650 DEFINE FUNCTION PIMONITORED.I INTEGER LIROW RETURNS INTEGER
#REM 81654 DEFINE PROCEDURE SET PIMONITORED.I INTEGER LIROW INTEGER VALUE
81659>>>>>>>>>  procedure add_attribute integer liAttr
81661>>>>>>>>>    set piMonitored.i liAttr to 1
81662>>>>>>>>>    if liAttr lt (piLowIndex(self))  set piLowIndex to liAttr
81665>>>>>>>>>    if liAttr gt (piHighIndex(self)) set piHighIndex to liAttr
81668>>>>>>>>>  end_procedure
81669>>>>>>>>>  procedure CalcAttrIndices // Sent by end_construct_object
81671>>>>>>>>>    integer liAttr liMin liMax liIndex
81671>>>>>>>>>    move 0 to liIndex
81672>>>>>>>>>    get piLowIndex  to liMin
81673>>>>>>>>>    get piHighIndex to liMax
81674>>>>>>>>>    for liAttr from liMin to liMax
81680>>>>>>>>>>
81680>>>>>>>>>      if (piMonitored.i(self,liAttr)) begin
81682>>>>>>>>>        set piAttrIndex.i liAttr to liIndex
81683>>>>>>>>>        increment liIndex
81684>>>>>>>>>      end
81684>>>>>>>>>>
81684>>>>>>>>>    loop
81685>>>>>>>>>>
81685>>>>>>>>>  end_procedure
81686>>>>>>>>>  procedure end_construct_object
81688>>>>>>>>>    forward send end_construct_object
81690>>>>>>>>>    send CalcAttrIndices
81691>>>>>>>>>  end_procedure
81692>>>>>>>>>end_class // cFdxMonitoredAttributes
81693>>>>>>>>>
81693>>>>>>>>>desktop_section // Make sure object is instantiated on desktop level
81698>>>>>>>>>  object oMonitoredGlobalAttributes is a cFdxMonitoredAttributes no_image
81700>>>>>>>>>    send add_attribute DF_ALL_FILES_TOUCHED
81701>>>>>>>>>    send add_attribute DF_API_DISABLED
81702>>>>>>>>>    send add_attribute DF_API_DISABLED_ERROR
81703>>>>>>>>>    send add_attribute DF_DATE_FORMAT
81704>>>>>>>>>    send add_attribute DF_DATE_SEPARATOR
81705>>>>>>>>>    send add_attribute DF_DECIMAL_SEPARATOR
81706>>>>>>>>>    send add_attribute DF_FILELIST_NAME
81707>>>>>>>>>    send add_attribute DF_HIGH_DATA_INTEGRITY
81708>>>>>>>>>    send add_attribute DF_LOCK_DELAY
81709>>>>>>>>>    send add_attribute DF_LOCK_TIMEOUT
81710>>>>>>>>>    send add_attribute DF_NUMBER_DRIVERS
81711>>>>>>>>>    send add_attribute DF_OPEN_PATH
81712>>>>>>>>>    send add_attribute DF_REREAD_REQUIRED
81713>>>>>>>>>    send add_attribute DF_STRICT_ATTRIBUTES
81714>>>>>>>>>    send add_attribute DF_THOUSANDS_SEPARATOR
81715>>>>>>>>>    send add_attribute DF_TRANSACTION_ABORT
81716>>>>>>>>>    send add_attribute DF_TRAN_COUNT
81717>>>>>>>>>  end_object // oMonitoredGlobalAttributes
81718>>>>>>>>>  object oMonitoredFileAttributes is a cFdxMonitoredAttributes no_image
81720>>>>>>>>>    send add_attribute DF_FILE_COMPRESSION
81721>>>>>>>>>    send add_attribute DF_FILE_DISPLAY_NAME  // Type: FILELIST
81722>>>>>>>>>    send add_attribute DF_FILE_DRIVER
81723>>>>>>>>>    send add_attribute DF_FILE_INTEGRITY_CHECK
81724>>>>>>>>>    send add_attribute DF_FILE_IS_SYSTEM_FILE
81725>>>>>>>>>    send add_attribute DF_FILE_LAST_INDEX_NUMBER
81726>>>>>>>>>    send add_attribute DF_FILE_LOCK_TYPE
81727>>>>>>>>>    send add_attribute DF_FILE_LOGICAL_NAME  // Type: FILELIST
81728>>>>>>>>>    send add_attribute DF_FILE_MAX_RECORDS
81729>>>>>>>>>    send add_attribute DF_FILE_MULTIUSER
81730>>>>>>>>>    send add_attribute DF_FILE_NUMBER_FIELDS
81731>>>>>>>>>    send add_attribute DF_FILE_RECORDS_USED
81732>>>>>>>>>    send add_attribute DF_FILE_RECORD_LENGTH
81733>>>>>>>>>    send add_attribute DF_FILE_RECORD_LENGTH_USED
81734>>>>>>>>>    send add_attribute DF_FILE_REUSE_DELETED
81735>>>>>>>>>    send add_attribute DF_FILE_REVISION
81736>>>>>>>>>    send add_attribute DF_FILE_ROOT_NAME     // Type: FILELIST
81737>>>>>>>>>    send add_attribute DF_FILE_TRANSACTION
81738>>>>>>>>>    send add_attribute DF_FILE_PHYSICAL_NAME
81739>>>>>>>>>    send add_attribute DF_FILE_RECORD_IDENTITY
81740>>>>>>>>>    send add_attribute DF_FILE_TYPE
81741>>>>>>>>>  end_object // oMonitoredFileAttributes
81742>>>>>>>>>end_desktop_section
81747>>>>>>>>>
81747>>>>>>>>>enumeration_list // File list read modes
81747>>>>>>>>>  define FDX_ALL_OPEN  // All files currently open
81747>>>>>>>>>  define FDX_ALL_FILES // All files
81747>>>>>>>>>  define FDX_FROM_SET  // From pre-specified set of files (not implemented)
81747>>>>>>>>>end_enumeration_list
81747>>>>>>>>>
81747>>>>>>>>>enumeration_list // Data origin modes
81747>>>>>>>>>  define FDX_EMPTY          // The FDX object is empty
81747>>>>>>>>>  define FDX_REAL_WORLD     // Definitions have been read from current filelist
81747>>>>>>>>>  define FDX_READ_FROM_FILE // Definitions have been read from a sequential file
81747>>>>>>>>>end_enumeration_list
81747>>>>>>>>>
81747>>>>>>>>>enumeration_list // Relation origins for cFdxFileRelations
81747>>>>>>>>>  define FDX_RELORIG_ALL
81747>>>>>>>>>  define FDX_RELORIG_GENERIC
81747>>>>>>>>>end_enumeration_list
81747>>>>>>>>>
81747>>>>>>>>>//> An object of this class is inside a FDX object, but it is really just an
81747>>>>>>>>>//> appendix to the FDX object. It only holds redundant information about
81747>>>>>>>>>//> relations between file tables and is therefore not written to the .FDX
81747>>>>>>>>>//> files.
81747>>>>>>>>>class cFdxFileRelations is a cArray
81748>>>>>>>>>  procedure construct_object integer liImage
81750>>>>>>>>>    forward send construct_object liImage
81752>>>>>>>>>    property integer piArray_Filled public 0
81753>>>>>>>>>    property string  psTmpString    public ""
81754>>>>>>>>>  end_procedure
81755>>>>>>>>>  item_property_list
81755>>>>>>>>>    item_property integer piType.i
81755>>>>>>>>>    item_property integer piFileFrom.i
81755>>>>>>>>>    item_property integer piFieldFrom.i
81755>>>>>>>>>    item_property integer piFileTo.i
81755>>>>>>>>>    item_property integer piFieldTo.i
81755>>>>>>>>>  end_item_property_list cFdxFileRelations
#REM 81796 DEFINE FUNCTION PIFIELDTO.I INTEGER LIROW RETURNS INTEGER
#REM 81800 DEFINE PROCEDURE SET PIFIELDTO.I INTEGER LIROW INTEGER VALUE
#REM 81804 DEFINE FUNCTION PIFILETO.I INTEGER LIROW RETURNS INTEGER
#REM 81808 DEFINE PROCEDURE SET PIFILETO.I INTEGER LIROW INTEGER VALUE
#REM 81812 DEFINE FUNCTION PIFIELDFROM.I INTEGER LIROW RETURNS INTEGER
#REM 81816 DEFINE PROCEDURE SET PIFIELDFROM.I INTEGER LIROW INTEGER VALUE
#REM 81820 DEFINE FUNCTION PIFILEFROM.I INTEGER LIROW RETURNS INTEGER
#REM 81824 DEFINE PROCEDURE SET PIFILEFROM.I INTEGER LIROW INTEGER VALUE
#REM 81828 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 81832 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
81837>>>>>>>>>  //>
81837>>>>>>>>>  procedure aux_callback.iiiii integer liMsg integer liObj integer liSelectType integer liSelectToFile integer liSelectToField
81839>>>>>>>>>    integer liMax liRow liOK
81839>>>>>>>>>    ifnot (piArray_Filled(self)) send fill_array
81842>>>>>>>>>    get row_count to liMax
81843>>>>>>>>>    for liRow from 0 to (liMax-1)
81849>>>>>>>>>>
81849>>>>>>>>>      move 1 to liOK
81850>>>>>>>>>      if liSelectType if (piType.i(self,liRow)) ne liSelectType move 0 to liOK
81855>>>>>>>>>      if liOK if (piFileTo.i(self,liRow))  ne liSelectToFile move 0 to liOK
81860>>>>>>>>>      if liOK if (piFieldTo.i(self,liRow)) ne liSelectToField move 0 to liOK
81865>>>>>>>>>      if liOK send liMsg to liObj (piType.i(self,liRow)) (piFileFrom.i(self,liRow)) (piFieldFrom.i(self,liRow)) (piFileTo.i(self,liRow)) (piFieldTo.i(self,liRow))
81868>>>>>>>>>    loop
81869>>>>>>>>>>
81869>>>>>>>>>  end_procedure
81870>>>>>>>>>  procedure callback.iiiii integer liMsg integer liObj integer liSelectType integer liSelectFrom integer liSelectTo
81872>>>>>>>>>    integer liMax liRow liOK
81872>>>>>>>>>    ifnot (piArray_Filled(self)) send fill_array
81875>>>>>>>>>    get row_count to liMax
81876>>>>>>>>>    for liRow from 0 to (liMax-1)
81882>>>>>>>>>>
81882>>>>>>>>>      move 1 to liOK
81883>>>>>>>>>      if liSelectType if (piType.i(self,liRow)) ne liSelectType move 0 to liOK
81888>>>>>>>>>      if (liOK and liSelectFrom) if (piFileFrom.i(self,liRow)) ne liSelectFrom move 0 to liOK
81893>>>>>>>>>      if (liOK and liSelectTo) if (piFileTo.i(self,liRow)) ne liSelectTo move 0 to liOK
81898>>>>>>>>>      if liOK send liMsg to liObj (piType.i(self,liRow)) (piFileFrom.i(self,liRow)) (piFieldFrom.i(self,liRow)) (piFileTo.i(self,liRow)) (piFieldTo.i(self,liRow))
81901>>>>>>>>>    loop
81902>>>>>>>>>>
81902>>>>>>>>>  end_procedure
81903>>>>>>>>>  procedure add_relation.iiiii integer liType integer liFile1 integer liField1 integer liFile2 integer liField2
81905>>>>>>>>>    integer liRow
81905>>>>>>>>>    get row_count to liRow
81906>>>>>>>>>    set piType.i      liRow to liType
81907>>>>>>>>>    set piFileFrom.i  liRow to liFile1
81908>>>>>>>>>    set piFieldFrom.i liRow to liField1
81909>>>>>>>>>    set piFileTo.i    liRow to liFile2
81910>>>>>>>>>    set piFieldTo.i   liRow to liField2
81911>>>>>>>>>  end_procedure
81912>>>>>>>>>  procedure reset
81914>>>>>>>>>    send delete_data
81915>>>>>>>>>    set piArray_Filled to false
81916>>>>>>>>>  end_procedure
81917>>>>>>>>>  procedure fill_array
81919>>>>>>>>>    integer liFile liField liToFile liToField liMax liParent liAvailable
81919>>>>>>>>>    send reset
81920>>>>>>>>>    move (parent(self)) to liParent // Save time delegation
81921>>>>>>>>>    move 0 to liFile
81922>>>>>>>>>    repeat
81922>>>>>>>>>>
81922>>>>>>>>>      get AttrValue_FLSTNAV of liParent DF_FILE_NEXT_USED liFile to liFile
81923>>>>>>>>>      if liFile begin
81925>>>>>>>>>        get iCanOpen.i liFile to liAvailable
81926>>>>>>>>>        if liAvailable begin
81928>>>>>>>>>          get AttrValue_FILE of liParent DF_FILE_NUMBER_FIELDS liFile to liMax
81929>>>>>>>>>          for liField from 1 to liMax
81935>>>>>>>>>>
81935>>>>>>>>>            get AttrValue_FIELD of liParent DF_FIELD_RELATED_FILE  liFile liField to liToFile
81936>>>>>>>>>            if liToFile begin
81938>>>>>>>>>              get AttrValue_FIELD of liParent DF_FIELD_RELATED_FIELD liFile liField to liToField
81939>>>>>>>>>              send add_relation.iiiii FDX_RELORIG_GENERIC liFile liField liToFile liToField
81940>>>>>>>>>            end
81940>>>>>>>>>>
81940>>>>>>>>>          loop
81941>>>>>>>>>>
81941>>>>>>>>>        end
81941>>>>>>>>>>
81941>>>>>>>>>      end
81941>>>>>>>>>>
81941>>>>>>>>>    until (not(liFile))
81943>>>>>>>>>    set piArray_Filled to true
81944>>>>>>>>>  end_procedure
81945>>>>>>>>>  procedure ParentFilesHelp integer liType integer liFile integer liFld integer liRFile integer liRFld
81947>>>>>>>>>    string lsStr
81947>>>>>>>>>    get psTmpString to lsStr
81948>>>>>>>>>    ifnot (IsIntegerPresent(lsStr,liRFile)) begin
81950>>>>>>>>>      move (AddIntegerToString(lsStr,liRFile)) to lsStr
81951>>>>>>>>>      set psTmpString to lsStr
81952>>>>>>>>>      send callback.iiiii msg_ParentFilesHelp self FDX_RELORIG_ALL liRFile 0
81953>>>>>>>>>    end
81953>>>>>>>>>>
81953>>>>>>>>>  end_procedure
81954>>>>>>>>>  function sParentFiles.i integer liFile returns string
81956>>>>>>>>>    set psTmpString to ""
81957>>>>>>>>>    send callback.iiiii msg_ParentFilesHelp self FDX_RELORIG_ALL liFile 0
81958>>>>>>>>>    function_return (psTmpString(self))
81959>>>>>>>>>  end_function
81960>>>>>>>>>  procedure ChildFilesHelp integer liType integer liFile integer liFld integer liRFile integer liRFld
81962>>>>>>>>>    string lsStr
81962>>>>>>>>>    get psTmpString to lsStr
81963>>>>>>>>>    ifnot (IsIntegerPresent(lsStr,liFile)) begin
81965>>>>>>>>>      move (AddIntegerToString(lsStr,liFile)) to lsStr
81966>>>>>>>>>      set psTmpString to lsStr
81967>>>>>>>>>      send callback.iiiii msg_ChildFilesHelp self FDX_RELORIG_ALL 0 liFile
81968>>>>>>>>>    end
81968>>>>>>>>>>
81968>>>>>>>>>  end_procedure
81969>>>>>>>>>  function sChildFiles.i integer liFile returns string
81971>>>>>>>>>    set psTmpString to ""
81972>>>>>>>>>    send callback.iiiii msg_ChildFilesHelp self FDX_RELORIG_ALL 0 liFile
81973>>>>>>>>>    function_return (psTmpString(self))
81974>>>>>>>>>  end_function
81975>>>>>>>>>end_class // cFdxFileRelations
81976>>>>>>>>>
81976>>>>>>>>>class cFdxFileDef_IndexAttr is a cArray
81977>>>>>>>>>  item_property_list
81977>>>>>>>>>    item_property integer piType.i
81977>>>>>>>>>    item_property integer piSegments.i
81977>>>>>>>>>    item_property integer piBuffers.i
81977>>>>>>>>>    item_property integer piKey_Length.i
81977>>>>>>>>>    item_property integer piLevels.i
81977>>>>>>>>>    item_property string  psFields.i
81977>>>>>>>>>    item_property string  psUppercase.i
81977>>>>>>>>>    item_property string  psDirection.i
81977>>>>>>>>>  end_item_property_list cFdxFileDef_IndexAttr // Repeat class name here!
#REM 82027 DEFINE FUNCTION PSDIRECTION.I INTEGER LIROW RETURNS STRING
#REM 82031 DEFINE PROCEDURE SET PSDIRECTION.I INTEGER LIROW STRING VALUE
#REM 82035 DEFINE FUNCTION PSUPPERCASE.I INTEGER LIROW RETURNS STRING
#REM 82039 DEFINE PROCEDURE SET PSUPPERCASE.I INTEGER LIROW STRING VALUE
#REM 82043 DEFINE FUNCTION PSFIELDS.I INTEGER LIROW RETURNS STRING
#REM 82047 DEFINE PROCEDURE SET PSFIELDS.I INTEGER LIROW STRING VALUE
#REM 82051 DEFINE FUNCTION PILEVELS.I INTEGER LIROW RETURNS INTEGER
#REM 82055 DEFINE PROCEDURE SET PILEVELS.I INTEGER LIROW INTEGER VALUE
#REM 82059 DEFINE FUNCTION PIKEY_LENGTH.I INTEGER LIROW RETURNS INTEGER
#REM 82063 DEFINE PROCEDURE SET PIKEY_LENGTH.I INTEGER LIROW INTEGER VALUE
#REM 82067 DEFINE FUNCTION PIBUFFERS.I INTEGER LIROW RETURNS INTEGER
#REM 82071 DEFINE PROCEDURE SET PIBUFFERS.I INTEGER LIROW INTEGER VALUE
#REM 82075 DEFINE FUNCTION PISEGMENTS.I INTEGER LIROW RETURNS INTEGER
#REM 82079 DEFINE PROCEDURE SET PISEGMENTS.I INTEGER LIROW INTEGER VALUE
#REM 82083 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 82087 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
82092>>>>>>>>>  procedure reset
82094>>>>>>>>>    send delete_data
82095>>>>>>>>>  end_procedure
82096>>>>>>>>>end_class // cFdxFileDef_IndexAttr
82097>>>>>>>>>class cFdxFileDef_FileAttr is a cArray
82098>>>>>>>>>  procedure add_attr_value string lsValue
82100>>>>>>>>>    set value item (item_count(self)) to lsValue
82101>>>>>>>>>  end_procedure
82102>>>>>>>>>  procedure reset
82104>>>>>>>>>    send delete_data
82105>>>>>>>>>  end_procedure
82106>>>>>>>>>end_class // cFdxFileDef_FileAttr
82107>>>>>>>>>
82107>>>>>>>>>class cFdxFileDef_DataAndConfigurationFilesHelp is a cArray
82108>>>>>>>>>  procedure construct_object integer liImage
82110>>>>>>>>>    forward send construct_object liImage
82112>>>>>>>>>    property integer pbFileNotFound public DFTRUE
82113>>>>>>>>>    property string  psFileName     public ""
82114>>>>>>>>>    property string  psFilePath     public ""
82115>>>>>>>>>    property number  pnFileTime     public 0
82116>>>>>>>>>    property number  pnFileSize     public 0
82117>>>>>>>>>  end_procedure
82118>>>>>>>>>  procedure Reset
82120>>>>>>>>>    send delete_data
82121>>>>>>>>>    set pbFileNotFound to DFTRUE
82122>>>>>>>>>    set psFileName to ""
82123>>>>>>>>>    set psFilePath to ""
82124>>>>>>>>>    set pnFileTime to 0
82125>>>>>>>>>    set pnFileSize to 0
82126>>>>>>>>>  end_procedure
82127>>>>>>>>>  procedure Read_FileFromDisk string lsFileName
82129>>>>>>>>>    integer liChannel lbSeqEof
82129>>>>>>>>>    string lsLine
82129>>>>>>>>>    send Reset
82130>>>>>>>>>    if (SEQ_FileExists(lsFileName)=SEQIT_FILE) begin
82132>>>>>>>>>      set pbFileNotFound to DFFALSE
82133>>>>>>>>>      set psFileName to lsFileName
82134>>>>>>>>>      set psFilePath to (SEQ_FindFileAlongDFPath(lsFileName))
82135>>>>>>>>>      set pnFileTime to (SEQ_FileModTime(lsFileName))
82136>>>>>>>>>      set pnFileSize to (SEQ_FileSize(lsFileName))
82137>>>>>>>>>      get SEQ_DirectInput lsFileName to liChannel
82138>>>>>>>>>      if (liChannel>=0) begin
82140>>>>>>>>>        repeat
82140>>>>>>>>>>
82140>>>>>>>>>          readln channel liChannel lsLine
82142>>>>>>>>>          move (seqeof) to lbSeqEof
82143>>>>>>>>>          ifnot lbSeqEof set value item (item_count(self)) to lsLine
82146>>>>>>>>>        until lbSeqEof
82148>>>>>>>>>        send SEQ_CloseInput liChannel
82149>>>>>>>>>      end
82149>>>>>>>>>>
82149>>>>>>>>>    end
82149>>>>>>>>>>
82149>>>>>>>>>  end_procedure
82150>>>>>>>>>  procedure Seq_Read integer liChannel
82152>>>>>>>>>    set pbFileNotFound to (SEQ_ReadLn(liChannel))
82153>>>>>>>>>    set psFileName     to (SEQ_ReadLn(liChannel))
82154>>>>>>>>>    set psFilePath     to (SEQ_ReadLn(liChannel))
82155>>>>>>>>>    set pnFileTime     to (SEQ_ReadLn(liChannel))
82156>>>>>>>>>    set pnFileSize     to (SEQ_ReadLn(liChannel))
82157>>>>>>>>>    send SEQ_ReadArrayItems liChannel self
82158>>>>>>>>>  end_procedure
82159>>>>>>>>>  procedure Seq_Write integer liChannel
82161>>>>>>>>>    writeln channel liChannel (pbFileNotFound(self))
82164>>>>>>>>>    writeln (psFileName(self))
82166>>>>>>>>>    writeln (psFilePath(self))
82168>>>>>>>>>    writeln (pnFileTime(self))
82170>>>>>>>>>    writeln (pnFileSize(self))
82172>>>>>>>>>    send SEQ_WriteArrayItems liChannel self
82173>>>>>>>>>  end_procedure
82174>>>>>>>>>end_class // cFdxFileDef_DataAndConfigurationFilesHelp
82175>>>>>>>>>
82175>>>>>>>>>class cFdxFileDef_DataAndConfigurationFiles is a cArray
82176>>>>>>>>>  procedure construct_object integer liImage
82178>>>>>>>>>    forward send construct_object liImage
82180>>>>>>>>>    property integer pbDataIncluded   public DFFALSE
82181>>>>>>>>>    property integer pbDataByteOffset public 0
82182>>>>>>>>>    object oTagFile is a cFdxFileDef_DataAndConfigurationFilesHelp
82184>>>>>>>>>    end_object
82185>>>>>>>>>    object oFdFile is a cFdxFileDef_DataAndConfigurationFilesHelp
82187>>>>>>>>>    end_object
82188>>>>>>>>>    object oIntFile is a cFdxFileDef_DataAndConfigurationFilesHelp
82190>>>>>>>>>    end_object
82191>>>>>>>>>    object oFutureUse is a cFdxFileDef_DataAndConfigurationFilesHelp
82193>>>>>>>>>    end_object
82194>>>>>>>>>    property number priv.pnOffset public 0
82195>>>>>>>>>  end_procedure
82196>>>>>>>>>  procedure Reset
82198>>>>>>>>>    send Reset to (oTagFile(self))
82199>>>>>>>>>    send Reset to (oFdFile(self))
82200>>>>>>>>>    send Reset to (oIntFile(self))
82201>>>>>>>>>    send Reset to (oFutureUse(self))
82202>>>>>>>>>  end_procedure
82203>>>>>>>>>  procedure Read_AuxillaryFiles string lsRoot
82205>>>>>>>>>    send Read_FileFromDisk to (oTagFile(self))   (lsRoot+".tag")
82206>>>>>>>>>    send Read_FileFromDisk to (oFdFile(self))    (lsRoot+".fd")
82207>>>>>>>>>    send Read_FileFromDisk to (oIntFile(self))   (lsRoot+".int")
82208>>>>>>>>>//  send Read_FileFromDisk to (oFutureUse(self)) (lsRoot+".")
82208>>>>>>>>>  end_procedure
82209>>>>>>>>>  procedure Seq_Read integer liChannel
82211>>>>>>>>>    set pbDataIncluded   to (Seq_ReadLn(liChannel))
82212>>>>>>>>>    set pbDataByteOffset to (Seq_ReadLn(liChannel))
82213>>>>>>>>>    send Seq_Read to (oTagFile(self)) liChannel
82214>>>>>>>>>    send Seq_Read to (oFdFile(self)) liChannel
82215>>>>>>>>>    send Seq_Read to (oIntFile(self)) liChannel
82216>>>>>>>>>    send Seq_Read to (oFutureUse(self)) liChannel
82217>>>>>>>>>  end_procedure
82218>>>>>>>>>  procedure Seq_Write integer liChannel
82220>>>>>>>>>    number lnChannelPos
82220>>>>>>>>>    writeln channel liChannel (pbDataIncluded(self))
82223>>>>>>>>>    get_channel_position liChannel to lnChannelPos
82224>>>>>>>>>>
82224>>>>>>>>>    set priv.pnOffset to lnChannelPos
82225>>>>>>>>>    writeln (repeat(" ",20))
82227>>>>>>>>>    send Seq_Write to (oTagFile(self)) liChannel
82228>>>>>>>>>    send Seq_Write to (oFdFile(self)) liChannel
82229>>>>>>>>>    send Seq_Write to (oIntFile(self)) liChannel
82230>>>>>>>>>    send Seq_Write to (oFutureUse(self)) liChannel
82231>>>>>>>>>  end_procedure
82232>>>>>>>>>  procedure Write_DataOffset integer liChannel number lnOffset
82234>>>>>>>>>    number lnChannelPos
82234>>>>>>>>>    get_channel_position liChannel to lnChannelPos
82235>>>>>>>>>>
82235>>>>>>>>>    set_channel_position liChannel to (priv.pnOffset(self))
82236>>>>>>>>>>
82236>>>>>>>>>    write channel liChannel lnOffset
82238>>>>>>>>>    set_channel_position liChannel to lnChannelPos
82239>>>>>>>>>>
82239>>>>>>>>>  end_procedure
82240>>>>>>>>>end_class // cFdxFileDef_DataAndConfigurationFiles
82241>>>>>>>>>
82241>>>>>>>>>
82241>>>>>>>>>class cFdxFileDef is a cArray
82242>>>>>>>>>  procedure construct_object integer liImage
82244>>>>>>>>>    forward send construct_object liImage
82246>>>>>>>>>    property integer piMainFile public 0
82247>>>>>>>>>    object oFileAttr is a cFdxFileDef_FileAttr NO_IMAGE
82249>>>>>>>>>    end_object
82250>>>>>>>>>    object oIndexAttr is a cFdxFileDef_IndexAttr NO_IMAGE
82252>>>>>>>>>    end_object
82253>>>>>>>>>    object oDatAndConf is a cFdxFileDef_DataAndConfigurationFiles NO_IMAGE
82255>>>>>>>>>    end_object
82256>>>>>>>>>    property string  psDatPath            public "" // Where is the dat file?
82257>>>>>>>>>    property number  pnTimeStamp          public 0  // How old is it?
82258>>>>>>>>>    // Property piReadDuringRestruct should always be false. Except when
82258>>>>>>>>>    // a cFdxFileDef object is used to read a file definition during a
82258>>>>>>>>>    // restructure operation.
82258>>>>>>>>>    property integer piReadDuringRestruct public DFFALSE  //
82259>>>>>>>>>    property integer piDataOrigin   public FDX_EMPTY // 0=empty 1=Read from current 2=Read from file
82260>>>>>>>>>  end_procedure
82261>>>>>>>>>  function iCanOpen.i integer liFile returns integer
82263>>>>>>>>>    integer liDelegate liRval
82263>>>>>>>>>    if liFile eq (piMainFile(self)) function_return 1
82266>>>>>>>>>    get iFdxIsEncapsulated to liDelegate
82267>>>>>>>>>    if liDelegate delegate get iCanOpen.i liFile to liRval
82271>>>>>>>>>    else move 0 to liRval
82273>>>>>>>>>    function_return liRval
82274>>>>>>>>>  end_function
82275>>>>>>>>>
82275>>>>>>>>>  function AttrValue_IsEmpty integer liFile returns integer
82277>>>>>>>>>    function_return 0
82278>>>>>>>>>  end_function
82279>>>>>>>>>
82279>>>>>>>>>  item_property_list // Field parameters
82279>>>>>>>>>    item_property string  psName.i        // DF_FIELD_NAME
82279>>>>>>>>>    item_property integer piNumber.i      // DF_FIELD_NUMBER
82279>>>>>>>>>    item_property integer piOldNumber.i   // DF_FIELD_OLD_NUMBER
82279>>>>>>>>>    item_property integer piType.i        // DF_FIELD_TYPE
82279>>>>>>>>>    item_property integer piLen.i         // DF_FIELD_LENGTH
82279>>>>>>>>>    item_property integer piNative_len.i  // DF_FIELD_NATIVE_LENGTH
82279>>>>>>>>>    item_property integer piPrec.i        // DF_FIELD_PRECISION
82279>>>>>>>>>    item_property integer piRfile.i       // DF_FIELD_RELATED_FILE
82279>>>>>>>>>    item_property integer piRfld.i        // DF_FIELD_RELATED_FIELD
82279>>>>>>>>>    item_property integer piIdx.i         // DF_FIELD_INDEX
82279>>>>>>>>>    item_property integer piOffset.i      // DF_FIELD_OFFSET
82279>>>>>>>>>  end_item_property_list cFdxFileDef
#REM 82338 DEFINE FUNCTION PIOFFSET.I INTEGER LIROW RETURNS INTEGER
#REM 82342 DEFINE PROCEDURE SET PIOFFSET.I INTEGER LIROW INTEGER VALUE
#REM 82346 DEFINE FUNCTION PIIDX.I INTEGER LIROW RETURNS INTEGER
#REM 82350 DEFINE PROCEDURE SET PIIDX.I INTEGER LIROW INTEGER VALUE
#REM 82354 DEFINE FUNCTION PIRFLD.I INTEGER LIROW RETURNS INTEGER
#REM 82358 DEFINE PROCEDURE SET PIRFLD.I INTEGER LIROW INTEGER VALUE
#REM 82362 DEFINE FUNCTION PIRFILE.I INTEGER LIROW RETURNS INTEGER
#REM 82366 DEFINE PROCEDURE SET PIRFILE.I INTEGER LIROW INTEGER VALUE
#REM 82370 DEFINE FUNCTION PIPREC.I INTEGER LIROW RETURNS INTEGER
#REM 82374 DEFINE PROCEDURE SET PIPREC.I INTEGER LIROW INTEGER VALUE
#REM 82378 DEFINE FUNCTION PINATIVE_LEN.I INTEGER LIROW RETURNS INTEGER
#REM 82382 DEFINE PROCEDURE SET PINATIVE_LEN.I INTEGER LIROW INTEGER VALUE
#REM 82386 DEFINE FUNCTION PILEN.I INTEGER LIROW RETURNS INTEGER
#REM 82390 DEFINE PROCEDURE SET PILEN.I INTEGER LIROW INTEGER VALUE
#REM 82394 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 82398 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 82402 DEFINE FUNCTION PIOLDNUMBER.I INTEGER LIROW RETURNS INTEGER
#REM 82406 DEFINE PROCEDURE SET PIOLDNUMBER.I INTEGER LIROW INTEGER VALUE
#REM 82410 DEFINE FUNCTION PINUMBER.I INTEGER LIROW RETURNS INTEGER
#REM 82414 DEFINE PROCEDURE SET PINUMBER.I INTEGER LIROW INTEGER VALUE
#REM 82418 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 82422 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
82427>>>>>>>>>
82427>>>>>>>>>  procedure Reset
82429>>>>>>>>>    send delete_data
82430>>>>>>>>>    send delete_data to (oFileAttr(self))
82431>>>>>>>>>    send delete_data to (oIndexAttr(self))
82432>>>>>>>>>    send Reset       to (oDatAndConf(self))
82433>>>>>>>>>    set psDatPath   to ""
82434>>>>>>>>>    set pnTimeStamp to 0
82435>>>>>>>>>    set piDataOrigin to FDX_EMPTY
82436>>>>>>>>>  end_procedure
82437>>>>>>>>>
82437>>>>>>>>>  procedure DoTransferToMapableObject integer lhMapObject
82439>>>>>>>>>    integer liMax liRow
82439>>>>>>>>>    send DoReset to lhMapObject
82440>>>>>>>>>    get row_count to liMax
82441>>>>>>>>>    decrement liMax
82442>>>>>>>>>    for liRow from 1 to liMax
82448>>>>>>>>>>
82448>>>>>>>>>      if (piType.i(self,liRow)<>DF_OVERLAP) ;        send DoAddItem to lhMapObject liRow (psName.i(self,liRow)) ""
82451>>>>>>>>>    loop
82452>>>>>>>>>>
82452>>>>>>>>>  end_procedure
82453>>>>>>>>>
82453>>>>>>>>>  procedure Seq_Write integer liChannel
82455>>>>>>>>>    writeln channel liChannel "*** File definition: **********************"
82458>>>>>>>>>    writeln channel liChannel (piMainFile(self))
82461>>>>>>>>>    writeln channel liChannel "--- Field data ----------------------------"
82464>>>>>>>>>    send SEQ_WriteArrayItems liChannel self
82465>>>>>>>>>    writeln channel liChannel "--- File data -----------------------------"
82468>>>>>>>>>    send SEQ_WriteArrayItems liChannel (oFileAttr(self))
82469>>>>>>>>>    writeln channel liChannel "--- Index data ----------------------------"
82472>>>>>>>>>    send SEQ_WriteArrayItems liChannel (oIndexAttr(self))
82473>>>>>>>>>    writeln channel liChannel "-------------------------------------------"
82476>>>>>>>>>    writeln channel liChannel (psDatPath(self))
82479>>>>>>>>>    writeln channel liChannel (pnTimeStamp(self))
82482>>>>>>>>>//  send Seq_Write to (oDatAndConf(self)) liChannel
82482>>>>>>>>>    writeln channel liChannel "*** End of file definition ****************"
82485>>>>>>>>>  end_procedure
82486>>>>>>>>>
82486>>>>>>>>>  //> Read definition from sequential file
82486>>>>>>>>>  procedure Seq_Read integer liChannel
82488>>>>>>>>>    integer liMainFile
82488>>>>>>>>>    string lsThrowAway
82488>>>>>>>>>    set piDataOrigin to FDX_READ_FROM_FILE
82489>>>>>>>>>    readln channel liChannel lsThrowAway
82491>>>>>>>>>    readln liMainFile
82492>>>>>>>>>    set piMainFile to liMainFile
82493>>>>>>>>>    readln lsThrowAway
82494>>>>>>>>>    send SEQ_ReadArrayItems liChannel self
82495>>>>>>>>>    readln lsThrowAway
82496>>>>>>>>>    send SEQ_ReadArrayItems liChannel (oFileAttr(self))
82497>>>>>>>>>    readln lsThrowAway
82498>>>>>>>>>    send SEQ_ReadArrayItems liChannel (oIndexAttr(self))
82499>>>>>>>>>    readln lsThrowAway
82500>>>>>>>>>    set psDatPath   to (SEQ_ReadLn(liChannel))
82501>>>>>>>>>    set pnTimeStamp to (SEQ_ReadLn(liChannel))
82502>>>>>>>>>//  send Seq_Read to (oDatAndConf(self)) liChannel
82502>>>>>>>>>    readln lsThrowAway
82503>>>>>>>>>  end_procedure
82504>>>>>>>>>
82504>>>>>>>>>  procedure Read_File_Attr integer liFile // Get monitored file(list) attributes from record buffer
82506>>>>>>>>>    integer liMin liMax liAttr liReadDuringRestruct
82506>>>>>>>>>    integer liFileAttrObj liMonitoredFileAttributesObj
82506>>>>>>>>>    string lsValue
82506>>>>>>>>>    move (oFileAttr(self)) to liFileAttrObj
82507>>>>>>>>>    move (oMonitoredFileAttributes(self)) to liMonitoredFileAttributesObj
82508>>>>>>>>>    get piReadDuringRestruct to liReadDuringRestruct
82509>>>>>>>>>    send reset to liFileAttrObj
82510>>>>>>>>>    get piLowIndex  of liMonitoredFileAttributesObj to liMin
82511>>>>>>>>>    get piHighIndex of liMonitoredFileAttributesObj to liMax
82512>>>>>>>>>    for liAttr from liMin to liMax
82518>>>>>>>>>>
82518>>>>>>>>>      if (piMonitored.i(liMonitoredFileAttributesObj,liAttr)) begin // If it's monitored
82520>>>>>>>>>        if (not(liReadDuringRestruct) or API_AttrType(liAttr)<>ATTRTYPE_FILELIST) ;          get_attribute liAttr of liFile to lsValue
82525>>>>>>>>>        else move "" to lsValue
82527>>>>>>>>>        send add_attr_value to liFileAttrObj lsValue
82528>>>>>>>>>      end
82528>>>>>>>>>>
82528>>>>>>>>>    loop
82529>>>>>>>>>>
82529>>>>>>>>>  end_procedure
82530>>>>>>>>>  procedure Read_Field_Attr integer liFile // Get field attributes from record buffer
82532>>>>>>>>>    integer liField liMax liRestruct
82532>>>>>>>>>    get piReadDuringRestruct to liRestruct
82533>>>>>>>>>    get_attribute DF_FILE_NUMBER_FIELDS of liFile to liMax
82536>>>>>>>>>    for liField from 1 to liMax
82542>>>>>>>>>>
82542>>>>>>>>>      set psName.i       liField to (API_AttrValue_FIELD(DF_FIELD_NAME,liFile,liField))
82543>>>>>>>>>      set piNumber.i     liField to (API_AttrValue_FIELD(DF_FIELD_NUMBER,liFile,liField))
82544>>>>>>>>>      if liRestruct set piOldNumber.i  liField to (API_AttrValue_FIELD(DF_FIELD_OLD_NUMBER,liFile,liField))
82547>>>>>>>>>      else set piOldNumber.i  liField to liField
82549>>>>>>>>>      set piType.i       liField to (API_AttrValue_FIELD(DF_FIELD_TYPE,liFile,liField))
82550>>>>>>>>>      set piLen.i        liField to (API_AttrValue_FIELD(DF_FIELD_LENGTH,liFile,liField))
82551>>>>>>>>>      set piNative_Len.i liField to (API_AttrValue_FIELD(DF_FIELD_NATIVE_LENGTH,liFile,liField))
82552>>>>>>>>>      set piPrec.i       liField to (API_AttrValue_FIELD(DF_FIELD_PRECISION,liFile,liField))
82553>>>>>>>>>      set piRfile.i      liField to (API_AttrValue_FIELD(DF_FIELD_RELATED_FILE,liFile,liField))
82554>>>>>>>>>      set piRfld.i       liField to (API_AttrValue_FIELD(DF_FIELD_RELATED_FIELD,liFile,liField))
82555>>>>>>>>>      set piIdx.i        liField to (API_AttrValue_FIELD(DF_FIELD_INDEX,liFile,liField))
82556>>>>>>>>>      set piOffset.i     liField to (API_AttrValue_FIELD(DF_FIELD_OFFSET,liFile,liField))
82557>>>>>>>>>    loop
82558>>>>>>>>>>
82558>>>>>>>>>  end_procedure
82559>>>>>>>>>  procedure Read_Index_Attr integer liFile
82561>>>>>>>>>    integer liIndexAttrObj liSegment liMax liIndex liRestruct
82561>>>>>>>>>    string lsFields lsUppercases lsDirections
82561>>>>>>>>>    move (oIndexAttr(self)) to liIndexAttrObj
82562>>>>>>>>>    send reset to liIndexAttrObj
82563>>>>>>>>>    get piReadDuringRestruct to liRestruct
82564>>>>>>>>>    for liIndex from 1 to 15
82570>>>>>>>>>>
82570>>>>>>>>>      get_attribute DF_INDEX_NUMBER_SEGMENTS of liFile liIndex to liMax
82573>>>>>>>>>      if liMax begin // If there's an index at all
82575>>>>>>>>>        set piType.i       of liIndexAttrObj liIndex to (API_AttrValue_INDEX(DF_INDEX_TYPE,liFile,liIndex))
82576>>>>>>>>>        set piSegments.i   of liIndexAttrObj liIndex to liMax
82577>>>>>>>>>        ifnot liRestruct set piBuffers.i of liIndexAttrObj liIndex to (API_AttrValue_INDEX(DF_INDEX_NUMBER_BUFFERS,liFile,liIndex))
82580>>>>>>>>>        set piKey_Length.i of liIndexAttrObj liIndex to (API_AttrValue_INDEX(DF_INDEX_KEY_LENGTH,liFile,liIndex))
82581>>>>>>>>>        set piLevels.i     of liIndexAttrObj liIndex to (API_AttrValue_INDEX(DF_INDEX_LEVELS,liFile,liIndex))
82582>>>>>>>>>        move "" to lsFields
82583>>>>>>>>>        move "" to lsUppercases
82584>>>>>>>>>        move "" to lsDirections
82585>>>>>>>>>        for liSegment from 1 to liMax
82591>>>>>>>>>>
82591>>>>>>>>>          move (lsFields    +pad(API_AttrValue_IDXSEG(DF_INDEX_SEGMENT_FIELD    ,liFile,liIndex,liSegment),4)) to lsFields
82592>>>>>>>>>          move (lsUppercases+pad(API_AttrValue_IDXSEG(DF_INDEX_SEGMENT_CASE     ,liFile,liIndex,liSegment),4)) to lsUppercases
82593>>>>>>>>>          move (lsDirections+pad(API_AttrValue_IDXSEG(DF_INDEX_SEGMENT_DIRECTION,liFile,liIndex,liSegment),4)) to lsDirections
82594>>>>>>>>>        loop
82595>>>>>>>>>>
82595>>>>>>>>>        set psFields.i    of liIndexAttrObj liIndex to lsFields
82596>>>>>>>>>        set psUppercase.i of liIndexAttrObj liIndex to lsUppercases
82597>>>>>>>>>        set psDirection.i of liIndexAttrObj liIndex to lsDirections
82598>>>>>>>>>      end
82598>>>>>>>>>>
82598>>>>>>>>>    loop
82599>>>>>>>>>>
82599>>>>>>>>>  end_procedure
82600>>>>>>>>>
82600>>>>>>>>>  //> Read definition from table
82600>>>>>>>>>  procedure Read_File_Definition.i integer liFile
82602>>>>>>>>>    string lsDriver lsExt lsPhysFileName lsPath
82602>>>>>>>>>    set piDataOrigin to FDX_REAL_WORLD
82603>>>>>>>>>    set piMainFile to liFile
82604>>>>>>>>>    send Read_File_Attr liFile
82605>>>>>>>>>    send Read_Field_Attr liFile
82606>>>>>>>>>    send Read_Index_Attr liFile
82607>>>>>>>>>    get AttrValue_FILE DF_FILE_DRIVER liFile to lsDriver
82608>>>>>>>>>    if lsDriver eq "DATAFLEX" move ".DAT" to lsExt
82611>>>>>>>>>    else move ".INT" to lsExt
82613>>>>>>>>>    get AttrValue_FILE DF_FILE_PHYSICAL_NAME liFile to lsPhysFileName
82614>>>>>>>>>    ifnot "." in (SEQ_RemovePathFromFileName(lsPhysFileName)) move (lsPhysFileName+lsExt) to lsPhysFileName
82617>>>>>>>>>
82617>>>>>>>>>//  send Read_AuxillaryFiles to (oDatAndConf(self)) (StringLeftBut(lsPhysFileName,4))
82617>>>>>>>>>
82617>>>>>>>>>    if (SEQ_ExtractPathFromFileName(lsPhysFileName)) eq "" begin
82619>>>>>>>>>      move (SEQ_FindFileAlongDFPath(lsPhysFileName)) to lsPath
82620>>>>>>>>>      move (SEQ_ComposeAbsoluteFileName(lsPath,lsPhysFileName)) to lsPhysFileName
82621>>>>>>>>>    end
82621>>>>>>>>>>
82621>>>>>>>>>    set psDatPath   to lsPhysFileName
82622>>>>>>>>>    set pnTimeStamp to (SEQ_FileModTime(lsPhysFileName))
82623>>>>>>>>>  end_procedure
82624>>>>>>>>>
82624>>>>>>>>>  // *************************************************************************
82624>>>>>>>>>  // *** These attribute value functions are used by the cFdx class ******
82624>>>>>>>>>  //> Call back for every entry with a rootname
82624>>>>>>>>>  function sAttrValueFile.i integer liAttr returns string
82626>>>>>>>>>    integer liMonitoredFileAttributesObj
82626>>>>>>>>>    move (oMonitoredFileAttributes(self)) to liMonitoredFileAttributesObj
82627>>>>>>>>>    if (piMonitored.i(liMonitoredFileAttributesObj,liAttr)) begin
82629>>>>>>>>>      get piAttrIndex.i of liMonitoredFileAttributesObj liAttr to liAttr
82630>>>>>>>>>      function_return (value(oFileAttr(self),liAttr))
82631>>>>>>>>>    end
82631>>>>>>>>>>
82631>>>>>>>>>    function_return t.fdx.attr_not_avail
82632>>>>>>>>>  end_function
82633>>>>>>>>>  function sAttrValueField.ii integer liAttr integer liField returns string
82635>>>>>>>>>    if liAttr eq DF_FIELD_NAME          function_return (psName.i(self,liField))
82638>>>>>>>>>    if liAttr eq DF_FIELD_NUMBER        function_return (piNumber.i(self,liField))
82641>>>>>>>>>    if liAttr eq DF_FIELD_OLD_NUMBER    function_return (piOldNumber.i(self,liField))
82644>>>>>>>>>    if liAttr eq DF_FIELD_TYPE          function_return (piType.i(self,liField))
82647>>>>>>>>>    if liAttr eq DF_FIELD_LENGTH        function_return (piLen.i(self,liField))
82650>>>>>>>>>    if liAttr eq DF_FIELD_NATIVE_LENGTH function_return (piNative_Len.i(self,liField))
82653>>>>>>>>>    if liAttr eq DF_FIELD_PRECISION     function_return (piPrec.i(self,liField))
82656>>>>>>>>>    if liAttr eq DF_FIELD_RELATED_FILE  function_return (piRfile.i(self,liField))
82659>>>>>>>>>    if liAttr eq DF_FIELD_RELATED_FIELD function_return (piRfld.i(self,liField))
82662>>>>>>>>>    if liAttr eq DF_FIELD_INDEX         function_return (piIdx.i(self,liField))
82665>>>>>>>>>    if liAttr eq DF_FIELD_OFFSET        function_return (piOffset.i(self,liField))
82668>>>>>>>>>    function_return t.fdx.attr_not_avail
82669>>>>>>>>>  end_function
82670>>>>>>>>>  function sAttrValueIndex.ii integer liAttr integer liIndex returns string
82672>>>>>>>>>    integer liObj
82672>>>>>>>>>    move (oIndexAttr(self)) to liObj
82673>>>>>>>>>    if liAttr eq DF_INDEX_NUMBER_SEGMENTS function_return (piSegments.i(liObj,liIndex))
82676>>>>>>>>>    if liAttr eq DF_INDEX_NUMBER_BUFFERS  function_return (piBuffers.i(liObj,liIndex))
82679>>>>>>>>>    if liAttr eq DF_INDEX_TYPE            function_return (piType.i(liObj,liIndex))
82682>>>>>>>>>    if liAttr eq DF_INDEX_LEVELS          function_return (piLevels.i(liObj,liIndex))
82685>>>>>>>>>    if liAttr eq DF_INDEX_KEY_LENGTH      function_return (piKey_Length.i(liObj,liIndex))
82688>>>>>>>>>    function_return t.fdx.attr_not_avail
82689>>>>>>>>>  end_function
82690>>>>>>>>>  function sAttrValueIndexSegment.iii integer liAttr integer liIndex integer liSegment returns string
82692>>>>>>>>>    integer liObj
82692>>>>>>>>>    string lsStr
82692>>>>>>>>>    move (oIndexAttr(self)) to liObj
82693>>>>>>>>>    if liAttr eq DF_INDEX_SEGMENT_FIELD     move (psFields.i(liObj,liIndex)) to lsStr
82696>>>>>>>>>    if liAttr eq DF_INDEX_SEGMENT_CASE      move (psUppercase.i(liObj,liIndex)) to lsStr
82699>>>>>>>>>    if liAttr eq DF_INDEX_SEGMENT_DIRECTION move (psDirection.i(liObj,liIndex)) to lsStr
82702>>>>>>>>>    function_return (mid(lsStr,4,liSegment-1*4+1))
82703>>>>>>>>>  end_function
82704>>>>>>>>>  function sAttrValueSpecial1.iii integer liAttr integer liField1 integer liField2 returns string
82706>>>>>>>>>    integer liStart1 liEnd1 liStart2 liEnd2 liFile
82706>>>>>>>>>    get piMainFile to liFile // The liFile parameter is ignored whe called from in here.
82707>>>>>>>>>    get AttrValue_FIELD DF_FIELD_OFFSET liFile liField1 to liStart1
82708>>>>>>>>>    get AttrValue_FIELD DF_FIELD_OFFSET liFile liField2 to liStart2
82709>>>>>>>>>    get AttrValue_FIELD DF_FIELD_NATIVE_LENGTH liFile liField1 to liEnd1 // overload
82710>>>>>>>>>    get AttrValue_FIELD DF_FIELD_NATIVE_LENGTH liFile liField2 to liEnd2 // overload
82711>>>>>>>>>    move (liStart1+liEnd1-1) to liEnd1
82712>>>>>>>>>    move (liStart2+liEnd2-1) to liEnd2
82713>>>>>>>>>    //send obs  (string(liStart1)+"<="+string(liEnd2)+"and"+string(liStart2)+"<="+string(liEnd1)) (liStart1<=liEnd2 and liStart2<=liEnd1)
82713>>>>>>>>>    function_return (liStart1<=liEnd2 and liStart2<=liEnd1)
82714>>>>>>>>>  end_function
82715>>>>>>>>>
82715>>>>>>>>>  function AttrValue_FILE integer liAttr integer liFile returns string
82717>>>>>>>>>    integer liDelegate
82717>>>>>>>>>    string lsRval
82717>>>>>>>>>    if liFile eq (piMainFile(self)) function_return (sAttrValueFile.i(self,liAttr))
82720>>>>>>>>>    get iFdxIsEncapsulated to liDelegate
82721>>>>>>>>>    if liDelegate delegate get AttrValue_FILE liAttr liFile to lsRval
82725>>>>>>>>>    else move "Not available" to lsRval
82727>>>>>>>>>    function_return lsRval
82728>>>>>>>>>  end_function
82729>>>>>>>>>
82729>>>>>>>>>  procedure set AttrValue_FILE integer liAttr integer liFile string lsValue
82731>>>>>>>>>    integer liMonitoredFileAttributesObj
82731>>>>>>>>>    if (liFile=piMainFile(self)) begin
82733>>>>>>>>>      move (oMonitoredFileAttributes(self)) to liMonitoredFileAttributesObj
82734>>>>>>>>>      if (piMonitored.i(liMonitoredFileAttributesObj,liAttr)) begin
82736>>>>>>>>>        get piAttrIndex.i of liMonitoredFileAttributesObj liAttr to liAttr
82737>>>>>>>>>        set value of (oFileAttr(self)) item liAttr to lsValue
82738>>>>>>>>>      end
82738>>>>>>>>>>
82738>>>>>>>>>    end
82738>>>>>>>>>>
82738>>>>>>>>>    else error 666 "Illegal file number"
82740>>>>>>>>>  end_procedure
82741>>>>>>>>>
82741>>>>>>>>>  function AttrValue_FILELIST integer liAttr integer liFile returns string
82743>>>>>>>>>    integer liDelegate
82743>>>>>>>>>    string lsRval
82743>>>>>>>>>    get iFdxIsEncapsulated to liDelegate
82744>>>>>>>>>    if liDelegate delegate get AttrValue_FILELIST liAttr liFile to lsRval
82748>>>>>>>>>    else begin
82749>>>>>>>>>      move t.fdx.attr_not_avail to lsRval
82750>>>>>>>>>      if liAttr eq DF_FILE_ROOT_NAME    move ("FILE"+string(liFile)) to lsRval
82753>>>>>>>>>      if liAttr eq DF_FILE_LOGICAL_NAME move ("DFFILE"+string(liFile)) to lsRval
82756>>>>>>>>>      if liAttr eq DF_FILE_DISPLAY_NAME move ("File"+string(liFile)) to lsRval
82759>>>>>>>>>      move (rtrim(lsRval)) to lsRval
82760>>>>>>>>>    end
82760>>>>>>>>>>
82760>>>>>>>>>    function_return lsRval
82761>>>>>>>>>  end_function
82762>>>>>>>>>
82762>>>>>>>>>  function AttrValue_FIELD integer liAttr integer liFile integer liField returns string
82764>>>>>>>>>    integer liDelegate
82764>>>>>>>>>    string lsRval
82764>>>>>>>>>    if liFile eq (piMainFile(self)) function_return (sAttrValueField.ii(self,liAttr,liField))
82767>>>>>>>>>    get iFdxIsEncapsulated to liDelegate
82768>>>>>>>>>    if liDelegate delegate get AttrValue_FIELD liAttr liFile liField to lsRval
82772>>>>>>>>>    else begin
82773>>>>>>>>>      move "Not available" to lsRval
82774>>>>>>>>>      if liAttr eq DF_FIELD_NAME move ("FIELD"+string(liField)) to lsRval
82777>>>>>>>>>    end
82777>>>>>>>>>>
82777>>>>>>>>>    function_return lsRval
82778>>>>>>>>>  end_function
82779>>>>>>>>>
82779>>>>>>>>>  procedure set AttrValue_FIELD integer liAttr integer liFile integer liField string lsValue
82781>>>>>>>>>    if (liFile=piMainFile(self)) begin
82783>>>>>>>>>      if liAttr eq DF_FIELD_NAME          set psName.i       liField to lsValue
82786>>>>>>>>>      if liAttr eq DF_FIELD_NUMBER        set piNumber.i     liField to lsValue
82789>>>>>>>>>      if liAttr eq DF_FIELD_OLD_NUMBER    set piOldNumber.i  liField to lsValue
82792>>>>>>>>>      if liAttr eq DF_FIELD_TYPE          set piType.i       liField to lsValue
82795>>>>>>>>>      if liAttr eq DF_FIELD_LENGTH        set piLen.i        liField to lsValue
82798>>>>>>>>>      if liAttr eq DF_FIELD_NATIVE_LENGTH set piNative_Len.i liField to lsValue
82801>>>>>>>>>      if liAttr eq DF_FIELD_PRECISION     set piPrec.i       liField to lsValue
82804>>>>>>>>>      if liAttr eq DF_FIELD_RELATED_FILE  set piRfile.i      liField to lsValue
82807>>>>>>>>>      if liAttr eq DF_FIELD_RELATED_FIELD set piRfld.i       liField to lsValue
82810>>>>>>>>>      if liAttr eq DF_FIELD_INDEX         set piIdx.i        liField to lsValue
82813>>>>>>>>>      if liAttr eq DF_FIELD_OFFSET        set piOffset.i     liField to lsValue
82816>>>>>>>>>    end
82816>>>>>>>>>>
82816>>>>>>>>>    else error 666 "Illegal file number"
82818>>>>>>>>>  end_procedure
82819>>>>>>>>>
82819>>>>>>>>>  function AttrValue_INDEX integer liAttr integer liFile integer liIndex returns string
82821>>>>>>>>>    integer liDelegate
82821>>>>>>>>>    string lsRval
82821>>>>>>>>>    if liFile eq (piMainFile(self)) function_return (sAttrValueIndex.ii(self,liAttr,liIndex))
82824>>>>>>>>>    get iFdxIsEncapsulated to liDelegate
82825>>>>>>>>>    if liDelegate delegate get AttrValue_INDEX liAttr liFile liIndex to lsRval
82829>>>>>>>>>    else move "Not available" to lsRval
82831>>>>>>>>>    function_return lsRval
82832>>>>>>>>>  end_function
82833>>>>>>>>>
82833>>>>>>>>>  procedure set AttrValue_INDEX integer liAttr integer liFile integer liIndex string lsValue
82835>>>>>>>>>    integer liObj
82835>>>>>>>>>    if (liFile=piMainFile(self)) begin
82837>>>>>>>>>      move (oIndexAttr(self)) to liObj
82838>>>>>>>>>      if liAttr eq DF_INDEX_NUMBER_SEGMENTS set piSegments.i   of liObj liIndex to lsValue
82841>>>>>>>>>      if liAttr eq DF_INDEX_NUMBER_BUFFERS  set piBuffers.i    of liObj liIndex to lsValue
82844>>>>>>>>>      if liAttr eq DF_INDEX_TYPE            set piType.i       of liObj liIndex to lsValue
82847>>>>>>>>>      if liAttr eq DF_INDEX_LEVELS          set piLevels.i     of liObj liIndex to lsValue
82850>>>>>>>>>      if liAttr eq DF_INDEX_KEY_LENGTH      set piKey_Length.i of liObj liIndex to lsValue
82853>>>>>>>>>    end
82853>>>>>>>>>>
82853>>>>>>>>>    else error 666 "Illegal file number"
82855>>>>>>>>>  end_procedure
82856>>>>>>>>>
82856>>>>>>>>>  function AttrValue_IDXSEG integer liAttr integer liFile integer liIndex integer liSegment returns string
82858>>>>>>>>>    integer liDelegate
82858>>>>>>>>>    string lsRval
82858>>>>>>>>>    if liFile eq (piMainFile(self)) function_return (sAttrValueIndexSegment.iii(self,liAttr,liIndex,liSegment))
82861>>>>>>>>>    get iFdxIsEncapsulated to liDelegate
82862>>>>>>>>>    if liDelegate delegate get AttrValue_IDXSEG liAttr liFile liIndex liSegment to lsRval
82866>>>>>>>>>    else move "Not available" to lsRval
82868>>>>>>>>>    function_return lsRval
82869>>>>>>>>>  end_function
82870>>>>>>>>>
82870>>>>>>>>>  procedure set AttrValue_IDXSEG integer liAttr integer liFile integer liIndex integer liSegment string lsValue
82872>>>>>>>>>    integer liObj
82872>>>>>>>>>    string lsStr
82872>>>>>>>>>    if (liFile=piMainFile(self)) begin
82874>>>>>>>>>      move (oIndexAttr(self)) to liObj
82875>>>>>>>>>      if liAttr eq DF_INDEX_SEGMENT_FIELD     get psFields.i    of liObj liIndex to lsStr
82878>>>>>>>>>      if liAttr eq DF_INDEX_SEGMENT_CASE      get psUppercase.i of liObj liIndex to lsStr
82881>>>>>>>>>      if liAttr eq DF_INDEX_SEGMENT_DIRECTION get psDirection.i of liObj liIndex to lsStr
82884>>>>>>>>>
82884>>>>>>>>>      move (overstrike(pad(trim(lsValue),4),lsStr,liSegment-1*4+1)) to lsStr
82885>>>>>>>>>
82885>>>>>>>>>      if liAttr eq DF_INDEX_SEGMENT_FIELD     set psFields.i    of liObj liIndex to lsStr
82888>>>>>>>>>      if liAttr eq DF_INDEX_SEGMENT_CASE      set psUppercase.i of liObj liIndex to lsStr
82891>>>>>>>>>      if liAttr eq DF_INDEX_SEGMENT_DIRECTION set psDirection.i of liObj liIndex to lsStr
82894>>>>>>>>>    end
82894>>>>>>>>>>
82894>>>>>>>>>    else error 666 "Illegal file number"
82896>>>>>>>>>  end_procedure
82897>>>>>>>>>
82897>>>>>>>>>  function AttrValue_SPECIAL1 integer liAttr integer liFile integer liField1 integer liField2 returns string
82899>>>>>>>>>    integer liDelegate
82899>>>>>>>>>    string lsRval
82899>>>>>>>>>    if liFile eq (piMainFile(self)) function_return (sAttrValueSpecial1.iii(self,liAttr,liField1,liField2))
82902>>>>>>>>>    get iFdxIsEncapsulated to liDelegate
82903>>>>>>>>>    if liDelegate delegate get AttrValue_SPECIAL1 liAttr liFile liField1 liField2 to lsRval
82907>>>>>>>>>    else move "Not available" to lsRval
82909>>>>>>>>>    function_return lsRval
82910>>>>>>>>>  end_function
82911>>>>>>>>>  function sDatPath.i integer liFile returns string
82913>>>>>>>>>    if liFile eq (piMainFile(self)) function_return (psDatPath(self))
82916>>>>>>>>>    function_return ""
82917>>>>>>>>>  end_function
82918>>>>>>>>>  function nTimeStamp.i integer liFile returns number
82920>>>>>>>>>    if liFile eq (piMainFile(self)) function_return (pnTimeStamp(self))
82923>>>>>>>>>    function_return 0
82924>>>>>>>>>  end_function
82925>>>>>>>>>
82925>>>>>>>>>  function psFileName returns string
82927>>>>>>>>>    integer lbDelegate
82927>>>>>>>>>    string lsRval
82927>>>>>>>>>    get iFdxIsEncapsulated to lbDelegate
82928>>>>>>>>>    if lbDelegate delegate get psFileName to lsRval
82932>>>>>>>>>    else move "" to lsRval
82934>>>>>>>>>    function_return lsRval
82935>>>>>>>>>  end_function
82936>>>>>>>>>
82936>>>>>>>>>  function AttrValue_IsEmpty integer liFile returns integer
82938>>>>>>>>>    string lsStr
82938>>>>>>>>>    get psRootName.i liFile to lsStr
82939>>>>>>>>>    function_return (lsStr="")
82940>>>>>>>>>  end_function
82941>>>>>>>>>
82941>>>>>>>>>
82941>>>>>>>>>  function iFdxIsEncapsulated returns integer
82943>>>>>>>>>    integer liRval
82943>>>>>>>>>    delegate get iFdxIsEncapsulated to liRval
82945>>>>>>>>>    function_return liRval
82946>>>>>>>>>  end_function
82947>>>>>>>>>end_class // cFdxFileDef
82948>>>>>>>>>
82948>>>>>>>>>define FDX_FILE_VERSION for "FDX2.0"
82948>>>>>>>>>
82948>>>>>>>>>class cFdx is a cArray
82949>>>>>>>>>  procedure construct_object integer liImage
82951>>>>>>>>>    forward send construct_object liImage
82953>>>>>>>>>    property integer piFileDefClass public U_cFdxFileDef  // Class ID for FileDefObject
82954>>>>>>>>>    property string  psVersion      public FDX_FILE_VERSION
82955>>>>>>>>>    property integer piReadMode     public -1 // All files, open files or custom selection?
82956>>>>>>>>>    property string  psIdTag        public "" // For future use
82957>>>>>>>>>    property number  pnTS_Time      public 0  // Date of snapshot (TS format)
82958>>>>>>>>>    property string  psTitle        public ""
82959>>>>>>>>>    property string  psFileName     public "Un-known"
82960>>>>>>>>>    property integer piDataOrigin   public FDX_EMPTY // 0=empty 1=Read from current 2=Read from file
82961>>>>>>>>>
82961>>>>>>>>>    property integer pbIncludeFDTAGINT public DFFALSE
82962>>>>>>>>>
82962>>>>>>>>>    object oGlobalAttributes is a cArray no_image
82964>>>>>>>>>    end_object
82965>>>>>>>>>    object oOtherAttributes is a cArray no_image
82967>>>>>>>>>    end_object
82968>>>>>>>>>    object oFdxFileRelations is a cFdxFileRelations no_image
82970>>>>>>>>>    end_object
82971>>>>>>>>>    property integer piReadResult   public 0 // Was last Seq_Read operation successful?
82972>>>>>>>>>  end_procedure
82973>>>>>>>>>
82973>>>>>>>>>  function sOriginAsText returns string
82975>>>>>>>>>    if (piDataOrigin(self)) eq FDX_EMPTY function_return "Empty"
82978>>>>>>>>>    if (piDataOrigin(self)) eq FDX_REAL_WORLD function_return "Current"
82981>>>>>>>>>    function_return (SEQ_RemovePathFromFileName(psFileName(self)))
82982>>>>>>>>>  end_function
82983>>>>>>>>>
82983>>>>>>>>>  item_property_list
82983>>>>>>>>>    item_property string  psRootName.i
82983>>>>>>>>>    item_property string  psDFName.i
82983>>>>>>>>>    item_property string  psDisplayName.i
82983>>>>>>>>>    item_property integer piFileDefObject.i
82983>>>>>>>>>    item_property integer piAuxArray.i
82983>>>>>>>>>    item_property integer aux_value
82983>>>>>>>>>  end_item_property_list cFdx
#REM 83027 DEFINE FUNCTION AUX_VALUE INTEGER LIROW RETURNS INTEGER
#REM 83031 DEFINE PROCEDURE SET AUX_VALUE INTEGER LIROW INTEGER VALUE
#REM 83035 DEFINE FUNCTION PIAUXARRAY.I INTEGER LIROW RETURNS INTEGER
#REM 83039 DEFINE PROCEDURE SET PIAUXARRAY.I INTEGER LIROW INTEGER VALUE
#REM 83043 DEFINE FUNCTION PIFILEDEFOBJECT.I INTEGER LIROW RETURNS INTEGER
#REM 83047 DEFINE PROCEDURE SET PIFILEDEFOBJECT.I INTEGER LIROW INTEGER VALUE
#REM 83051 DEFINE FUNCTION PSDISPLAYNAME.I INTEGER LIROW RETURNS STRING
#REM 83055 DEFINE PROCEDURE SET PSDISPLAYNAME.I INTEGER LIROW STRING VALUE
#REM 83059 DEFINE FUNCTION PSDFNAME.I INTEGER LIROW RETURNS STRING
#REM 83063 DEFINE PROCEDURE SET PSDFNAME.I INTEGER LIROW STRING VALUE
#REM 83067 DEFINE FUNCTION PSROOTNAME.I INTEGER LIROW RETURNS STRING
#REM 83071 DEFINE PROCEDURE SET PSROOTNAME.I INTEGER LIROW STRING VALUE
83076>>>>>>>>>
83076>>>>>>>>>  function iCanOpen.i integer liFile returns integer
83078>>>>>>>>>    function_return (piFileDefObject.i(self,liFile))
83079>>>>>>>>>  end_function
83080>>>>>>>>>
83080>>>>>>>>>  procedure AttrType_Callback integer liAttrType integer liMsg integer liObj
83082>>>>>>>>>    integer liMin liMax liSelf liMonAttrObj liAttr
83082>>>>>>>>>    move (oMonitoredGlobalAttributes(self)) to liMonAttrObj
83083>>>>>>>>>    move self to liSelf
83084>>>>>>>>>    if liAttrType eq ATTRTYPE_GLOBAL begin
83086>>>>>>>>>      get piLowIndex of liMonAttrObj to liMin
83087>>>>>>>>>      get piHighIndex of liMonAttrObj to liMax
83088>>>>>>>>>      for liAttr from liMin to liMax
83094>>>>>>>>>>
83094>>>>>>>>>        if (piMonitored.i(liMonAttrObj,liAttr)) send liMsg to liObj liSelf liAttr
83097>>>>>>>>>      loop
83098>>>>>>>>>>
83098>>>>>>>>>    end
83098>>>>>>>>>>
83098>>>>>>>>>  end_procedure
83099>>>>>>>>>
83099>>>>>>>>>  procedure Wait_SetText string lsStr
83101>>>>>>>>>  end_procedure
83102>>>>>>>>>  procedure Wait_SetText2 string lsStr
83104>>>>>>>>>  end_procedure
83105>>>>>>>>>
83105>>>>>>>>>  procedure Reset
83107>>>>>>>>>    integer liMax liRow liObj
83107>>>>>>>>>    get row_count to liMax
83108>>>>>>>>>    for liRow from 0 to (liMax-1)
83114>>>>>>>>>>
83114>>>>>>>>>      get piFileDefObject.i liRow to liObj
83115>>>>>>>>>      if liObj send request_destroy_object to liObj
83118>>>>>>>>>      get piAuxArray.i liRow to liObj
83119>>>>>>>>>      if liObj send request_destroy_object to liObj
83122>>>>>>>>>    loop
83123>>>>>>>>>>
83123>>>>>>>>>    send delete_data
83124>>>>>>>>>    send delete_data to (oGlobalAttributes(self))
83125>>>>>>>>>    send delete_data to (oOtherAttributes(self))
83126>>>>>>>>>    send reset to (oFdxFileRelations(self))
83127>>>>>>>>>    set piDataOrigin to FDX_EMPTY
83128>>>>>>>>>    set psTitle    to ""
83129>>>>>>>>>    set psFileName to ""
83130>>>>>>>>>  end_procedure
83131>>>>>>>>>
83131>>>>>>>>>  procedure Callback_RelationsToField integer liMsg integer liObj integer liSelectType integer liSelectToFile integer liSelectToField
83133>>>>>>>>>    send aux_callback.iiiii to (oFdxFileRelations(self)) liMsg liObj liSelectType liSelectToFile liSelectToField
83134>>>>>>>>>  end_procedure
83135>>>>>>>>>  procedure Callback_Relations integer liMsg integer liObj integer liSelectType integer liSelectFrom integer liSelectTo
83137>>>>>>>>>    send callback.iiiii to (oFdxFileRelations(self)) liMsg liObj liSelectType liSelectFrom liSelectTo
83138>>>>>>>>>  end_procedure
83139>>>>>>>>>  function sChildFiles.i integer liFile returns string
83141>>>>>>>>>    function_return (sChildFiles.i(oFdxFileRelations(self),liFile))
83142>>>>>>>>>  end_function
83143>>>>>>>>>  function sParentFiles.i integer liFile returns string
83145>>>>>>>>>    function_return (sParentFiles.i(oFdxFileRelations(self),liFile))
83146>>>>>>>>>  end_function
83147>>>>>>>>>
83147>>>>>>>>>  function iCreate_FileDef_Object returns integer
83149>>>>>>>>>    integer liRval liCurrentObject liClass
83149>>>>>>>>>    get piFileDefClass to liClass
83150>>>>>>>>>    if liClass begin
83152>>>>>>>>>      name liClass U_aps_class
83152>>>>>>>>>      move self to liCurrentObject
83153>>>>>>>>>      object dynamo_object is a aps_class
83155>>>>>>>>>        move self to liRval
83156>>>>>>>>>      end_object
83157>>>>>>>>>      move liCurrentObject to self
83158>>>>>>>>>    end
83158>>>>>>>>>>
83158>>>>>>>>>    else move 0 to liRval
83160>>>>>>>>>    function_return liRval
83161>>>>>>>>>  end_function
83162>>>>>>>>>
83162>>>>>>>>>  procedure OnFileAdded integer liFile
83164>>>>>>>>>    send Wait_SetText2 (psDisplayName.i(self,liFile))
83165>>>>>>>>>  end_procedure
83166>>>>>>>>>
83166>>>>>>>>>  procedure Read_Global_Attributes
83168>>>>>>>>>    integer liGlobalAttributesObj liAttr liMin liMax liMonGlAttrObj
83168>>>>>>>>>    move (oMonitoredGlobalAttributes(self)) to liMonGlAttrObj
83169>>>>>>>>>    move (oGlobalAttributes(self)) to liGlobalAttributesObj
83170>>>>>>>>>    get piLowIndex  of liMonGlAttrObj to liMin
83171>>>>>>>>>    get piHighIndex of liMonGlAttrObj to liMax
83172>>>>>>>>>    for liAttr from liMin to liMax
83178>>>>>>>>>>
83178>>>>>>>>>      if (piMonitored.i(liMonGlAttrObj,liAttr)) set value of liGlobalAttributesObj item (piAttrIndex.i(liMonGlAttrObj,liAttr)) to (API_AttrValue_GLOBAL(liAttr))
83181>>>>>>>>>    loop
83182>>>>>>>>>>
83182>>>>>>>>>  end_procedure
83183>>>>>>>>>  procedure Read_Other_Attributes
83185>>>>>>>>>    integer liAttr liMax liOtherAttributesObj
83185>>>>>>>>>    move (oOtherAttributes(self)) to liOtherAttributesObj
83186>>>>>>>>>    for liAttr from 0 to (OA_MAX-1) // OA_MAX is a constant (API_ATTR.UTL)
83192>>>>>>>>>>
83192>>>>>>>>>      set value of liOtherAttributesObj item liAttr to (API_OtherAttr_Value(liAttr))
83193>>>>>>>>>    loop
83194>>>>>>>>>>
83194>>>>>>>>>  end_procedure
83195>>>>>>>>>  procedure Read_Driver_Information // We currently don't do drivers
83197>>>>>>>>>  end_procedure
83198>>>>>>>>>
83198>>>>>>>>>  procedure Read_File_Definition integer liFile
83200>>>>>>>>>    integer liOpen liWasOpen liObj
83200>>>>>>>>>    set psRootName.i    liFile to (DBMS_Rootname(liFile))
83201>>>>>>>>>    set psDFName.i      liFile to (DBMS_DFName(liFile))
83202>>>>>>>>>    set psDisplayName.i liFile to (DBMS_DisplayName(liFile))
83203>>>>>>>>>    get_attribute DF_FILE_OPENED of liFile to liWasOpen
83206>>>>>>>>>    ifnot liWasOpen move (DBMS_OpenFile(liFile,DF_SHARE,0)) to liOpen
83209>>>>>>>>>    else move 1 to liOpen
83211>>>>>>>>>    if liOpen begin
83213>>>>>>>>>      get iCreate_FileDef_Object to liObj
83214>>>>>>>>>      send Read_File_Definition.i to liObj liFile
83215>>>>>>>>>      set piFileDefObject.i liFile to liObj
83216>>>>>>>>>    end
83216>>>>>>>>>>
83216>>>>>>>>>    send OnFileAdded liFile
83217>>>>>>>>>    if (liOpen and not(liWasOpen)) close liFile
83220>>>>>>>>>  end_procedure
83221>>>>>>>>>
83221>>>>>>>>>  //> This is used for rereading a definition after
83221>>>>>>>>>  //> it has been restructured
83221>>>>>>>>>  procedure Read_File_Definition_Again integer liFile
83223>>>>>>>>>    integer liObj
83223>>>>>>>>>    get piFileDefObject.i liFile to liObj
83224>>>>>>>>>    if liObj begin
83226>>>>>>>>>      send request_destroy_object to liObj
83227>>>>>>>>>      set piFileDefObject.i liFile to 0
83228>>>>>>>>>    end
83228>>>>>>>>>>
83228>>>>>>>>>    send Read_File_Definition liFile
83229>>>>>>>>>  end_procedure
83230>>>>>>>>>
83230>>>>>>>>>  procedure Read_File_RootName_Again string lsRootName
83232>>>>>>>>>    integer liFile
83232>>>>>>>>>    move (uppercase(lsRootName)) to lsRootName
83233>>>>>>>>>    move 0 to liFile
83234>>>>>>>>>    repeat
83234>>>>>>>>>>
83234>>>>>>>>>      get_attribute DF_FILE_NEXT_USED of liFile to liFile
83237>>>>>>>>>      if liFile begin
83239>>>>>>>>>        if lsRootName eq (uppercase(API_AttrValue_FILELIST(DF_FILE_ROOT_NAME,liFile))) send Read_File_Definition_Again liFile
83242>>>>>>>>>      end
83242>>>>>>>>>>
83242>>>>>>>>>    until liFile eq 0
83244>>>>>>>>>  end_procedure
83245>>>>>>>>>
83245>>>>>>>>>  procedure Read_Current_Filelist integer liReadMode // FDX_ALL_OPEN FDX_ALL_FILES FDX_FROM_SET
83247>>>>>>>>>    integer liFile
83247>>>>>>>>>    send Wait_SetText "Reading current table definitions"
83248>>>>>>>>>    send Reset
83249>>>>>>>>>    set psVersion  to FDX_FILE_VERSION
83250>>>>>>>>>    set piReadMode to liReadMode
83251>>>>>>>>>    set psIdTag    to "Un-tagged"
83252>>>>>>>>>    set pnTS_Time  to (TS_SysTime())
83253>>>>>>>>>    set psTitle    to ""
83254>>>>>>>>>    send Read_Global_Attributes
83255>>>>>>>>>    send Read_Other_Attributes
83256>>>>>>>>>    if liReadMode eq FDX_ALL_OPEN begin
83258>>>>>>>>>      move 0 to liFile
83259>>>>>>>>>      repeat
83259>>>>>>>>>>
83259>>>>>>>>>        get_attribute DF_FILE_NEXT_OPENED of liFile to liFile
83262>>>>>>>>>        if liFile send Read_File_Definition liFile
83265>>>>>>>>>      until liFile eq 0
83267>>>>>>>>>    end
83267>>>>>>>>>>
83267>>>>>>>>>    if liReadMode eq FDX_ALL_FILES begin
83269>>>>>>>>>      move 0 to liFile
83270>>>>>>>>>      repeat
83270>>>>>>>>>>
83270>>>>>>>>>        get_attribute DF_FILE_NEXT_USED of liFile to liFile
83273>>>>>>>>>        if liFile send Read_File_Definition liFile
83276>>>>>>>>>      until liFile eq 0
83278>>>>>>>>>    end
83278>>>>>>>>>>
83278>>>>>>>>>    send Read_Driver_Information // We wait until here because at this point drivers have been loaded in order to open the files that were included
83279>>>>>>>>>    set piDataOrigin to FDX_REAL_WORLD
83280>>>>>>>>>  end_procedure
83281>>>>>>>>>
83281>>>>>>>>>  // *************************************************************************
83281>>>>>>>>>  // *** Sequential read/write methods ***************************************
83281>>>>>>>>>  procedure OnFileRead integer liChannel integer liFile
83283>>>>>>>>>  end_procedure
83284>>>>>>>>>  procedure OnFileWrite integer liChannel integer liFile
83286>>>>>>>>>  end_procedure
83287>>>>>>>>>
83287>>>>>>>>>  procedure Seq_Read_AuxArray integer liChannel integer liFile
83289>>>>>>>>>    integer liDo liObj
83289>>>>>>>>>    readln channel liChannel liDo
83291>>>>>>>>>    if liDo begin
83293>>>>>>>>>      object oArray is a cArray
83295>>>>>>>>>        move self to liObj
83296>>>>>>>>>      end_object
83297>>>>>>>>>      send SEQ_ReadArrayItems liChannel liObj
83298>>>>>>>>>      set piAuxArray.i liFile to liObj
83299>>>>>>>>>    end
83299>>>>>>>>>>
83299>>>>>>>>>  end_procedure
83300>>>>>>>>>
83300>>>>>>>>>  procedure Seq_Read_FileDefObject integer liChannel integer liFile
83302>>>>>>>>>    integer liDo liObj
83302>>>>>>>>>    readln channel liChannel liDo
83304>>>>>>>>>    if liDo begin
83306>>>>>>>>>      get iCreate_FileDef_Object to liObj
83307>>>>>>>>>      if liObj begin
83309>>>>>>>>>        send Seq_Read to liObj liChannel liFile
83310>>>>>>>>>        set piFileDefObject.i liFile to liObj
83311>>>>>>>>>      end
83311>>>>>>>>>>
83311>>>>>>>>>      else error 666 "File definition class has not been specified in cFDX_Container object"
83313>>>>>>>>>    end
83313>>>>>>>>>>
83313>>>>>>>>>  end_procedure
83314>>>>>>>>>
83314>>>>>>>>>  procedure Seq_Read integer liChannel
83316>>>>>>>>>    integer liSeqEof liFile
83316>>>>>>>>>    string lsDisplayName lsDFName lsRootName lsTemp
83316>>>>>>>>>    send Wait_SetText "Importing table definitions"
83317>>>>>>>>>    send Wait_SetText2 ""
83318>>>>>>>>>    move (SEQ_ReadLn(liChannel)) to lsTemp
83319>>>>>>>>>    set piReadResult to 0
83320>>>>>>>>>    if lsTemp eq (psVersion(self)) begin
83322>>>>>>>>>      send reset
83323>>>>>>>>>      set piReadMode to (SEQ_ReadLn(liChannel))
83324>>>>>>>>>      set psIdTag    to (SEQ_ReadLn(liChannel))
83325>>>>>>>>>      set pnTS_Time  to (SEQ_ReadLn(liChannel))
83326>>>>>>>>>      set psTitle    to (SEQ_ReadLn(liChannel))
83327>>>>>>>>>      send SEQ_ReadArrayItems liChannel (oGlobalAttributes(self))
83328>>>>>>>>>      send SEQ_ReadArrayItems liChannel (oOtherAttributes(self))
83329>>>>>>>>>      move 0 to liSeqEof
83330>>>>>>>>>      repeat
83330>>>>>>>>>>
83330>>>>>>>>>        readln channel liChannel lsTemp
83332>>>>>>>>>        if lsTemp eq "END.OF.FILELIST.CFG" move 1 to liSeqEof
83335>>>>>>>>>        else begin
83336>>>>>>>>>          move lsTemp to liFile
83337>>>>>>>>>          readln lsRootName
83338>>>>>>>>>          readln lsDFName
83339>>>>>>>>>          readln lsDisplayName
83340>>>>>>>>>        end
83340>>>>>>>>>>
83340>>>>>>>>>        if (seqeof) move 1 to liSeqEof
83343>>>>>>>>>        ifnot liSeqEof begin
83345>>>>>>>>>          set psRootName.i    liFile to lsRootName
83346>>>>>>>>>          set psDFName.i      liFile to lsDFName
83347>>>>>>>>>          set psDisplayName.i liFile to lsDisplayName
83348>>>>>>>>>          send Seq_Read_AuxArray liChannel liFile
83349>>>>>>>>>          send Seq_Read_FileDefObject liChannel liFile
83350>>>>>>>>>          send OnFileRead liChannel liFile
83351>>>>>>>>>          send OnFileAdded liFile
83352>>>>>>>>>        end
83352>>>>>>>>>>
83352>>>>>>>>>      until liSeqEof
83354>>>>>>>>>      set piDataOrigin to FDX_READ_FROM_FILE
83355>>>>>>>>>      set piReadResult to 1
83356>>>>>>>>>    end
83356>>>>>>>>>>
83356>>>>>>>>>    else error 736 "Incompatible FDX file!"
83358>>>>>>>>>//    else send obs "Incompatible FDX file!" "Reading abandoned." ("Version in file: "+lsTemp) ("This program reads only: "+psVersion(self))
83358>>>>>>>>>  end_procedure
83359>>>>>>>>>
83359>>>>>>>>>  procedure Seq_Write_AuxArray integer liChannel integer liFile
83361>>>>>>>>>    integer liObj
83361>>>>>>>>>    get piAuxArray.i liFile to liObj
83362>>>>>>>>>    if liObj begin
83364>>>>>>>>>      writeln channel liChannel 1
83367>>>>>>>>>      send SEQ_WriteArrayItems liChannel liObj
83368>>>>>>>>>    end
83368>>>>>>>>>>
83368>>>>>>>>>    else writeln channel liChannel 0
83372>>>>>>>>>  end_procedure
83373>>>>>>>>>
83373>>>>>>>>>  procedure Seq_Write_FileDefObject integer liChannel integer liFile
83375>>>>>>>>>    integer liObj
83375>>>>>>>>>    get piFileDefObject.i liFile to liObj
83376>>>>>>>>>    if liObj begin
83378>>>>>>>>>      writeln channel liChannel 1
83381>>>>>>>>>      send Seq_Write to liObj liChannel liFile
83382>>>>>>>>>    end
83382>>>>>>>>>>
83382>>>>>>>>>    else writeln channel liChannel 0
83386>>>>>>>>>  end_procedure
83387>>>>>>>>>
83387>>>>>>>>>  procedure Seq_Write integer liChannel
83389>>>>>>>>>    integer liFile liMax
83389>>>>>>>>>    string lsRootName
83389>>>>>>>>>    writeln channel liChannel (psVersion(self))
83392>>>>>>>>>    writeln (piReadMode(self))
83394>>>>>>>>>    writeln (psIdTag(self))
83396>>>>>>>>>    writeln (pnTS_Time(self))
83398>>>>>>>>>    writeln (psTitle(self))
83400>>>>>>>>>    send SEQ_WriteArrayItems liChannel (oGlobalAttributes(self))
83401>>>>>>>>>    send SEQ_WriteArrayItems liChannel (oOtherAttributes(self))
83402>>>>>>>>>    get row_count to liMax
83403>>>>>>>>>    for liFile from 1 to (liMax-1)
83409>>>>>>>>>>
83409>>>>>>>>>      move (psRootName.i(self,liFile)) to lsRootName
83410>>>>>>>>>      if lsRootName ne "" begin
83412>>>>>>>>>        writeln channel liChannel (string(liFile))
83415>>>>>>>>>        writeln (psRootName.i(self,liFile))
83417>>>>>>>>>        writeln (psDFName.i(self,liFile))
83419>>>>>>>>>        writeln (psDisplayName.i(self,liFile))
83421>>>>>>>>>        send Seq_Write_AuxArray liChannel liFile
83422>>>>>>>>>        send Seq_Write_FileDefObject liChannel liFile
83423>>>>>>>>>        send OnFileWrite liChannel liFile
83424>>>>>>>>>      end
83424>>>>>>>>>>
83424>>>>>>>>>    loop
83425>>>>>>>>>>
83425>>>>>>>>>    writeln channel liChannel "END.OF.FILELIST.CFG"
83428>>>>>>>>>  end_procedure
83429>>>>>>>>>
83429>>>>>>>>>  // *************************************************************************
83429>>>>>>>>>  // *** Call back methods ***************************************************
83429>>>>>>>>>
83429>>>>>>>>>  //
83429>>>>>>>>>  //  Procedure called back should be defined like this
83429>>>>>>>>>  //    procedure HandleTable integer liFile string lsRoot string lsDFName string lsUserName
83429>>>>>>>>>  //
83429>>>>>>>>>
83429>>>>>>>>>  //> Call back for every entry with a rootname
83429>>>>>>>>>  procedure Callback.ii integer liMsg integer liObj
83431>>>>>>>>>    integer liFile liMax
83431>>>>>>>>>    string lsRootName
83431>>>>>>>>>    get row_count to liMax
83432>>>>>>>>>    for liFile from 1 to (liMax-1)
83438>>>>>>>>>>
83438>>>>>>>>>      move (psRootName.i(self,liFile)) to lsRootName
83439>>>>>>>>>      if lsRootName ne "" send liMsg to liObj liFile lsRootName (psDFName.i(self,liFile)) (psDisplayName.i(self,liFile)) (aux_value(self,liFile))
83442>>>>>>>>>    loop
83443>>>>>>>>>>
83443>>>>>>>>>  end_procedure
83444>>>>>>>>>  //> Call back for one specified file
83444>>>>>>>>>  procedure Callback_File.iii integer liFile integer liMsg integer liObj
83446>>>>>>>>>    send liMsg to liObj liFile (psRootName.i(self,liFile)) (psDFName.i(self,liFile)) (psDisplayName.i(self,liFile)) (aux_value(self,liFile))
83447>>>>>>>>>  end_procedure
83448>>>>>>>>>  //> Call a function for one specified file
83448>>>>>>>>>  function iCallback_File.iii integer liFile integer liGet integer liObj returns integer
83450>>>>>>>>>    integer liRval
83450>>>>>>>>>    get liGet of liObj liFile (psRootName.i(self,liFile)) (psDFName.i(self,liFile)) (psDisplayName.i(self,liFile)) (aux_value(self,liFile)) to liRval
83451>>>>>>>>>    function_return liRval
83452>>>>>>>>>  end_function
83453>>>>>>>>>
83453>>>>>>>>>  // *************************************************************************
83453>>>>>>>>>  // *** Attribute value access **********************************************
83453>>>>>>>>>  function AttrValue_GLOBAL integer liAttr returns string
83455>>>>>>>>>    integer liMonitoredGlobalAttributesObj
83455>>>>>>>>>    move (oMonitoredGlobalAttributes(self)) to liMonitoredGlobalAttributesObj
83456>>>>>>>>>    if (piMonitored.i(liMonitoredGlobalAttributesObj,liAttr)) begin
83458>>>>>>>>>      get piAttrIndex.i of liMonitoredGlobalAttributesObj liAttr to liAttr
83459>>>>>>>>>      function_return (value(oGlobalAttributes(self),liAttr))
83460>>>>>>>>>    end
83460>>>>>>>>>>
83460>>>>>>>>>    function_return t.fdx.attr_not_avail
83461>>>>>>>>>  end_function
83462>>>>>>>>>  function AttrValue_FILELIST integer liAttr integer liFile returns string
83464>>>>>>>>>    string lsStr
83464>>>>>>>>>    move "" to lsStr
83465>>>>>>>>>    if liAttr eq DF_FILE_ROOT_NAME    move (psRootName.i(self,liFile)) to lsStr
83468>>>>>>>>>    if liAttr eq DF_FILE_LOGICAL_NAME move (psDFName.i(self,liFile)) to lsStr
83471>>>>>>>>>    if liAttr eq DF_FILE_DISPLAY_NAME move (psDisplayName.i(self,liFile)) to lsStr
83474>>>>>>>>>    move (rtrim(lsStr)) to lsStr
83475>>>>>>>>>    if lsStr ne "" function_return lsStr
83478>>>>>>>>>    if liAttr eq DF_FILE_ROOT_NAME    function_return ("FILE"+string(liFile))
83481>>>>>>>>>    if liAttr eq DF_FILE_LOGICAL_NAME function_return ("DFFILE"+string(liFile))
83484>>>>>>>>>    if liAttr eq DF_FILE_DISPLAY_NAME function_return ("File"+string(liFile))
83487>>>>>>>>>    function_return t.fdx.attr_not_avail
83488>>>>>>>>>  end_function
83489>>>>>>>>>  function AttrValue_IsEmpty integer liFile returns integer
83491>>>>>>>>>    string lsStr
83491>>>>>>>>>    get psRootName.i liFile to lsStr
83492>>>>>>>>>    function_return (lsStr="")
83493>>>>>>>>>  end_function
83494>>>>>>>>>  function AttrValue_FILE integer liAttr integer liFile returns string
83496>>>>>>>>>    integer liObj
83496>>>>>>>>>    get piFileDefObject.i liFile to liObj
83497>>>>>>>>>    if liObj function_return (sAttrValueFile.i(liObj,liAttr))
83500>>>>>>>>>    function_return t.fdx.attr_not_avail
83501>>>>>>>>>  end_function
83502>>>>>>>>>  function AttrValue_FIELD integer liAttr integer liFile integer liField returns string
83504>>>>>>>>>    integer liObj
83504>>>>>>>>>    get piFileDefObject.i liFile to liObj
83505>>>>>>>>>    if liObj function_return (sAttrValueField.ii(liObj,liAttr,liField))
83508>>>>>>>>>    if liAttr eq DF_FIELD_NAME function_return ("FIELD"+string(liField))
83511>>>>>>>>>    function_return t.fdx.attr_not_avail
83512>>>>>>>>>  end_function
83513>>>>>>>>>  function AttrValue_INDEX integer liAttr integer liFile integer liIndex returns string
83515>>>>>>>>>    integer liObj
83515>>>>>>>>>    get piFileDefObject.i liFile to liObj
83516>>>>>>>>>    if liObj function_return (sAttrValueIndex.ii(liObj,liAttr,liIndex))
83519>>>>>>>>>    function_return t.fdx.attr_not_avail
83520>>>>>>>>>  end_function
83521>>>>>>>>>  function AttrValue_IDXSEG integer liAttr integer liFile integer liIndex integer liSegment returns string
83523>>>>>>>>>    integer liObj
83523>>>>>>>>>    get piFileDefObject.i liFile to liObj
83524>>>>>>>>>    if liObj function_return (sAttrValueIndexSegment.iii(liObj,liAttr,liIndex,liSegment))
83527>>>>>>>>>    function_return t.fdx.attr_not_avail
83528>>>>>>>>>  end_function
83529>>>>>>>>>  function AttrValue_SPECIAL1 integer liAttr integer liFile integer liField1 integer liField2 returns string
83531>>>>>>>>>    integer liObj
83531>>>>>>>>>    get piFileDefObject.i liFile to liObj
83532>>>>>>>>>    if liObj function_return (sAttrValueSpecial1.iii(liObj,liAttr,liField1,liField2))
83535>>>>>>>>>    function_return t.fdx.attr_not_avail
83536>>>>>>>>>  end_function
83537>>>>>>>>>  function sDatPath.i integer liFile returns string
83539>>>>>>>>>    integer liObj
83539>>>>>>>>>    get piFileDefObject.i liFile to liObj
83540>>>>>>>>>    if liObj function_return (psDatPath(liObj))
83543>>>>>>>>>    function_return ""
83544>>>>>>>>>  end_function
83545>>>>>>>>>  function nTimeStamp.i integer liFile returns number
83547>>>>>>>>>    integer liObj
83547>>>>>>>>>    get piFileDefObject.i liFile to liObj
83548>>>>>>>>>    if liObj function_return (pnTimeStamp(liObj))
83551>>>>>>>>>    function_return 0
83552>>>>>>>>>  end_function
83553>>>>>>>>>  function AttrValue_FLSTNAV integer liAttr integer liFile returns string
83555>>>>>>>>>    if liAttr eq DF_FILE_NEXT_OPENED function_return t.fdx.attr_not_avail
83558>>>>>>>>>    if liAttr eq DF_FILE_NEXT_USED begin
83560>>>>>>>>>      repeat
83560>>>>>>>>>>
83560>>>>>>>>>        increment liFile
83561>>>>>>>>>        if (psRootName.i(self,liFile)) ne "" function_return liFile
83564>>>>>>>>>      until (liFile>FILELIST_MAX_ENTRY)
83566>>>>>>>>>      function_return 0
83567>>>>>>>>>    end
83567>>>>>>>>>>
83567>>>>>>>>>    if liAttr eq DF_FILE_NEXT_EMPTY begin
83569>>>>>>>>>      repeat
83569>>>>>>>>>>
83569>>>>>>>>>        increment liFile
83570>>>>>>>>>        if (psRootName.i(self,liFile)) eq "" function_return liFile
83573>>>>>>>>>      until (liFile>FILELIST_MAX_ENTRY)
83575>>>>>>>>>      function_return 0
83576>>>>>>>>>    end
83576>>>>>>>>>>
83576>>>>>>>>>  end_function
83577>>>>>>>>>  function AttrValue_DRIVER integer liAttr integer liDriver returns string
83579>>>>>>>>>    function_return t.fdx.attr_not_avail
83580>>>>>>>>>  end_function
83581>>>>>>>>>  function AttrValue_DRVSRV integer liAttr integer liDriver integer liServer returns string
83583>>>>>>>>>    function_return t.fdx.attr_not_avail
83584>>>>>>>>>  end_function
83585>>>>>>>>>  function OtherAttr_Value integer liAttr returns string
83587>>>>>>>>>    function_return (value(oOtherAttributes(self),liAttr))
83588>>>>>>>>>  end_function
83589>>>>>>>>>
83589>>>>>>>>>  function iNextFileThatCanOpen integer liFile returns integer
83591>>>>>>>>>    repeat
83591>>>>>>>>>>
83591>>>>>>>>>      move (AttrValue_FLSTNAV(self,DF_FILE_NEXT_USED,liFile)) to liFile
83592>>>>>>>>>      if liFile if (iCanOpen.i(self,liFile)) function_return liFile
83597>>>>>>>>>    until (not(liFile))
83599>>>>>>>>>    //function_return 0
83599>>>>>>>>>  end_function
83600>>>>>>>>>
83600>>>>>>>>>  //> Function iFindRootName.sii goes through the table definitions and looks
83600>>>>>>>>>  //> for an entry with root name as specified in the lsRootName parameter. The
83600>>>>>>>>>  //> search is not case sensitive.
83600>>>>>>>>>  //>   Parameter root_of_root# is a boolean. If TRUE path and driver
83600>>>>>>>>>  //> information is stripped from the root name before the comparison is
83600>>>>>>>>>  //> made.
83600>>>>>>>>>  //>   The search starts at entry liFile+1
83600>>>>>>>>>  function iFindRootName.sii string lsRootName integer liFile integer liRootOfRoot returns integer
83602>>>>>>>>>    string lsTestRoot
83602>>>>>>>>>    move (uppercase(lsRootName)) to lsRootName
83603>>>>>>>>>//    increment liFile
83603>>>>>>>>>    if liRootOfRoot get DBMS_StripPathAndDriver lsRootName to lsRootName
83606>>>>>>>>>    repeat
83606>>>>>>>>>>
83606>>>>>>>>>      get AttrValue_FLSTNAV DF_FILE_NEXT_USED liFile to liFile
83607>>>>>>>>>      if liFile begin
83609>>>>>>>>>        get AttrValue_FILELIST DF_FILE_ROOT_NAME liFile to lsTestRoot
83610>>>>>>>>>        move (uppercase(lsTestRoot)) to lsTestRoot
83611>>>>>>>>>        if liRootOfRoot get DBMS_StripPathAndDriver lsTestRoot to lsTestRoot
83614>>>>>>>>>        if lsTestRoot eq lsRootName function_return liFile
83617>>>>>>>>>      end
83617>>>>>>>>>>
83617>>>>>>>>>    until (not(liFile))
83619>>>>>>>>>    //function_return 0
83619>>>>>>>>>  end_function
83620>>>>>>>>>
83620>>>>>>>>>  //> Function iFindLogicalName.s goes through the table definitions and looks
83620>>>>>>>>>  //> for an entry with loagical name as specified in the ln# parameter. The
83620>>>>>>>>>  //> search is not case sensitive.
83620>>>>>>>>>  function iFindLogicalName.si string lsLogicalName integer liFile returns integer
83622>>>>>>>>>    string lsTestLogicalName
83622>>>>>>>>>    move (uppercase(lsLogicalName)) to lsLogicalName
83623>>>>>>>>>    repeat
83623>>>>>>>>>>
83623>>>>>>>>>      get AttrValue_FLSTNAV DF_FILE_NEXT_USED liFile to liFile
83624>>>>>>>>>      if liFile begin
83626>>>>>>>>>        get AttrValue_FILELIST DF_FILE_LOGICAL_NAME liFile to lsTestLogicalName
83627>>>>>>>>>        move (uppercase(lsTestLogicalName)) to lsTestLogicalName
83628>>>>>>>>>        if lsTestLogicalName eq lsLogicalName function_return liFile
83631>>>>>>>>>      end
83631>>>>>>>>>>
83631>>>>>>>>>    until (not(liFile))
83633>>>>>>>>>    //function_return 0
83633>>>>>>>>>  end_function
83634>>>>>>>>>
83634>>>>>>>>>  //> This function returns a list of files with identical rootname
83634>>>>>>>>>  //> to that of the liFile passed. The list of files will exclude
83634>>>>>>>>>  //> the passed file itself.
83634>>>>>>>>>  function sAliasFiles.i integer liFile returns string
83636>>>>>>>>>    integer liExcludeFile
83636>>>>>>>>>    string lsRval lsRootName
83636>>>>>>>>>    move "" to lsRval
83637>>>>>>>>>    get AttrValue_FILELIST DF_FILE_ROOT_NAME liFile to lsRootName
83638>>>>>>>>>    move liFile to liExcludeFile
83639>>>>>>>>>    move 0 to liFile
83640>>>>>>>>>    repeat
83640>>>>>>>>>>
83640>>>>>>>>>      get iFindRootName.sii lsRootName liFile 0 to liFile
83641>>>>>>>>>      if (liFile<>0 and liFile<>liExcludeFile) move (AddIntegerToString(lsRval,liFile)) to lsRval
83644>>>>>>>>>    until liFile eq 0
83646>>>>>>>>>    function_return lsRval
83647>>>>>>>>>  end_function
83648>>>>>>>>>end_class // cFDX
83649>>>>>>>>>
83649>>>>>>>>>function iFdxIsEncapsulated for Desktop returns integer
83651>>>>>>>>>  function_return DFFALSE
83652>>>>>>>>>end_function
83653>>>>>>>>>
83653>>>>>>>>>function iFdxIsEncapsulated for cFdx returns integer
83655>>>>>>>>>  function_return DFTRUE
83656>>>>>>>>>end_function
83657>>>>>>>>>
83657>>>>>>>>>function NewFdxObject global integer liTable returns integer
83659>>>>>>>>>  integer lhObj
83659>>>>>>>>>  object oFdxObject is a cFdxFileDef
83661>>>>>>>>>    move self to lhObj
83662>>>>>>>>>    if liTable send Read_File_Definition.i liTable
83665>>>>>>>>>  end_object
83666>>>>>>>>>  function_return lhObj
83667>>>>>>>>>end_function
83668>>>>>>>
83668>>>>>>> define t.FDX.Btn.SelectOpen   for "Auto select"
83668>>>>>>> define t.FDX.Btn.SelectAll    for "Select all"
83668>>>>>>> define t.FDX.Btn.SelectNone   for "Clear selection"
83668>>>>>>> define t.FDX.Btn.SelectInvert for "Invert selection"
83668>>>>>>> define t.FDX.Btn.SelectPhys   for "Select master"
83668>>>>>>> define t.FDX.Btn.SelectParent for "Select parent"
83668>>>>>>> define t.FDX.Btn.SelectChild  for "Select children"
83668>>>>>>> define t.FDX.UserName         for "User name"
83668>>>>>>> define t.FDX.DFname           for "Logical name"
83668>>>>>>> define t.FDX.RootName         for "File name"
83668>>>>>>> define t.FDX.Selected         for "Selected:"
83668>>>>>>>
83668>>>>>>>enumeration_list
83668>>>>>>>  define BAD_ENTRIES_NO_CHECK  // This one also defers check for DB-Driver
83668>>>>>>>  define BAD_ENTRIES_SHADOW
83668>>>>>>>  define BAD_ENTRIES_EXCLUDE
83668>>>>>>>end_enumeration_list
83668>>>>>>>
83668>>>>>>>class cFdxFileMultiSelector is a aps.Grid
83669>>>>>>>  procedure DoHeaderLabels integer by#
83671>>>>>>>    set header_label item 1 to "#"
83672>>>>>>>    set header_label item 2 to t.FDX.UserName
83673>>>>>>>    set header_label item 3 to t.FDX.DFname
83674>>>>>>>    set header_label item 4 to t.FDX.RootName
83675>>>>>>>    set header_label item by# to ("*"+header_label(self,by#)+"*")
83676>>>>>>>  end_procedure
83677>>>>>>>  procedure construct_object
83679>>>>>>>    forward send construct_object
83681>>>>>>>    set line_width to 5 0
83682>>>>>>>    on_key key_ctrl+key_a send select_all_not_bad
83683>>>>>>>    set form_margin item 0 to  2
83684>>>>>>>    set form_margin item 1 to  3
83685>>>>>>>    set form_margin item 2 to 30
83686>>>>>>>    set form_margin item 3 to 15
83687>>>>>>>    set form_margin item 4 to 15
83688>>>>>>>    set highlight_row_state to true
83689>>>>>>>    set CurrentCellColor     to clHighlight
83690>>>>>>>    set CurrentCellTextColor to clHighlightText
83691>>>>>>>    set CurrentRowColor      to clHighlight
83692>>>>>>>    set CurrentRowTextColor  to clHighlightText
83693>>>>>>>//   set highlight_row_color to (rgb(0,255,255))
83693>>>>>>>//   set current_item_color to (rgb(0,255,255))
83693>>>>>>>    on_key knext_item send switch
83694>>>>>>>    on_key kprevious_item send switch_back
83695>>>>>>>    on_key kswitch send switch
83696>>>>>>>    on_key kswitch_back send switch_back
83697>>>>>>>    set auto_top_item_state to false // Does not work!
83698>>>>>>>    send DoHeaderLabels 1
83699>>>>>>>    set select_mode to multi_select
83700>>>>>>>    object oSortArray is an cArray no_image
83702>>>>>>>      //           Sort value          fil Select?
83702>>>>>>>      // Ĵ
83702>>>>>>>      //               30               3  1
83702>>>>>>>      // The first 30 characters of each item in this array will be used for
83702>>>>>>>      // sorting the values.
83702>>>>>>>    end_object
83703>>>>>>>    object oRootNames is a cSet no_image
83705>>>>>>>    end_object
83706>>>>>>>    property integer piNo_Alias_State             public false
83707>>>>>>>    property integer piBad_Entries_State          public BAD_ENTRIES_SHADOW
83708>>>>>>>    property integer piGeneric_Display_Name_State public false
83709>>>>>>>    property integer piDriverFilter_State         public false
83710>>>>>>>    property integer piFDX_Server                 public 0
83711>>>>>>>    object oDriversIncluded is a cArray no_image
83713>>>>>>>    end_object
83714>>>>>>>    on_key key_ctrl+key_d send display_file_things
83715>>>>>>>    on_key key_ctrl+key_l send display_file_location
83716>>>>>>>    on_key key_ctrl+key_w send DoWriteToFile
83717>>>>>>>  end_procedure
83718>>>>>>>  procedure DoWriteToFile
83720>>>>>>>    send Grid_DoWriteToFile self
83721>>>>>>>  end_procedure
83722>>>>>>>  procedure wait_on
83724>>>>>>>    send cursor_wait to (cursor_control(self))
83725>>>>>>>  end_procedure
83726>>>>>>>  procedure wait_off
83728>>>>>>>    send cursor_ready to (cursor_control(self))
83729>>>>>>>  end_procedure
83730>>>>>>>  procedure DriverFilter_Add integer driver_type#
83732>>>>>>>    set piDriverFilter_State to true
83733>>>>>>>    set value of (oDriversIncluded(self)) item driver_type# to 1
83734>>>>>>>  end_procedure
83735>>>>>>>  procedure DriverFilter_Reset
83737>>>>>>>    send delete_data to (oDriversIncluded(self))
83738>>>>>>>    set piDriverFilter_State to false
83739>>>>>>>  end_procedure
83740>>>>>>>  function DriverFilter_Include integer driver_type# returns integer
83742>>>>>>>    if (piDriverFilter_State(self)) function_return (value(oDriversIncluded(self),driver_type#))
83745>>>>>>>    function_return 1
83746>>>>>>>  end_function
83747>>>>>>>  procedure update_select_display // Intended for augmentation
83749>>>>>>>    // Called everytime the number of selected entries changes.
83749>>>>>>>  end_procedure
83750>>>>>>>  function Row_Count returns integer
83752>>>>>>>    function_return (item_count(self)/5)
83753>>>>>>>  end_function
83754>>>>>>>  function Row_Shadow_State integer row# returns integer
83756>>>>>>>    integer select#
83756>>>>>>>    get shadow_state item (row#*5) to select#
83757>>>>>>>    function_return select#
83758>>>>>>>  end_function
83759>>>>>>>  procedure set File_Select_State integer file# integer select#
83761>>>>>>>    integer row# max#
83761>>>>>>>    get Row_Count to max#
83762>>>>>>>    for row# from 0 to (max#-1)
83768>>>>>>>>
83768>>>>>>>      ifnot (Row_Shadow_State(self,row#)) if (integer(value(self,row#*5+1))=file#) set select_state item (row#*5) to select#
83773>>>>>>>    loop
83774>>>>>>>>
83774>>>>>>>    set dynamic_update_state to true // Force repaint
83775>>>>>>>  end_procedure
83776>>>>>>>  function File_Select_State integer file# returns integer
83778>>>>>>>    integer row# max# select#
83778>>>>>>>    get Row_Count to max#
83779>>>>>>>    for row# from 0 to (max#-1)
83785>>>>>>>>
83785>>>>>>>      if (integer(value(self,row#*5+1))=file#) begin
83787>>>>>>>        get select_state item (row#*5) to select#
83788>>>>>>>        function_return select#
83789>>>>>>>      end
83789>>>>>>>>
83789>>>>>>>    loop
83790>>>>>>>>
83790>>>>>>>  end_function
83791>>>>>>>  function Row_Select_State integer row# returns integer
83793>>>>>>>    integer select#
83793>>>>>>>    get select_state item (row#*5) to select#
83794>>>>>>>    function_return select#
83795>>>>>>>  end_function
83796>>>>>>>  procedure set Row_Select_State integer row# integer select#
83798>>>>>>>    ifnot (item_shadow_state(self,row#*5)) set select_state item (row#*5) to select#
83801>>>>>>>  end_procedure
83802>>>>>>>  function Row_File integer row# returns integer
83804>>>>>>>    function_return (value(self,row#*5+1))
83805>>>>>>>  end_function
83806>>>>>>>  function Row_DisplayName integer row# returns string
83808>>>>>>>    function_return (value(self,row#*5+2))
83809>>>>>>>  end_function
83810>>>>>>>  function Row_DfName integer row# returns string
83812>>>>>>>    function_return (value(self,row#*5+3))
83813>>>>>>>  end_function
83814>>>>>>>  function Row_RootName integer row# returns string
83816>>>>>>>    function_return (value(self,row#*5+4))
83817>>>>>>>  end_function
83818>>>>>>>  function Current_Row returns integer
83820>>>>>>>    integer itm#
83820>>>>>>>    get current_item to itm#
83821>>>>>>>    function_return (itm#/5)
83822>>>>>>>  end_function
83823>>>>>>>  function Current_Column returns integer
83825>>>>>>>    function_return (current_item(self)-(current_row(self)*5))
83826>>>>>>>  end_function
83827>>>>>>>  function Current_File returns integer
83829>>>>>>>    function_return (Row_File(self,Current_Row(self)))
83830>>>>>>>  end_function
83831>>>>>>>  function File_Select_Count returns integer
83833>>>>>>>    integer row# max# rval#
83833>>>>>>>    move 0 to rval#
83834>>>>>>>    get row_count to max#
83835>>>>>>>    for row# from 0 to (max#-1)
83841>>>>>>>>
83841>>>>>>>      if (Row_Select_State(self,row#)) increment rval#
83844>>>>>>>    loop
83845>>>>>>>>
83845>>>>>>>    function_return rval#
83846>>>>>>>  end_function
83847>>>>>>>  procedure sort.i integer by# // 1:Number 2:Display 3:DF 4:Root
83849>>>>>>>    integer row# max# arr# file# select#
83849>>>>>>>    string str#
83849>>>>>>>    if by# begin
83851>>>>>>>      send wait_on
83852>>>>>>>      move (oSortArray(self)) to arr#
83853>>>>>>>      send delete_data to arr#
83854>>>>>>>      get Row_Count to max#
83855>>>>>>>      for row# from 0 to (max#-1)
83861>>>>>>>>
83861>>>>>>>        move (value(self,row#*5+by#)) to str#
83862>>>>>>>        if by# eq 1 move (IntToStrR(str#,4)) to str#
83865>>>>>>>        move (integer(value(self,row#*5+1))) to file#
83866>>>>>>>        move (select_state(self,row#*5)) to select#
83867>>>>>>>        move (pad(str#,30)+IntToStrR(file#,4)+IntToStrR(select#,1)) to str#
83868>>>>>>>        set value of arr# item row# to str#
83869>>>>>>>      loop
83870>>>>>>>>
83870>>>>>>>      send sort_items to arr#
83871>>>>>>>      send DoHeaderLabels by#
83872>>>>>>>      send fill_list_from_sort_array
83873>>>>>>>      send delete_data to arr#
83874>>>>>>>      send wait_off
83875>>>>>>>    end
83875>>>>>>>>
83875>>>>>>>  end_procedure
83876>>>>>>>  procedure header_mouse_click integer itm#
83878>>>>>>>    send sort.i itm#
83879>>>>>>>    forward send header_mouse_click itm#
83881>>>>>>>  end_procedure
83882>>>>>>>  procedure add_row.isssi integer file# string dn# string ln# string rn# integer shade#
83884>>>>>>>    integer base#
83884>>>>>>>    get item_count to base#
83885>>>>>>>    send add_item msg_none ""
83886>>>>>>>    set checkbox_item_state item base# to true
83887>>>>>>>    send add_item msg_none (string(file#))
83888>>>>>>>    send add_item msg_none dn#
83889>>>>>>>    send add_item msg_none ln#
83890>>>>>>>    send add_item msg_none rn#
83891>>>>>>>    set entry_state item (base#+1) to false
83892>>>>>>>    set entry_state item (base#+2) to false
83893>>>>>>>    set entry_state item (base#+3) to false
83894>>>>>>>    set entry_state item (base#+4) to false
83895>>>>>>>    if shade# begin
83897>>>>>>>      set item_shadow_state item  base#    to true
83898>>>>>>>      set item_shadow_state item (base#+1) to true
83899>>>>>>>      set item_shadow_state item (base#+2) to true
83900>>>>>>>      set item_shadow_state item (base#+3) to true
83901>>>>>>>      set item_shadow_state item (base#+4) to true
83902>>>>>>>    end
83902>>>>>>>>
83902>>>>>>>  end_procedure
83903>>>>>>>  register_function iFile_loaded.i integer file# returns integer
83903>>>>>>>  function iFileAvailable.i integer file# returns integer
83905>>>>>>>    integer oFDX#
83905>>>>>>>    get piFDX_Server to oFDX#
83906>>>>>>>    function_return (FDX_CanOpenFile(oFDX#,file#))
83907>>>>>>>  end_function
83908>>>>>>>  procedure add_file.i integer file#
83910>>>>>>>    integer base# piNo_Alias_State# AddFile# bad# piBad_Entries_State# driver_type#
83910>>>>>>>    string dn# ln# rootname#
83910>>>>>>>    get piNo_Alias_State to piNo_Alias_State#
83911>>>>>>>    move (FDX_AttrValue_FILELIST(piFDX_Server(self),DF_FILE_ROOT_NAME,file#)) to RootName#
83912>>>>>>>    move 0 to bad#
83913>>>>>>>    get piBad_Entries_State to piBad_Entries_State#
83914>>>>>>>
83914>>>>>>>    if (piNo_Alias_State# and element_find(oRootNames(self),uppercase(RootName#))<>-1) move 0 to AddFile#
83917>>>>>>>    else begin
83918>>>>>>>      if piBad_Entries_State# ne BAD_ENTRIES_NO_CHECK begin
83920>>>>>>>        move (iFileAvailable.i(self,file#)) to driver_type#
83921>>>>>>>        move (not(driver_type#)) to bad#
83922>>>>>>>        ifnot bad# move (not(DriverFilter_Include(self,driver_type#))) to bad#
83925>>>>>>>      end
83925>>>>>>>>
83925>>>>>>>
83925>>>>>>>      if (bad# and piBad_Entries_State#=BAD_ENTRIES_EXCLUDE) move 0 to AddFile#
83928>>>>>>>      else move 1 to AddFile#
83930>>>>>>>    end
83930>>>>>>>>
83930>>>>>>>
83930>>>>>>>    if AddFile# begin
83932>>>>>>>      if (piGeneric_Display_Name_State(self)) move (rtrim(FDX_AttrValue_FILELIST(piFDX_Server(self),DF_FILE_DISPLAY_NAME,file#))) to dn#
83935>>>>>>>      else move (File_Display_Name(file#)) to dn#
83937>>>>>>>      //get_attribute DF_FILE_LOGICAL_NAME of file# to ln#
83937>>>>>>>      move (FDX_AttrValue_FILELIST(piFDX_Server(self),DF_FILE_LOGICAL_NAME,file#)) to ln#
83938>>>>>>>      if piNo_Alias_State# send element_add to (oRootNames(self)) (uppercase(rootname#))
83941>>>>>>>      send add_row.isssi file# dn# ln# rootname# (bad# and piBad_Entries_State#=BAD_ENTRIES_SHADOW)
83942>>>>>>>    end
83942>>>>>>>>
83942>>>>>>>  end_procedure // add_file.i
83943>>>>>>>  procedure row_change integer row_from# integer row_to#
83945>>>>>>>  end_procedure
83946>>>>>>>  procedure item_change integer i1# integer i2# returns integer
83948>>>>>>>    integer rval# row_from# row_to#
83948>>>>>>>    forward get msg_item_change i1# i2# to rval#
83950>>>>>>>    if (i1#/5) ne (i2#/5) send row_change (i1#/5) (i2#/5)
83953>>>>>>>    procedure_return rval#
83954>>>>>>>  end_procedure
83955>>>>>>>  procedure select_toggling integer itm# integer i#
83957>>>>>>>    integer ci#
83957>>>>>>>    get current_item to ci#
83958>>>>>>>    move ((ci#/5)*5) to ci# // Redirect to first column
83959>>>>>>>    forward send select_toggling ci# i#
83961>>>>>>>    send update_select_display
83962>>>>>>>  end_procedure
83963>>>>>>>  procedure fill_list_all_files
83965>>>>>>>    integer file# oFDX#
83965>>>>>>>    set dynamic_update_state to false
83966>>>>>>>    get piFDX_Server to oFDX#
83967>>>>>>>    send delete_data
83968>>>>>>>    send delete_data to (oRootNames(self))
83969>>>>>>>    move 0 to file#
83970>>>>>>>    send wait_on
83971>>>>>>>    repeat
83971>>>>>>>>
83971>>>>>>>      move (FDX_AttrValue_FLSTNAV(oFDX#,DF_FILE_NEXT_USED,file#)) to file#
83972>>>>>>>      if file# send add_file.i file#
83975>>>>>>>    until file# eq 0
83977>>>>>>>    send update_select_display
83978>>>>>>>    set dynamic_update_state to true
83979>>>>>>>    send wait_off
83980>>>>>>>  end_procedure
83981>>>>>>>  procedure fill_list_all_open // Only if we are working on real data
83983>>>>>>>    integer file# oFDX#
83983>>>>>>>    get piFDX_Server to oFDX#
83984>>>>>>>    set dynamic_update_state to false
83985>>>>>>>    ifnot oFDX# begin
83987>>>>>>>      send wait_on
83988>>>>>>>      send delete_data
83989>>>>>>>      send delete_data to (oRootNames(self))
83990>>>>>>>      move 0 to file#
83991>>>>>>>      repeat
83991>>>>>>>>
83991>>>>>>>        move (FDX_AttrValue_FLSTNAV(oFDX#,DF_FILE_NEXT_OPENED,file#)) to file#
83992>>>>>>>        if file# send add_file.i file#
83995>>>>>>>      until file# eq 0
83997>>>>>>>      send update_select_display
83998>>>>>>>      send wait_off
83999>>>>>>>    end
83999>>>>>>>>
83999>>>>>>>  end_procedure
84000>>>>>>>  procedure fill_list_from_sort_array
84002>>>>>>>    integer file# arr# itm# max# select# piNo_Alias_State#
84002>>>>>>>    string str#
84002>>>>>>>    set dynamic_update_state to false
84003>>>>>>>    get piNo_Alias_State to piNo_Alias_State#
84004>>>>>>>    set piNo_Alias_State to false
84005>>>>>>>    send delete_data
84006>>>>>>>    send delete_data to (oRootNames(self))
84007>>>>>>>    move (oSortArray(self)) to arr#
84008>>>>>>>    get item_count of arr# to max#
84009>>>>>>>    for itm# from 0 to (max#-1)
84015>>>>>>>>
84015>>>>>>>      get value of arr# item itm# to str#
84016>>>>>>>      move (integer(mid(str#,4,31))) to file#
84017>>>>>>>      move (integer(mid(str#,1,35))) to select#
84018>>>>>>>      send add_file.i file#
84019>>>>>>>      if select# set select_state item (item_count(self)-5) to true
84022>>>>>>>    loop
84023>>>>>>>>
84023>>>>>>>    set piNo_Alias_State to piNo_Alias_State# // Restore
84024>>>>>>>    set dynamic_update_state to true
84025>>>>>>>  end_procedure
84026>>>>>>>  procedure select_all
84028>>>>>>>    integer itm# max# row#
84028>>>>>>>    get Row_Count to max#
84029>>>>>>>    for row# from 0 to (max#-1)
84035>>>>>>>>
84035>>>>>>>      set Row_Select_State Row# to true
84036>>>>>>>    loop
84037>>>>>>>>
84037>>>>>>>    send update_select_display
84038>>>>>>>    set dynamic_update_state to true
84039>>>>>>>  end_procedure
84040>>>>>>>  procedure select_all_not_bad
84042>>>>>>>    integer itm# max# row# bad# file#
84042>>>>>>>    send wait_on
84043>>>>>>>    get Row_Count to max#
84044>>>>>>>    for row# from 0 to (max#-1)
84050>>>>>>>>
84050>>>>>>>      if (uppercase(Row_RootName(self,row#))<>"FLEXERRS") begin
84052>>>>>>>        get Row_File row# to file#
84053>>>>>>>        move (not(iFileAvailable.i(self,file#))) to bad#
84054>>>>>>>        if (not(bad#)) set Row_Select_State Row# to true
84057>>>>>>>      end
84057>>>>>>>>
84057>>>>>>>    loop
84058>>>>>>>>
84058>>>>>>>    send update_select_display
84059>>>>>>>    send wait_off
84060>>>>>>>    set dynamic_update_state to true
84061>>>>>>>  end_procedure
84062>>>>>>>  procedure select_none
84064>>>>>>>    integer itm# max# row#
84064>>>>>>>    get Row_Count to max#
84065>>>>>>>    for row# from 0 to (max#-1)
84071>>>>>>>>
84071>>>>>>>      set Row_Select_State Row# to false
84072>>>>>>>    loop
84073>>>>>>>>
84073>>>>>>>    send update_select_display
84074>>>>>>>    set dynamic_update_state to true
84075>>>>>>>  end_procedure
84076>>>>>>>  procedure select_invert
84078>>>>>>>    integer max# row# st#
84078>>>>>>>    get Row_Count to max#
84079>>>>>>>    for row# from 0 to (max#-1)
84085>>>>>>>>
84085>>>>>>>      ifnot (Row_Shadow_State(self,row#)) begin
84087>>>>>>>        get Row_Select_State Row# to st#
84088>>>>>>>        if (st# or uppercase(Row_RootName(self,row#))<>"FLEXERRS") set Row_Select_State Row# to (not(st#))
84091>>>>>>>      end
84091>>>>>>>>
84091>>>>>>>    loop
84092>>>>>>>>
84092>>>>>>>    send update_select_display
84093>>>>>>>    set dynamic_update_state to true
84094>>>>>>>  end_procedure
84095>>>>>>>
84095>>>>>>>  register_function sChildFiles.i integer file# returns string
84095>>>>>>>  register_function sParentFiles.i integer file# returns string
84095>>>>>>>  procedure select_parents
84097>>>>>>>    integer oFDX# itm# max# file#
84097>>>>>>>    string str#
84097>>>>>>>    get piFDX_Server to oFDX#
84098>>>>>>>    if oFDX# begin
84100>>>>>>>      ifnot (Row_Shadow_State(self,current_row(self))) begin
84102>>>>>>>        get sParentFiles.i of oFDX# (Current_File(self)) to str#
84103>>>>>>>        move (HowManyIntegers(str#)) to max#
84104>>>>>>>        for itm# from 1 to max#
84110>>>>>>>>
84110>>>>>>>          set File_Select_State (ExtractInteger(str#,itm#)) to true
84111>>>>>>>        loop
84112>>>>>>>>
84112>>>>>>>        set File_Select_State (Current_File(self)) to true
84113>>>>>>>        send update_select_display
84114>>>>>>>        set dynamic_update_state to true
84115>>>>>>>      end
84115>>>>>>>>
84115>>>>>>>    end
84115>>>>>>>>
84115>>>>>>>  end_procedure
84116>>>>>>>  procedure select_children
84118>>>>>>>    integer oFDX# itm# max# file#
84118>>>>>>>    string str#
84118>>>>>>>    get piFDX_Server to oFDX#
84119>>>>>>>    if oFDX# begin
84121>>>>>>>      ifnot (Row_Shadow_State(self,current_row(self))) begin
84123>>>>>>>        get sChildFiles.i of oFDX# (Current_File(self)) to str#
84124>>>>>>>        move (HowManyIntegers(str#)) to max#
84125>>>>>>>        for itm# from 1 to max#
84131>>>>>>>>
84131>>>>>>>          set File_Select_State (ExtractInteger(str#,itm#)) to true
84132>>>>>>>        loop
84133>>>>>>>>
84133>>>>>>>        set File_Select_State (Current_File(self)) to true
84134>>>>>>>        send update_select_display
84135>>>>>>>        set dynamic_update_state to true
84136>>>>>>>      end
84136>>>>>>>>
84136>>>>>>>    end
84136>>>>>>>>
84136>>>>>>>  end_procedure
84137>>>>>>>  procedure select_master
84139>>>>>>>    integer itm# max# row#
84139>>>>>>>    string rn# str#
84139>>>>>>>    get Row_Count to max#
84140>>>>>>>    move "" to str#
84141>>>>>>>    for row# from 0 to (max#-1)
84147>>>>>>>>
84147>>>>>>>      get Row_RootName row# to rn#
84148>>>>>>>      ifnot (uppercase(rn#)) eq "FLEXERRS" begin
84150>>>>>>>        ifnot (""+uppercase(rn#)+"") in str# begin
84152>>>>>>>          set Row_Select_State Row# to true
84153>>>>>>>          move (str#+uppercase(rn#)+"") to str#
84154>>>>>>>        end
84154>>>>>>>>
84154>>>>>>>      end
84154>>>>>>>>
84154>>>>>>>    loop
84155>>>>>>>>
84155>>>>>>>    send update_select_display
84156>>>>>>>    set dynamic_update_state to true
84157>>>>>>>  end_procedure
84158>>>>>>>  procedure select_bad
84160>>>>>>>    integer max# row# file# bad#
84160>>>>>>>    set dynamic_update_state to false
84161>>>>>>>    send wait_on
84162>>>>>>>    get Row_Count to max#
84163>>>>>>>    for row# from 0 to (max#-1)
84169>>>>>>>>
84169>>>>>>>      get Row_File row# to file#
84170>>>>>>>      move (not(iFileAvailable.i(self,file#))) to bad#
84171>>>>>>>      if bad# set Row_Select_State Row# to true
84174>>>>>>>    loop
84175>>>>>>>>
84175>>>>>>>    set dynamic_update_state to true
84176>>>>>>>    send update_select_display
84177>>>>>>>    send wait_off
84178>>>>>>>  end_procedure
84179>>>>>>>  procedure select_open
84181>>>>>>>    integer max# row# open# file#
84181>>>>>>>    ifnot (piFDX_Server(self)) begin
84183>>>>>>>      get Row_Count to max#
84184>>>>>>>      for row# from 0 to (max#-1)
84190>>>>>>>>
84190>>>>>>>        get Row_File row# to file#
84191>>>>>>>        if (DBMS_IsOpenFile(file#)) set Row_Select_State Row# to true
84194>>>>>>>      loop
84195>>>>>>>>
84195>>>>>>>      send update_select_display
84196>>>>>>>      set dynamic_update_state to true
84197>>>>>>>    end
84197>>>>>>>>
84197>>>>>>>  end_procedure
84198>>>>>>>
84198>>>>>>>  procedure Callback_Selected_Files integer msg# integer tmp_obj#
84200>>>>>>>    integer obj# max# row# open# file#
84200>>>>>>>    if num_arguments gt 1 move tmp_obj# to obj#
84203>>>>>>>    else move self to obj#
84205>>>>>>>    get Row_Count to max#
84206>>>>>>>    for row# from 0 to (max#-1)
84212>>>>>>>>
84212>>>>>>>      if (Row_Select_State(self,row#)) begin
84214>>>>>>>        move (Row_File(self,row#)) to file#
84215>>>>>>>        send msg# to obj# file# (Row_DisplayName(self,row#)) (Row_DfName(self,row#)) (Row_RootName(self,row#))
84216>>>>>>>      end
84216>>>>>>>>
84216>>>>>>>    loop
84217>>>>>>>>
84217>>>>>>>  end_procedure
84218>>>>>>>
84218>>>>>>>  procedure Callback_All_Files integer msg# integer tmp_obj#
84220>>>>>>>    integer obj# max# row# open# file#
84220>>>>>>>    if num_arguments gt 1 move tmp_obj# to obj#
84223>>>>>>>    else move self to obj#
84225>>>>>>>    get Row_Count to max#
84226>>>>>>>    for row# from 0 to (max#-1)
84232>>>>>>>>
84232>>>>>>>      move (Row_File(self,row#)) to file#
84233>>>>>>>      send msg# to obj# file# (Row_DisplayName(self,row#)) (Row_DfName(self,row#)) (Row_RootName(self,row#))
84234>>>>>>>    loop
84235>>>>>>>>
84235>>>>>>>  end_procedure
84236>>>>>>>
84236>>>>>>>  //> Procedure Callback_General are used for calling back
84236>>>>>>>  //>
84236>>>>>>>  //>  Selected# =  0 => Only files not selected are called back
84236>>>>>>>  //>  Selected# =  1 => Only files that are selected are called back
84236>>>>>>>  //>  Selected# = -1 => Files are called back whether they are selected or not
84236>>>>>>>  //>
84236>>>>>>>  //>  Shaded#   =  0 => Only files not shaded are called back
84236>>>>>>>  //>  Shaded#   =  1 => Only shaded files are called back
84236>>>>>>>  //>  Shaded#   = -1 => Files are called back whether they are shaded or not
84236>>>>>>>  //>
84236>>>>>>>  //>  Master#   =  0 => All entries fulfilling the above are called back
84236>>>>>>>  //>  Master#   =  1 => If more entries have identical root names they are only called back once.
84236>>>>>>>  procedure Callback_General integer msg# integer obj# integer selected# integer shaded# integer master_tmp#
84238>>>>>>>    integer row# max# file# is_selected# is_shaded# master# ok#
84238>>>>>>>    string check# root#
84238>>>>>>>    if num_arguments lt 5 move 0 to master#
84241>>>>>>>    else move master_tmp# to master#
84243>>>>>>>    move ";" to check#
84244>>>>>>>    get Row_Count to max#
84245>>>>>>>    for row# from 0 to (max#-1)
84251>>>>>>>>
84251>>>>>>>      move (Row_Select_State(self,row#)) to is_selected#
84252>>>>>>>      move (Row_Shadow_State(self,row#)) to is_shaded#
84253>>>>>>>      if ((selected#=-1 or selected#=is_selected#) and (shaded#=-1 or shaded#=is_shaded#)) begin
84255>>>>>>>        if master# begin
84257>>>>>>>          move (trim(lowercase(Row_RootName(self,row#)))) to root#
84258>>>>>>>          if (";"+root#+";") in check# move 0 to ok#
84261>>>>>>>          else begin
84262>>>>>>>            move (check#+root#+";") to check#
84263>>>>>>>            move 1 to ok#
84264>>>>>>>          end
84264>>>>>>>>
84264>>>>>>>        end
84264>>>>>>>>
84264>>>>>>>        else move 1 to ok#
84266>>>>>>>        if ok# begin
84268>>>>>>>          get Row_File row# to file#
84269>>>>>>>          send msg# to obj# file# is_selected# is_shaded#
84270>>>>>>>        end
84270>>>>>>>>
84270>>>>>>>      end
84270>>>>>>>>
84270>>>>>>>    loop
84271>>>>>>>>
84271>>>>>>>  end_procedure
84272>>>>>>>
84272>>>>>>>  // Returns true if the function is completed
84272>>>>>>>  register_function iCallback_File.iii integer file# integer get# integer obj# returns integer
84272>>>>>>>  function iCallback_Selected_Files_Server integer get# integer obj# returns integer
84274>>>>>>>    integer max# row# open# file# rval# svr#
84274>>>>>>>    get piFDX_Server to svr#
84275>>>>>>>    get Row_Count to max#
84276>>>>>>>    move 1 to rval#
84277>>>>>>>    for row# from 0 to (max#-1)
84283>>>>>>>>
84283>>>>>>>      if rval# begin
84285>>>>>>>        if (Row_Select_State(self,row#)) get iCallback_File.iii of svr# (Row_File(self,row#)) get# obj# to rval#
84288>>>>>>>      end
84288>>>>>>>>
84288>>>>>>>      else function_return 0
84290>>>>>>>    loop
84291>>>>>>>>
84291>>>>>>>    function_return 1
84292>>>>>>>  end_function
84293>>>>>>>  procedure load_current_selection string fn#
84295>>>>>>>    integer ch# row# max# file# st# fin#
84295>>>>>>>    string str#
84295>>>>>>>    get Seq_New_Channel to ch#
84296>>>>>>>    direct_input channel ch# fn#
84298>>>>>>>    if [~seqeof] begin
84300>>>>>>>      send wait_on
84301>>>>>>>      readln str#
84302>>>>>>>      ifnot str# eq "LFSELECT1.0" send obs "Incompatible format"
84305>>>>>>>      else begin
84306>>>>>>>        repeat
84306>>>>>>>>
84306>>>>>>>          readln file#
84307>>>>>>>          readln st#
84308>>>>>>>          move (seqeof) to fin#
84309>>>>>>>          ifnot fin# if st# set file_select_state file# to st#
84314>>>>>>>        until fin#
84316>>>>>>>      end
84316>>>>>>>>
84316>>>>>>>      send wait_off
84317>>>>>>>    end
84317>>>>>>>>
84317>>>>>>>    else send obs "File not found"
84319>>>>>>>    close_input channel ch#
84321>>>>>>>    send Seq_Release_Channel ch#
84322>>>>>>>    send update_select_display
84323>>>>>>>  end_procedure
84324>>>>>>>  procedure load_current_selection.browse
84326>>>>>>>    string fn#
84326>>>>>>>    move (SEQ_SelectFile("Load filelist selection","Filelist selections (*.fsl)|*.FSL")) to fn#
84327>>>>>>>    if fn# ne "" send load_current_selection fn#
84330>>>>>>>  end_procedure
84331>>>>>>>  procedure save_current_selection string fn#
84333>>>>>>>    integer ch# row# max# file# st#
84333>>>>>>>    send wait_on
84334>>>>>>>    get Seq_New_Channel to ch#
84335>>>>>>>    direct_output channel ch# fn#
84337>>>>>>>    writeln "LFSELECT1.0"
84339>>>>>>>    get Row_Count to max#
84340>>>>>>>    for row# from 0 to (max#-1)
84346>>>>>>>>
84346>>>>>>>      get Row_File row# to file#
84347>>>>>>>      get Row_Select_state row# to st#
84348>>>>>>>      writeln file#
84350>>>>>>>      writeln st#
84352>>>>>>>    loop
84353>>>>>>>>
84353>>>>>>>    close_output channel ch#
84355>>>>>>>    send Seq_Release_Channel ch#
84356>>>>>>>    send wait_off
84357>>>>>>>  end_procedure
84358>>>>>>>  procedure save_current_selection.browse
84360>>>>>>>    string fn#
84360>>>>>>>    move (SEQ_SelectOutFile("Save filelist selection","Filelist selections (*.fsl)|*.FSL")) to fn#
84361>>>>>>>    if fn# ne "" send save_current_selection fn#
84364>>>>>>>  end_procedure
84365>>>>>>>  procedure display_file_things
84367>>>>>>>    if (item_count(self)) ifnot (Row_Shadow_State(self,Current_Row(self))) send FDX_ModalDisplayFileAttributes (piFDX_Server(self)) (Current_File(self))
84372>>>>>>>  end_procedure
84373>>>>>>>  procedure display_file_location
84375>>>>>>>    integer fdx# file#
84375>>>>>>>    number ts#
84375>>>>>>>    string path#
84375>>>>>>>    ifnot (Row_Shadow_State(self,Current_Row(self))) begin
84377>>>>>>>      get piFDX_Server to fdx#
84378>>>>>>>      get Current_File to file#
84379>>>>>>>      get sDatPath.i of fdx# file# to path#
84380>>>>>>>      get nTimeStamp.i of fdx# file# to ts#
84381>>>>>>>      send obs "Data path:" path# "Table data last modified:" (TS_ConvertToString(ts#))
84382>>>>>>>    end
84382>>>>>>>>
84382>>>>>>>  end_procedure
84383>>>>>>>end_class // cFdxFileMultiSelector
84384>>>>>Use Version.nui
84384>>>>>
84384>>>>>define VDFSORT$INCLUDE_VDFCLEAN for 1
84384>>>>>
84384>>>>>define hlpid.VdfSort_Select     for 5001
84384>>>>>define hlpid.VdfSort_Properties for 5002
84384>>>>>define hlpid.VdfSort_Result     for 5003
84384>>>>>
84384>>>>> define t.VdfSort.Caption           for "Select file(s) to sort"
84384>>>>> define t.VdfSort.Btn.Reindex       for "Sort"
84384>>>>> define t.VdfSort.Btn.CleanUp       for "Cleanup"
84384>>>>> define t.VdfSort.Wait.Caption      for "Reindex, status"
84384>>>>> define t.VdfSort.Wait.Status       for "History"
84384>>>>> define t.VdfSort.Wait.History      for "Action"
84384>>>>> define t.VdfSort.Wait.Error        for "Error"
84384>>>>> define t.VdfSort.Wait.Of           for " of "
84384>>>>> define t.VdfSort.Err.Exclusive1    for "The sort routine could not obtain exclusive access."
84384>>>>> define t.VdfSort.Err.Exclusive2    for "Make sure noone else is using the system and that"
84384>>>>> define t.VdfSort.Err.Exclusive3    for "you are not running a copy of this program in the"
84384>>>>> define t.VdfSort.Err.Exclusive4    for "background. Then try again."
84384>>>>> define t.VdfSort.Prop_Caption      for "Sort properties"
84384>>>>> define t.VdfSort.Prop_BadData      for "Bad data"
84384>>>>> define t.VdfSort.Prop_BD_NoCheck   for "No check"
84384>>>>> define t.VdfSort.Prop_BD_SpaceFill for "Fill with spaces"
84384>>>>> define t.VdfSort.Prop_BD_WriteFile for "Write to file"
84384>>>>> define t.VdfSort.Prop_BD_Abort     for "Abort on bad data"
84384>>>>> define t.VdfSort.Prop_Duplicates   for "Duplicate records"
84384>>>>> define t.VdfSort.Prop_DD_WriteFile for "Write to file"
84384>>>>> define t.VdfSort.Prop_DD_Abort     for "Abort on duplicates"
84384>>>>> define t.VdfSort.Prop_SortBuffer   for "Sort buffer size (Kb)"
84384>>>>> define t.VdfSort.Done              for "Re-index done"
84384>>>>> define t.VdfSort.NoErrors          for "No errors during sort operation"
84384>>>>> define t.VdfSort.FileLocations     for "File locations"
84384>>>>> define t.VdfSort.ReindexHistory    for "Re-index, history"
84384>>>>> define t.VdfSort.ReindexErrors     for "Re-index, errors"
84384>>>>> define t.VdfSort.NoFilesToClean    for "No files to clean up"
84384>>>>> define t.VdfSort.CleanFile         for "Clean up file"
84384>>>>> define t.VdfSort.Btn.Skip          for "Skip set"
84384>>>>> define t.VdfSort.Btn.Auto          for "Auto clean set"
84384>>>>> define t.VdfSort.Lbl.SetNo         for "Set of duplicate records (set: #/#)"
84384>>>>> define t.VdfSort.Lbl.SelectRec     for "Select record to keep:"
84384>>>>> define t.VdfSort.LoadingSet        for "Loading set..."
84384>>>>> define t.VdfSort.DeletingRecs      for "Deleting records..."
84384>>>>> define t.VdfSort.CountingSets      for "Counting number of sets..."
84384>>>>> define t.VdfSort.RecordsInSet      for " records in set"
84384>>>>> define t.VdfSort.DoReindexAgain    for "You must re-index the file again"
84384>>>>> define t.VdfSort.SelectError       for "You have not selected the record to keep!"
84384>>>>> define t.VdfSort.Lbl.FieldName     for "Field name"
84384>>>>> define t.VdfSort.Lbl.CurrentRec    for "Current record"
84384>>>>> define t.VdfSort.Lbl.RecordToKeep  for "Record to keep"
84384>>>>> define t.VdfSort.Lbl.FieldType     for "Field type"
84384>>>>> define t.VdfSort.SelectFileToClean for "Select file to clean up"
84384>>>>> define t.VdfSort.Lbl.UserName      for "User name"
84384>>>>> define t.VdfSort.Lbl.DataFileLoc   for "Data file location"
84384>>>>> define t.VdfSort.Lbl.BadFileLoc    for "Bad file location"
84384>>>>> define t.VdfSort.Lbl.SizeAndTime   for "Size and time"
84384>>>>> define t.VdfSort.BadErr.Txt1       for "In the .BAD file there were more"
84384>>>>> define t.VdfSort.BadErr.Txt2       for "errors than just duplicate records."
84384>>>>> define t.VdfSort.BadErr.Txt3       for "Re-index file again and clean"
84384>>>>> define t.VdfSort.BadErr.Txt4       for "with regular clean up program"
84384>>>>> define t.VdfSort.BadErr.Txt5       for "(A component called 'DataBase Builder')"
84384>>>>> define t.VdfSort.Lbl.DataFile      for "Data file:"
84384>>>>> define t.VdfSort.Lbl.BadFile       for "BAD file:"
84384>>>>> define t.VdfSort.CantGainExcl      for "Can not get (exclusive) access to data file"
84384>>>>> define t.VdfSort.Definition        for "Definition"
84384>>>>> define t.VdfSort.WriteFDX          for "Write FDX"
84384>>>>>
84384>>>>>function VdfSort_field_length_string global integer file# integer field# returns string
84386>>>>>  integer fieldtype# len# dec# obj#
84386>>>>>  string rval#
84386>>>>>  get_attribute DF_FIELD_TYPE of file# field# to fieldtype#
84389>>>>>  get_attribute DF_FIELD_LENGTH of file# field# to len#
84392>>>>>  if fieldtype# eq DF_DATE move 3 to len#
84395>>>>>  move len# to rval#
84396>>>>>  if fieldtype# eq DF_BCD begin
84398>>>>>    get gl_effective_form_datatype file# field# to dec#
84399>>>>>    move "#.#" to rval#
84400>>>>>    replace "#" in rval# with (string(len#-dec#))
84402>>>>>    replace "#" in rval# with (string(dec#))
84404>>>>>  end
84404>>>>>>
84404>>>>>  function_return rval#
84405>>>>>end_function
84406>>>>>
84406>>>>>function VdfSort_field_status_help global integer file# integer field# returns string
84408>>>>>  integer fieldtype# obj#
84408>>>>>  string rval# str#
84408>>>>>  move "# (#)" to rval#
84409>>>>>  move (FieldInf_FieldType(file#,field#)) to fieldtype#
84410>>>>>  if fieldtype# eq DF_ASCII move "Ascii" to str#
84413>>>>>  if fieldtype# eq DF_DATE move "Date" to str#
84416>>>>>  if fieldtype# eq DF_TEXT move "Text" to str#
84419>>>>>  if fieldtype# eq DF_BCD  move "Number" to str#
84422>>>>>  if fieldtype# eq DF_BINARY  move "Binary" to str#
84425>>>>>  if str# eq "" move "Unknown" to str#
84428>>>>>  replace "#" in rval# with str#
84430>>>>>  replace "#" in rval# with (VdfSort_field_length_string(file#,field#))
84432>>>>>  function_return rval#
84433>>>>>end_function
84434>>>>>
84434>>>>>Use APS          // Auto Positioning and Sizing classes for VDF
84434>>>>>Use ObjGroup.utl // Defining groups of objects
84434>>>>>Use MsgBox       // DAC class
84434>>>>>register_object oList
84434>>>>>register_object oCont
84434>>>>>register_object oVdfSort
84434>>>>>
84434>>>>>integer oVdfSort_Callback_vw# oVdfSort#
84434>>>>>
84434>>>>>integer oVdfSort_SortOptions#
84434>>>>>move (DF_SORT_OPTION_BAD_DATA_FILE+DF_SORT_OPTION_DUP_DATA_FILE) to oVdfSort_SortOptions#
84435>>>>>//move (DF_SORT_OPTION_NO_DATA_CHECK+DF_SORT_OPTION_DUP_DATA_FILE) to oVdfSort_SortOptions#
84435>>>>>
84435>>>>>DEFINE_OBJECT_GROUP OG_VdfSort_Callback_vw
84436>>>>>
84436>>>>>  object oVdfSort_Callback_vw is a aps.View label t.VdfSort.Wait.Caption
84439>>>>>    on_key kcancel send close_panel
84440>>>>>    set Border_Style to BORDER_THICK   // Make panel resizeable
84441>>>>>    property integer pCount public 0
84443>>>>>    property integer pCount2 public 0
84445>>>>>    set help_id to hlpid.VdfSort_Result
84446>>>>>
84446>>>>>    object oCnt is a aps.Container3D
84448>>>>>      set peAnchors to (anTop+anLeft+anRight+anBottom)
84449>>>>>      object Sort_Progress_List is a aps.Edit Label t.VdfSort.Wait.History
84452>>>>>        set peAnchors to (anTop+anLeft+anRight)
84453>>>>>        set size to 75 250
84454>>>>>      end_object
84455>>>>>      Send Aps_Goto_Max_Row
84456>>>>>      object Sort_Warning is a aps.Edit Label t.VdfSort.Wait.Error
84459>>>>>        set peAnchors to (anTop+anLeft+anRight+anBottom)
84460>>>>>        set size to 50 250
84461>>>>>      end_object
84462>>>>>      Send Aps_Goto_Max_Row
84463>>>>>      Send Make_Row_Space 3
84464>>>>>      object Sort_Progress_Title is a aps.Form Label t.VdfSort.Wait.Status Abstract AFT_ASCII20
84468>>>>>        set object_shadow_state to true
84469>>>>>        set peAnchors to (anLeft+anBottom)
84470>>>>>      end_object
84471>>>>>      object Sort_Progress_Value is a aps.Form Abstract AFT_ASCII25 snap SL_RIGHT
84475>>>>>        set object_shadow_state to true
84476>>>>>        set peAnchors to (anLeft+anRight+anBottom)
84477>>>>>      end_object
84478>>>>>      send aps_align_by_sizing (Sort_Progress_Value(self)) (Sort_Warning(self)) sl_align_right
84479>>>>>      procedure Print_History
84482>>>>>        integer obj# itm# max#
84482>>>>>        if (iDirect_Output_Title(seq.object#,t.VdfSort.ReindexHistory)) begin
84484>>>>>          seq.writeln t.VdfSort.ReindexHistory
84486>>>>>          send make_horizontal_line to seq.object#
84487>>>>>          seq.writeln ""
84489>>>>>          move (Sort_Progress_List(self)) to obj#
84490>>>>>          get pCount to max#
84491>>>>>          for itm# from 0 to max#
84497>>>>>>
84497>>>>>            seq.writeln (value(obj#,itm#))
84499>>>>>          loop
84500>>>>>>
84500>>>>>          seq.writeln ""
84502>>>>>          seq.writeln ""
84504>>>>>          seq.writeln t.VdfSort.ReindexErrors
84506>>>>>          send make_horizontal_line to seq.object#
84507>>>>>          move (Sort_Warning(self)) to obj#
84508>>>>>          get pCount2 to max#
84509>>>>>          for itm# from 0 to max#
84515>>>>>>
84515>>>>>            seq.writeln (value(obj#,itm#))
84517>>>>>          loop
84518>>>>>>
84518>>>>>          seq.close_output
84519>>>>>        end
84519>>>>>>
84519>>>>>      end_procedure
84520>>>>>    end_object
84521>>>>>
84521>>>>>    procedure Print_Report
84524>>>>>      send Print_History to (oCnt(self))
84525>>>>>    end_procedure
84526>>>>>
84526>>>>>    object oBtn1 is a aps.multi_button
84528>>>>>      set peAnchors to (anRight+anBottom)
84529>>>>>      on_item t.btn.print send Print_History to (oCnt(self))
84530>>>>>    end_object
84531>>>>>    object oBtn2 is a aps.multi_button
84533>>>>>      set peAnchors to (anRight+anBottom)
84534>>>>>      on_item t.VdfSort.Btn.CleanUp send SelectBadFile to (oList(oCont(oVdfSort(self))))
84535>>>>>    end_object
84536>>>>>    object oBtn3 is a aps.multi_button
84538>>>>>      set peAnchors to (anRight+anBottom)
84539>>>>>      on_item t.btn.close send close_panel
84540>>>>>    end_object
84541>>>>>    send aps_locate_multi_buttons
84542>>>>>
84542>>>>>    function callback string txt# integer typ# returns integer
84545>>>>>      if (typ# ge DF_MESSAGE_HEADING_1 and typ# le DF_MESSAGE_HEADING_5) begin
84547>>>>>        set value of (Sort_Progress_List(oCnt(self))) item (pcount(self)) to txt#
84548>>>>>        send paint to (Sort_Progress_List(oCnt(self)))
84549>>>>>        set pcount to (pcount(self) + 1)
84550>>>>>      end
84550>>>>>>
84550>>>>>      else if typ# eq DF_MESSAGE_PROGRESS_TITLE begin
84553>>>>>        set value of (sort_progress_title(oCnt(self))) item 0 to txt#
84554>>>>>        send paint to (sort_progress_title(oCnt(self)))
84555>>>>>      end
84555>>>>>>
84555>>>>>      else if typ# eq DF_MESSAGE_PROGRESS_VALUE begin
84558>>>>>        replace ',' in txt# with t.VdfSort.Wait.Of
84560>>>>>        set value of (sort_progress_value(oCnt(self))) item 0 to txt#
84561>>>>>        send paint to (sort_progress_value(oCnt(self)))
84562>>>>>      end
84562>>>>>>
84562>>>>>      else if typ# eq DF_MESSAGE_WARNING begin
84565>>>>>        set value of (sort_warning(oCnt(self))) item (pcount2(self)) to txt#
84566>>>>>        send paint to (sort_warning(oCnt(self)))
84567>>>>>        set pcount2 to (pcount2(self)+1)
84568>>>>>        set value of (Sort_Progress_List(oCnt(self))) item (pcount(self)) to txt#
84569>>>>>        send paint to (Sort_Progress_List(oCnt(self)))
84570>>>>>        set pcount to (pcount(self)+1)
84571>>>>>      end
84571>>>>>>
84571>>>>>      function_return 0
84572>>>>>    end_function
84573>>>>>    procedure popup
84576>>>>>      set pcount to 0
84577>>>>>      set pcount2 to 0
84578>>>>>      send delete_data to (Sort_Progress_List(oCnt(self)))
84579>>>>>      send delete_data to (Sort_Warning(oCnt(self)))
84580>>>>>      set value of (Sort_Progress_Title(oCnt(self))) item 0 to ""
84581>>>>>      set value of (Sort_Progress_Value(oCnt(self))) item 0 to ""
84582>>>>>      set object_shadow_state of (oBtn1(self)) to true
84583>>>>>      set object_shadow_state of (oBtn2(self)) to true
84584>>>>>      set object_shadow_state of (oBtn3(self)) to true
84585>>>>>      forward send popup
84587>>>>>    end_procedure
84588>>>>>    procedure ending_sort
84591>>>>>      set value of (Sort_Progress_List(oCnt(self))) item (pcount(self)) to t.VdfSort.Done
84592>>>>>      ifnot (pcount2(self)) ;          set value of (Sort_Warning(oCnt(self))) item 0 to t.VdfSort.NoErrors
84595>>>>>      set object_shadow_state of (oBtn1(self)) to false
84596>>>>>      set object_shadow_state of (oBtn2(self)) to false
84597>>>>>      set object_shadow_state of (oBtn3(self)) to false
84598>>>>>      send activate to (oBtn3(self))
84599>>>>>    end_procedure
84600>>>>>
84600>>>>>    move self to oVdfSort_Callback_vw#
84601>>>>>  end_object
84602>>>>>  set piMinSize of oVdfSort_Callback_vw# to (hi(size(oVdfSort_Callback_vw#))) (low(size(oVdfSort_Callback_vw#)))
84603>>>>>END_DEFINE_OBJECT_GROUP
84604>>>>>
84604>>>>>DEFINE_OBJECT_GROUP OG_VdfSort
84605>>>>>  object VdfSort_oFileAllFiles is a cTablesOpenStatus
84607>>>>>  end_object
84608>>>>>
84608>>>>>   class cBadFileReader is an array
84609>>>>>     procedure construct_object
84611>>>>>       forward send construct_object
84613>>>>>       set delegation_mode to DELEGATE_TO_PARENT
84614>>>>>       property string  pBadFileName      public ""
84615>>>>>       property integer pCurrentPosition  public 0
84616>>>>>       property integer pChannel          public 0
84617>>>>>       property integer pBadDataInFile    public 0 // Something other than duplicate records in file?
84618>>>>>       property integer pMainFile         public 0
84619>>>>>       property integer private.pFirstRec public 0
84620>>>>>       property integer private.pRecCount public 0
84621>>>>>     end_procedure
84622>>>>>
84622>>>>>     function iCountSetsInFile returns integer
84624>>>>>       integer rval# ch# prev_rec# current_rec# fin#
84624>>>>>       string str#
84624>>>>>       get Seq_New_Channel to ch#
84625>>>>>       move 0 to rval#
84626>>>>>       move 0 to fin#
84627>>>>>       direct_input channel ch# (pBadFileName(self))
84629>>>>>       move -1 to prev_rec#
84630>>>>>       repeat
84630>>>>>>
84630>>>>>         readln str#
84631>>>>>         move (seqeof) to fin#
84632>>>>>         ifnot fin# begin
84634>>>>>           if (StringBeginsWith(str#,"DUPLICATE,")) begin
84636>>>>>             move (ExtractInteger(str#,1)) to current_rec#
84637>>>>>             if current_rec# ne prev_rec# increment rval#
84640>>>>>             move (ExtractInteger(str#,2)) to prev_rec#
84641>>>>>           end
84641>>>>>>
84641>>>>>         end
84641>>>>>>
84641>>>>>       until fin#
84643>>>>>       close_input channel ch#
84645>>>>>       send Seq_Release_Channel ch#
84646>>>>>       function_return rval#
84647>>>>>     end_function
84648>>>>>
84648>>>>>     procedure DeleteBadFile
84650>>>>>       string str1# str2# str3# str4# str5#
84650>>>>>       if (pBadDataInFile(self)) begin
84652>>>>>         move t.VdfSort.BadErr.Txt1 to str1#
84653>>>>>         move t.VdfSort.BadErr.Txt2 to str2#
84654>>>>>         move t.VdfSort.BadErr.Txt3 to str3#
84655>>>>>         move t.VdfSort.BadErr.Txt4 to str4#
84656>>>>>         move t.VdfSort.BadErr.Txt5 to str5#
84657>>>>>         send obs str1# str2# "" str3# str4# str5#
84658>>>>>       end
84658>>>>>>
84658>>>>>       erasefile (pBadFileName(self))
84659>>>>>>
84659>>>>>     end_procedure
84660>>>>>     procedure reset
84662>>>>>       set pCurrentPosition to 0
84663>>>>>       set pBadDataInFile to 0
84664>>>>>     end_procedure
84665>>>>>     // function sReadLnDuplicate.i will return the empty string only if an EOF
84665>>>>>     // marker has been reached
84665>>>>>     function sReadLnDuplicate.i integer ch# returns string
84667>>>>>       integer fin# pos#
84667>>>>>       string rval#
84667>>>>>       repeat
84667>>>>>>
84667>>>>>         get_channel_position ch# to pos# // Always keep pCurrentPosition pointing
84668>>>>>>
84668>>>>>         set pCurrentPosition to pos#     // to the beginning of the line just read.
84669>>>>>         readln channel ch# rval#
84671>>>>>         if (seqeof) function_return ""
84674>>>>>         if (StringBeginsWith(rval#,"DUPLICATE,")) move 1 to fin#
84677>>>>>         else if rval# ne "" set pBadDataInFile to true
84681>>>>>       until fin#
84683>>>>>       function_return rval#
84684>>>>>     end_function
84685>>>>>
84685>>>>>     enumeration_list // Return values of call back function (iCallBack_Next_Set)
84685>>>>>       define CBNS_CANCELLED          // The reading operation was cancelled by operator
84685>>>>>       define CBNS_END_OF_FILE        // The file is empty
84685>>>>>       define CBNS_OK                 // The reading of the set was completed
84685>>>>>       define CBNS_ERROR              // Some error occurred
84685>>>>>       define CBNS_ONE_OR_NONE_IN_SET // One or no records in set, but we're not done...
84685>>>>>     end_enumeration_list
84685>>>>>
84685>>>>>     function iExistsRecord.i integer rec# returns integer
84687>>>>>       integer file#
84687>>>>>       get pMainFile to file#
84688>>>>>       clear file#
84689>>>>>       set_field_value file# 0 to rec#
84692>>>>>       vfind file# 0 EQ
84694>>>>>       function_return (found)
84695>>>>>     end_function
84696>>>>>
84696>>>>>     function iCallBack_Next_Set_Help integer get# integer obj# integer rec# returns integer
84698>>>>>       integer rval#
84698>>>>>       if (iExistsRecord.i(self,rec#)) begin
84700>>>>>         if (private.pRecCount(self)) begin
84702>>>>>           get get# of obj# rec# to rval#
84703>>>>>           set private.pRecCount to (private.pRecCount(self)+1)
84704>>>>>         end
84704>>>>>>
84704>>>>>         else begin
84705>>>>>           if (private.pFirstRec(self)) begin
84707>>>>>             // Only call back when we have at least two
84707>>>>>             get get# of obj# (private.pFirstRec(self)) to rval#
84708>>>>>             if rval# get get# of obj# rec# to rval#
84711>>>>>             set private.pRecCount to 2
84712>>>>>           end
84712>>>>>>
84712>>>>>           else begin
84713>>>>>             set private.pFirstRec to rec#
84714>>>>>             move 1 to rval# // 1 means continue...
84715>>>>>           end
84715>>>>>>
84715>>>>>         end
84715>>>>>>
84715>>>>>       end
84715>>>>>>
84715>>>>>       else move 1 to rval#
84717>>>>>       function_return rval#
84718>>>>>     end_function
84719>>>>>
84719>>>>>     function iCallBack_Next_Set integer get# integer tmp_obj# returns integer
84721>>>>>       integer obj# ch# rval# pos# continue# fin#
84721>>>>>       integer prev_rec# current_rec#
84721>>>>>       string str#
84721>>>>>       if num_arguments gt 1 move tmp_obj# to obj#
84724>>>>>       else move self to obj#
84726>>>>>       get Seq_New_Channel to ch#
84727>>>>>
84727>>>>>       move CBNS_OK to rval# // Default return value
84728>>>>>       set private.pFirstRec to 0
84729>>>>>       set private.pRecCount to 0
84730>>>>>
84730>>>>>       get pCurrentPosition to pos#
84731>>>>>       direct_input channel ch# (pBadFileName(self))
84733>>>>>       ifnot (seqeof) begin
84735>>>>>         set_channel_position ch# to (pCurrentPosition(self))
84736>>>>>>
84736>>>>>
84736>>>>>         get sReadLnDuplicate.i ch# to str# // Get first line
84737>>>>>         if str# eq "" move CBNS_END_OF_FILE to rval#
84740>>>>>
84740>>>>>         if rval# ne CBNS_END_OF_FILE begin
84742>>>>>           move (ExtractInteger(str#,1)) to current_rec#
84743>>>>>           move (ExtractInteger(str#,2)) to prev_rec#
84744>>>>>           get iCallBack_Next_Set_Help get# obj# current_rec# to continue#
84745>>>>>           if continue# get iCallBack_Next_Set_Help get# obj# prev_rec# to continue#
84748>>>>>           if continue# begin
84750>>>>>             move 0 to fin#
84751>>>>>             repeat
84751>>>>>>
84751>>>>>               get sReadLnDuplicate.i ch# to str# // Get first line
84752>>>>>               if str# eq "" move 1 to fin#
84755>>>>>               else begin
84756>>>>>                 move (ExtractInteger(str#,1)) to current_rec#
84757>>>>>                 if current_rec# eq prev_rec# begin // still part of current set
84759>>>>>                   move (ExtractInteger(str#,2)) to prev_rec#
84760>>>>>                   get iCallBack_Next_Set_Help get# obj# prev_rec# to continue#
84761>>>>>                   ifnot continue# begin
84763>>>>>                     move 1 to fin#
84764>>>>>                     move CBNS_CANCELLED to fin#
84765>>>>>                   end
84765>>>>>>
84765>>>>>                 end
84765>>>>>>
84765>>>>>                 else move 1 to fin#
84767>>>>>               end
84767>>>>>>
84767>>>>>             until fin#
84769>>>>>           end
84769>>>>>>
84769>>>>>           else move CBNS_CANCELLED to rval#
84771>>>>>         end
84771>>>>>>
84771>>>>>
84771>>>>>         if (rval#=CBNS_OK and not(private.pRecCount(self))) ;                                         move CBNS_ONE_OR_NONE_IN_SET to rval#
84774>>>>>       end
84774>>>>>>
84774>>>>>       else move CBNS_ERROR to rval#
84776>>>>>       close_input channel ch#
84778>>>>>       send Seq_Release_Channel ch#
84779>>>>>       function_return rval#
84780>>>>>     end_procedure
84781>>>>>   end_class // iCallBack_Next_Set
84782>>>>>
84782>>>>>   class cDisplayRecordsGrid is a aps.Grid
84783>>>>>     procedure construct_object
84785>>>>>       forward send construct_object
84787>>>>>       property integer pMainFile public 0
84788>>>>>       //> The embedded array oFields contains a list of fields in file
84788>>>>>       //> pMainFile that should be displayed by the grid.
84788>>>>>       object oFields is an array
84790>>>>>       end_object
84791>>>>>       object oColors is an array
84793>>>>>       end_object
84794>>>>>     end_procedure
84795>>>>>
84795>>>>>     function iColumns returns integer
84797>>>>>       integer ms#
84797>>>>>       get matrix_size to ms#
84798>>>>>       function_return (low(ms#))
84799>>>>>     end_function
84800>>>>>
84800>>>>>     procedure set column_color integer column# integer color#
84802>>>>>       set value of (oColors(self)) item column# to color#
84803>>>>>     end_procedure
84804>>>>>
84804>>>>>     procedure read_fields
84806>>>>>       integer file# fld# itm# obj# type# max#
84806>>>>>       get pMainFile to file#
84807>>>>>       move (oFields(self)) to obj#
84808>>>>>       send delete_data to obj#
84809>>>>>       move 0 to itm#
84810>>>>>       get_attribute DF_FILE_NUMBER_FIELDS of file# to max#
84813>>>>>       for fld# from 0 to max#
84819>>>>>>
84819>>>>>         get_attribute DF_FIELD_TYPE of file# fld# to type#
84822>>>>>         if type# ne DF_OVERLAP begin
84824>>>>>           set value of obj# item itm# to fld#
84825>>>>>           increment itm#
84826>>>>>         end
84826>>>>>>
84826>>>>>       loop
84827>>>>>>
84827>>>>>     end_procedure
84828>>>>>
84828>>>>>     procedure initialize_items
84830>>>>>       integer max# itm# file# columns# rows# column# row# color# oColors#
84830>>>>>       get pMainFile to file#
84831>>>>>       move (oColors(self)) to oColors#
84832>>>>>       get item_count of (oFields(self)) to rows#
84833>>>>>       get icolumns to columns#
84834>>>>>       send delete_data
84835>>>>>       for row# from 0 to (rows#-1)
84841>>>>>>
84841>>>>>         for column# from 0 to (columns#-1)
84847>>>>>>
84847>>>>>           move (row#*columns#+column#) to itm#
84848>>>>>           send add_item msg_none ""
84849>>>>>           set entry_state item itm# to dfFalse
84850>>>>>           get value of oColors# item column# to color#
84851>>>>>           if color# set item_color item itm# to color#
84854>>>>>         loop
84855>>>>>>
84855>>>>>       loop
84856>>>>>>
84856>>>>>     end_procedure
84857>>>>>
84857>>>>>     procedure fill_list_field_names integer col#
84859>>>>>       integer fld# max# itm# step_size# file# obj#
84859>>>>>       string str#
84859>>>>>       move (oFields(self)) to obj#
84860>>>>>       get iColumns to step_size#
84861>>>>>       get item_count of obj# to max#
84862>>>>>       get pMainFile to file#
84863>>>>>       for itm# from 0 to (max#-1)
84869>>>>>>
84869>>>>>         get value of obj# item itm# to fld#
84870>>>>>         move (FieldInf_FieldLabel_Long(file#,fld#)) to str#
84871>>>>>         set value item col# to str#
84872>>>>>         move (col#+step_size#) to col#
84873>>>>>       loop
84874>>>>>>
84874>>>>>       set dynamic_update_state to true // Otherwise nothing will display
84875>>>>>     end_procedure
84876>>>>>
84876>>>>>     procedure fill_list_field_types integer col#
84878>>>>>       integer fld# max# itm# step_size# file# obj#
84878>>>>>       string str#
84878>>>>>       move (oFields(self)) to obj#
84879>>>>>       get iColumns to step_size#
84880>>>>>       get item_count of obj# to max#
84881>>>>>       get pMainFile to file#
84882>>>>>       for itm# from 0 to (max#-1)
84888>>>>>>
84888>>>>>         get value of obj# item itm# to fld#
84889>>>>>         move (VdfSort_field_status_help(file#,fld#)) to str#
84890>>>>>         set value item col# to str#
84891>>>>>         move (col#+step_size#) to col#
84892>>>>>       loop
84893>>>>>>
84893>>>>>       set dynamic_update_state to true // Otherwise nothing will display
84894>>>>>     end_procedure
84895>>>>>
84895>>>>>     procedure fill_list_field_data integer col# // Uses current record
84897>>>>>       integer fld# max# itm# step_size# file# obj#
84897>>>>>       string str#
84897>>>>>       move (oFields(self)) to obj#
84898>>>>>       get iColumns to step_size#
84899>>>>>       get item_count of obj# to max#
84900>>>>>       get pMainFile to file#
84901>>>>>       for itm# from 0 to (max#-1)
84907>>>>>>
84907>>>>>         get value of obj# item itm# to fld#
84908>>>>>         get_field_value file# fld# to str#
84911>>>>>         set value item col# to str#
84912>>>>>         move (col#+step_size#) to col#
84913>>>>>       loop
84914>>>>>>
84914>>>>>       set dynamic_update_state to true // Otherwise nothing will display
84915>>>>>     end_procedure
84916>>>>>
84916>>>>>     procedure clear_column integer col#
84918>>>>>       integer fld# max# itm# step_size# file#
84918>>>>>       get iColumns to step_size#
84919>>>>>       get item_count of (oFields(self)) to max#
84920>>>>>       get pMainFile to file#
84921>>>>>       for itm# from 0 to (max#-1)
84927>>>>>>
84927>>>>>         set value item col# to ""
84928>>>>>         move (col#+step_size#) to col#
84929>>>>>       loop
84930>>>>>>
84930>>>>>       set dynamic_update_state to true // Otherwise nothing will display
84931>>>>>     end_procedure
84932>>>>>
84932>>>>>     procedure fill_list.i integer file#
84934>>>>>       set pMainFile to file#
84935>>>>>       send read_fields
84936>>>>>       send initialize_items
84937>>>>>       send fill_list_field_names 0
84938>>>>>       send fill_list_field_types 3
84939>>>>>     end_procedure
84940>>>>>   end_class // cDisplayRecordsGrid
84941>>>>>
84941>>>>>   object oCleanUp_Panel is a aps.ModalPanel
84943>>>>>     set p_Auto_Column to true
84944>>>>>     set locate_mode to center_on_screen
84945>>>>>     on_key kcancel send close_panel
84946>>>>>     property integer pChanged_State  public 0
84948>>>>>     property integer pRecordToKeep   public 0
84950>>>>>     property integer pMainFile       public 0
84952>>>>>     property integer pDeleteBadOnEOF public 0
84954>>>>>     object oBadFileReader is an cBadFileReader
84956>>>>>     end_object
84957>>>>>     object oDataFileName is a aps.Form label t.VdfSort.Lbl.DataFile abstract aft_ascii80
84961>>>>>       set object_shadow_state to true
84962>>>>>     end_object
84963>>>>>     object oBadFileName is a aps.Form label t.VdfSort.Lbl.BadFile abstract aft_ascii80
84967>>>>>       set object_shadow_state to true
84968>>>>>     end_object
84969>>>>>     procedure DeleteBadFile
84972>>>>>       if (pDeleteBadOnEOF(self)) send DeleteBadFile to (oBadFileReader(self))
84975>>>>>     end_procedure
84976>>>>>
84976>>>>>     set p_Auto_Column to false
84977>>>>>     send aps_goto_max_row
84978>>>>>     send aps_make_row_space
84979>>>>>
84979>>>>>     object oGrp is a aps.Group
84981>>>>>       set p_Auto_Column to false
84982>>>>>       property integer pSetNumber public 0
84984>>>>>       property integer pMaxSet    public 0
84986>>>>>       procedure display_set_no
84989>>>>>         string str#
84989>>>>>         move t.VdfSort.Lbl.SetNo to str#
84990>>>>>         replace "#" in str# with (string(pSetNumber(self)))
84992>>>>>         replace "#" in str# with (string(pMaxSet(self)))
84994>>>>>         set label to str#
84995>>>>>       end_procedure
84996>>>>>       procedure increment_set_no
84999>>>>>         set pSetNumber to (pSetNumber(self)+1)
85000>>>>>         send display_set_no
85001>>>>>       end_procedure
85002>>>>>       procedure reset_set_no
85005>>>>>         set pSetNumber to 0
85006>>>>>         send display_set_no
85007>>>>>       end_procedure
85008>>>>>       object oLst is a aps.List label t.VdfSort.Lbl.SelectRec
85011>>>>>         set size to 150 65
85012>>>>>         set label_justification_mode to jmode_top
85013>>>>>         set select_mode to multi_select // Makes it single select (???)
85014>>>>>         function add_recnum integer rec# returns integer
85017>>>>>           send add_item msg_none rec# //(string(rec#))
85018>>>>>           function_return 1 // makes it continue
85019>>>>>         end_function
85020>>>>>         function iFill_List returns integer
85023>>>>>           integer rval# get# self# max#
85023>>>>>           send cursor_wait to (cursor_control(self))
85024>>>>>           send update_form t.VdfSort.LoadingSet
85025>>>>>           send clear_record_grid
85026>>>>>           send delete_data
85027>>>>>           move self to self#
85028>>>>>           move get_add_recnum to get#
85029>>>>>           repeat
85029>>>>>>
85029>>>>>             get iCallBack_Next_Set of (oBadFileReader(self)) get# self# to rval#
85030>>>>>             if (rval#=CBNS_OK or rval#=CBNS_ONE_OR_NONE_IN_SET) send increment_set_no
85033>>>>>           until (rval#<>CBNS_ONE_OR_NONE_IN_SET)
85035>>>>>           get item_count to max#
85036>>>>>           send update_form (string(max#)+t.VdfSort.RecordsInSet)
85037>>>>>           send cursor_ready to (cursor_control(self))
85038>>>>>           function_return rval#
85039>>>>>         end_function
85040>>>>>         procedure fill_list
85043>>>>>           integer rval#
85043>>>>>           get iFill_List to rval#
85044>>>>>           if rval# eq CBNS_END_OF_FILE begin
85046>>>>>             send obs t.VdfSort.DoReindexAgain
85047>>>>>             send DeleteBadFile // Delete .BAD file if file is cleaned
85048>>>>>             send close_panel
85049>>>>>           end
85049>>>>>>
85049>>>>>         end_procedure
85050>>>>>         procedure select_first
85053>>>>>           integer rec#
85053>>>>>           set current_item to 0
85054>>>>>           set select_state item 0 to true
85055>>>>>           get value item 0 to rec#
85056>>>>>           set pRecordToKeep to rec#
85057>>>>>         end_procedure
85058>>>>>         procedure initialize_set_count
85061>>>>>           send cursor_wait to (cursor_control(self))
85062>>>>>           send update_form t.VdfSort.CountingSets
85063>>>>>           set pMaxSet to (iCountSetsInFile(oBadFileReader(self)))
85064>>>>>           send cursor_ready to (cursor_control(self))
85065>>>>>         end_procedure
85066>>>>>         procedure auto_clean
85069>>>>>           integer fin# keep_rec# rval#
85069>>>>>           move 0 to fin#
85070>>>>>           repeat
85070>>>>>>
85070>>>>>             get iRecordSelected to keep_rec#
85071>>>>>             ifnot keep_rec# begin
85073>>>>>               send select_first
85074>>>>>               get iRecordSelected to keep_rec#
85075>>>>>             end
85075>>>>>>
85075>>>>>             ifnot keep_rec# move 1 to fin#
85078>>>>>             ifnot fin# begin
85080>>>>>               send delete_records keep_rec#
85081>>>>>               get iFill_List to rval#
85082>>>>>               if rval# eq CBNS_END_OF_FILE begin
85084>>>>>                 send obs t.VdfSort.DoReindexAgain
85085>>>>>                 send DeleteBadFile // Delete .BAD file if file is cleaned
85086>>>>>                 move 1 to fin#
85087>>>>>               end
85087>>>>>>
85087>>>>>             end
85087>>>>>>
85087>>>>>           until fin#
85089>>>>>           send close_panel
85090>>>>>         end_procedure
85091>>>>>         // This function will serve as a boolean test that it is indeed
85091>>>>>         // OK to delete all the records (but one) in the set. And it will
85091>>>>>         // in fact return the record number of the record to be kept
85091>>>>>         function iRecordSelected returns integer
85094>>>>>           integer rec# file#
85094>>>>>           // First we will check that a record has been selected:
85094>>>>>           get pRecordToKeep to rec#
85095>>>>>           if rec# begin
85097>>>>>             // OK! Now we know that a record has been selected. But we
85097>>>>>             // have to make sure that it actually still exists. It may
85097>>>>>             // have been wiped by a previous attempt to clean the file
85097>>>>>             // or indeed as a result of cleaning a previous set of identical
85097>>>>>             // records (according to another index).
85097>>>>>             //   If this situation arises (un-likely) the best the operator
85097>>>>>             // can do is to re-index the file again to generate a new up-
85097>>>>>             // to-date BAD file. Well, that's enough talking:
85097>>>>>             get pMainFile to file#
85098>>>>>             clear file#
85099>>>>>             set_field_value file# 0 to rec#
85102>>>>>             vfind file# 0 EQ
85104>>>>>             ifnot (found) move 0 to rec#
85107>>>>>           end
85107>>>>>>
85107>>>>>           function_return rec#
85108>>>>>         end_function
85109>>>>>         procedure delete_records integer keep_rec#
85112>>>>>           integer itm# max# rec# file#
85112>>>>>           send cursor_wait to (cursor_control(self))
85113>>>>>           send update_form t.VdfSort.DeletingRecs
85114>>>>>           get pMainFile to file#
85115>>>>>           get item_count to max#
85116>>>>>           lock
85117>>>>>>
85117>>>>>             for itm# from 0 to (max#-1)
85123>>>>>>
85123>>>>>               get value item itm# to rec#
85124>>>>>               if rec# ne keep_rec# begin // If it's not the record we want to keep
85126>>>>>                 clear file#
85127>>>>>                 set_field_value file# 0 to rec#
85130>>>>>                 vfind file# 0 EQ
85132>>>>>                 if (found) delete file#
85135>>>>>               end
85135>>>>>>
85135>>>>>             loop
85136>>>>>>
85136>>>>>           unlock
85137>>>>>>
85137>>>>>           send cursor_ready to (cursor_control(self))
85138>>>>>         end_procedure
85139>>>>>         procedure delete_records_and_fill_list // Delete all records not selected and get next set
85142>>>>>           integer keep_rec#
85142>>>>>           get iRecordSelected to keep_rec#
85143>>>>>           if keep_rec# begin
85145>>>>>             send delete_records keep_rec#
85146>>>>>             send fill_list
85147>>>>>           end
85147>>>>>>
85147>>>>>           else send obs t.VdfSort.SelectError
85149>>>>>         end_procedure
85150>>>>>         procedure item_change integer i1# integer i2# returns integer
85153>>>>>           integer rec#
85153>>>>>           forward get msg_item_change i1# i2# to i2#
85155>>>>>           get value item i2# to rec#
85156>>>>>           send display_current_record rec#
85157>>>>>           procedure_return i2#
85158>>>>>         end_procedure
85159>>>>>         procedure select_toggling integer itm# integer st#
85162>>>>>           integer rec#
85162>>>>>           forward send select_toggling itm# st#
85164>>>>>           if st# begin
85166>>>>>             get value item itm# to rec#
85167>>>>>             send display_keep_record rec#
85168>>>>>           end
85168>>>>>>
85168>>>>>         end_procedure
85169>>>>>       end_object
85170>>>>>       object oFrm1 is a aps.form abstract aft_ascii25 snap sl_down
85174>>>>>         set object_shadow_state to true
85175>>>>>       end_object
85176>>>>>       send aps_size_identical_max (oLst(self)) (oFrm1(self)) sl_horizontal
85177>>>>>       procedure update_form string str#
85180>>>>>         set value of (oFrm1(self)) item 0 to str#
85181>>>>>         set dynamic_update_state of (oFrm1(self)) to true
85182>>>>>       end_procedure
85183>>>>>     end_object // oGrp
85184>>>>>
85184>>>>>     object oRecordValues is a cDisplayRecordsGrid
85186>>>>>       set size to 100 0
85187>>>>>       set highlight_row_state to true
85188>>>>>//      set highlight_row_color to (rgb(0,255,255))
85188>>>>>//      set current_item_color to (rgb(0,255,255))
85188>>>>>       set CurrentCellColor     to clHighlight
85189>>>>>       set CurrentCellTextColor to clHighlightText
85190>>>>>       set CurrentRowColor      to clHighlight
85191>>>>>       set CurrentRowTextColor  to clHighlightText
85192>>>>>       set line_width to 4 0
85193>>>>>       set form_margin item 0 to 3
85194>>>>>       set form_margin item 1 to 25
85195>>>>>       set form_margin item 2 to 25
85196>>>>>       set form_margin item 3 to 10
85197>>>>>       set header_label item 0 to t.VdfSort.Lbl.FieldName
85198>>>>>       set header_label item 1 to t.VdfSort.Lbl.CurrentRec
85199>>>>>       set header_label item 2 to t.VdfSort.Lbl.RecordToKeep
85200>>>>>       set header_label item 3 to t.VdfSort.Lbl.FieldType
85201>>>>>       set select_mode to no_select
85202>>>>>       set column_color item 0 to clLtGray
85203>>>>>       set column_color item 2 to |CI$0000FF00 // Light green
85204>>>>>       set column_color item 3 to clLtGray
85205>>>>>       on_key knext_item send switch
85206>>>>>       on_key kprevious_item send switch_back
85207>>>>>       on_key kswitch send switch
85208>>>>>       on_key kswitch_back send switch_back
85209>>>>>       procedure clear_column integer col#
85212>>>>>         if col# eq 2 set pRecordToKeep to 0
85215>>>>>         forward send clear_column col#
85217>>>>>       end_procedure
85218>>>>>       procedure fill_list.i integer file#
85221>>>>>         set pRecordToKeep to 0
85222>>>>>         forward send fill_list.i file#
85224>>>>>       end_procedure
85225>>>>>       procedure display_current_record integer rec#
85228>>>>>         integer file#
85228>>>>>         get pMainFile to file#
85229>>>>>         if rec# begin
85231>>>>>           clear file#
85232>>>>>           set_field_value file# 0 to rec#
85235>>>>>           vfind file# 0 EQ
85237>>>>>           send fill_list_field_data 1
85238>>>>>         end
85238>>>>>>
85238>>>>>         else send clear_column 1
85240>>>>>       end_procedure
85241>>>>>       procedure display_keep_record integer rec#
85244>>>>>         integer file#
85244>>>>>         get pMainFile to file#
85245>>>>>         set pRecordToKeep to rec#
85246>>>>>         if rec# begin
85248>>>>>           clear file#
85249>>>>>           set_field_value file# 0 to rec#
85252>>>>>           vfind file# 0 EQ
85254>>>>>           send fill_list_field_data 2
85255>>>>>         end
85255>>>>>>
85255>>>>>         else send clear_column 2
85257>>>>>       end_procedure
85258>>>>>     end_object // oRecordValues
85259>>>>>     send aps_align_by_sizing (oRecordValues(self)) (oGrp(self)) sl_align_bottom
85260>>>>>     procedure display_current_record integer rec#
85263>>>>>       send display_current_record to (oRecordValues(self)) rec#
85264>>>>>     end_procedure
85265>>>>>     procedure display_keep_record integer rec#
85268>>>>>       send display_keep_record to (oRecordValues(self)) rec#
85269>>>>>     end_procedure
85270>>>>>     procedure clear_record_grid
85273>>>>>       send clear_column to (oRecordValues(self)) 1
85274>>>>>       send clear_column to (oRecordValues(self)) 2
85275>>>>>     end_procedure
85276>>>>>     procedure skip_set
85279>>>>>       set pDeleteBadOnEOF to false
85280>>>>>       send fill_list to (oLst(oGrp(self)))
85281>>>>>     end_procedure
85282>>>>>     on_key ksave_record send delete_records_and_fill_list to (oLst(oGrp(self)))
85283>>>>>     object oBtn1 is a aps.Multi_Button
85285>>>>>       on_item t.btn.ok send delete_records_and_fill_list to (oLst(oGrp(self)))
85286>>>>>     end_object
85287>>>>>     object oBtn2 is a aps.Multi_Button
85289>>>>>       on_item t.VdfSort.Btn.Skip send skip_set
85290>>>>>     end_object
85291>>>>>     object oBtn3 is a aps.Multi_Button
85293>>>>>       on_item t.VdfSort.Btn.Auto send auto_clean to (oLst(oGrp(self)))
85294>>>>>     end_object
85295>>>>>     object oBtn4 is a aps.Multi_Button
85297>>>>>       on_item t.btn.cancel send close_panel
85298>>>>>     end_object
85299>>>>>     send aps_locate_multi_buttons
85300>>>>>     function sBadFileInfo string badfile# returns string
85303>>>>>       string rval#
85303>>>>>       number ts#
85303>>>>>       if (SEQ_FileExists(badfile#)) begin
85305>>>>>         move "# bytes, generated: #" to rval#
85306>>>>>         replace "#" in rval# with (string(SEQ_FileSize(badfile#)))
85308>>>>>         move (SEQ_FileModTime(badfile#)) to ts#
85309>>>>>         replace "#" in rval# with (TS_ConvertToString(ts#))
85311>>>>>       end
85311>>>>>>
85311>>>>>       else move "File not found" to rval#
85313>>>>>       function_return rval#
85314>>>>>     end_function
85315>>>>>     procedure run.isss integer file# string caption# string rn# string bad#
85318>>>>>       integer wasopen# open# type#
85318>>>>>       move (DBMS_IsOpenFile(file#)) to wasopen#
85319>>>>>       move (DBMS_OpenFile(file#,DF_EXCLUSIVE,0)) to open#
85320>>>>>       if open# begin
85322>>>>>         set pChanged_State to false
85323>>>>>         set pBadFileName of (oBadFileReader(self)) to bad#
85324>>>>>         send reset to (oBadFileReader(self))
85325>>>>>         set pMainFile of (oBadFileReader(self)) to file#
85326>>>>>         send reset_set_no to (oGrp(self))
85327>>>>>         send fill_list.i to (oRecordValues(self)) file#
85328>>>>>         set value of (oDataFileName(self)) to (rn#+" ("+string(DBMS_FileInfo(file#,1))+" records in file)")
85329>>>>>         set value of (oBadFileName(self)) to (bad#+" ("+sBadFileInfo(self,bad#)+")")
85330>>>>>         set label to ("Clean up, "+caption#)
85331>>>>>         set pMainFile to file#
85332>>>>>         send deferred_message msg_initialize_set_count (oLst(oGrp(self)))
85333>>>>>         send deferred_message msg_fill_list (oLst(oGrp(self)))
85334>>>>>         set pDeleteBadOnEOF to true
85335>>>>>         send popup
85336>>>>>       end
85336>>>>>>
85336>>>>>       else send obs t.VdfSort.CantGainExcl
85338>>>>>       if wasopen# move (DBMS_OpenFile(file#,DF_SHARE,0)) to open# // Switch back to shared mode
85341>>>>>       else close file#
85343>>>>>     end_procedure
85344>>>>>     set pMinimumSize to 160 0
85345>>>>>     set Border_Style to BORDER_THICK   // Make panel resizeable
85346>>>>>     procedure aps_onResize integer delta_rw# integer delta_cl#
85349>>>>>       send aps_init to (oGrp(self))
85350>>>>>       send aps_resize (oLst(oGrp(self))) delta_rw# 0
85351>>>>>       send aps_auto_locate_control to (oGrp(self)) (oFrm1(oGrp(self))) sl_down (oLst(oGrp(self)))
85352>>>>>       send aps_auto_size_container to (oGrp(self))
85353>>>>>       send aps_align_by_sizing (oRecordValues(self)) (oGrp(self)) sl_align_bottom
85354>>>>>       send aps_register_max_rc (oRecordValues(self))
85355>>>>>       send aps_register_multi_button (oBtn1(self))
85356>>>>>       send aps_register_multi_button (oBtn2(self))
85357>>>>>       send aps_register_multi_button (oBtn3(self))
85358>>>>>       send aps_register_multi_button (oBtn4(self))
85359>>>>>       send aps_locate_multi_buttons
85360>>>>>       send aps_auto_size_container
85361>>>>>     end_procedure
85362>>>>>   end_object
85363>>>>>
85363>>>>>   procedure DoCleanupFile integer file# string caption# string rn# string bad#
85366>>>>>     send run.isss to (oCleanUp_Panel(self)) file# caption# rn# bad#
85367>>>>>   end_procedure
85368>>>>>
85368>>>>>   object oSelectBadFile is a aps.ModalPanel label t.VdfSort.SelectFileToClean
85371>>>>>     set locate_mode to center_on_screen
85372>>>>>     set Border_Style to BORDER_THICK   // Make panel resizeable
85373>>>>>     on_key kCancel      send close_panel
85374>>>>>     on_key kSave_Record send CleanUp_File
85375>>>>>     object oGrd is a aps.Grid
85377>>>>>       set size to 200 0
85378>>>>>       set highlight_row_state to true
85379>>>>>       set CurrentCellColor     to clHighlight
85380>>>>>       set CurrentCellTextColor to clHighlightText
85381>>>>>       set CurrentRowColor      to clHighlight
85382>>>>>       set CurrentRowTextColor  to clHighlightText
85383>>>>>     //set highlight_row_color to (rgb(0,255,255))
85383>>>>>     //set current_item_color to (rgb(0,255,255))
85383>>>>>       set line_width to 5 0
85384>>>>>       set form_margin item 0 to 3
85385>>>>>       set form_margin item 1 to 17
85386>>>>>       set form_margin item 2 to 30
85387>>>>>       set form_margin item 3 to 30
85388>>>>>       set form_margin item 4 to 25
85389>>>>>       set header_label item 0 to "#"
85390>>>>>       set header_label item 1 to t.VdfSort.Lbl.UserName
85391>>>>>       set header_label item 2 to t.VdfSort.Lbl.DataFileLoc
85392>>>>>       set header_label item 3 to t.VdfSort.Lbl.BadFileLoc
85393>>>>>       set header_label item 4 to t.VdfSort.Lbl.SizeAndTime
85394>>>>>       set select_mode to no_select
85395>>>>>       on_key kenter send CleanUp_File
85396>>>>>       on_key kSave_Record send CleanUp_File
85397>>>>>
85397>>>>>       object oValues is an array
85399>>>>>       end_object
85400>>>>>
85400>>>>>       procedure add_item_value string value#
85403>>>>>         integer arr#
85403>>>>>         move (oValues(self)) to arr#
85404>>>>>         set value of arr# item (item_count(arr#)) to value#
85405>>>>>       end_procedure
85406>>>>>
85406>>>>>       procedure add_bad_file integer file# string dn# string rn_path# string badfile#
85409>>>>>         string str#
85409>>>>>         move (TS_ConvertToString(SEQ_FileModTime(badfile#))+", ("+InsertThousandsSep(string(SEQ_FileSize(badfile#)))+" bytes)") to str#
85410>>>>>         send add_item msg_none (string(file#))
85411>>>>>         send add_item msg_none dn#
85412>>>>>         send add_item msg_none (lowercase(rn_path#))
85413>>>>>         send add_item msg_none badfile#
85414>>>>>         send add_item msg_none str#
85415>>>>>         send add_item_value (string(file#))
85416>>>>>         send add_item_value dn#
85417>>>>>         send add_item_value (lowercase(rn_path#))
85418>>>>>         send add_item_value badfile#
85419>>>>>         send add_item_value str#
85420>>>>>       end_procedure
85421>>>>>
85421>>>>>       object oBadFiles is a set
85423>>>>>         set delegation_mode to delegate_to_parent
85424>>>>>         procedure dump_items integer file# string dn# string rn_path#
85427>>>>>           integer max# itm#
85427>>>>>           get item_count to max#
85428>>>>>           for itm# from 0 to (max#-1)
85434>>>>>>
85434>>>>>             send add_bad_file file# dn# rn_path# (value(self,itm#))
85435>>>>>           loop
85436>>>>>>
85436>>>>>         end_procedure
85437>>>>>         procedure add_element_lowercase string file#
85440>>>>>           move (SEQ_TranslatePathToAbsolute(file#)) to file#
85441>>>>>           send add_element (lowercase(file#))
85442>>>>>         end_procedure
85443>>>>>         procedure fill_list_help2 integer file# string dn# string rn# string rn_path#
85446>>>>>           string badfile# path#
85446>>>>>           send delete_data
85447>>>>>
85447>>>>>           // First test if there is a .BAD file next to the .DAT file:
85447>>>>>           uppercase rn_path#
85448>>>>>>
85448>>>>>           move (StripFromLastOccurance(rn_path#,".DAT")) to badfile#
85449>>>>>           move (badfile#+".BAD") to badfile#
85450>>>>>           if (SEQ_FileExists(badfile#)) send add_element_lowercase badfile#
85453>>>>>
85453>>>>>           // Then we check to see if there are any bad files in other directories along dfpath
85453>>>>>           get SEQ_DfPath to path#
85454>>>>>           send SEQ_CallBack_FileInPath (rn#+".bad") path# msg_add_element_lowercase self
85455>>>>>           send dump_items file# dn# rn_path#
85456>>>>>           send delete_data
85457>>>>>         end_procedure
85458>>>>>       end_object // oBadFiles
85459>>>>>       procedure fill_list1 integer file#
85462>>>>>         integer wasopen# type#
85462>>>>>         string str# rn# bad_name#
85462>>>>>         if file# begin
85464>>>>>           move (DBMS_IsOpenFile(file#)) to wasopen#
85465>>>>>           if wasopen# move (DBMS_FileDriverType(file#)) to type#
85468>>>>>           else move (DBMS_OpenFile(file#,DF_SHARE,0)) to type#
85470>>>>>           if type# eq DBMS_DRIVER_DATAFLEX begin // OK! We're dealing with a DF file that can be opened:
85472>>>>>             // Now, is there a BAD file present on the system?:
85472>>>>>             get_attribute DF_FILE_ROOT_NAME of file# to rn#
85475>>>>>             send fill_list_help2 to (oBadFiles(self)) file# (File_Display_Name(file#)) rn# (DBMS_Rootname_Path(file#))
85476>>>>>           end
85476>>>>>>
85476>>>>>           if (DBMS_IsOpenFile(file#) and not(wasopen#)) close file#
85479>>>>>         end
85479>>>>>>
85479>>>>>       end_procedure
85480>>>>>       procedure fill_list
85483>>>>>         integer itm# max# self#
85483>>>>>         send cursor_wait to (cursor_control(self))
85484>>>>>         send delete_data
85485>>>>>         send delete_data to (oValues(self))
85486>>>>>         move self to self#
85487>>>>>         send DBMS_Callback_FilelistEntries (FLEC_ALL+FLEC_NO_ALIAS) msg_fill_list1 self#
85488>>>>>         get item_count to max#
85489>>>>>         for itm# from 0 to (max#-1)
85495>>>>>>
85495>>>>>           set entry_state item itm# to false
85496>>>>>         loop
85497>>>>>>
85497>>>>>         send cursor_ready to (cursor_control(self))
85498>>>>>       end_procedure
85499>>>>>       procedure CleanUp_File
85502>>>>>         integer base# tmp# file#
85502>>>>>         string caption# rn# bad_file#
85502>>>>>         if (item_count(self)) begin
85504>>>>>           get current_item to base#
85505>>>>>           move ((base#/5)*5) to base#
85506>>>>>           get value of (oValues(self)) item base# to file#
85507>>>>>           get value of (oValues(self)) item (base#+1) to caption#
85508>>>>>           get value of (oValues(self)) item (base#+2) to rn#
85509>>>>>           get value of (oValues(self)) item (base#+3) to bad_file#
85510>>>>>           send DoCleanupFile file# caption# rn# bad_file#
85511>>>>>           ifnot (SEQ_FileExists(bad_file#)) send fill_list
85514>>>>>         end
85514>>>>>>
85514>>>>>       end_procedure
85515>>>>>     end_object // oGrd
85516>>>>>     procedure CleanUp_File
85519>>>>>       send CleanUp_File to (oGrd(self))
85520>>>>>     end_procedure
85521>>>>>     register_object oBtn2
85521>>>>>     procedure empty_warning
85524>>>>>       send obs t.VdfSort.NoFilesToClean
85525>>>>>       send activate to (oBtn2(self))
85526>>>>>     end_procedure
85527>>>>>     procedure popup
85530>>>>>       send fill_list to (oGrd(self))
85531>>>>>       ifnot (item_count(oGrd(self))) send deferred_message msg_empty_warning
85534>>>>>       forward send popup
85536>>>>>     end_procedure
85537>>>>>     object oBtn1 is a aps.Multi_Button
85539>>>>>       on_item t.VdfSort.CleanFile send CleanUp_File
85540>>>>>     end_object
85541>>>>>     object oBtn2 is a aps.Multi_Button
85543>>>>>       on_item t.btn.close send close_panel
85544>>>>>     end_object
85545>>>>>     send aps_locate_multi_buttons
85546>>>>>     procedure aps_onResize integer delta_rw# integer delta_cl#
85549>>>>>       send aps_resize (oGrd(self)) delta_rw# 0
85550>>>>>       send aps_register_multi_button (oBtn1(self))
85551>>>>>       send aps_register_multi_button (oBtn2(self))
85552>>>>>       send aps_locate_multi_buttons
85553>>>>>       send aps_auto_size_container
85554>>>>>     end_procedure
85555>>>>>   end_object
85556>>>>>  register_object oBtn2
85556>>>>>  register_object oSortBufferSize
85556>>>>>
85556>>>>>  object oVdfSort_Properties is a aps.ModalPanel label t.VdfSort.Prop_Caption
85559>>>>>    set help_id to hlpid.VdfSort_Properties
85560>>>>>    property integer pResult public 0
85562>>>>>    set locate_mode to center_on_screen
85563>>>>>    on_key kcancel send close_panel
85564>>>>>    procedure activate_next
85567>>>>>      send activate to (oSortBufferSize(self))
85568>>>>>    end_procedure
85569>>>>>    procedure activate_previous
85572>>>>>      send activate to (oBtn2(self))
85573>>>>>    end_procedure
85574>>>>>    object oRadio1 is a aps.RadioGroup label t.VdfSort.Prop_BadData
85577>>>>>      on_key knext_item     send activate_next
85578>>>>>      on_key kprevious_item send activate_previous
85579>>>>>      object oRad1 is a aps.Radio label t.VdfSort.Prop_BD_NoCheck
85582>>>>>      end_object
85583>>>>>      object oRad2 is a aps.Radio label t.VdfSort.Prop_BD_SpaceFill
85586>>>>>      end_object
85587>>>>>      object oRad3 is a aps.Radio label t.VdfSort.Prop_BD_WriteFile
85590>>>>>      end_object
85591>>>>>      object oRad4 is a aps.Radio label t.VdfSort.Prop_BD_Abort
85594>>>>>        set object_shadow_state to true
85595>>>>>      end_object
85596>>>>>    end_object
85597>>>>>    object oRadio2 is a aps.RadioGroup label t.VdfSort.Prop_Duplicates
85600>>>>>      object oRad1 is a aps.Radio label t.VdfSort.Prop_DD_WriteFile
85603>>>>>        set object_shadow_state to true
85604>>>>>      end_object
85605>>>>>      object oRad2 is a aps.Radio label t.VdfSort.Prop_DD_Abort
85608>>>>>        set object_shadow_state to true
85609>>>>>      end_object
85610>>>>>    end_object
85611>>>>>    send aps_size_identical_max (oRadio1(self)) (oRadio2(self)) sl_vertical
85612>>>>>    send aps_goto_max_row
85613>>>>>    object oSortBufferSize is a aps.Form label (t.VdfSort.Prop_SortBuffer+":") abstract aft_numeric6.0
85617>>>>>      procedure switch_back
85620>>>>>        send activate to (oRadio1(self))
85621>>>>>      end_procedure
85622>>>>>      on_key kprevious_item send switch_back
85623>>>>>    end_object
85624>>>>>    send aps_align_by_moving (oSortBufferSize(self)) (oRadio2(self)) sl_align_left
85625>>>>>    object oBtn1 is a aps.Multi_Button
85627>>>>>      on_item t.btn.ok send close_panel_ok
85628>>>>>    end_object
85629>>>>>    object oBtn2 is a aps.Multi_Button
85631>>>>>      on_item t.btn.cancel send close_panel
85632>>>>>    end_object
85633>>>>>    send aps_locate_multi_buttons
85634>>>>>    procedure close_panel_ok
85637>>>>>      set pResult to true
85638>>>>>      send close_panel
85639>>>>>    end_procedure
85640>>>>>    procedure popup
85643>>>>>      integer itm# grb# buffer#
85643>>>>>      integer iNull
85643>>>>>      string sNull
85643>>>>>      move 0 to iNull
85644>>>>>      move "" to sNull
85645>>>>>      move 0 to itm#
85646>>>>>      if (oVdfSort_SortOptions# iand DF_SORT_OPTION_NO_DATA_CHECK ) move 0 to itm#
85649>>>>>      if (oVdfSort_SortOptions# iand DF_SORT_OPTION_BAD_DATA_FIXUP) move 1 to itm#
85652>>>>>      if (oVdfSort_SortOptions# iand DF_SORT_OPTION_BAD_DATA_FILE ) move 2 to itm#
85655>>>>>      if (oVdfSort_SortOptions# iand DF_SORT_OPTION_BAD_DATA_ABORT) move 3 to itm#
85658>>>>>      set current_radio of (oRadio1(self)) to itm#
85659>>>>>      move 0 to itm#
85660>>>>>      if (oVdfSort_SortOptions# iand DF_SORT_OPTION_DUP_DATA_FILE ) move 0 to itm#
85663>>>>>      if (oVdfSort_SortOptions# iand DF_SORT_OPTION_DUP_DATA_ABORT) move 1 to itm#
85666>>>>>      set current_radio of (oRadio2(self)) to itm#
85667>>>>>
85667>>>>>      call_driver iNull "DATAFLEX" function FLEX_GET_MAX_SORT_BUFFER callback iNull passing sNull iNull iNull result buffer#
85672>>>>>      set value of (oSortBufferSize(self)) item 0 to buffer#
85673>>>>>
85673>>>>>      set pResult to false
85674>>>>>      forward send popup
85676>>>>>      if (pResult(self)) begin
85678>>>>>        move 0 to oVdfSort_SortOptions#
85679>>>>>        get current_radio of (oRadio1(self)) to itm#
85680>>>>>        if itm# eq 0 move DF_SORT_OPTION_NO_DATA_CHECK  to oVdfSort_SortOptions#
85683>>>>>        if itm# eq 1 move DF_SORT_OPTION_BAD_DATA_FIXUP to oVdfSort_SortOptions#
85686>>>>>        if itm# eq 2 move DF_SORT_OPTION_BAD_DATA_FILE  to oVdfSort_SortOptions#
85689>>>>>        if itm# eq 3 move DF_SORT_OPTION_BAD_DATA_ABORT to oVdfSort_SortOptions#
85692>>>>>        get current_radio of (oRadio2(self)) to itm#
85693>>>>>        if itm# eq 0 move (DF_SORT_OPTION_DUP_DATA_FILE +oVdfSort_SortOptions#) to oVdfSort_SortOptions#
85696>>>>>        if itm# eq 1 move (DF_SORT_OPTION_DUP_DATA_ABORT+oVdfSort_SortOptions#) to oVdfSort_SortOptions#
85699>>>>>
85699>>>>>        get value of (oSortBufferSize(self)) item 0 to buffer#
85700>>>>>        call_driver iNull "DATAFLEX" function FLEX_SET_MAX_SORT_BUFFER callback iNull passing sNull iNull buffer# result grb#
85705>>>>>      end
85705>>>>>>
85705>>>>>    end_procedure
85706>>>>>  end_object //oVdfSort_Properties
85707>>>>>
85707>>>>>  procedure popup_sort_properties
85710>>>>>    send popup to (oVdfSort_Properties(self))
85711>>>>>  end_procedure
85712>>>>>
85712>>>>>  object oVdfSort is a aps.View label t.VdfSort.Caption
85715>>>>>    on_key kCancel send close_panel
85716>>>>>    set help_id to hlpid.VdfSort_Select
85717>>>>>    procedure Print_Report
85720>>>>>      // Cancel ToolBar message
85720>>>>>    end_procedure
85721>>>>>    object oCont is a aps.Container3D
85723>>>>>      set p_auto_column to false
85724>>>>>      set peAnchors to (anTop+anLeft+anRight+anBottom)
85725>>>>>      object oList is a cFdxFileMultiSelector // cFileListMultiSelectorGrid
85727>>>>>        set size to 180 0
85728>>>>>        set piNo_Alias_State to true          // Exclude alias files
85729>>>>>        set piBad_Entries_State to BAD_ENTRIES_SHADOW // Shade un-available entries
85730>>>>>        send DriverFilter_Add DBMS_DRIVER_DATAFLEX
85731>>>>>        set peResizeColumn to rcAll
85732>>>>>        set peAnchors to (anTop+anLeft+anRight+anBottom)
85733>>>>>        object oExclusiveError is an Array
85735>>>>>        end_object
85736>>>>>        function sExclusiveErrorText returns string
85739>>>>>          integer obj# itm# max#
85739>>>>>          string rval#
85739>>>>>          move (oExclusiveError(self)) to obj#
85740>>>>>          get item_count of obj# to max#
85741>>>>>          move (max# min 5) to max#
85742>>>>>          for itm# from 0 to (max#-1)
85748>>>>>>
85748>>>>>            move (rval#+DBMS_Rootname_Path(value(obj#,itm#))) to rval#
85749>>>>>            if itm# ne (max#-1) move (rval#+character(10)) to rval#
85752>>>>>          loop
85753>>>>>>
85753>>>>>          if (item_count(obj#)) gt max# move (rval#+character(10)+"...") to rval#
85756>>>>>          function_return rval#
85757>>>>>        end_function
85758>>>>>
85758>>>>>        procedure add_file.i integer file#
85761>>>>>          if file# ne 50 forward send add_file.i file# // Skip FLEXERRS
85765>>>>>        end_procedure
85766>>>>>
85766>>>>>        procedure SortFile integer file#
85769>>>>>          sort File# '' oVdfSort_SortOptions# oVdfSort_Callback_vw#
85771>>>>>        end_procedure
85772>>>>>
85772>>>>>        procedure OpenFileExclusive integer file#
85775>>>>>          ifnot (iOpen_file.ii(VdfSort_oFileAllFiles(self),file#,DF_EXCLUSIVE)) ;            set value of (oExclusiveError(self)) ;              item (item_count(oExclusiveError(self))) to file#
85778>>>>>        end_procedure
85779>>>>>
85779>>>>>        procedure VdfSort_RestoreOpenFiles
85782>>>>>          //send obs "VdfSort_RestoreOpenFiles was called"
85782>>>>>        end_procedure
85783>>>>>
85783>>>>>        procedure CustomizedRestore
85786>>>>>          broadcast recursive send VdfSort_RestoreOpenFiles to desktop
85788>>>>>        end_procedure
85789>>>>>
85789>>>>>        procedure WS_OnCloseWorkSpace string lsOldWS
85792>>>>>          send delete_data
85793>>>>>        end_procedure
85794>>>>>
85794>>>>>        procedure DoReindex_Help
85797>>>>>          send Callback_Selected_Files msg_SortFile
85798>>>>>          send Ending_Sort to oVdfSort_Callback_vw#
85799>>>>>          send RestoreFiles to (VdfSort_oFileAllFiles(self))
85800>>>>>          send CustomizedRestore
85801>>>>>          send Cursor_Ready to (cursor_control(self))
85802>>>>>        end_procedure
85803>>>>>
85803>>>>>        procedure DoReindex
85806>>>>>          integer Self# Client_ID#
85806>>>>>          string str#
85806>>>>>          move self to Self#
85807>>>>>          ifnot oVdfSort_Callback_vw# begin
85809>>>>>            // If oVdfSort_Callback_vw has not yet been created we do it here:
85809>>>>>            move (Client_ID(Self#)) to Client_ID#
85810>>>>>            if Client_ID# CREATE_OBJECT_GROUP OG_VdfSort_Callback_vw PARENT Client_ID#
85821>>>>>            else error 666 "ClientArea not found!"
85823>>>>>          end
85823>>>>>>
85823>>>>>          if oVdfSort_Callback_vw# begin
85825>>>>>            send Cursor_Wait to (cursor_control(self))
85826>>>>>            send RegisterCurrentOpenFiles to (VdfSort_oFileAllFiles(self))
85827>>>>>            send CloseAllFiles to (VdfSort_oFileAllFiles(self))
85828>>>>>            send Delete_Data to (oExclusiveError(self))
85829>>>>>            send Callback_Selected_Files msg_OpenFileExclusive
85830>>>>>            ifnot (item_count(oExclusiveError(self))) begin
85832>>>>>              send Popup to oVdfSort_Callback_vw#
85833>>>>>              // The below message makes sure that procedure DoReindex_Help
85833>>>>>              // is not executed until the previous message has finished
85833>>>>>              // 100%. It's a way of bypassing screen paint optimization.
85833>>>>>              send deferred_message msg_DoReindex_Help
85834>>>>>            end
85834>>>>>>
85834>>>>>            else begin // Exclusive access could not be obtained
85835>>>>>              send CloseAllFiles to (VdfSort_oFileAllFiles(self))
85836>>>>>              send RestoreFiles to (VdfSort_oFileAllFiles(self))
85837>>>>>              send CustomizedRestore
85838>>>>>              send Cursor_Ready to (cursor_control(self))
85839>>>>>              move (t.VdfSort.Err.Exclusive1+character(10)) to str#
85840>>>>>              move (str#+t.VdfSort.Err.Exclusive2+character(10)) to str#
85841>>>>>              move (str#+t.VdfSort.Err.Exclusive3+character(10)) to str#
85842>>>>>              move (str#+t.VdfSort.Err.Exclusive4) to str#
85843>>>>>              move (str#+character(10)+character(10)+sExclusiveErrorText(self)) to str#
85844>>>>>              send Info_Box str# t.VdfSort.Wait.Error
85845>>>>>            end
85845>>>>>>
85845>>>>>          end
85845>>>>>>
85845>>>>>        end_procedure
85846>>>>>        send fill_list_all_files
85847>>>>>        procedure Conditional_FillList
85850>>>>>          ifnot (item_count(self)) send fill_list_all_files
85853>>>>>        end_procedure
85854>>>>>        procedure SelectBadFile
85857>>>>>          send popup to (oSelectBadFile(self))
85858>>>>>        end_procedure
85859>>>>>        procedure update_select_display // This is called automatically by the class
85862>>>>>          integer selected# total#
85862>>>>>          get File_Select_Count to selected#
85863>>>>>          get Row_Count to total#
85864>>>>>          send select_display selected# total#
85865>>>>>        end_procedure
85866>>>>>        register_procedure cleanup_file integer file# string dn# string fn# string bad#
85866>>>>>      end_object // oList
85867>>>>>      object oBtn1 is a aps.multi_button
85869>>>>>        set peAnchors to (anTop+anRight)
85870>>>>>        on_item t.FDX.Btn.SelectOpen send select_open to (oList(self))
85871>>>>>      end_object
85872>>>>>      object oBtn2 is a aps.multi_button
85874>>>>>        set peAnchors to (anTop+anRight)
85875>>>>>        on_item t.FDX.Btn.SelectAll send select_all_not_bad to (oList(self))
85876>>>>>      end_object
85877>>>>>      object oBtn3 is a aps.multi_button
85879>>>>>        set peAnchors to (anTop+anRight)
85880>>>>>        on_item t.FDX.Btn.SelectNone send select_none to (oList(self))
85881>>>>>      end_object
85882>>>>>      object oBtn4 is a aps.multi_button
85884>>>>>        set peAnchors to (anTop+anRight)
85885>>>>>        on_item t.FDX.Btn.SelectInvert send select_invert to (oList(self))
85886>>>>>      end_object
85887>>>>>      object oBtn6 is a aps.multi_button
85889>>>>>        set peAnchors to (anTop+anRight)
85890>>>>>        on_item t.VdfSort.FileLocations send OpenStat.DisplayFileLocations
85891>>>>>      end_object
85892>>>>>      send aps_register_multi_button (oBtn6(self))
85893>>>>>      object oBtn7 is a aps.multi_button
85895>>>>>        set peAnchors to (anTop+anRight)
85896>>>>>        on_item "DFMatrix" send OpenStat.Chain_DFMatrix
85897>>>>>      end_object
85898>>>>>      send aps_locate_multi_buttons SL_VERTICAL
85899>>>>>      object oSelectTxt is a aps.TextBox snap sl_right relative_to (oList(self))
85907>>>>>        set fixed_size to 10 50
85908>>>>>        set peAnchors to (anBottom+anRight)
85909>>>>>      end_object
85910>>>>>      send aps_align_by_moving (oSelectTxt(self)) (oList(self)) SL_ALIGN_BOTTOM
85911>>>>>      procedure select_display integer selected# integer total#
85914>>>>>        set value of (oSelectTxt(self)) to (t.FDX.Selected+" "+string(selected#))
85915>>>>>      end_procedure
85916>>>>>    end_object
85917>>>>>    on_key ksave_record send DoReindex to (oList(oCont(self)))
85918>>>>>    object oBtn1 is a aps.multi_button
85920>>>>>      set peAnchors to (anBottom+anRight)
85921>>>>>      on_item t.VdfSort.Btn.Reindex send DoReindex to (oList(oCont(self)))
85922>>>>>    end_object
85923>>>>>    object oBtn2 is a aps.multi_button
85925>>>>>      set peAnchors to (anBottom+anRight)
85926>>>>>      on_item t.btn.properties send popup_sort_properties
85927>>>>>    end_object
85928>>>>>    object oBtn3 is a aps.multi_button
85930>>>>>      set peAnchors to (anBottom+anRight)
85931>>>>>      on_item t.btn.close send close_panel
85932>>>>>    end_object
85933>>>>>    send aps_locate_multi_buttons
85934>>>>>
85934>>>>>    set Border_Style to BORDER_THICK   // Make panel resizeable
85935>>>>>    set Window_Style to WS_MAXIMIZEBOX 1
85936>>>>>    move self to oVdfSort#
85937>>>>>    procedure Close_Query_View
85940>>>>>      send close_panel
85941>>>>>    end_procedure
85942>>>>>    procedure popup
85945>>>>>      send Conditional_FillList to (oList(oCont(self)))
85946>>>>>      forward send popup
85948>>>>>    end_procedure
85949>>>>>
85949>>>>>    procedure DoDefaultSortBuffer
85952>>>>>      integer liGrb iNull
85952>>>>>      string sNull
85952>>>>>      call_driver iNull "DATAFLEX" function FLEX_SET_MAX_SORT_BUFFER callback iNull passing sNull iNull 65536 result liGrb
85957>>>>>    end_procedure
85958>>>>>    send DoDefaultSortBuffer
85959>>>>>
85959>>>>>  end_object
85960>>>>>  set piMinSize of oVdfSort# to (hi(size(oVdfSort#))) (low(size(oVdfSort#)))
85961>>>>>END_DEFINE_OBJECT_GROUP // OG_VdfSort
85962>>>>>
85962>>>>>procedure Activate_Sort_Vw
85965>>>>>  integer Self# Client_ID# DbBldr#
85965>>>>>  ifnot oVdfSort# begin
85967>>>>>    // If oVdfSort view has not yet been created we do it here:
85967>>>>>    move self to Self#
85968>>>>>    move (Client_ID(Self#)) to Client_ID#
85969>>>>>    if Client_ID# CREATE_OBJECT_GROUP OG_VdfSort PARENT Client_ID# //DbBldr#
85980>>>>>    else error 666 "ClientArea not found!"
85982>>>>>  end
85982>>>>>>
85982>>>>>  if oVdfSort# send popup to oVdfSort#
85985>>>>>end_procedure
85986>>>>>
85986>>>>>
85986>>>>>//  Use DBMS.utl     // Basic DBMS functions
85986>>>>>//  Use Files.utl    // Utilities for handling file related stuff
85986>>>>>//
85986>>>>>//  procedure reindex_one
85986>>>>>//    integer open#
85986>>>>>//    string file_name#
85986>>>>>//
85986>>>>>//    get SEQ_SelectFile "Locate data file to reindex" ;
85986>>>>>//                         "Datafiles (*.dat)|*.DAT" to file_name#
85986>>>>>//    if file_name# ne "" begin
85986>>>>>//      get DBMS_OpenFileAs file_name# 249 DF_EXCLUSIVE 0 to open#
85986>>>>>//      if open# begin
85986>>>>>//        sort 249 // Vi forudstter at 249 er ledig
85986>>>>>//        close 249
85986>>>>>//      end
85986>>>>>//    end
85986>>>>>//  end_procedure
85986>  End_Object  // Client_Area
85987>
85987>  Object Status_Bar is a cSturesStatusBar
85989>  End_Object
85990>End_Object // Main
85991>send deactivate to (oSplash(self))
85992>send Open_A_View_Please to (Client_Area(Main(self)))
85993>
85993>Start_UI
85994>
85994>
Summary
Memory Available: 2147483647
Total Warnings : 0
Total Errors   : 0
Total Symbols  : 42962
Total Resources: 0
Total Commands : 85993
Total Windows  : 1
Total Pages    : 1
Static Data    : 670219
Message area   : 520823
Total Blocks   : 30020