Compiling Program: C:\Apps\VDFQuery\AppSrc\fastview.src
Memory Available: 1259876352
Warning: Header for C:\Apps\VDFQuery\AppSrc\fastview not found, compiling whole program.
1>// The section embraced between the #HEADER and the #ENDHEADER symbols
1>// represents 99% of the code making up FastView. This may be compiled
1>// once and for all.
1>
1>Use dfallent
Using pre-compiled package DFALLENT
Including file: dfallent.pkd (c:\VDF12\Pkg\dfallent.pkd)
34150>Use LangSymb.pkg // Language symbols
Including file: langsymb.pkg (C:\Apps\VDFQuery\AppSrc\langsymb.pkg)
34150>>>// Use LangSymb.pkg // Language symbols
34150>>>//
34150>>>// This package file is part of VDFQuery.
34150>>>
34150>>>define LNG_DUTCH for 0 // 131
34150>>>define LNG_FRENCH for 1 // 133
34150>>>define LNG_SPANISH for 2 // 134
34150>>>define LNG_ITALIAN for 3 // 139 // NOT TRANSLATED. DO NOT SELECT!
34150>>>define LNG_ENGLISH for 4 // 144
34150>>>define LNG_DANISH for 5 // 145
34150>>>define LNG_SWEDISH for 6 // 146
34150>>>define LNG_NORWEGIAN for 7 // 147
34150>>>define LNG_GERMAN for 8 // 149
34150>>>define LNG_PORTUGUESE for 9 // 155
34150>>>define LNG_PAPIAMENTU for 10 // 199 // NOT TRANSLATED. DO NOT SELECT!
34150>>>define LNG_MAX for 11 // Points one higher than the highest language
34150>define lng_default for LNG_ENGLISH // <-- Change default language here
34150>
34150>Use FastView.pkg
Including file: fastview.pkg (C:\Apps\VDFQuery\AppSrc\fastview.pkg)
34150>>>Use APS
Including file: aps.pkg (C:\Apps\VDFQuery\AppSrc\aps.pkg)
34150>>>>>// *************************************************************************
34150>>>>>// Use APS.pkg // Auto Positioning and Sizing classes for VDF
34150>>>>>//
34150>>>>>// Version: 2.1+
34150>>>>>// by Sture Andersen
34150>>>>>//
34150>>>>>// NOTE! The classes defined in this file are ONLY concerned with sizing and
34150>>>>>// locating objects. They do not change the navigational behavior of
34150>>>>>// your objects or in any other way extend or limit the functionality
34150>>>>>// compared to standard VDF classes.
34150>>>>>//
34150>>>>>// Once the objects have been created, sized and located APS makes
34150>>>>>// no difference to the behavior to your objects.
34150>>>>>//
34150>>>>>// Support: Contact via DAW news groups preferred.
34150>>>>>//
34150>>>>>// E-mail: sture.aps@mail.tele.dk
34150>>>>>//
34150>>>>>// ***********************************************************************
34150>>>>>//
34150>>>>>// The following classes are defined in this package:
34150>>>>>//
34150>>>>>//
34150>>>>>// Panel containers: aps.View aps.BasicPanel
34150>>>>>// aps.dbView aps.TopMostModalPanel
34150>>>>>// aps.ModalPanel aps.dbTopMostModalPanel
34150>>>>>// aps.dbModalPanel aps.dbTabView
34150>>>>>//
34150>>>>>// Other containers: aps.Group aps.dbGroup
34150>>>>>// aps.Container3D aps.dbContainer3D
34150>>>>>// aps.TabDialog aps.dbTabDialog
34150>>>>>// aps.TabPage aps.dbTabPage
34150>>>>>// aps.RadioGroup aps.dbRadioGroup
34150>>>>>// aps.RadioContainer //<-- NOTE: These do not have sizes
34150>>>>>// aps.dbRadioContainer //<-- or locations.
34150>>>>>//
34150>>>>>// Controls: aps.Form aps.dbForm
34150>>>>>// aps.ComboForm aps.dbComboForm
34150>>>>>// aps.SpinForm aps.dbSpinForm
34150>>>>>// aps.CheckBox aps.dbCheckBox
34150>>>>>// aps.Edit aps.dbEdit
34150>>>>>// aps.RichEdit aps.dbRichEdit
34150>>>>>// aps.TextEdit aps.dbTextEdit
34150>>>>>// aps.TextBox aps.Button
34150>>>>>// aps.Radio aps.Multi_Button
34150>>>>>//
34150>>>>>// Grid controls: aps.List aps.dbList
34150>>>>>// aps.Grid aps.dbGrid
34150>>>>>//
34150>>>>>// Exotics: aps.BitmapContainer aps.ToolButton
34150>>>>>// aps.LineControl
34150>>>>>//
34150>>>>>// ***********************************************************************
34150>>>>>//
34150>>>>>// The following global alignment procedures are defined in this package:
34150>>>>>//
34150>>>>>//
34150>>>>>// Align object 1 relative to object 2, by re-locating object 1:
34150>>>>>// send APS_ALIGN_BY_MOVING obj1# obj2# align_mode#
34150>>>>>//
34150>>>>>// Align object 1 relative to object 2, by re-sizing object 1:
34150>>>>>// send APS_ALIGN_BY_SIZING obj1# obj2# align_mode#
34150>>>>>//
34150>>>>>// Objects are sized to the bigger of the two:
34150>>>>>// send APS_SIZE_IDENTICAL_MAX obj1# obj2# sizing_mode#
34150>>>>>//
34150>>>>>// Align an object (with ID ctrl#) inside its parent by re-locating it:
34150>>>>>// send APS_ALIGN_INSIDE_CONTAINER_BY_MOVING ctrl# align_mode#
34150>>>>>//
34150>>>>>// Align an object (with ID ctrl#) inside its parent by re-sizing it:
34150>>>>>// send APS_ALIGN_INSIDE_CONTAINER_BY_SIZING ctrl# align_mode#
34150>>>>>//
34150>>>>>//
34150>>>>>// align_mode# : SL_ALIGN_LEFT SL_ALIGN_RIGHT SL_ALIGN_TOP
34150>>>>>// SL_ALIGN_BOTTOM SL_ALIGN_CENTER SL_ALIGN_VCENTER
34150>>>>>//
34150>>>>>// sizing_mode# : SL_HORIZONTAL SL_VERTICAL
34150>>>>>//
34150>>>>>//
34150>>>>>//
34150>>>>>// ***********************************************************************
34150>>>>>
34150>>>>>Use DfAllent // Standard DAW everything
34150>>>>>Use dfline // DAW
34150>>>>>Use Version.nui //
Including file: version.nui (C:\Apps\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:\Apps\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 <field label> ;
34150>>>>>>>// [<grid label> [<status help>]]
34150>>>>>>>//
34150>>>>>>>// 2 REGISTER_ABSTRACT_FIELD_TYPE <un-typed abstract_id> ;
34150>>>>>>>// <length> <data_type>
34150>>>>>>>//
34150>>>>>>>// 3 MODIFY_FIELD_TYPE dffile.field <abstract_id>
34150>>>>>>>//
34150>>>>>>>// 4 REGISTER_FILE_ALIAS <master_dffile> <shadow_dffile>
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:\Apps\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:\Apps\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>>>>>>>>>>>//> <code>
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>>>>>>>>>>>//> </code>
34150>>>>>>>>>>>//>
34150>>>>>>>>>>>//> You will now be able to write code like:
34150>>>>>>>>>>>//>
34150>>>>>>>>>>>//> <code>
34150>>>>>>>>>>>//> set pItem_Label item 2 to "Amazing"
34150>>>>>>>>>>>//> get pItem_Default item 0 to sVar
34150>>>>>>>>>>>//> </code>
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>>>>>>>>>>>//> <code>
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>>>>>>>>>>>//> </code>
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:\Apps\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:\Apps\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:\VDF12\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:\Apps\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:\VDF12\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>>>>>>>>>// ³ <string> -- <encrypted_string> -- <string> ³
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<liLen and mid(lsValue,1,liPos)=lsSeparatorChar)
35444>>>>>>>>> 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 <alias#> refer to file number <master#> 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 <field label> ;
35597>>>>>>>// [<grid label> [<status help>]]
35597>>>>>>>
35597>>>>>>>
35597>>>>>>>
35597>>>>>>>// REGISTER_ABSTRACT_FIELD_TYPE <un-typed name> ;
35597>>>>>>>// <margin> <data_type>
35597>>>>>>>
35597>>>>>>>
35597>>>>>>>
35597>>>>>>>// REGISTER_ABSTRACT_FIELD_LABEL <previously un-typed name> ;
35597>>>>>>>// <field label> [<grid label> [<status help>]]
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 <abstract_id>
35597>>>>>>>
35597>>>>>>>
35597>>>>>>>// REGISTER_FILE_ALIAS <master_dffile> <shadow_dffile>
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 <string>
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:\VDF12\Pkg\cDbRichEdit.pkg)
36567>>>>>>>Use cRichEdit.pkg
Including file: cRichEdit.pkg (c:\VDF12\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 <lhObj>
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 <lhObj>
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 <column#>
37267>>>>> // (0-base) in grid <lhObj>.
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 <rel.loc.> ; This will make the object locate itself
37760>>>>>// [RELATIVE_TO obj] relative to a previous objects within the
37760>>>>>// current container. Valid <rel.loc.>'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 <abstrID> (Re-)defines the form_margin and form_type for
37760>>>>>// that (db)Form to be equal to those defined
37760>>>>>// for abstract field type <abstrID>.
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
39085>>>define LNG_DEFAULT for lng_english
39085>>>
/FASTVIEW.KNOWNISSUES
Image 2, FASTVIEW.KNOWNISSUES
FastView 'Known issues'
1 No longer an issue
2 I have not been able to do anything
about the irritating select toggling
when expanding/collapsing with the
mouse in the field selector.
Reason: TreeView wasn't built for
multi selection.
Impact: Annoying (aren't they all?)
3 Complex overlap structures (multi-
layer) may fool FastView into not
asking whether child fields should
be replaced by parent fields.
Reason: I was too busy.
Impact: View does not work properly
when child fields are used.
4 Program goes into infinate loop on
error 90.
Reason: Missing parent record (data
inconsistancy)
Impact: Program must be terminated.
5 No longer an issue
/*
39085>>>
39085>>>
/FASTVIEW.LOG
Image 3, FASTVIEW.LOG
FastView for Visual DataFlex
Please use this Data Access public newsgroup for questions and suggestions:
news://dataaccess.com/dac-public-newsgroups.visual-dataflex-support
Use www.sture.com/wasp (which is a heavy duty intelligent search page, that I did) for searching newsgroups for previous content
Programmed by Sture ApS (CPH, Denmark)
Tel: +45 40 59 70 20
E-mail: sture.aps@mail.tele.dk
--- Version 12.0 ---
21-07-06 Ctrl+G while focus is with a grid
will create a query on the records
shown in the grid with the columns
also represented in the grid.
--- Version 2.9b ---
06-02-04 "Close all tables" temporarily
button added to menus.
- DBD View is now refreshed when
when reading table definitions.
- Explore 'Data' Folder
--- Version 2.9 ---
15-05-03 FTS Monitoring system feature
21-07-03 DBD feature
22-11-03 FastView home folder is now
specific to each windows user.
--- Version 2.0 ---
11-05-02 Auto-recompile feature turned
into source code warning
feature.
--- Version 1.92 ---
13-04-02 Explicit pathing ignored in fvc
files.
05-04-02 If child table no longer has a
'sensible' relationship to the
header table, it was not possible
to edit the view. This is fixed
22-03-02 Now also opens system files when
WS DD's are used
09-03-02 Enter key now works as tab key
- Alt+F2 now saves without clearing
--- Version 1.91 ---
26-02-02 Enabled delta sizing of dbGrids
columns
- Enabled resizing FastViews
(anchors)
- New tool bar
- Less irritating mechanism when
saving (or not) view definitions
11-02-02 Cosmetics
--- Version 1.9 ---
10-02-02 Restructured for shorter compile
time
08-02-02 Adapted for VDF 8.1
- Auto-recompile detection
20-01-02 Fixed positioning error when Edit
object was used in sidecar section
preceeding other objects.
--- Version 1.0 ---
11-01-02 Final version prepared
--- Version 0.993 ---
09-01-02 Cmd line param '-view <vw>' added
- Cmd line param '-collection <vcl>'
added
--- Version 0.992 ---
08-01-02 Bug introduced in 0.991 fixed
- Not possible to select text fields
to a grid object
--- Version 0.991 ---
07-01-02 FastLoad option implemented
- Cmd line parameter '-filelist <fl>'
added
- First unique index is now assigned
as ordering to grid views
--- Version 0.99 ---
06-01-02 Ctrl+I displays table definition,
except in Wiz comboforms that do
not allow for capturing ctrl keys
- Focus problem can not be reproduced
- No longer prompts for auto-load
- dbEdit in sidecar problem fixed
- Cmd line parameter '-noload' added
- Cmd line parameter '-ws <wskey>'
added
- 'Re-load definition' to right-
click menu
- Field options Capslock and
Promptlist added.
- 'Edit properties' grid re-worked
--- Version 0.93 ---
05-01-02 fvw file format changed to prepare
for future enhancements (existing
fvw files are now invalid, please
delete)
- Fixed broken Auto prompt (Ctrl+F)
- Now writes a ReadMe.txt file when
creating a FastView directory that
explains why it's there
- Fixed SaveEnvironment problem
- Grids and Lists now responds to
dbl click whenever appropriate
- Whenever you save or delete from a
'sidecar' field focus will now go
back to the first focusable column
of the current row of the grid.
- Ctrl+F1 in a view will now popup
a DD inspection thing
04-01-02 'Use generic DD' checkbox'es are
now disabled if none are available
- Generic DD classes are now neatly
wrapped. FastView automatically
determines if they are applicable
- Table selector now only displays
applicable main tables when H/D
- Alternative table selector for
large filelist.cfg's
- 'Administrator mode' may now be
switched off by using cmdline
parameter -USER
- Error in relation detection
mechanism fixed when a relating
overlap type field was selected
- Now automatically test DD classes
for appropriate class to use on
field level
--- Version 0.92 ---
04-01-02 Comboforms now size according to
the field they represent
- Preparations for using generic
DD classes
- Indication of function keys in
'Edit properties' panel
- It is now possible to omit the
prompt for 'Save definition' on
exiting of 'Edit properties' panel
--- Version 0.91 ---
03-01-02 Extended tab settings now also in
effect for sidecar fields
- Top labels added to wizard pages
- Now offers to use parent fields
whenever child fields are selected
- Wizard now offers to save the view
definition on exit
- Edit dialog now offers to save on
exit
--- Version 0.90 ---
02-01-02 A lot of fixes
/FastView_CmdLineOptions
Image 4, FASTVIEW_CMDLINEOPTIONS
FastView understands these command line parameters:
-noload
Disables the automatic loading of views on start up
-ws <wskey>
Makes FastView load the specified WS on start up (instead of the default)
-filelist <fl>
FastView loads the specified <fl> (full path to a filelist.cfg) on start up
-collection <collection name>
FastView loads the view collection of that name on start-up
-view <view name>
FastView loads the specified view on start-up
Each of the following only have an impact if the feature they turn off, was enabled in the compiled program.
-nopkgcheck
FastView does not check for changes in DD packages (Disables the 'should I re-compile myself?' logic)
-readonly
User is not allowed to edit data.
-noddbypass
User is not allowed to disable using the workspace DD's (when they are present)
-nowschange
User is not allowed to point FastView to another WS
-user
Disables the editing and creating view definitions ('security by obscurity' as Wil van Antwerpen points out).
/*
39085>>>
39085>>>
39085>>>Use Splash.utl // Graphic splish-splash
Including file: splash.utl (C:\Apps\VDFQuery\AppSrc\splash.utl)
39085>>>>>// Use Splash.utl //
39085>>>>>
39085>>>>>Use VdfGraph.utl // Graphics for Visual DataFlex
Including file: vdfgraph.utl (C:\Apps\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:\Apps\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:\Apps\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#<number_value(self,itm#+1)) ; function_return (number_value(self,itm#+1+OffSet#))
40749>>>>>>> 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:\Apps\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:\Apps\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:\Apps\VDFQuery\AppSrc\buttons.utl)
42502>>>>>>>// Use Buttons.utl // Button texts
42502>>>>>>>Use Language
Including file: language.pkg (C:\Apps\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:\Apps\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:\Apps\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:\Apps\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:\Apps\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:\Apps\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:\Apps\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>>>>>>>>>>>// P†ske s›ndag: For†rsj‘vnd›gn -> Fuldm†ne -> S›ndag
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:\Apps\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:\Apps\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 <<AS IS>> 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 <fn#> 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 <fn#>.
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<lnSize) error 421 "File too big. Adjust arg size."
44640>>>>>>>>>
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:\Apps\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:\Apps\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 <pre>2003-08-23_175515.<ext>
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 "FastView"
45655>>>set AppInfo AI_SUBTITLE to "Visual DataFlex"
45656>>>set AppInfo AI_VERSION to "12.0"
45657>>>set AppInfo AI_REVISION to ""
45658>>>set AppInfo AI_AUTHOR to "Sture ApS"
45659>>>set AppInfo AI_WATERMARK to "12.0"
45660>>>set AppInfo AI_RELEASEDATE to ""
45661>>>set AppInfo AI_LOG_IMAGE to FastView.Log.N
45662>>>set AppInfo AI_KNOWN_ISSUES to FastView.KnownIssues.N
45663>>>
45663>>>object oSplash is a cGraphicSplash
45665>>>end_object
45666>>>
45666>>>Use CmdLine.nui // Simple thing for reading command line parameters
Including file: cmdline.nui (C:\Apps\VDFQuery\AppSrc\cmdline.nui)
45666>>>>>// Use CmdLine.nui // Simple thing for reading command line parameters
45666>>>>>
45666>>>>>use Base.nui
45666>>>>>
45666>>>>>desktop_section
45671>>>>> object oCmdLineParameters is a cArray
45673>>>>> send delete_data
45674>>>>> procedure DoRead
45677>>>>> string lsParam
45677>>>>> repeat
45677>>>>>>
45677>>>>> cmdline lsParam
45678>>>>>>
45678>>>>> if lsParam ne "" set value item (item_count(self)) to lsParam
45681>>>>> until lsParam eq ""
45683>>>>> end_procedure
45684>>>>> function iFindParamValue.si string lsValue integer lbUpperCase returns integer
45687>>>>> integer liItem liMax
45687>>>>> string lsTestValue
45687>>>>> if lbUpperCase move (uppercase(lsValue)) to lsValue
45690>>>>> get item_count to liMax
45691>>>>> for liItem from 0 to liMax
45697>>>>>>
45697>>>>> get value item liItem to lsTestValue
45698>>>>> if lbUpperCase move (uppercase(lsTestValue)) to lsTestValue
45701>>>>> if (lsTestValue=lsValue) function_return liItem
45704>>>>> loop
45705>>>>>>
45705>>>>> function_return -1 // not found
45706>>>>> end_function
45707>>>>> end_object // oCmdLineParameters
45708>>>>>end_desktop_section
45713>>>>>
45713>>>>>procedure DoReadCmdLine global
45715>>>>> send DoRead to (oCmdLineParameters(self))
45716>>>>>end_procedure
45717>>>>>send DoReadCmdLine
45718>>>>>
45718>>>>>function CmdLineParamCount global returns integer
45720>>>>> function_return (item_count(oCmdLineParameters(self)))
45721>>>>>end_function
45722>>>>>function CmdLineParamValue global integer liParam returns string
45724>>>>> function_return (value(oCmdLineParameters(self),liParam))
45725>>>>>end_function
45726>>>>>function CmdLineFindParamValue global string lsValue integer lbUpperCase returns integer
45728>>>>> integer liRval
45728>>>>> get iFindParamValue.si of (oCmdLineParameters(self)) lsValue lbUpperCase to liRval
45729>>>>> function_return liRval
45730>>>>>end_function
45731>>>
45731>>>procedure FV_DoCmdLineHelp
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
45733>>> integer liLogImage
45733>>> string lsLog
45733>>> if (CmdLineFindParamValue("?",DFTRUE)<>-1 or CmdLineFindParamValue("-?",DFTRUE)<>-1 or CmdLineFindParamValue("-h",DFTRUE)<>-1 or CmdLineFindParamValue("-help",DFTRUE)<>-1) begin
45735>>> move FastView_CmdLineOptions.N to liLogImage
45736>>> get sTextFromDfImage liLogImage to lsLog
45737>>> send DoDisplayText "FastView command line options" lsLog
45738>>> end
45738>>>>
45738>>>end_procedure
45739>>>send FV_DoCmdLineHelp
45740>>>
45740>>>integer ghClientArea_FastView
45740>>>
45740>>>enumeration_list
45740>>> DEFINE FVSETUP_OLD_PKG_CHECK // Check for old packages YES NO
45740>>> DEFINE FVSETUP_USER_CHG_DATA // Allow changing data YES NO
45740>>> DEFINE FVSETUP_USER_BYPASS_WS_DD // Allow bypassing WS DD's YES NO
45740>>> DEFINE FVSETUP_USER_CHG_WS // Allow changing WS YES NO
45740>>> DEFINE FVSETUP_USER_EDIT_VIEWS // Allow create/change views YES NO
45740>>> DEFINE FVSETUP_WORKSPACE_NAME
45740>>> DEFINE FVSETUP_WORKSPACE
45740>>>end_enumeration_list
45740>>>
45740>>>object oFVSetup is a cArray
45742>>> item_property_list
45742>>> item_property string psName.i
45742>>> item_property integer psValue.i // 0=FALSE 1=TRUE
45742>>> item_property string psCmdLineToken.i
45742>>> end_item_property_list
#REM 45782 DEFINE FUNCTION PSCMDLINETOKEN.I INTEGER LIROW RETURNS STRING
#REM 45787 DEFINE PROCEDURE SET PSCMDLINETOKEN.I INTEGER LIROW STRING VALUE
#REM 45792 DEFINE FUNCTION PSVALUE.I INTEGER LIROW RETURNS INTEGER
#REM 45797 DEFINE PROCEDURE SET PSVALUE.I INTEGER LIROW INTEGER VALUE
#REM 45802 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 45807 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
45813>>> procedure DefineValue integer liRow string lsName string lsDefault string lsCmdLineToken
45816>>> set psName.i liRow to lsName
45817>>> set psValue.i liRow to lsDefault
45818>>> set psCmdLineToken.i liRow to lsCmdLineToken
45819>>> end_procedure // Default---V
45820>>> send DefineValue FVSETUP_OLD_PKG_CHECK "Check for old packages" DFTRUE "-NOPKGCHECK"
45821>>> send DefineValue FVSETUP_USER_CHG_DATA "Allow changing data" DFTRUE "-READONLY"
45822>>> send DefineValue FVSETUP_USER_BYPASS_WS_DD "Allow bypassing WS DD's" DFTRUE "-NODDBYPASS"
45823>>> send DefineValue FVSETUP_USER_CHG_WS "Allow changing WS" DFTRUE "-NOWSCHANGE"
45824>>> send DefineValue FVSETUP_USER_EDIT_VIEWS "Allow create/change views" DFTRUE "-NOVIEWEDIT"
45825>>> send DefineValue FVSETUP_WORKSPACE_NAME "Workspace name" "" ""
45826>>> send DefineValue FVSETUP_WORKSPACE "Workspace id" "" ""
45827>>> procedure DoCmdLine
45830>>> integer liRow liMax liParam lbValue
45830>>> string lsCmdLineToken
45830>>> get row_count to liMax
45831>>> decrement liMax
45832>>> for liRow from 0 to liMax
45838>>>>
45838>>> if (liRow<>FVSETUP_WORKSPACE_NAME and liRow<>FVSETUP_WORKSPACE) begin
45840>>> get psCmdLineToken.i liRow to lsCmdLineToken
45841>>> get CmdLineFindParamValue lsCmdLineToken DFTRUE to liParam
45842>>> if (liParam<>-1) set psValue.i liRow to 0
45845>>> end
45845>>>>
45845>>> loop
45846>>>>
45846>>> end_procedure
45847>>>end_object
45848>>>function FVSetupValue global integer liItem returns string
45850>>> function_return (psValue.i(oFVSetup(self),liItem))
45851>>>end_function
45852>>>procedure set FVSetupValue integer liItem string lsValue
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
45854>>> set psValue.i of (oFVSetup(self)) liItem to lsValue
45855>>>end_procedure
45856>>>
45856>>>GoSub RegisterRestrictions // Gosub setup rutine at the bottom
45857>>>>
45857>>>send DoCmdLine to (oFVSetup(self))
45858>>>
45858>>>if (FVSetupValue(FVSETUP_WORKSPACE_NAME)="") set AppInfo AI_SUBTITLE2 to "(No Workspace DD classes included)"
45861>>>else set AppInfo AI_SUBTITLE2 to ("(Including DD classes for '"+FVSetupValue(FVSETUP_WORKSPACE_NAME)+"')")
45863>>>
45863>>>send activate to (oSplash(self)) // <<<-----------SPLASH ON
45864>>>
45864>>>use autodown.pkg
Including file: autodown.pkg (C:\Apps\VDFQuery\AppSrc\autodown.pkg)
45864>>>>>// Use AutoDown.pkg
45864>>>>>
45864>>>>>use dfallent
45864>>>>>use AutoDown.nui
Including file: autodown.nui (C:\Apps\VDFQuery\AppSrc\autodown.nui)
45864>>>>>>>// Remote Application Termination
45864>>>>>>>// ------------------------------
45864>>>>>>>// This package lets you take down a running application by using a timer
45864>>>>>>>// object to detect for the presence of a specific file name.
45864>>>>>>>//
45864>>>>>>>// Update: 19/06/2003 Included ObjGroup.utl to get rid of errors
45864>>>>>>>// when autodowning. Due to DD's firering
45864>>>>>>>// new_current_record when destroyed
45864>>>>>>>//
45864>>>>>>>
45864>>>>>>>// This package may be developed in these areas
45864>>>>>>>//
45864>>>>>>>// * Create a user interface for creating the stop file.
45864>>>>>>>//
45864>>>>>>>// * Have the program creating the stop file check when
45864>>>>>>>// exclusive access can be obtained.
45864>>>>>>>//
45864>>>>>>>// * Have programs that exits write in the log file.
45864>>>>>>>//
45864>>>>>>>// * Warn the users that their program will be closed in x minutes
45864>>>>>>>
45864>>>>>>>// Usage (in ClientArea):
45864>>>>>>>//
45864>>>>>>>// Use AutoDown.nui
45864>>>>>>>// object oSystemDowner is a cSystemDowner
45864>>>>>>>// send ApplicationAutoExit
45864>>>>>>>// end_object
45864>>>>>>>//
45864>>>>>>>// and this at client_area level:
45864>>>>>>>//
45864>>>>>>>// move self to glMainClientId#
45864>>>>>>>//
45864>>>>>>>// send CreateAutoDownObject to (oSystemDowner(self)) glMainClientId#
45864>>>>>>>//
45864>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
45864>>>>>>>Use Files.nui // Utilities for handling file related stuff (No User Interface)
45864>>>>>>>Use DFTimer.pkg // DAW DFTimer class
Including file: Dftimer.pkg (c:\VDF12\Pkg\Dftimer.pkg)
45864>>>>>>>>>//************************************************************************
45864>>>>>>>>>//--- DFTimer Timer package for DataFlex programs
45864>>>>>>>>>//
45864>>>>>>>>>// Copyright (c) 1983-2002 Data Access Corporation, Miami Florida,
45864>>>>>>>>>// All rights reserved.
45864>>>>>>>>>// DataFlex is a registered trademark of Data Access Corporation.
45864>>>>>>>>>//
45864>>>>>>>>>//************************************************************************
45864>>>>>>>>>// Description:
45864>>>>>>>>>// This package contains all components needed to implement timers
45864>>>>>>>>>// in a DataFlex 4 program.
45864>>>>>>>>>//
45864>>>>>>>>>//
45864>>>>>>>>>// Author: Eddy Kleinjan, Data Access Nederland
45864>>>>>>>>>//************************************************************************
45864>>>>>>>>>// 03/03/2001 EK Fixed Timer_Active_State to check for valid windows
45864>>>>>>>>>// handle before trying to set or kill a timer.
45864>>>>>>>>>// Fixed Kill_All_Timers to check for valid windows
45864>>>>>>>>>// handle before trying to kill a timer.
45864>>>>>>>>>// The windows handle might not exist anymore when the
45864>>>>>>>>>// program is being exited using Exit_Application.
45864>>>>>>>>>// 12/13/2001 JJT fixed Timer_Active_State to check for -1 (not 0). Fixed a
45864>>>>>>>>>// a bug where set Timeout started inactive timers.
45864>>>>>>>>>// Added code to force timer object to desktop
45864>>>>>>>>>//************************************************************************
45864>>>>>>>>>// CLASS DFTimer
45864>>>>>>>>>//
45864>>>>>>>>>// Usage:
45864>>>>>>>>>// Object MyTimer is a DFTimer
45864>>>>>>>>>//
45864>>>>>>>>>// Set Timeout to 2000 // Default 1000
45864>>>>>>>>>// Set Auto_Start_State to TRUE|FALSE // Default TRUE
45864>>>>>>>>>// Set Auto_Stop_State to TRUE|FALSE // Default TRUE
45864>>>>>>>>>// Set Timer_Message to MyMessage // Default 0
45864>>>>>>>>>// Set Timer_Object to (MyObject(self)) // Default 0
45864>>>>>>>>>// Set Timer_Active_State to TRUE|FALSE // Default FALSE
45864>>>>>>>>>//
45864>>>>>>>>>// // Augment when no Timer_Message
45864>>>>>>>>>// Procedure OnTimer
45864>>>>>>>>>// Send Info_Box "HEY, WAKE UP!"
45864>>>>>>>>>// End_Procedure
45864>>>>>>>>>//
45864>>>>>>>>>// End_Object
45864>>>>>>>>>//
45864>>>>>>>>>// DESCRIPTION
45864>>>>>>>>>// Objects of this class can be used to trigger an event after a
45864>>>>>>>>>// certain amount of time has passed. You can specify this time
45864>>>>>>>>>// by setting the Timeout property of the object. This timeout
45864>>>>>>>>>// is in miliseconds.
45864>>>>>>>>>//
45864>>>>>>>>>// Whenever a timer event happens, it will notify the object by
45864>>>>>>>>>// sending an OnTimer event. You can trap this event to do whatever
45864>>>>>>>>>// you want the timer to do. By default this OnTimer event
45864>>>>>>>>>// will send the Timer_Message to Timer_Object, when these have
45864>>>>>>>>>// been specified.
45864>>>>>>>>>//
45864>>>>>>>>>// By default, you have to activate a timer by setting its
45864>>>>>>>>>// Timer_Active_State to TRUE. When the timer has been placed
45864>>>>>>>>>// inside a user-interface object, it can also be activated
45864>>>>>>>>>// automatically when this user-interface object is being
45864>>>>>>>>>// activated. This only happes when it Auto_Start_State is TRUE,
45864>>>>>>>>>// which is the default setting. In such a case, the timer will
45864>>>>>>>>>// also automatically being stopped when the user-interface
45864>>>>>>>>>// object is taken of the screen. This depends on the
45864>>>>>>>>>// Auto_Stop_Timer state to happen.
45864>>>>>>>>>//
45864>>>>>>>>>// When you need to set a new timeout value, you can do so
45864>>>>>>>>>// even when the timer is active. It will adjust the timeout
45864>>>>>>>>>// immediately.
45864>>>>>>>>>//
45864>>>>>>>>>// Note that timer events depend on Windows for the delivery of
45864>>>>>>>>>// the event. Since timer events get a low priority in Windows,
45864>>>>>>>>>// it might put your program on hold when other programs are very
45864>>>>>>>>>// busy. In such a case, you will only receive one timer event
45864>>>>>>>>>// after the process stopped. There is no way, other than
45864>>>>>>>>>// calculating it yourself, to determine how many time has passed
45864>>>>>>>>>// or how many timer event should have happened since the last
45864>>>>>>>>>// timer event or timer activation.
45864>>>>>>>>>//
45864>>>>>>>>>// PUBLIC INTERFACE
45864>>>>>>>>>//
45864>>>>>>>>>// PROPERTIES
45864>>>>>>>>>//
45864>>>>>>>>>// Auto_Start_State When TRUE (default) the timer will be activated
45864>>>>>>>>>// automatically when the object will be (virtually)
45864>>>>>>>>>// paged on the screen.
45864>>>>>>>>>// Example: When a timer object has been placed
45864>>>>>>>>>// inside a view, then the timer will be activated
45864>>>>>>>>>// when the view is activated.
45864>>>>>>>>>//
45864>>>>>>>>>// Auto_Stop_State When TRUE (default) the timer will be deactivated
45864>>>>>>>>>// automatically when the object will be (virtually)
45864>>>>>>>>>// taken off the screen.
45864>>>>>>>>>//
45864>>>>>>>>>// Timeout The timeout value for the timer to fire. The
45864>>>>>>>>>// timeout value must be set in miliseconds.
45864>>>>>>>>>// This property may be set even when the timer is
45864>>>>>>>>>// active. The new timeout value will be applied
45864>>>>>>>>>// immediately.
45864>>>>>>>>>// NOTE: The timeout set here is never precise. It
45864>>>>>>>>>// depends on Windows to deliver the message to our
45864>>>>>>>>>// application.
45864>>>>>>>>>// Default 1000.
45864>>>>>>>>>//
45864>>>>>>>>>// Timer_Active_State
45864>>>>>>>>>// Set to TRUE to activate the timer, to FALSE to
45864>>>>>>>>>// deactivate the timer.
45864>>>>>>>>>//
45864>>>>>>>>>//
45864>>>>>>>>>// Timer_Message This property can be set to a messageID which has
45864>>>>>>>>>// to be sent whenever a timer event occurs. Default
45864>>>>>>>>>// this message will be send to the object itself
45864>>>>>>>>>// unless a Timer_Object as been specified.
45864>>>>>>>>>//
45864>>>>>>>>>// Timer_Object This property can be set to an objectID which has
45864>>>>>>>>>// to receive the Timer_Message whenever a timer
45864>>>>>>>>>// event occurs. This value has no meaning when
45864>>>>>>>>>// no Timer_Message has been set.
45864>>>>>>>>>//
45864>>>>>>>>>// METHODS
45864>>>>>>>>>//
45864>>>>>>>>>// OnTimer This event will happen whenever the specified
45864>>>>>>>>>// amount of time has passed and the timer is
45864>>>>>>>>>// active. By default it sends the message in
45864>>>>>>>>>// the Timer_Message property to the object in
45864>>>>>>>>>// the Timer_Object when these have been specified.
45864>>>>>>>>>// When you don't need this, you can just override
45864>>>>>>>>>// the OnTimer event.
45864>>>>>>>>>//
45864>>>>>>>>>// PUBLIC INTERFACE
45864>>>>>>>>>//
45864>>>>>>>>>// Page_Object Has been augmented to auto_start the timer when
45864>>>>>>>>>// it becomes active as part or a user-interface
45864>>>>>>>>>// object.
45864>>>>>>>>>//
45864>>>>>>>>>// Page_Delete Has been augmented to auto_stop the timer when
45864>>>>>>>>>// it is deactivated as part or a user-interface
45864>>>>>>>>>// object.
45864>>>>>>>>>//
45864>>>>>>>>>// Destroy_Object Has been augmented to deactivate the timer.
45864>>>>>>>>>//
45864>>>>>>>>>Use LanguageText.pkg
45864>>>>>>>>>Use Windows.pkg
45864>>>>>>>>>Use WinUser.pkg
45864>>>>>>>>>
45864>>>>>>>>>External_Function SetTimer "SetTimer" User32.DLL ; Integer hWnd ; Integer idTimer ; Integer idTimeout ; Pointer tmprc ; Returns Integer
45865>>>>>>>>>
45865>>>>>>>>>External_Function KillTimer "KillTimer" User32.DLL ; Integer hWnd ; Integer idTimer ; Returns Integer
45866>>>>>>>>>
45866>>>>>>>>>// This global integer holds the ID of the object
45866>>>>>>>>>// that manages all timers.
45866>>>>>>>>>Integer giTimerManager
45866>>>>>>>>>
45866>>>>>>>>>// This class is used to store the object IDs
45866>>>>>>>>>// of the active timer objects. It augments
45866>>>>>>>>>// the Destroy_Object procedure to notify
45866>>>>>>>>>// the DFTimerManager to kill all its active
45866>>>>>>>>>// timers.
45866>>>>>>>>>// NOTE: This class looks very much like the
45866>>>>>>>>>// Set class. I didn't want to use Set because
45866>>>>>>>>>// Remove_Element shifts items which I don't
45866>>>>>>>>>// want to happen because item numbers are used
45866>>>>>>>>>// as timerIDs.
45866>>>>>>>>>
45866>>>>>>>>>Class TimersArray is an Array
45867>>>>>>>>>
45867>>>>>>>>> Function Find_Object Integer iObj Returns Integer
45869>>>>>>>>> Integer iMax
45869>>>>>>>>> Integer iItem
45869>>>>>>>>> Integer iValue
45869>>>>>>>>> Get Item_count to iMax
45870>>>>>>>>> Decrement iMax
45871>>>>>>>>> For iItem from 1 to iMax
45877>>>>>>>>>>
45877>>>>>>>>> Get Integer_Value item iItem to iValue
45878>>>>>>>>> If iValue EQ iObj; Function_Return iItem
45881>>>>>>>>> Loop
45882>>>>>>>>>>
45882>>>>>>>>> Function_Return -1
45883>>>>>>>>> End_Function
45884>>>>>>>>>
45884>>>>>>>>> Procedure Add_Object Integer iObj Returns Integer
45886>>>>>>>>> Integer iItem
45886>>>>>>>>> Get Find_Object iObj to iItem
45887>>>>>>>>> If iItem LT 0 Begin
45889>>>>>>>>> Get Find_Object 0 to iItem
45890>>>>>>>>> If iItem LT 0 ; Get Item_Count to iItem
45893>>>>>>>>> End
45893>>>>>>>>>>
45893>>>>>>>>> Set Array_Value item iItem to iObj
45894>>>>>>>>> Procedure_Return iItem
45895>>>>>>>>> End_Procedure
45896>>>>>>>>>
45896>>>>>>>>> Procedure Remove_Object Integer iObj
45898>>>>>>>>> Integer iItem
45898>>>>>>>>> Get Find_Object iObj to iItem
45899>>>>>>>>> If iItem GT 0 ; Set Array_Value item iItem to 0
45902>>>>>>>>> End_Procedure
45903>>>>>>>>>
45903>>>>>>>>> Procedure Destroy_Object
45905>>>>>>>>> Delegate Send Kill_All_Timers
45907>>>>>>>>> Forward Send Destroy_Object
45909>>>>>>>>> End_Procedure
45910>>>>>>>>>
45910>>>>>>>>>End_Class // TimersArray
45911>>>>>>>>>
45911>>>>>>>>>// This class is the actual timer manager
45911>>>>>>>>>// A timer will be created when Message Set_Timer_Active_State
45911>>>>>>>>>// has been send. This message needs two arguments. The first
45911>>>>>>>>>// is the objectID of the object to receive the timer event,
45911>>>>>>>>>// and the second is state. The object which ID has been passed,
45911>>>>>>>>>// needs to have a Timeout property to return the timeout for the
45911>>>>>>>>>// timer and it also needs to handle the MSG_OnTimer whenever a
45911>>>>>>>>>// timer event occurs.
45911>>>>>>>>>// The objectID of the Object will be placed in an array which contains
45911>>>>>>>>>// the objectIDs of all active timers. The Windows timer ID of a timer
45911>>>>>>>>>// is the itemnumber of the object in the array.
45911>>>>>>>>>//
45911>>>>>>>>>Class DFTimerManager is a DfBaseControl
45912>>>>>>>>>
45912>>>>>>>>> Procedure Construct_Object
45914>>>>>>>>>
45914>>>>>>>>> Forward Send Construct_Object
45916>>>>>>>>>
45916>>>>>>>>> Set Visible_State to FALSE
45917>>>>>>>>>
45917>>>>>>>>> Set External_Class_Name "cVdfTimer" to "static"
45918>>>>>>>>> Set External_Message WM_TIMER to OnTimer
45919>>>>>>>>>
45919>>>>>>>>> Object TimersArray is a TimersArray
45921>>>>>>>>> Set Array_Value item 0 to -9999 // So we don't use item 0
45922>>>>>>>>> End_Object
45923>>>>>>>>>
45923>>>>>>>>> Move self to giTimerManager
45924>>>>>>>>>
45924>>>>>>>>> End_Procedure
45925>>>>>>>>>
45925>>>>>>>>> Procedure Set Timer_Active_State Integer iObj Integer iState
45927>>>>>>>>> Integer iTimerID
45927>>>>>>>>> Integer iTimeout
45927>>>>>>>>> Integer iResult
45927>>>>>>>>> Integer iSet
45927>>>>>>>>> Dword nResult
45927>>>>>>>>> Handle hWnd
45927>>>>>>>>>
45927>>>>>>>>> // Get the handle of this object
45927>>>>>>>>> Get Window_Handle to hWnd
45928>>>>>>>>> If (Not(hWnd)) Begin
45930>>>>>>>>> Error DFERR_DFTIMER C_$TimerNoHandle
45931>>>>>>>>>>
45931>>>>>>>>> Procedure_Return
45932>>>>>>>>> End
45932>>>>>>>>>>
45932>>>>>>>>>
45932>>>>>>>>> // Test if handle is valid. If not, we leave.
45932>>>>>>>>> If (Not(IsWindow(hWnd))) ; Procedure_Return
45935>>>>>>>>>
45935>>>>>>>>> Move (TimersArray(self)) to iSet
45936>>>>>>>>>
45936>>>>>>>>> If (iSet) Begin
45938>>>>>>>>>
45938>>>>>>>>> // Let's create or modify a timer
45938>>>>>>>>> If iState Begin
45940>>>>>>>>>
45940>>>>>>>>> // Get the exising to new TimerID
45940>>>>>>>>> Get MSG_Add_Object of iSet iObj to iTimerID
45941>>>>>>>>>
45941>>>>>>>>> // Set/Modify the timer
45941>>>>>>>>> Get Timeout of iObj to iTimeout
45942>>>>>>>>> Move (SetTimer(hWnd, iTimerID, iTimeout, 0)) to iResult
45943>>>>>>>>> If Not iResult Begin
45945>>>>>>>>> Error DFERR_DFTIMER C_$TooManyTimers
45946>>>>>>>>>>
45946>>>>>>>>> Procedure_Return
45947>>>>>>>>> End
45947>>>>>>>>>>
45947>>>>>>>>>
45947>>>>>>>>> End
45947>>>>>>>>>>
45947>>>>>>>>>
45947>>>>>>>>> // Let's kill an existing timer
45947>>>>>>>>> Else Begin
45948>>>>>>>>>
45948>>>>>>>>> // Look up the object in the set
45948>>>>>>>>> Get Find_Object of iSet iObj to iTimerID
45949>>>>>>>>>
45949>>>>>>>>> If iTimerID EQ -1 ; Procedure_Return
45952>>>>>>>>>
45952>>>>>>>>> // Kill the timer
45952>>>>>>>>> Move (KillTimer(hWnd, iTimerID)) to iResult
45953>>>>>>>>> If Not iResult Begin
45955>>>>>>>>> Move (GetLastError()) to nResult
45956>>>>>>>>> Error DFERR_DFTIMER (C_$CantKillTimer * string(nResult) - "!")
45957>>>>>>>>>>
45957>>>>>>>>> Procedure_Return
45958>>>>>>>>> End
45958>>>>>>>>>>
45958>>>>>>>>>
45958>>>>>>>>> // Remove the objectID
45958>>>>>>>>> Send Remove_Object to iSet iObj
45959>>>>>>>>> End
45959>>>>>>>>>>
45959>>>>>>>>> End
45959>>>>>>>>>>
45959>>>>>>>>> End_Procedure
45960>>>>>>>>>
45960>>>>>>>>> Function Timer_Active_State Integer iObj Returns Integer
45962>>>>>>>>> Integer iResult
45962>>>>>>>>> Get Find_Object of (TimersArray(self)) iObj to iResult
45963>>>>>>>>> Function_Return (iResult<>-1) // note: -1= not found
45964>>>>>>>>> End_Function
45965>>>>>>>>>
45965>>>>>>>>> // Will be called by the Set when it is being destroyed.
45965>>>>>>>>> Procedure Kill_All_Timers
45967>>>>>>>>> Integer iMax
45967>>>>>>>>> Integer iSet
45967>>>>>>>>> Integer iItem
45967>>>>>>>>> Integer iObj
45967>>>>>>>>> Integer iResult
45967>>>>>>>>> Handle hWnd
45967>>>>>>>>>
45967>>>>>>>>> // Get the handle of this object
45967>>>>>>>>> Get Window_Handle to hWnd
45968>>>>>>>>> If (Not(hWnd)) Begin
45970>>>>>>>>> Error DFERR_DFTIMER C_$TimerNoHandle
45971>>>>>>>>>>
45971>>>>>>>>> Procedure_Return
45972>>>>>>>>> End
45972>>>>>>>>>>
45972>>>>>>>>>
45972>>>>>>>>> // If the window handle is no longer valid, we
45972>>>>>>>>> // leave this procedure. This can happen when the
45972>>>>>>>>> // program is begin aborted using Exit_Application
45972>>>>>>>>> If (Not(IsWindow(hWnd))) ; Procedure_Return
45975>>>>>>>>>
45975>>>>>>>>> // Scan the set and kill all known timers
45975>>>>>>>>> Move (TimersArray(self)) to iSet
45976>>>>>>>>> If (iSet) Begin
45978>>>>>>>>> Get Item_Count of iSet to iMax
45979>>>>>>>>> Decrement iMax
45980>>>>>>>>> For iItem From 1 to iMax
45986>>>>>>>>>>
45986>>>>>>>>> Get Integer_Value of iSet item iItem to iObj
45987>>>>>>>>> If iObj Begin
45989>>>>>>>>> Move (KillTimer(hWnd, iItem)) to iResult
45990>>>>>>>>> Set Array_Value of iSet item iItem to 0
45991>>>>>>>>> End
45991>>>>>>>>>>
45991>>>>>>>>> Loop
45992>>>>>>>>>>
45992>>>>>>>>> End
45992>>>>>>>>>>
45992>>>>>>>>>
45992>>>>>>>>> End_Procedure
45993>>>>>>>>>
45993>>>>>>>>> Procedure OnTimer Integer wParam Integer lParam
45995>>>>>>>>> Integer iObj
45995>>>>>>>>> Get Integer_Value of (TimersArray(self)) item wParam to iObj
45996>>>>>>>>> If Not iObj Begin
45998>>>>>>>>> Error DFERR_DFTIMER C_$TimerWithoutObject
45999>>>>>>>>>>
45999>>>>>>>>> Procedure_Return
46000>>>>>>>>> End
46000>>>>>>>>>>
46000>>>>>>>>> Send OnTimer to iObj wParam lParam
46001>>>>>>>>> End_Procedure
46002>>>>>>>>>
46002>>>>>>>>> Procedure Destroy_Object
46004>>>>>>>>> Send Kill_All_Timers
46005>>>>>>>>> Forward Send Destroy_Object
46007>>>>>>>>> Move 0 to giTimerManager
46008>>>>>>>>> End_Procedure
46009>>>>>>>>>
46009>>>>>>>>>End_Class // DFTimerManger
46010>>>>>>>>>
46010>>>>>>>>>
46010>>>>>>>>>
46010>>>>>>>>>
46010>>>>>>>>>// This class acts as a container for the
46010>>>>>>>>>// timer manager object. This is needed because
46010>>>>>>>>>// A DFTimerManager object created directly at the
46010>>>>>>>>>// desktop doesn't have a Window_Handle which we
46010>>>>>>>>>// need to create a Windoows timer. By placing
46010>>>>>>>>>// this non-visual container around the timer
46010>>>>>>>>>// manager, it does get a Window_Handle.
46010>>>>>>>>>// The procedure End_Construct_Object has been
46010>>>>>>>>>// augmented to create a window and also
46010>>>>>>>>>// automatically page all children, which will
46010>>>>>>>>>// be the timer manager.
46010>>>>>>>>>//
46010>>>>>>>>>Class DFTimerManagerPanel is a dfBasePanel
46011>>>>>>>>>
46011>>>>>>>>> Procedure Construct_Object
46013>>>>>>>>> Forward Send Construct_Object
46015>>>>>>>>> Set Visible_State to FALSE
46016>>>>>>>>> Object DFTimerManager is a DFTimerManager
46018>>>>>>>>> End_Object
46019>>>>>>>>> End_Procedure
46020>>>>>>>>>
46020>>>>>>>>> Procedure End_Construct_Object
46022>>>>>>>>> Forward Send End_Construct_Object
46024>>>>>>>>> Send Page_Object TRUE
46025>>>>>>>>> Broadcast Send Page_Object TRUE
46027>>>>>>>>> End_Procedure
46028>>>>>>>>>
46028>>>>>>>>>End_Class
46029>>>>>>>>>
46029>>>>>>>>>// This is the class the user uses to create DFTimer objects
46029>>>>>>>>>
46029>>>>>>>>>
46029>>>>>>>>>//{ OverrideProperty=Skip_State DesignTime=False }
46029>>>>>>>>>//{ OverrideProperty=TypeFace DesignTime=False }
46029>>>>>>>>>Class DFTimer is a Textbox
46030>>>>>>>>>
46030>>>>>>>>> Procedure Construct_Object
46032>>>>>>>>> Forward Send Construct_Object
46034>>>>>>>>>
46034>>>>>>>>> // Make sure this object never appears
46034>>>>>>>>> Set Visible_State to FALSE
46035>>>>>>>>>
46035>>>>>>>>> Property Integer Private.Timeout 1000
46036>>>>>>>>>
46036>>>>>>>>> Property Integer Timer_Message 0
46037>>>>>>>>> Property Integer Timer_Object 0
46038>>>>>>>>> Property Integer Auto_Start_State True
46039>>>>>>>>> Property Integer Auto_Stop_State True
46040>>>>>>>>> End_Procedure
46041>>>>>>>>>
46041>>>>>>>>> Procedure Set Timer_Active_State Integer iState
46043>>>>>>>>> Integer iObj
46043>>>>>>>>> Move self to iObj
46044>>>>>>>>> If giTimerManager ; Set Timer_Active_State of giTimerManager iObj to iState
46047>>>>>>>>> End_Procedure
46048>>>>>>>>>
46048>>>>>>>>> Function Timer_Active_State Returns Integer
46050>>>>>>>>> Integer iState
46050>>>>>>>>> Integer iObj
46050>>>>>>>>> Move self to iObj
46051>>>>>>>>> If giTimerManager ; Get Timer_Active_State of giTimerManager iObj to iState
46054>>>>>>>>> Function_Return iState
46055>>>>>>>>> End_Function
46056>>>>>>>>>
46056>>>>>>>>> Procedure Set Timeout Integer iTimeout
46058>>>>>>>>> Integer iActive
46058>>>>>>>>> Set Private.Timeout to iTimeout
46059>>>>>>>>> Get Timer_Active_State to iActive
46060>>>>>>>>> If iActive ; Set Timer_Active_State to TRUE
46063>>>>>>>>> End_Procedure
46064>>>>>>>>>
46064>>>>>>>>> Function Timeout Returns Integer
46066>>>>>>>>> Integer iTimeout
46066>>>>>>>>> Get Private.Timeout to iTimeout
46067>>>>>>>>> Function_Return iTimeout
46068>>>>>>>>> End_Function
46069>>>>>>>>>
46069>>>>>>>>> Procedure OnTimer Integer iwParam Integer ilParam
46071>>>>>>>>> Integer iMsg
46071>>>>>>>>> Integer iObj
46071>>>>>>>>> Get Timer_Message to iMsg
46072>>>>>>>>> If (iMsg) Begin
46074>>>>>>>>> Get Timer_Object to iObj
46075>>>>>>>>> If iObj ; Send iMsg to iObj iwParam ilParam
46078>>>>>>>>> Else ; Send iMsg iwParam ilParam
46080>>>>>>>>> End
46080>>>>>>>>>>
46080>>>>>>>>> End_Procedure
46081>>>>>>>>>
46081>>>>>>>>> // Augmented to Auto_Start a timer
46081>>>>>>>>> //
46081>>>>>>>>> Procedure Page_Object Integer iState
46083>>>>>>>>> Forward Send Page_Object iState
46085>>>>>>>>> If (iState AND Auto_Start_State(self)) ; Set Timer_Active_State to TRUE
46088>>>>>>>>> End_Procedure
46089>>>>>>>>>
46089>>>>>>>>> // Augmented to Auto_Stop a timer
46089>>>>>>>>> //
46089>>>>>>>>> Procedure Page_Delete
46091>>>>>>>>> If (Auto_Stop_State(self)) ; Set Timer_Active_State to FALSE
46094>>>>>>>>> Forward Send Page_Delete
46096>>>>>>>>> End_Procedure
46097>>>>>>>>>
46097>>>>>>>>> // Augmented to stop the timer
46097>>>>>>>>> //
46097>>>>>>>>> Procedure Destroy_Object
46099>>>>>>>>> Set Timer_Active_State to FALSE
46100>>>>>>>>> Forward Send Destroy_Object
46102>>>>>>>>> End_Procedure
46103>>>>>>>>>
46103>>>>>>>>>End_Class // DFTimer
46104>>>>>>>>>
46104>>>>>>>>>//
46104>>>>>>>>>// This was moved into a method so it can be reliable created
46104>>>>>>>>>// at the desktop. Note that cDesktop adds method to cDesktop class (class of desktop)
46104>>>>>>>>>//
46104>>>>>>>>>Procedure CreateDfTimerManagerPanel FOR cDesktop
46106>>>>>>>>> // Create the Desktop Timer Manager Object.
46106>>>>>>>>> Object DFTimerManagerPanel is a DFTimerManagerPanel
46108>>>>>>>>> End_Object
46109>>>>>>>>>End_Procedure
46110>>>>>>>>>
46110>>>>>>>>>Send CreateDfTimerManagerPanel of DESKTOP
46111>>>>>>>>>
46111>>>>>>>Use LogFile.nui // Class for handling a log file (No User Interface)
Including file: logfile.nui (C:\Apps\VDFQuery\AppSrc\logfile.nui)
46111>>>>>>>>>// Use LogFile.nui // Class for handling a log file (No User Interface)
46111>>>>>>>>>//
46111>>>>>>>>>// by Sture ApS
46111>>>>>>>>>//
46111>>>>>>>>>//
46111>>>>>>>>>// This package implements the cLogFile class. An object of this class may
46111>>>>>>>>>// be used to generate output to a logfile.
46111>>>>>>>>>//
46111>>>>>>>>>// Typical application:
46111>>>>>>>>>//
46111>>>>>>>>>// Writing detailed information to a file as a batch process progresses.
46111>>>>>>>>>// Could also be used to log information every time the application performs
46111>>>>>>>>>// a specific action.
46111>>>>>>>>>//
46111>>>>>>>>>// Code sample:
46111>>>>>>>>>//
46111>>>>>>>>>// object oStructure_LogFile is a cLogFile
46111>>>>>>>>>// set psFileName to "dfmatrix.log" // Write to this file
46111>>>>>>>>>// set piCloseOnWrite to DFTRUE // Close the log file on each write
46111>>>>>>>>>// set psPurpose to "Events during table restructuring" // A little friendliness won't hurt
46111>>>>>>>>>// end_object // oStructure_LogFile
46111>>>>>>>>>//
46111>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
46111>>>>>>>>>Use Files.nui // Utilities for handling file related stuff
46111>>>>>>>>>Use Dates.nui // Date manipulation for VDF
46111>>>>>>>>>Use Strings.nui // String manipulation for VDF (No User Interface)
46111>>>>>>>>>
46111>>>>>>>>>class cLogFile is a cArray
46112>>>>>>>>> procedure construct_object integer liImg
46114>>>>>>>>> forward send construct_object liImg
46116>>>>>>>>> // Public
46116>>>>>>>>> property integer piCloseOnWrite public DFFALSE
46117>>>>>>>>> property string psPurpose public ""
46118>>>>>>>>> property integer pbANSI_State public 1
46119>>>>>>>>> // Private
46119>>>>>>>>> property string prv.psFileName public ""
46120>>>>>>>>> property integer prv.piChannel public -1
46121>>>>>>>>> end_procedure
46122>>>>>>>>>
46122>>>>>>>>> function psFileName returns string
46124>>>>>>>>> function_return (prv.psFileName(self))
46125>>>>>>>>> end_function
46126>>>>>>>>>
46126>>>>>>>>> procedure set psFileName string lsFileName
46128>>>>>>>>> integer liExists
46128>>>>>>>>> if (SEQ_ExtractPathFromFileName(lsFileName)="") begin
46130>>>>>>>>> get SEQ_FileExists lsFileName to liExists
46131>>>>>>>>> if liExists eq SEQIT_DIRECTORY error 123 "Illegal file name in cLogFile object"
46134>>>>>>>>> else begin
46135>>>>>>>>> if liExists eq SEQIT_NONE get SEQ_TranslatePathToAbsolute lsFileName to lsFileName
46138>>>>>>>>> else get SEQ_ConvertToAbsoluteFileName lsFileName to lsFileName
46140>>>>>>>>> end
46140>>>>>>>>>>
46140>>>>>>>>> end
46140>>>>>>>>>>
46140>>>>>>>>> set prv.psFileName to lsFileName
46141>>>>>>>>> end_procedure
46142>>>>>>>>>
46142>>>>>>>>> procedure DirectOutputHelp integer liAppend string lsFileName
46144>>>>>>>>> integer liChannel liWasCreated
46144>>>>>>>>> string lsFile
46144>>>>>>>>> if NUM_ARGUMENTS eq 2 begin
46146>>>>>>>>> move lsFileName to lsFile
46147>>>>>>>>> set psFileName to lsFile
46148>>>>>>>>> end
46148>>>>>>>>>>
46148>>>>>>>>> else get psFileName to lsFile
46150>>>>>>>>> if liAppend begin
46152>>>>>>>>> move (not(SEQ_FileExists(lsFile))) to liWasCreated
46153>>>>>>>>> get SEQ_AppendOutput lsFile to liChannel
46154>>>>>>>>> end
46154>>>>>>>>>>
46154>>>>>>>>> else begin
46155>>>>>>>>> get SEQ_DirectOutput lsFile to liChannel
46156>>>>>>>>> move 1 to liWasCreated
46157>>>>>>>>> end
46157>>>>>>>>>>
46157>>>>>>>>> set prv.piChannel to liChannel
46158>>>>>>>>> if (piCloseOnWrite(self)) Close_Output channel liChannel
46162>>>>>>>>> if liWasCreated send OnLogFileCreated
46165>>>>>>>>> send OnLogFileOpen
46166>>>>>>>>> end_procedure
46167>>>>>>>>>
46167>>>>>>>>> procedure OnLogFileOpen
46169>>>>>>>>> end_procedure
46170>>>>>>>>> procedure OnLogFileClose
46172>>>>>>>>> end_procedure
46173>>>>>>>>> procedure OnLogFileCreated
46175>>>>>>>>> string lsPurpose
46175>>>>>>>>> get psPurpose to lsPurpose
46176>>>>>>>>> if (lsPurpose<>"") begin
46178>>>>>>>>> send WriteLn lsPurpose
46179>>>>>>>>> send WriteLn (repeat("-",length(lsPurpose)))
46180>>>>>>>>> send DoWriteTimeEntry "File created"
46181>>>>>>>>> end
46181>>>>>>>>>>
46181>>>>>>>>> end_procedure
46182>>>>>>>>>
46182>>>>>>>>> procedure DeleteFile string lsFileName
46184>>>>>>>>> string lsFile
46184>>>>>>>>> if NUM_ARGUMENTS eq 1 move lsFileName to lsFile
46187>>>>>>>>> else get psFileName to lsFile
46189>>>>>>>>> get SEQ_TranslatePathToAbsolute lsFile to lsFile
46190>>>>>>>>> erasefile lsFile
46191>>>>>>>>>>
46191>>>>>>>>> end_procedure
46192>>>>>>>>>
46192>>>>>>>>> procedure DirectOutput string lsFileName
46194>>>>>>>>> if NUM_ARGUMENTS send DirectOutputHelp DFFALSE lsFileName
46197>>>>>>>>> else send DirectOutputHelp DFFALSE (psFileName(self))
46199>>>>>>>>> end_procedure
46200>>>>>>>>>
46200>>>>>>>>> procedure AppendOutput string lsFileName
46202>>>>>>>>> if NUM_ARGUMENTS send DirectOutputHelp DFTRUE lsFileName
46205>>>>>>>>> else send DirectOutputHelp DFTRUE (psFileName(self))
46207>>>>>>>>> end_procedure
46208>>>>>>>>>
46208>>>>>>>>> procedure CloseOutput
46210>>>>>>>>> send OnLogFileClose
46211>>>>>>>>> ifnot (piCloseOnWrite(self)) send SEQ_CloseOutput (prv.piChannel(self))
46214>>>>>>>>> else send Seq_Release_Channel (prv.piChannel(self))
46216>>>>>>>>> set prv.piChannel to -1
46217>>>>>>>>> end_procedure
46218>>>>>>>>>
46218>>>>>>>>> procedure WriteLn string lsLine
46220>>>>>>>>> integer liCloseOnWrite liChannel lbRelease liPos liOriginalCloseOnWrite
46220>>>>>>>>> if (pbANSI_State(self)) move (StringOemToAnsi(lsLine)) to lsLine
46223>>>>>>>>> get piCloseOnWrite to liCloseOnWrite
46224>>>>>>>>> get prv.piChannel to liChannel
46225>>>>>>>>>
46225>>>>>>>>> if (liChannel=-1) begin
46227>>>>>>>>> get Seq_New_Channel to liChannel
46228>>>>>>>>> move (TRUE) to lbRelease
46229>>>>>>>>> move liCloseOnWrite to liOriginalCloseOnWrite
46230>>>>>>>>> move 1 to liCloseOnWrite
46231>>>>>>>>> end
46231>>>>>>>>>>
46231>>>>>>>>>
46231>>>>>>>>> if liCloseOnWrite Append_Output channel liChannel (psFileName(self))
46235>>>>>>>>> if lbRelease begin
46237>>>>>>>>> get_channel_position liChannel to liPos
46238>>>>>>>>>>
46238>>>>>>>>> if (liPos<=0) begin
46240>>>>>>>>> set piCloseOnWrite to 0
46241>>>>>>>>> set prv.piChannel to liChannel
46242>>>>>>>>> send OnLogFileCreated
46243>>>>>>>>> set prv.piChannel to -1
46244>>>>>>>>> set piCloseOnWrite to liOriginalCloseOnWrite
46245>>>>>>>>> end
46245>>>>>>>>>>
46245>>>>>>>>> end
46245>>>>>>>>>>
46245>>>>>>>>> writeln channel liChannel lsLine
46248>>>>>>>>> if liCloseOnWrite Close_Output channel liChannel
46252>>>>>>>>>
46252>>>>>>>>> if lbRelease send Seq_Release_Channel liChannel
46255>>>>>>>>> end_procedure
46256>>>>>>>>>
46256>>>>>>>>> procedure DoWriteTimeEntry string lsValue
46258>>>>>>>>> if NUM_ARGUMENTS send WriteLn (TS_ConvertToString(TS_SysTime())+": "+lsValue)
46261>>>>>>>>> else send WriteLn (TS_ConvertToString(TS_SysTime()))
46263>>>>>>>>> end_procedure
46264>>>>>>>>>
46264>>>>>>>>> procedure Output_Image integer liImg
46266>>>>>>>>> integer liAuxChannel liChannel liCloseOnWrite liSeqEof lbRelease
46266>>>>>>>>> string lsLine
46266>>>>>>>>>
46266>>>>>>>>> get Seq_New_Channel to liAuxChannel
46267>>>>>>>>> get piCloseOnWrite to liCloseOnWrite
46268>>>>>>>>> get prv.piChannel to liChannel
46269>>>>>>>>>
46269>>>>>>>>> if (liChannel=-1) begin
46271>>>>>>>>> get Seq_New_Channel to liChannel
46272>>>>>>>>> move (TRUE) to lbRelease
46273>>>>>>>>> move 1 to liCloseOnWrite
46274>>>>>>>>> end
46274>>>>>>>>>>
46274>>>>>>>>>
46274>>>>>>>>> if liCloseOnWrite Append_Output channel liChannel (psFileName(self))
46278>>>>>>>>>
46278>>>>>>>>> direct_input channel liAuxChannel ("image: "+string(liImg))
46280>>>>>>>>> ifnot (SeqEof) readln channel liAuxChannel lsLine
46284>>>>>>>>> repeat
46284>>>>>>>>>>
46284>>>>>>>>> move (SeqEof) to liSeqEof
46285>>>>>>>>> ifnot liSeqEof begin
46287>>>>>>>>> writeln channel liChannel (rtrim(lsLine))
46290>>>>>>>>> readln channel liAuxChannel lsLine
46292>>>>>>>>> end
46292>>>>>>>>>>
46292>>>>>>>>> until liSeqEof
46294>>>>>>>>> close_input channel liAuxChannel
46296>>>>>>>>>
46296>>>>>>>>> if liCloseOnWrite Close_Output channel liChannel
46300>>>>>>>>> if lbRelease send Seq_Release_Channel liChannel
46303>>>>>>>>>
46303>>>>>>>>> send Seq_Release_Channel liAuxChannel
46304>>>>>>>>> end_procedure
46305>>>>>>>>>end_class // cLogFile
46306>>>>>>>>>
46306>>>>>>>Use WinUser.nui // User_Windows_User_Name function
Including file: winuser.nui (C:\Apps\VDFQuery\AppSrc\winuser.nui)
46306>>>>>>>>>// Use WinUser.nui // User_Windows_User_Name function
46306>>>>>>>>>Use Windows
46306>>>>>>>>>Use DLL
46306>>>>>>>>>// External_Function User_WNetGetUser "WNetGetUserA" mpr.dll pointer lpName pointer lpUserName string lpnLength returns DWord
46306>>>>>>>>>External_Function User_WNetGetUser "WNetGetUserA" mpr.dll pointer lpName pointer lpUserName pointer lpLength returns DWord
46307>>>>>>>>>
46307>>>>>>>>>Function User_Windows_User_Name global Returns String
46309>>>>>>>>> String sName sLength
46309>>>>>>>>> Pointer lpName_Addr lpLength_Addr
46309>>>>>>>>> Integer iRetval
46309>>>>>>>>>
46309>>>>>>>>> Movestr (Repeat (Character (0), 255)) To sName
46310>>>>>>>>>>
46310>>>>>>>>> GetAddress Of sName To lpName_Addr
46311>>>>>>>>> Movestr (DwordToBytes (255)) To sLength
46312>>>>>>>>>>
46312>>>>>>>>> GetAddress Of sLength To lpLength_Addr
46313>>>>>>>>>
46313>>>>>>>>> Moveint (User_WNetGetUser (0, lpName_Addr, lpLength_Addr)) To iRetval
46314>>>>>>>>>>
46314>>>>>>>>>
46314>>>>>>>>> If iRetval Eq 0 Function_Return (CString (sName))
46317>>>>>>>>> Else Function_Return "User Unknown"
46319>>>>>>>>>End_Function // Network_User_Name
46320>>>>>>>Use ObjGroup.utl // Defining groups of objects
Including file: objgroup.utl (C:\Apps\VDFQuery\AppSrc\objgroup.utl)
46320>>>>>>>>>//**********************************************************************
46320>>>>>>>>>// Use ObjGroup.utl // Defining groups of objects
46320>>>>>>>>>//
46320>>>>>>>>>// Author: Sture B. Andersen
46320>>>>>>>>>//
46320>>>>>>>>>// Create: Fri 18-07-1997
46320>>>>>>>>>// Update: Mon 17-11-1997 - Deferred_Request_Destroy_Object added
46320>>>>>>>>>// Wed 28-01-1998 - Procedure Deferred_Message added
46320>>>>>>>>>// Tue 11-08-1998 - Deferred_Message now implemented for use
46320>>>>>>>>>// with character mode as well. Beware though,
46320>>>>>>>>>// a lot of things will make it fail (inkey$
46320>>>>>>>>>// commands etc...)
46320>>>>>>>>>// - Non-use of K$ removed.
46320>>>>>>>>>// Mon 18-01-1999 - Global integer NotExitingApplication
46320>>>>>>>>>// introduced.
46320>>>>>>>>>// - A lot of comments added.
46320>>>>>>>>>// Sun 25-04-1999 - Fixed NotExitingApplication
46320>>>>>>>>>// Tue 31-07-2001 - Added Exit_Application_Check (Fixed
46320>>>>>>>>>// NotExitingApplication for CM)
46320>>>>>>>>>// Thu 08-08-2002 - Changed timer create/destroy strategy for
46320>>>>>>>>>// character mode DataFlex
46320>>>>>>>>>//
46320>>>>>>>>>// Purpose: 1: To provide a global mechanism for defining groups of objects
46320>>>>>>>>>// that may be instatiated in different parts of the application
46320>>>>>>>>>// object tree (determined at runtime).
46320>>>>>>>>>//
46320>>>>>>>>>// 2: To provide a method for adding a message to the back of the
46320>>>>>>>>>// DataFlex message queue.
46320>>>>>>>>>//
46320>>>>>>>>>// It's an odd couple of features to present in one and the same
46320>>>>>>>>>// package but they really are depending upon its other services.
46320>>>>>>>>>// Nice and tight...
46320>>>>>>>>>//
46320>>>>>>>>>// Blabla: It may also be used as an easy method for creating multiple views
46320>>>>>>>>>// at runtime from the same object definition. That would be done
46320>>>>>>>>>// like this:
46320>>>>>>>>>//
46320>>>>>>>>>// ³ use objgroup.utl
46320>>>>>>>>>// ³
46320>>>>>>>>>// ³ DEFINE_OBJECT_GROUP OG_Modules
46320>>>>>>>>>// ³ object Modules_vw is a aps.dbview label (og_param(0))
46320>>>>>>>>>// ³ object dd is a Modules_dd
46320>>>>>>>>>// ³ end_object
46320>>>>>>>>>// ³ set main_dd to (dd(self))
46320>>>>>>>>>// ³ set server to (dd(self))
46320>>>>>>>>>// ³ object cont is a aps.dbcontainer3d
46320>>>>>>>>>// ³ set p_auto_column to false
46320>>>>>>>>>// ³ object grd is a aps.dbGrid
46320>>>>>>>>>// ³ begin_row
46320>>>>>>>>>// ³ entry_item Modules.Code
46320>>>>>>>>>// ³ entry_item Modules.Name
46320>>>>>>>>>// ³ end_row
46320>>>>>>>>>// ³ end_object
46320>>>>>>>>>// ³ end_object
46320>>>>>>>>>// ³ Procedure Close_Panel // Release when closed!
46320>>>>>>>>>// ³ Forward Send Close_Panel
46320>>>>>>>>>// ³ send Deferred_Request_Destroy_Object
46320>>>>>>>>>// ³ End_Procedure
46320>>>>>>>>>// ³ move self to OG_Current_Object# // global integer
46320>>>>>>>>>// ³ // The previous line makes sure we know the object-ID of
46320>>>>>>>>>// ³ // the view we just created.
46320>>>>>>>>>// ³ end_object
46320>>>>>>>>>// ³ END_DEFINE_OBJECT_GROUP
46320>>>>>>>>>// ³
46320>>>>>>>>>// ³ procedure OpenNewModuleVw // Access method
46320>>>>>>>>>// ³ CREATE_OBJECT_GROUP OG_Modules "Yet another view"
46320>>>>>>>>>// ³ send popup to OG_Current_Object#
46320>>>>>>>>>// ³ end_procedure
46320>>>>>>>>>//
46320>>>>>>>>>// This method does not require that the view is coded with
46320>>>>>>>>>// APS objects.
46320>>>>>>>>>//
46320>>>>>>>>>//
46320>>>>>>>>>// The Deferred_Message procedure
46320>>>>>>>>>// ------------------------------
46320>>>>>>>>>//
46320>>>>>>>>>// The package provides a third feature which is the Deferred_Message
46320>>>>>>>>>// method. This is a way to tell DataFlex that you want a procedure
46320>>>>>>>>>// to execute - not now - but when everything else is finished. In
46320>>>>>>>>>// effect you can now send a message by adding it to the very end of
46320>>>>>>>>>// the message queue.
46320>>>>>>>>>//
46320>>>>>>>>>// Why would one want to do that? Well, I invented it to get around
46320>>>>>>>>>// the problem of destroying panels, when they are closed. You may
46320>>>>>>>>>// create a procedure like this:
46320>>>>>>>>>//
46320>>>>>>>>>// Procedure Close_Panel
46320>>>>>>>>>// forward send Close_Panel
46320>>>>>>>>>// send Request_Destroy_Object // Destroy when closed
46320>>>>>>>>>// End_Procedure
46320>>>>>>>>>//
46320>>>>>>>>>// Because the runtime is still executing a procedure in the object
46320>>>>>>>>>// you are destroying, you will get problems. Since this goes for
46320>>>>>>>>>// all procedures within an object you simply cannot make an
46320>>>>>>>>>// object destroy itself, when it is closed.
46320>>>>>>>>>//
46320>>>>>>>>>// UNLESS you can find a way to put a message in the far back of
46320>>>>>>>>>// the message queue. That would make sure that everything in
46320>>>>>>>>>// connection with closing the panel had already happened before
46320>>>>>>>>>// object destruction. And that is what the Deferred_Message
46320>>>>>>>>>// procedure can do. Therefore you may instead write:
46320>>>>>>>>>//
46320>>>>>>>>>// Procedure Close_Panel
46320>>>>>>>>>// forward send Close_Panel
46320>>>>>>>>>// send Deferred_Message msg_Request_Destroy_Object
46320>>>>>>>>>// End_Procedure
46320>>>>>>>>>//
46320>>>>>>>>>// Somewhere along the VDF versions (6 or 7) DAW fixed this
46320>>>>>>>>>// particular problem so that now it is OK to destroy an object
46320>>>>>>>>>// while executing one of its methods.
46320>>>>>>>>>//
46320>>>>>>>>>//
46320>>>>>>>>>// This technique is also viable if you want to make more
46320>>>>>>>>>// independant DDO structures perform something in one go. It
46320>>>>>>>>>// is a fact that when a DDO object is doing something (saving
46320>>>>>>>>>// or finding or the like) you cannot make another (un-connected)
46320>>>>>>>>>// DDO structure do anything. It appears to be dead. The reason is
46320>>>>>>>>>// that while a DDO is performing one of those DDO things it sets
46320>>>>>>>>>// global integers OPERATION_MODE and OPERATION_ORIGIN to whatever
46320>>>>>>>>>// thereby blocking other DDO's from doing anything. If you
46320>>>>>>>>>// keep your tongue straight, you may use the Deferred_Message
46320>>>>>>>>>// procedure to get around this limitation.
46320>>>>>>>>>//
46320>>>>>>>>>// However, when using this technique, there is a couple of
46320>>>>>>>>>// (hundred) pitfalls.
46320>>>>>>>>>//
46320>>>>>>>>>// The technique I use to do this involves a timer object. The
46320>>>>>>>>>// first time you send a deferred message this timer object
46320>>>>>>>>>// will be created (and not before).
46320>>>>>>>>>//
46320>>>>>>>>>// As I understand it, a timer in Windows simply must have a
46320>>>>>>>>>// window handle (a Windows administrative thing that relates
46320>>>>>>>>>// to a window you can see on screen) in order to function. A
46320>>>>>>>>>// DataFlex application can have a lot of windows and it is
46320>>>>>>>>>// important that this window is the ClientArea object of your
46320>>>>>>>>>// application. Placing it anywhere else will give you problems.
46320>>>>>>>>>//
46320>>>>>>>>>// If you get an error 'DFTimerManager doesn't have Window_Handle!'
46320>>>>>>>>>// when you close your application, the timer object has been
46320>>>>>>>>>// created in the wrong place. You can get around this by inserting
46320>>>>>>>>>// this line in the beginning of the ClientArea object:
46320>>>>>>>>>//
46320>>>>>>>>>// Object Main_Client is a ClientArea
46320>>>>>>>>>// send Deferred_Message msg_none
46320>>>>>>>>>// ...
46320>>>>>>>>>//
46320>>>>>>>>>// Another error situation arises if there is any deferred
46320>>>>>>>>>// messages waiting to be executed when you close your
46320>>>>>>>>>// application. This may happen for example if you hook up
46320>>>>>>>>>// to the New_Current_Record method in a DD object.
46320>>>>>>>>>//
46320>>>>>>>>>// Procedure New_Current_Record integer old_rec# integer new_rec#
46320>>>>>>>>>// forward send New_Current_Record old_rec# new_rec#
46320>>>>>>>>>// send Deferred_Message msg_Update_Other_DD_Structures
46320>>>>>>>>>// End_Procedure
46320>>>>>>>>>//
46320>>>>>>>>>// For reasons un-known to man kind, a DD object fires a
46320>>>>>>>>>// New_Current_Record message when the object is destroyed (most
46320>>>>>>>>>// likely at the time of exiting the application). Do you see the
46320>>>>>>>>>// problem? A message is put in the message queue, when in fact
46320>>>>>>>>>// control never returns to the program. Timers don't like
46320>>>>>>>>>// that sort of thing. You will receive an "Can't kill timer!
46320>>>>>>>>>// Windows error #" error.
46320>>>>>>>>>//
46320>>>>>>>>>// If you get into this sort of trouble you may need to check
46320>>>>>>>>>// the value of global integer NotExitingApplication (defined
46320>>>>>>>>>// in this package) before you send a deferred message. The
46320>>>>>>>>>// procedure above would now look like this:
46320>>>>>>>>>//
46320>>>>>>>>>// Procedure New_Current_Record integer old_rec# integer new_rec#
46320>>>>>>>>>// forward send New_Current_Record old_rec# new_rec#
46320>>>>>>>>>// if NotExitingApplication ;
46320>>>>>>>>>// send Deferred_Message msg_Update_Other_DD_Structures
46320>>>>>>>>>// End_Procedure
46320>>>>>>>>>//
46320>>>>>>>>>//
46320>>>>>>>>>//**********************************************************************
46320>>>>>>>>>
46320>>>>>>>>>Use UI
46320>>>>>>>>>Use Macros.utl // Various macros (DESKTOP_SECTION)
46320>>>>>>>>>Use Set.utl // cArray, cSet and cStack classes
46320>>>>>>>>>Use Base.nui
46320>>>>>>>>> // when deferred_request_destroy_object is called
46320>>>>>>>>>desktop_section
46325>>>>>>>>> integer NotExitingApplication
46325>>>>>>>>> move 1 to NotExitingApplication
46326>>>>>>>>> object OG_Current_Object_stack is an cStack
46328>>>>>>>>> procedure Notify_Exit_Application
46331>>>>>>>>> move 0 to NotExitingApplication
46332>>>>>>>>> end_procedure
46333>>>>>>>>> procedure Broadcast_Notify_Exit_Application
46336>>>>>>>>> move 0 to NotExitingApplication
46337>>>>>>>>> end_procedure
46338>>>>>>>>> function Exit_Application_Check returns integer // CM check
46341>>>>>>>>> move 0 to NotExitingApplication
46342>>>>>>>>> function_return 0 // No changes
46343>>>>>>>>> end_function
46344>>>>>>>>> end_object
46345>>>>>>>>>
46345>>>>>>>>> // This object holds all parameters for Object Group instantiations. The
46345>>>>>>>>> // object is a stack and the last item holds the number of items for the
46345>>>>>>>>> // current object group instantiation.
46345>>>>>>>>> // The global integer ObjectGroupCurrentOffset# points to the first
46345>>>>>>>>> // parameter in the current object group instantiation.
46345>>>>>>>>>
46345>>>>>>>>> integer OG_ParameterArray# // Object ID for OG_ParameterArray
46345>>>>>>>>> object OG_ParameterArray is an array
46347>>>>>>>>> move self to OG_ParameterArray#
46348>>>>>>>>> end_object
46349>>>>>>>>>end_desktop_section
46354>>>>>>>>>
46354>>>>>>>>>integer OG_CurrentOffset# //
46354>>>>>>>>>move 0 to OG_CurrentOffset#
46355>>>>>>>>>
46355>>>>>>>>>integer OG_Current_Object# //
46355>>>>>>>>>integer OG_Tmp# //
46355>>>>>>>>>
46355>>>>>>>>>// The prefix "og" stands for object group.
46355>>>>>>>>>procedure og_set_param global integer itm# string value#
46357>>>>>>>>> set value of OG_ParameterArray# item (OG_CurrentOffset#+itm#) to value#
46358>>>>>>>>>end_procedure
46359>>>>>>>>>function og_param global integer itm# returns string
46361>>>>>>>>> function_return (value(OG_ParameterArray#,OG_CurrentOffset#+itm#))
46362>>>>>>>>>end_function
46363>>>>>>>>>procedure og_allocate_param_space global integer itm#
46365>>>>>>>>> integer item_count#
46365>>>>>>>>> get item_count of OG_ParameterArray# to item_count#
46366>>>>>>>>> set value of OG_ParameterArray# item (item_count#+itm#) to itm#
46367>>>>>>>>> move item_count# to OG_CurrentOffset#
46368>>>>>>>>>end_procedure
46369>>>>>>>>>procedure og_add_param global string value#
46371>>>>>>>>> integer item_count# max#
46371>>>>>>>>> get item_count of OG_ParameterArray# to item_count#
46372>>>>>>>>> get integer_value of OG_ParameterArray# item (item_count#-1) to max#
46373>>>>>>>>> send delete_item to OG_ParameterArray# (item_count#-1)
46374>>>>>>>>> set value of OG_ParameterArray# item (item_count#-1) to value#
46375>>>>>>>>> set value of OG_ParameterArray# item item_count# to (max#+1)
46376>>>>>>>>>end_procedure
46377>>>>>>>>>procedure og_drop_params global // Delete all parameters from last OG instantiation
46379>>>>>>>>> integer max# itm# item_count#
46379>>>>>>>>> get item_count of OG_ParameterArray# to item_count#
46380>>>>>>>>> get value of OG_ParameterArray# item (item_count#-1) to max#
46381>>>>>>>>> for itm# from 0 to max#
46387>>>>>>>>>>
46387>>>>>>>>> send delete_item to OG_ParameterArray# (item_count#-1-itm#)
46388>>>>>>>>> loop
46389>>>>>>>>>>
46389>>>>>>>>> get item_count of OG_ParameterArray# to item_count#
46390>>>>>>>>> if item_count# ; // Only if not empty move (item_count#-integer_value(OG_ParameterArray#,item_count#-1)-1) to OG_CurrentOffset#
46393>>>>>>>>> else move 0 to OG_CurrentOffset#
46395>>>>>>>>>end_procedure
46396>>>>>>>>>
46396>>>>>>>>>// The above set of messages enables two different strategies for setting
46396>>>>>>>>>// up parameters for an OG instantiation:
46396>>>>>>>>>//
46396>>>>>>>>>// 1) sending og_allocate_param_space to allocate the necessary number
46396>>>>>>>>>// of array items at one time. Afterwards the values are set using
46396>>>>>>>>>// the og_set_param message
46396>>>>>>>>>//
46396>>>>>>>>>// 2) sending og_allocate_param_space with parameter 0 simply to
46396>>>>>>>>>// indicate that a new parameter set is about to be specified.
46396>>>>>>>>>// Parameter values are hereafter set by using the og_add_param
46396>>>>>>>>>// message.
46396>>>>>>>>>//
46396>>>>>>>>>// Strategy 2 is somewhat slower than 1 but may be more convenient in
46396>>>>>>>>>// most instances.
46396>>>>>>>>>//
46396>>>>>>>>>// In any case message og_drop_params will drop the current parameters
46396>>>>>>>>>// by deleting them from the stack.
46396>>>>>>>>>
46396>>>>>>>>>
46396>>>>>>>>>
46396>>>>>>>>>
46396>>>>>>>>>// The rest of this file is dedicated to supplying a method to be used when
46396>>>>>>>>>// destroying objects. The method Deferred_Request_Destroy_Object is understood
46396>>>>>>>>>// by all objects but should only be sent to panels (View's and ModalPanel's)
46396>>>>>>>>>//
46396>>>>>>>>>// The next couple of hundred lines is a duplicate of the standard VDF timer
46396>>>>>>>>>// package except that class names has been changed ("0" has been added). This
46396>>>>>>>>>// is needed because I do not want to rely on the DfTimer.pkg package. Why not?
46396>>>>>>>>>// Because that has to be USE'd from within the (App)ClientArea to avoid focus
46396>>>>>>>>>// loss at application start up. This package (ObjGroup.utl) may be used
46396>>>>>>>>>// anywhere and still work (as far as I know).
46396>>>>>>>>>
46396>>>>>>>>>Use Windows // Standard DAC packages
46396>>>>>>>>>Use WinUser //
46396>>>>>>>>>
46396>>>>>>>>>External_Function SetTimer0 "SetTimer" User32.DLL Integer hWnd Integer idTimer Integer idTimeout Pointer tmprc Returns Integer
46397>>>>>>>>>External_Function KillTimer0 "KillTimer" User32.DLL Integer hWnd Integer idTimer Returns Integer
46398>>>>>>>>>External_Function GetLastError0 "GetLastError" Kernel32.DLL Returns DWORD
46399>>>>>>>>>
46399>>>>>>>>>Integer giTimerManager#
46399>>>>>>>>>
46399>>>>>>>>>Class TimersArray0 is an Array
46400>>>>>>>>> Function Find_Object Integer iObj Returns Integer
46402>>>>>>>>> integer iMax
46402>>>>>>>>> integer iItem
46402>>>>>>>>> integer iValue
46402>>>>>>>>> Get Item_count to iMax
46403>>>>>>>>> Decrement iMax
46404>>>>>>>>> For iItem from 1 to iMax
46410>>>>>>>>>>
46410>>>>>>>>> Get Integer_Value item iItem to iValue
46411>>>>>>>>> If iValue EQ iObj Function_Return iItem
46414>>>>>>>>> Loop
46415>>>>>>>>>>
46415>>>>>>>>> Function_Return -1
46416>>>>>>>>> End_Function
46417>>>>>>>>>
46417>>>>>>>>> Procedure Add_Object Integer iObj Returns Integer
46419>>>>>>>>> integer iItem
46419>>>>>>>>> Get Find_Object iObj to iItem
46420>>>>>>>>> If iItem LT 0 Begin
46422>>>>>>>>> Get Find_Object 0 to iItem
46423>>>>>>>>> If iItem LT 0 Get Item_Count to iItem
46426>>>>>>>>> End
46426>>>>>>>>>>
46426>>>>>>>>> Set Array_Value item iItem to iObj
46427>>>>>>>>> Procedure_Return iItem
46428>>>>>>>>> End_Procedure
46429>>>>>>>>>
46429>>>>>>>>> Procedure Remove_Object Integer iObj
46431>>>>>>>>> integer iItem
46431>>>>>>>>> Get Find_Object iObj to iItem
46432>>>>>>>>> If iItem GT 0 Set Array_Value item iItem to 0
46435>>>>>>>>> End_Procedure
46436>>>>>>>>> Procedure Destroy_Object
46438>>>>>>>>> Delegate Send Kill_All_Timers
46440>>>>>>>>> Forward Send Destroy_Object
46442>>>>>>>>> End_Procedure
46443>>>>>>>>>End_Class // TimersArray0
46444>>>>>>>>>
46444>>>>>>>>>Class DFTimerManager0 is a DFControl
46445>>>>>>>>> Procedure Construct_Object
46447>>>>>>>>> Forward Send Construct_Object
46449>>>>>>>>> Set Visible_State to FALSE
46450>>>>>>>>> Set External_Class_Name "DFTimer" to "static"
46451>>>>>>>>> Set External_Message WM_TIMER to OnTimer
46452>>>>>>>>> Object TimersArray0 is a TimersArray0
46454>>>>>>>>> Set Array_Value item 0 to -9999 // So we don't use item 0
46455>>>>>>>>> End_Object
46456>>>>>>>>> Move self to giTimerManager#
46457>>>>>>>>> End_Procedure
46458>>>>>>>>>
46458>>>>>>>>> Procedure Set Timer_Active_State Integer iObj Integer iState
46460>>>>>>>>> integer iTimerID iTimeout iResult iSet
46460>>>>>>>>> Dword nResult
46460>>>>>>>>> Handle hWnd
46460>>>>>>>>> Get Window_Handle to hWnd
46461>>>>>>>>> If Not hWnd Begin
46463>>>>>>>>> Error 999 "DFTimerManager doesn't have Window_Handle!"
46464>>>>>>>>>>
46464>>>>>>>>> Procedure_Return
46465>>>>>>>>> End
46465>>>>>>>>>>
46465>>>>>>>>>
46465>>>>>>>>> Move (TimersArray0(self)) to iSet
46466>>>>>>>>> If iState Begin
46468>>>>>>>>> Get MSG_Add_Object of iSet iObj to iTimerID
46469>>>>>>>>> Get Timeout of iObj to iTimeout
46470>>>>>>>>> Move (SetTimer0(hWnd, iTimerID, iTimeout, 0)) to iResult
46471>>>>>>>>> If Not iResult Begin
46473>>>>>>>>> Error 999 "Can't create timer. Too many?"
46474>>>>>>>>>>
46474>>>>>>>>> Procedure_Return
46475>>>>>>>>> End
46475>>>>>>>>>>
46475>>>>>>>>> End
46475>>>>>>>>>>
46475>>>>>>>>> Else Begin
46476>>>>>>>>> Get Find_Object of iSet iObj to iTimerID
46477>>>>>>>>> If iTimerID EQ -1 Procedure_Return
46480>>>>>>>>> Move (KillTimer0(hWnd, iTimerID)) to iResult
46481>>>>>>>>> If Not iResult Begin
46483>>>>>>>>> Move (GetLastError0()) to nResult
46484>>>>>>>>> Error 999 ("Can't kill timer! Windows error" * string(nResult) - "!")
46485>>>>>>>>>>
46485>>>>>>>>> Procedure_Return
46486>>>>>>>>> End
46486>>>>>>>>>>
46486>>>>>>>>> Send Remove_Object to iSet iObj
46487>>>>>>>>> End
46487>>>>>>>>>>
46487>>>>>>>>> End_Procedure
46488>>>>>>>>>
46488>>>>>>>>> Function Timer_Active_State Integer iObj Returns Integer
46490>>>>>>>>> integer iResult
46490>>>>>>>>> Get Find_Object of (TimersArray0(self)) iObj to iResult
46491>>>>>>>>> Function_Return (iResult NE 0)
46492>>>>>>>>> End_Function
46493>>>>>>>>>
46493>>>>>>>>> Procedure Kill_All_Timers
46495>>>>>>>>> integer iMax iSet iItem iObj iResult
46495>>>>>>>>> Handle hWnd
46495>>>>>>>>>
46495>>>>>>>>> Get Window_Handle to hWnd
46496>>>>>>>>> If Not hWnd Begin
46498>>>>>>>>> Error 999 "DFTimerManager doesn't have Window_Handle!"
46499>>>>>>>>>>
46499>>>>>>>>> Procedure_Return
46500>>>>>>>>> End
46500>>>>>>>>>>
46500>>>>>>>>>
46500>>>>>>>>> Move (TimersArray0(self)) to iSet
46501>>>>>>>>> Get Item_Count of iSet to iMax
46502>>>>>>>>> Decrement iMax
46503>>>>>>>>> For iItem From 1 to iMax
46509>>>>>>>>>>
46509>>>>>>>>> Get Integer_Value of iSet item iItem to iObj
46510>>>>>>>>> If iObj Begin
46512>>>>>>>>> Move (KillTimer0(hWnd, iItem)) to iResult
46513>>>>>>>>> Set Array_Value of iSet item iItem to 0
46514>>>>>>>>> End
46514>>>>>>>>>>
46514>>>>>>>>> Loop
46515>>>>>>>>>>
46515>>>>>>>>> End_Procedure
46516>>>>>>>>>
46516>>>>>>>>> Procedure OnTimer Integer wParam Integer lParam
46518>>>>>>>>> integer iObj
46518>>>>>>>>> Get Integer_Value of (TimersArray0(self)) item wParam to iObj
46519>>>>>>>>> If Not iObj Begin
46521>>>>>>>>> Error 999 "OnTimer: Timer event without object!"
46522>>>>>>>>>>
46522>>>>>>>>> Procedure_Return
46523>>>>>>>>> End
46523>>>>>>>>>>
46523>>>>>>>>> Send OnTimer to iObj wParam lParam
46524>>>>>>>>> End_Procedure
46525>>>>>>>>>
46525>>>>>>>>> Procedure Destroy_Object
46527>>>>>>>>> Forward Send Destroy_Object
46529>>>>>>>>> Move 0 to giTimerManager#
46530>>>>>>>>> End_Procedure
46531>>>>>>>>>End_Class // DFTimerManger
46532>>>>>>>>>
46532>>>>>>>>>Class DFTimerManagerPanel0 is a DFPanel
46533>>>>>>>>>
46533>>>>>>>>> Procedure Construct_Object
46535>>>>>>>>> Forward Send Construct_Object
46537>>>>>>>>> Set Visible_State to FALSE
46538>>>>>>>>> Object DFTimerManager is a DFTimerManager0
46540>>>>>>>>> End_Object
46541>>>>>>>>> End_Procedure
46542>>>>>>>>>
46542>>>>>>>>> Procedure End_Construct_Object
46544>>>>>>>>> Forward Send End_Construct_Object
46546>>>>>>>>> Send Page_Object TRUE
46547>>>>>>>>> Broadcast Send Page_Object TRUE
46549>>>>>>>>> End_Procedure
46550>>>>>>>>>End_Class
46551>>>>>>>>>
46551>>>>>>>>>Class DFTimer0 is a Textbox
46552>>>>>>>>> Procedure Construct_Object
46554>>>>>>>>> Forward Send Construct_Object
46556>>>>>>>>> Set Visible_State to FALSE
46557>>>>>>>>> Property Integer Timeout Private 1000
46558>>>>>>>>> Property Integer Timer_Message Public 0
46559>>>>>>>>> Property Integer Timer_Object Public 0
46560>>>>>>>>> Property Integer Auto_Start_State Public TRUE
46561>>>>>>>>> Property Integer Auto_Stop_State Public TRUE
46562>>>>>>>>> End_Procedure
46563>>>>>>>>>
46563>>>>>>>>> Procedure Set Timer_Active_State Integer iState
46565>>>>>>>>> integer iObj
46565>>>>>>>>> Move self to iObj
46566>>>>>>>>> If giTimerManager# Set Timer_Active_State of giTimerManager# iObj to iState
46569>>>>>>>>> End_Procedure
46570>>>>>>>>>
46570>>>>>>>>> Function Timer_Active_State returns integer
46572>>>>>>>>> integer iState
46572>>>>>>>>> integer iObj
46572>>>>>>>>> Move self to iObj
46573>>>>>>>>> If giTimerManager# Get Timer_Active_State of giTimerManager# iObj to iState
46576>>>>>>>>> Function_Return iState
46577>>>>>>>>> End_Function
46578>>>>>>>>>
46578>>>>>>>>> Procedure Set Timeout Integer iTimeout
46580>>>>>>>>> integer iActive
46580>>>>>>>>> Set !$.Timeout to iTimeout
46581>>>>>>>>> Get Timer_Active_State to iActive
46582>>>>>>>>> If iActive Set Timer_Active_State to TRUE
46585>>>>>>>>> End_Procedure
46586>>>>>>>>>
46586>>>>>>>>> Function Timeout Returns Integer
46588>>>>>>>>> integer iTimeout
46588>>>>>>>>> Get !$.Timeout to iTimeout
46589>>>>>>>>> Function_Return iTimeout
46590>>>>>>>>> End_Function
46591>>>>>>>>>
46591>>>>>>>>> Procedure OnTimer Integer iwParam Integer ilParam
46593>>>>>>>>> integer iMsg
46593>>>>>>>>> integer iObj
46593>>>>>>>>> Get Timer_Message to iMsg
46594>>>>>>>>> Get Timer_Object to iObj
46595>>>>>>>>> If (iMsg) Begin
46597>>>>>>>>> Get Timer_Object to iObj
46598>>>>>>>>> If iObj Send iMsg to iObj iwParam ilParam
46601>>>>>>>>> Else Send iMsg iwParam ilParam
46603>>>>>>>>> End
46603>>>>>>>>>>
46603>>>>>>>>> End_Procedure
46604>>>>>>>>>
46604>>>>>>>>> Procedure Page_Object Integer iState
46606>>>>>>>>> Forward Send Page_Object iState
46608>>>>>>>>> If (iState AND Auto_Start_State(self)) Set Timer_Active_State to TRUE
46611>>>>>>>>> End_Procedure
46612>>>>>>>>>
46612>>>>>>>>> Procedure Page_Delete
46614>>>>>>>>> If (Auto_Stop_State(self)) Set Timer_Active_State to FALSE
46617>>>>>>>>> Forward Send Page_Delete
46619>>>>>>>>> End_Procedure
46620>>>>>>>>>
46620>>>>>>>>> Procedure Destroy_Object
46622>>>>>>>>> Set Timer_Active_State to FALSE
46623>>>>>>>>> Forward Send Destroy_Object
46625>>>>>>>>> End_Procedure
46626>>>>>>>>>End_Class // DFTimer0
46627>>>>>>>>>
46627>>>>>>>>>// This is where this package differs from the DAC package. Object
46627>>>>>>>>>// DFTimerManagerPanel0 is NOT instantiated at program start up
46627>>>>>>>>>// thus leaving focus un-disturbed. Instead they are created the first
46627>>>>>>>>>// time Deferred_Request_Destroy_Object is sent.
46627>>>>>>>>>
46627>>>>>>>>>DEFINE_OBJECT_GROUP OG_DeferredTimer
46628>>>>>>>>> Object DFTimerManagerPanel0 is a DFTimerManagerPanel0
46630>>>>>>>>> // This object will make the program lose its focus if instantiated
46630>>>>>>>>> // before Main.Client_Area has been created.
46630>>>>>>>>> End_Object
46631>>>>>>>>>
46631>>>>>>>>> object oMessages is an Array no_image
46633>>>>>>>>> end_object
46634>>>>>>>>>
46634>>>>>>>>> object oDestructionTimer is a DfTimer0
46636>>>>>>>>> // And this object would have made the program crash
46636>>>>>>>>> set auto_start_state to false
46637>>>>>>>>> set auto_stop_state to false
46638>>>>>>>>> property integer pDestroyObject public 0
46640>>>>>>>>> procedure OnTimer
46643>>>>>>>>> integer obj# msg# oMessages#
46643>>>>>>>>> get pDestroyObject to obj#
46644>>>>>>>>> if obj# begin
46646>>>>>>>>> send request_destroy_object to obj#
46647>>>>>>>>> set pDestroyObject to 0
46648>>>>>>>>> set Timer_Active_State to false // Stop timer
46649>>>>>>>>> if (item_count(oMessages(self))) begin
46651>>>>>>>>> set TimeOut to 0 // This means "as soon as possible"
46652>>>>>>>>> set Timer_Active_State to true // Start timer
46653>>>>>>>>> end
46653>>>>>>>>>>
46653>>>>>>>>> end
46653>>>>>>>>>>
46653>>>>>>>>> else begin
46654>>>>>>>>> move (oMessages(self)) to oMessages#
46655>>>>>>>>> if (item_count(oMessages#)) begin
46657>>>>>>>>> get value of oMessages# item 0 to msg#
46658>>>>>>>>> get value of oMessages# item 1 to obj#
46659>>>>>>>>> send delete_item to oMessages# 0
46660>>>>>>>>> send delete_item to oMessages# 0
46661>>>>>>>>> set Timer_Active_State to false // Stop timer
46662>>>>>>>>> if obj# send msg# to obj#
46665>>>>>>>>> else send msg#
46667>>>>>>>>> if (item_count(oMessages#)) begin
46669>>>>>>>>> set TimeOut to 0 // This means "as soon as possible"
46670>>>>>>>>> set Timer_Active_State to true // Start timer
46671>>>>>>>>> end
46671>>>>>>>>>>
46671>>>>>>>>> end
46671>>>>>>>>>>
46671>>>>>>>>> end
46671>>>>>>>>>>
46671>>>>>>>>> end_procedure
46672>>>>>>>>> procedure Deferred_Destroy integer obj#
46675>>>>>>>>> set pDestroyObject to obj#
46676>>>>>>>>> set TimeOut to 0 // This means "as soon as possible"
46677>>>>>>>>> set Timer_Active_State to true // Start timer
46678>>>>>>>>> end_procedure
46679>>>>>>>>>
46679>>>>>>>>> procedure Send_Message integer msg# integer obj#
46682>>>>>>>>> integer oMessages#
46682>>>>>>>>> move (oMessages(self)) to oMessages#
46683>>>>>>>>> set value of oMessages# item (item_count(oMessages#)) to msg#
46684>>>>>>>>> set value of oMessages# item (item_count(oMessages#)) to obj#
46685>>>>>>>>> set TimeOut to 0 // This means "as soon as possible"
46686>>>>>>>>> set Timer_Active_State to true // Start timer
46687>>>>>>>>> end_procedure
46688>>>>>>>>> end_object
46689>>>>>>>>>END_DEFINE_OBJECT_GROUP
46690>>>>>>>>>
46690>>>>>>>>>Procedure Deferred_Request_Destroy_Object for BaseClass
46692>>>>>>>>> integer self# Client_ID#
46692>>>>>>>>> move self to self#
46693>>>>>>>>> ifnot giTimerManager# begin //
46695>>>>>>>>> move (Client_ID(self#)) to Client_ID#
46696>>>>>>>>> if Client_ID# begin
46698>>>>>>>>> CREATE_OBJECT_GROUP OG_DeferredTimer PARENT Client_ID#
46707>>>>>>>>> end
46707>>>>>>>>>>
46707>>>>>>>>> else error 666 "ClientArea not found!"
46709>>>>>>>>> end
46709>>>>>>>>>>
46709>>>>>>>>> send Deferred_Destroy to (oDestructionTimer(giTimerManager#)) self#
46710>>>>>>>>>End_Procedure
46711>>>>>>>>>
46711>>>>>>>>>Procedure Deferred_Message for BaseClass integer msg# integer obj#
46713>>>>>>>>> integer self# Client_ID#
46713>>>>>>>>> move self to self#
46714>>>>>>>>> ifnot giTimerManager# begin //
46716>>>>>>>>> move (Client_ID(self#)) to Client_ID#
46717>>>>>>>>> if Client_ID# begin
46719>>>>>>>>> CREATE_OBJECT_GROUP OG_DeferredTimer PARENT Client_ID#
46728>>>>>>>>> end
46728>>>>>>>>>>
46728>>>>>>>>> else error 666 "ClientArea not found!"
46730>>>>>>>>> end
46730>>>>>>>>>>
46730>>>>>>>>> if num_arguments gt 1 send send_message to (oDestructionTimer(giTimerManager#)) msg# obj#
46733>>>>>>>>> else send send_message to (oDestructionTimer(giTimerManager#)) msg# self#
46735>>>>>>>>>End_Procedure
46736>>>>>>>>>
46736>>>>>>>Use FList.nui // A lot of FLIST- procedures and functions
Including file: flist.nui (C:\Apps\VDFQuery\AppSrc\flist.nui)
46736>>>>>>>>>// Use FList.nui // A lot of FLIST- procedures and functions
46736>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
46736>>>>>>>>>Use Files.nui // Utilities for handling file related stuff
46736>>>>>>>>>
46736>>>>>>>>>desktop_section
46741>>>>>>>>> object oFileListStack is a cStack no_image
46743>>>>>>>>> end_object
46744>>>>>>>>>end_desktop_section
46749>>>>>>>>>
46749>>>>>>>>>procedure FLIST_CloseAllFiles global
46751>>>>>>>>> close DF_ALL
46752>>>>>>>>>end_procedure
46753>>>>>>>>>
46753>>>>>>>>>function FLIST_CurrentFilelist global returns string
46755>>>>>>>>> string lsRval
46755>>>>>>>>> get_attribute DF_FILELIST_NAME to lsRval
46758>>>>>>>>> move (ToOem(lsRval)) to lsRval
46759>>>>>>>>> function_return lsRval
46760>>>>>>>>>end_function
46761>>>>>>>>>
46761>>>>>>>>>procedure FLIST_SetCurrentFilelist global string lsFileName
46763>>>>>>>>> set_attribute DF_FILELIST_NAME to (ToAnsi(lsFileName))
46766>>>>>>>>>end_procedure
46767>>>>>>>>>
46767>>>>>>>>>procedure FLIST_SetOpenPath global string lsPath
46769>>>>>>>>> set_attribute DF_OPEN_PATH to (ToAnsi(lsPath))
46772>>>>>>>>>end_procedure
46773>>>>>>>>>
46773>>>>>>>>>procedure FLIST_PushCurrentFilelist global
46775>>>>>>>>> send Push.s to (oFileListStack(self)) (FLIST_CurrentFilelist())
46776>>>>>>>>>end_procedure
46777>>>>>>>>>procedure FLIST_PopCurrentFilelist global
46779>>>>>>>>> send FLIST_CloseAllFiles
46780>>>>>>>>> send FLIST_SetCurrentFilelist (sPop(oFileListStack(self)))
46781>>>>>>>>>end_procedure
46782>>>>>>>>>
46782>>>>>>>>>function FLIST_CurrentFileListFolder global returns string
46784>>>>>>>>> string lsFileList lsFolder
46784>>>>>>>>> get FLIST_CurrentFilelist to lsFileList
46785>>>>>>>>> if (lsFileList<>SEQ_RemovePathFromFileName(lsFileList)) function_return (SEQ_ExtractPathFromFileName(lsFileList))
46788>>>>>>>>> get SEQ_FindFileAlongDFPath lsFileList to lsFolder
46789>>>>>>>>> function_return lsFolder
46790>>>>>>>>>end_function
46791>>>>>>>>>
46791>>>>>>>>>// Find an empty entry in filelist cfg, that is not temporarily used
46791>>>>>>>>>// by an "open as" statement. Start the search at entry liFile + 1.
46791>>>>>>>>>function FLIST_TemporaryEntry global integer liFile returns integer
46793>>>>>>>>> integer lbOpened
46793>>>>>>>>> repeat
46793>>>>>>>>>>
46793>>>>>>>>> get_attribute DF_FILE_NEXT_EMPTY of liFile to liFile
46796>>>>>>>>> if liFile begin
46798>>>>>>>>> get_attribute DF_FILE_OPENED of liFile to lbOpened
46801>>>>>>>>> ifnot lbOpened function_return liFile
46804>>>>>>>>> end
46804>>>>>>>>>>
46804>>>>>>>>> until liFile eq 0
46806>>>>>>>>> function_return -1
46807>>>>>>>>>end_function
46808>>>>>>>>>
46808>>>>>>>>>// Returns DFTRUE if a filelist.cfg was created OK.
46808>>>>>>>>>function FLIST_CreateEmptyFileList global string lsFileListPathAndName returns integer
46810>>>>>>>>> integer liCount liOrg liChannel
46810>>>>>>>>> string lsFiller
46810>>>>>>>>> send FLIST_PushCurrentFilelist // Remember who we where.
46811>>>>>>>>> send FLIST_CloseAllFiles // Close all files just in case.
46812>>>>>>>>> get SEQ_DirectOutput ("binary:"+lsFileListPathAndName) to liChannel
46813>>>>>>>>>
46813>>>>>>>>> if (liChannel>=0) begin
46815>>>>>>>>> if 1 begin
46817>>>>>>>>> get_argument_size To liOrg // Create the filelist. It has to be of size
46818>>>>>>>>> set_argument_size 524277 // 32128, if it is any smaller errors occur
46819>>>>>>>>>>
46819>>>>>>>>> pad "" To lsFiller 524277 // when setting the filelist attributes.
46821>>>>>>>>>>
46821>>>>>>>>> move (repeat(character(0),524277)) to lsFiller
46822>>>>>>>>> write "filelist.cfg" // This has to be the first 13 characters
46823>>>>>>>>> write lsFiller //
46824>>>>>>>>> send SEQ_CloseOutput liChannel
46825>>>>>>>>> set_argument_size liOrg // Restore max argument size.
46826>>>>>>>>>>
46826>>>>>>>>>// set_attribute DF_FILELIST_NAME To lsFileListPathAndName // Setup the file list for DataFlex.
46826>>>>>>>>> send FLIST_SetCurrentFilelist lsFileListPathAndName
46827>>>>>>>>>
46827>>>>>>>>> set_attribute DF_FILE_ROOT_NAME of 4095 to "temp"
46830>>>>>>>>> set_attribute DF_FILE_LOGICAL_NAME of 4095 to "temp"
46833>>>>>>>>> set_attribute DF_FILE_DISPLAY_NAME of 4095 to "temp"
46836>>>>>>>>> set_attribute DF_FILE_ROOT_NAME of 4095 to ""
46839>>>>>>>>> set_attribute DF_FILE_LOGICAL_NAME of 4095 to ""
46842>>>>>>>>> set_attribute DF_FILE_DISPLAY_NAME of 4095 to ""
46845>>>>>>>>>
46845>>>>>>>>> set_attribute DF_FILE_ROOT_NAME of 50 to "flexerrs"
46848>>>>>>>>> set_attribute DF_FILE_LOGICAL_NAME of 50 to "FLEXERRS"
46851>>>>>>>>> set_attribute DF_FILE_DISPLAY_NAME of 50 to "@DataFlex Error File"
46854>>>>>>>>>
46854>>>>>>>>> //for liCount from 1 to 250 // Fill the filelist.
46854>>>>>>>>> // set_attribute DF_FILE_ROOT_NAME of liCount to "" // Every slot must be
46854>>>>>>>>> // set_attribute DF_FILE_LOGICAL_NAME of liCount to "" // emptied out. Otherwise
46854>>>>>>>>> // set_attribute DF_FILE_DISPLAY_NAME of liCount to "" // the API thinks some of
46854>>>>>>>>> //loop // the slots are used.
46854>>>>>>>>> end
46854>>>>>>>>>>
46854>>>>>>>>> else begin
46855>>>>>>>>> get_argument_size To liOrg // Create the filelist. It has to be of size
46856>>>>>>>>> set_argument_size 32117 // 32128, if it is any smaller errors occur
46857>>>>>>>>>>
46857>>>>>>>>> pad "" To lsFiller 32117 // when setting the filelist attributes.
46859>>>>>>>>>>
46859>>>>>>>>> write "filelist.cfg" // This has to be the first 13 characters
46860>>>>>>>>> write lsFiller //
46861>>>>>>>>> send SEQ_CloseOutput liChannel
46862>>>>>>>>> set_argument_size liOrg // Restore max argument size.
46863>>>>>>>>>>
46863>>>>>>>>> set_attribute DF_FILELIST_NAME To lsFileListPathAndName // Setup the file list for DataFlex.
46866>>>>>>>>> for liCount from 1 to 250 // Fill the filelist.
46872>>>>>>>>>>
46872>>>>>>>>> set_attribute DF_FILE_ROOT_NAME of liCount to "" // Every slot must be
46875>>>>>>>>> set_attribute DF_FILE_LOGICAL_NAME of liCount to "" // emptied out. Otherwise
46878>>>>>>>>> set_attribute DF_FILE_DISPLAY_NAME of liCount to "" // the API thinks some of
46881>>>>>>>>> loop // the slots are used.
46882>>>>>>>>>>
46882>>>>>>>>> end
46882>>>>>>>>>>
46882>>>>>>>>> send FLIST_PopCurrentFilelist // Restore current filelist.
46883>>>>>>>>> function_return (SEQ_FileExists(lsFileListPathAndName)=SEQIT_FILE)
46884>>>>>>>>> end
46884>>>>>>>>>>
46884>>>>>>>>> else function_return 0
46886>>>>>>>>>end_function
46887>>>>>>>>>
46887>>>>>>>>>enumeration_list
46887>>>>>>>>> define FLINFO_SIZE_BYTES // Filesize of filelist.cfg (bytes)
46887>>>>>>>>> define FLINFO_SIZE_ENTRIES // Max number of entries in filelist.cfg
46887>>>>>>>>> define FLINFO_LT_256 // Is this a (lt) 256 version (bool)
46887>>>>>>>>>end_enumeration_list
46887>>>>>>>>>
46887>>>>>>>>>function FLIST_Information global integer liWhat returns integer
46889>>>>>>>>> integer liRval
46889>>>>>>>>> string lsPath lsFileList
46889>>>>>>>>>
46889>>>>>>>>> move -1 to liRval
46890>>>>>>>>>
46890>>>>>>>>> if (liWhat=FLINFO_SIZE_BYTES) begin
46892>>>>>>>>> get FLIST_CurrentFilelist to lsFileList
46893>>>>>>>>> get SEQ_FileSize lsFileList to liRval
46894>>>>>>>>> end
46894>>>>>>>>>>
46894>>>>>>>>> if (liWhat=FLINFO_LT_256) begin
46896>>>>>>>>> get FLIST_Information FLINFO_SIZE_BYTES to liRval
46897>>>>>>>>> move (liRval<=32768) to liRval
46898>>>>>>>>> end
46898>>>>>>>>>>
46898>>>>>>>>> if (liWhat=FLINFO_SIZE_ENTRIES) begin
46900>>>>>>>>> get FLIST_Information FLINFO_SIZE_BYTES to liRval
46901>>>>>>>>> move (liRval/128-1) to liRval
46902>>>>>>>>> end
46902>>>>>>>>>>
46902>>>>>>>>> function_return liRval
46903>>>>>>>>>end_function
46904>>>>>>>>>
46904>>>>>>>>>procedure FLIST_Make4095 global
46906>>>>>>>>> if (FLIST_Information(FLINFO_LT_256)) begin
46908>>>>>>>>> set_attribute DF_FILE_ROOT_NAME of 4095 to "temp"
46911>>>>>>>>> set_attribute DF_FILE_LOGICAL_NAME of 4095 to "temp"
46914>>>>>>>>> set_attribute DF_FILE_DISPLAY_NAME of 4095 to "temp"
46917>>>>>>>>> set_attribute DF_FILE_ROOT_NAME of 4095 to ""
46920>>>>>>>>> set_attribute DF_FILE_LOGICAL_NAME of 4095 to ""
46923>>>>>>>>> set_attribute DF_FILE_DISPLAY_NAME of 4095 to ""
46926>>>>>>>>> end
46926>>>>>>>>>>
46926>>>>>>>>>end_procedure
46927>>>>>>>Use Language // Default language setup
46927>>>>>>>
46927>>>>>>>
46927>>>>>>> define t.autodown.purpose for "This file logs the automatic closing of a VDF application"
46927>>>>>>> define t.autodown.thrownoff for "has been thrown off"
46927>>>>>>> define t.autodown.accessdenied for "denied access"
46927>>>>>>>
46927>>>>>>>class cSystemDowner is a cArray
46928>>>>>>> procedure construct_object
46930>>>>>>> forward send construct_object
46932>>>>>>> property string psDownDisableFile public "DownOff.txt"
46933>>>>>>> property string psDownNowFile public "DownNow.txt"
46934>>>>>>> property string psDownLogFile public "DownLog.txt"
46935>>>>>>> property integer piCheckInterval public 180000 // 3 minutes (1000 = 1 sec)
46936>>>>>>> object oLogFile is a cLogFile
46938>>>>>>> set piCloseOnWrite to DFTRUE
46939>>>>>>> set psPurpose to t.autodown.purpose // "This file logs the automatic closing of a VDF application"
46940>>>>>>> end_object
46941>>>>>>> property integer piDownPhaseNumber public 0
46942>>>>>>> property integer priv.pbImTheOneWhoStartedIt public FALSE
46943>>>>>>> property integer priv.pbAccessDeniedState public FALSE
46944>>>>>>> property number priv.pnLogFileOffset public 0
46945>>>>>>> end_procedure
46946>>>>>>>
46946>>>>>>> function sFileNameAddPath string lsFile returns string
46948>>>>>>> string lsFolder
46948>>>>>>> get FLIST_CurrentFileListFolder to lsFolder
46949>>>>>>> get SEQ_RemovePathFromFileName lsFile to lsFile
46950>>>>>>> function_return (Files_AppendPath(lsFolder,lsFile))
46951>>>>>>> end_function
46952>>>>>>>
46952>>>>>>> function bFileExists string lsFile returns integer
46954>>>>>>> get sFileNameAddPath lsFile to lsFile
46955>>>>>>> function_return (SEQ_FileExists(lsFile)<>SEQIT_NONE)
46956>>>>>>> end_function
46957>>>>>>> function bFileDelete string lsFile returns integer
46959>>>>>>> get sFileNameAddPath lsFile to lsFile
46960>>>>>>> function_return (SEQ_EraseFile(lsFile))
46961>>>>>>> end_function
46962>>>>>>> function bFileCreate string lsFile returns integer
46964>>>>>>> integer liChannel
46964>>>>>>> get SEQ_DirectOutput (sFileNameAddPath(self,lsFile)) to liChannel
46965>>>>>>> if (liChannel>=0) begin
46967>>>>>>> write (character(26))
46968>>>>>>> send SEQ_CloseOutput liChannel
46969>>>>>>> end
46969>>>>>>>>
46969>>>>>>> function_return (bFileExists(self,lsFile))
46970>>>>>>> end_function
46971>>>>>>>
46971>>>>>>> procedure DoSetLogFileName
46973>>>>>>> string lsFile
46973>>>>>>> get psDownLogFile to lsFile
46974>>>>>>> get sFileNameAddPath lsFile to lsFile
46975>>>>>>> set psFileName of oLogFile to lsFile
46976>>>>>>> end_procedure
46977>>>>>>>
46977>>>>>>>//procedure set DownerDisableState integer lbState
46977>>>>>>>// integer lbGrb
46977>>>>>>>// if lbState get bFileCreate (psDownDisableFile(self)) to lbGrb
46977>>>>>>>// else get bFileDelete (psDownDisableFile(self)) to lbGrb
46977>>>>>>>//end_procedure
46977>>>>>>>
46977>>>>>>> function DownNowState returns integer
46979>>>>>>> integer lbState lbDownerDisabled
46979>>>>>>> get bFileExists (psDownDisableFile(self)) to lbDownerDisabled
46980>>>>>>> if lbDownerDisabled move FALSE to lbState
46983>>>>>>> else get bFileExists (psDownNowFile(self)) to lbState
46985>>>>>>> function_return lbState
46986>>>>>>> end_function
46987>>>>>>>
46987>>>>>>> procedure set DownNowState integer lbState
46989>>>>>>> integer lbGrb lbAlreadyDownNow
46989>>>>>>> number lnSize
46989>>>>>>> string lsFile
46989>>>>>>> lock
46990>>>>>>>>
46990>>>>>>> get bFileExists (psDownNowFile(self)) to lbAlreadyDownNow
46991>>>>>>>
46991>>>>>>> if lbState begin
46993>>>>>>> ifnot lbAlreadyDownNow begin
46995>>>>>>> get bFileCreate (psDownNowFile(self)) to lbGrb
46996>>>>>>> if lbGrb begin
46998>>>>>>> set priv.pbImTheOneWhoStartedIt to TRUE
46999>>>>>>>
46999>>>>>>> move (sFileNameAddPath(self,psDownLogFile(self))) to lsFile
47000>>>>>>> set psFileName of oLogFile to lsFile
47001>>>>>>>
47001>>>>>>> get SEQ_FileSize lsFile to lnSize
47002>>>>>>> set priv.pnLogFileOffset to lnSize
47003>>>>>>> send DoWriteTimeEntry to oLogFile ("System down state initated by "+User_Windows_User_Name()) // Nedlukning initieret af
47004>>>>>>> end
47004>>>>>>>>
47004>>>>>>> end
47004>>>>>>>>
47004>>>>>>> end
47004>>>>>>>>
47004>>>>>>> else begin
47005>>>>>>> if (priv.pbImTheOneWhoStartedIt(self)) begin
47007>>>>>>> get bFileDelete (psDownNowFile(self)) to lbGrb
47008>>>>>>> if lbGrb begin
47010>>>>>>> set priv.pbImTheOneWhoStartedIt to FALSE
47011>>>>>>> set priv.pnLogFileOffset to 0
47012>>>>>>> send DoWriteTimeEntry to oLogFile ("System down state cancelled by "+User_Windows_User_Name()) // Nedlukning aflyst af
47013>>>>>>> end
47013>>>>>>>>
47013>>>>>>> end
47013>>>>>>>>
47013>>>>>>> end
47013>>>>>>>>
47013>>>>>>> unlock
47014>>>>>>>>
47014>>>>>>> end_procedure
47015>>>>>>>
47015>>>>>>> function sLogFileTextSinceDowning returns string
47017>>>>>>> integer liChannel lbSeqEof lbDownState
47017>>>>>>> number lnSize
47017>>>>>>> string lsFile lsRval lsLine
47017>>>>>>>
47017>>>>>>> get DownNowState to lbDownState
47018>>>>>>>
47018>>>>>>> if lbDownState begin
47020>>>>>>> if (priv.pbImTheOneWhoStartedIt(self)) begin
47022>>>>>>> get psFileName of oLogFile to lsFile
47023>>>>>>> get priv.pnLogFileOffset to lnSize
47024>>>>>>> get SEQ_DirectInput lsFile to liChannel
47025>>>>>>> if (liChannel>=0) begin
47027>>>>>>> set_channel_position liChannel to lnSize
47028>>>>>>>>
47028>>>>>>> move "" to lsRval
47029>>>>>>> repeat
47029>>>>>>>>
47029>>>>>>> readln channel liChannel lsLine
47031>>>>>>> move (seqeof) to lbSeqEof
47032>>>>>>> ifnot lbSeqEof begin
47034>>>>>>> move (lsRval+lsLine+character(10)) to lsRval
47035>>>>>>> end
47035>>>>>>>>
47035>>>>>>> until lbSeqEof
47037>>>>>>> send SEQ_CloseInput liChannel
47038>>>>>>> if (pbANSI_State(oLogFile)) get ToOEM lsRval to lsRval
47041>>>>>>> end
47041>>>>>>>>
47041>>>>>>> else move "Log file read failure" to lsRval // Fejl ved l‘sning af log file
47043>>>>>>> end
47043>>>>>>>>
47043>>>>>>> else move "No access to log file" to lsRval // Ingen adgang til log fil
47045>>>>>>> end
47045>>>>>>>>
47045>>>>>>> else move "Access allowed" to lsRval // Systemet †bent
47047>>>>>>> function_return lsRval
47048>>>>>>> end_function
47049>>>>>>>
47049>>>>>>> procedure OnBeginWaitForExit
47051>>>>>>> end_procedure
47052>>>>>>> procedure OnAppEntryDenied
47054>>>>>>> end_procedure
47055>>>>>>>
47055>>>>>>> procedure ApplicationAutoExit
47057>>>>>>> integer lbBool lhLogFile
47057>>>>>>> string lsFile
47057>>>>>>> ifnot (priv.pbImTheOneWhoStartedIt(self)) begin
47059>>>>>>> get bFileExists (psDownDisableFile(self)) to lbBool
47060>>>>>>> ifnot lbBool begin // Is the downer system enabled?
47062>>>>>>> get bFileExists (psDownNowFile(self)) to lbBool
47063>>>>>>> if lbBool begin // Is the system marked for downing?
47065>>>>>>> if (piDownPhaseNumber(self)=0) begin
47067>>>>>>> get psDownLogFile to lsFile
47068>>>>>>> if (lsFile<>"") begin
47070>>>>>>> move (oLogFile(self)) to lhLogFile
47071>>>>>>> get sFileNameAddPath lsFile to lsFile
47072>>>>>>> set psFileName of lhLogFile to lsFile
47073>>>>>>> send AppendOutput to lhLogFile
47074>>>>>>> if (priv.pbAccessDeniedState(self)) send DoWriteTimeEntry to lhLogFile (User_Windows_User_Name()*t.autodown.accessdenied)
47077>>>>>>> else send DoWriteTimeEntry to lhLogFile (User_Windows_User_Name()*t.autodown.thrownoff)
47079>>>>>>> send CloseOutput to lhLogFile
47080>>>>>>> end
47080>>>>>>>>
47080>>>>>>> move 0 to NotExitingApplication // From objgroup.utl
47081>>>>>>> if (priv.pbAccessDeniedState(self)) send OnAppEntryDenied
47084>>>>>>> system
47085>>>>>>>>
47085>>>>>>> end
47085>>>>>>>>
47085>>>>>>> else begin
47086>>>>>>> set piDownPhaseNumber to (piDownPhaseNumber(self)-1)
47087>>>>>>> send OnBeginWaitForExit
47088>>>>>>> end
47088>>>>>>>>
47088>>>>>>> end
47088>>>>>>>>
47088>>>>>>> end
47088>>>>>>>>
47088>>>>>>> end
47088>>>>>>>>
47088>>>>>>> end_procedure
47089>>>>>>> // This procedure should execute on application startup.
47089>>>>>>> procedure CheckApplicationEntry
47091>>>>>>> integer liDownPhaseNumber
47091>>>>>>> get piDownPhaseNumber to liDownPhaseNumber // Save original value
47092>>>>>>> set piDownPhaseNumber to 0 // Exit immediately if down-file is found
47093>>>>>>> set priv.pbAccessDeniedState to TRUE // Makes it write "denied access" instead of "has been thrown off"
47094>>>>>>> send ApplicationAutoExit
47095>>>>>>> set priv.pbAccessDeniedState to FALSE
47096>>>>>>> set piDownPhaseNumber to liDownPhaseNumber // Restore
47097>>>>>>> end_procedure
47098>>>>>>>
47098>>>>>>> procedure end_construct_object
47100>>>>>>> forward send end_construct_object
47102>>>>>>> send CheckApplicationEntry
47103>>>>>>> end_procedure
47104>>>>>>>
47104>>>>>>> procedure CreateAutoDownObject integer lhClientArea
47106>>>>>>> integer lhSelf liTimeout
47106>>>>>>> move self to lhSelf
47107>>>>>>> get piCheckInterval to liTimeout
47108>>>>>>> move lhClientArea to self
47109>>>>>>> object oDownTimer is a DFTimer
47111>>>>>>> set Auto_Start_State to DFFALSE
47112>>>>>>> set Auto_Stop_State to DFFALSE
47113>>>>>>> set Timer_Message to msg_ApplicationAutoExit
47114>>>>>>> set Timer_Object to lhSelf
47115>>>>>>> set Timeout to liTimeout
47116>>>>>>> set Timer_Active_State to TRUE
47117>>>>>>> end_object
47118>>>>>>> move lhSelf to self
47119>>>>>>> end_procedure
47120>>>>>>>end_class // cSystemDowner
47121>>>>>use TimedObs.pkg
Including file: TimedObs.pkg (C:\Apps\VDFQuery\AppSrc\TimedObs.pkg)
47121>>>>>>>// Use TimedMessage.pkg // send TimedObs 7 "Seven seconds"
47121>>>>>>>
47121>>>>>>>use aps.pkg
47121>>>>>>>use msgbox.utl
Including file: msgbox.utl (C:\Apps\VDFQuery\AppSrc\msgbox.utl)
47121>>>>>>>>>// Use MsgBox.utl // obs procedure
47121>>>>>>>>>Use UI // Necessary to define IS$WINDOWS (if windows)
47121>>>>>>>>>Use Language
47121>>>>>>>>>
47121>>>>>>>>>
47121>>>>>>>>>// ======================================================================
47121>>>>>>>>>// OBS MESSAGE
47121>>>>>>>>>// ======================================================================
47121>>>>>>>>>Use MsgBox // DAC class
47121>>>>>>>>>Use Buttons.utl // Button texts
47121>>>>>>>>>
47121>>>>>>>>>procedure obs global string str#
47123>>>>>>>>> integer iArg max# self# focus#
47123>>>>>>>>> string msg# line#
47123>>>>>>>>> move "" to msg#
47124>>>>>>>>> for iArg from 1 to num_arguments
47130>>>>>>>>>>
47130>>>>>>>>> MoveStr iArg& to line# // tricky way to parse passed arguments
47131>>>>>>>>>>
47131>>>>>>>>> move (msg#+line#) to msg#
47132>>>>>>>>> if iArg ne num_arguments move (msg#+character(10)) to msg#
47135>>>>>>>>> loop
47136>>>>>>>>>>
47136>>>>>>>>> move self to self#
47137>>>>>>>>> get focus of desktop to focus#
47138>>>>>>>>> if focus# gt desktop move focus# to self
47141>>>>>>>>> send info_box msg# t.MsgBox.Message
47142>>>>>>>>> move self# to self
47143>>>>>>>>>end_procedure
47144>>>>>>>>>
47144>>>>>>>>>// ======================================================================
47144>>>>>>>>>// CONFIRM LIST
47144>>>>>>>>>// ======================================================================
47144>>>>>>>>>
47144>>>>>>>>>use APS
47144>>>>>>>>>object oConfirm_List is a aps.ModalPanel
47146>>>>>>>>> set locate_mode to center_on_screen
47147>>>>>>>>> property integer pResult public 0
47149>>>>>>>>> on_key kcancel send close_panel_ok
47150>>>>>>>>> object lbl is a aps.textbox
47152>>>>>>>>> end_object
47153>>>>>>>>> send aps_goto_max_row
47154>>>>>>>>> object lst is a aps.list no_image
47156>>>>>>>>> set size to 105 150
47157>>>>>>>>> set select_mode to no_select
47158>>>>>>>>> end_object
47159>>>>>>>>> procedure close_panel_ok
47162>>>>>>>>> set pResult to 1
47163>>>>>>>>> send close_panel
47164>>>>>>>>> end_procedure
47165>>>>>>>>> object btn1 is a aps.Multi_Button
47167>>>>>>>>> on_item t.btn.ok send close_panel_ok
47168>>>>>>>>> end_object
47169>>>>>>>>> object btn2 is a aps.Multi_Button
47171>>>>>>>>> on_item t.btn.cancel send close_panel
47172>>>>>>>>> end_object
47173>>>>>>>>> send aps_locate_multi_buttons
47174>>>>>>>>> procedure delete_data
47177>>>>>>>>> send delete_data to (lst(self))
47178>>>>>>>>> end_procedure
47179>>>>>>>>> procedure run.ss string title# string header#
47182>>>>>>>>> integer grb#
47182>>>>>>>>> set label to title#
47183>>>>>>>>> set value of (lbl(self)) to header#
47184>>>>>>>>> send popup
47185>>>>>>>>> send delete_data
47186>>>>>>>>> end_procedure
47187>>>>>>>>> function irun.ss string title# string header# returns integer
47190>>>>>>>>> integer rval#
47190>>>>>>>>> set label to title#
47191>>>>>>>>> set value of (lbl(self)) to header#
47192>>>>>>>>> set pResult to 0
47193>>>>>>>>> send popup
47194>>>>>>>>> get pResult to rval#
47195>>>>>>>>> send delete_data
47196>>>>>>>>> function_return rval#
47197>>>>>>>>> end_function
47198>>>>>>>>>end_object
47199>>>>>>>>>
47199>>>>>>>>>procedure Confirm_List_Reset
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
47201>>>>>>>>> send delete_data to (oConfirm_List(self))
47202>>>>>>>>>end_procedure
47203>>>>>>>>>procedure Confirm_List_Add string str#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
47205>>>>>>>>> integer obj#
47205>>>>>>>>> move (lst(oConfirm_List(self))) to obj#
47206>>>>>>>>> send add_item to obj# msg_none str#
47207>>>>>>>>>end_procedure
47208>>>>>>>>>procedure Confirm_List_Go string title# string header#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
47210>>>>>>>>> send run.ss to (oConfirm_List(self)) title# header#
47211>>>>>>>>>end_procedure
47212>>>>>>>>>function Confirm_List_Confirm global string title# string header# returns integer
47214>>>>>>>>> function_return (irun.ss(oConfirm_List(self),title#,header#))
47215>>>>>>>>>end_function
47216>>>>>>>>>
47216>>>>>>>>>// ======================================================================
47216>>>>>>>>>// YES/NO OBJECT
47216>>>>>>>>>// ======================================================================
47216>>>>>>>>>
47216>>>>>>>>>
47216>>>>>>>>>function MB_Verify global string str# integer def# returns integer
47218>>>>>>>>> integer rval#
47218>>>>>>>>> if def# move MB_DEFBUTTON1 to def#
47221>>>>>>>>> else move MB_DEFBUTTON2 to def#
47223>>>>>>>>> move (yesno_box(str#,t.MsgBox.Question,def#)) to rval#
47224>>>>>>>>> function_return (rval#=mbr_yes)
47225>>>>>>>>>end_function
47226>>>>>>>>>
47226>>>>>>>>>function MB_Verify4 global string str1# string str2# string str3# string str4# integer def# returns integer
47228>>>>>>>>> string lf#
47228>>>>>>>>> move (character(10)) to lf#
47229>>>>>>>>> function_return (MB_verify(str1#+lf#+str2#+lf#+str3#+lf#+str4#,def#))
47230>>>>>>>>>end_function
47231>>>>>>>>>
47231>>>>>>>>>function MB_CancelOnKeypress global string str# returns integer
47233>>>>>>>>>end_function
47234>>>>>>>>>
47234>>>>>>>use buttons.utl
47234>>>>>>>use dftimer.pkg
47234>>>>>>>
47234>>>>>>>desktop_section
47239>>>>>>> object oTimedObs is a aps.ModalPanel label t.MsgBox.Message
47242>>>>>>> property integer priv.Seconds
47244>>>>>>>
47244>>>>>>> register_procedure UpdateButtonText
47244>>>>>>>
47244>>>>>>> object oTimer is a DFTimer
47246>>>>>>> set Auto_Start_State to TRUE //<- If this is set to TRUE to timer is activated when
47247>>>>>>> set Auto_Stop_State to TRUE // the applications start regardless of the oTimedObs "activeness".
47248>>>>>>> set Timer_Message to msg_UpdateButtonText
47249>>>>>>> set Timer_Object to self
47250>>>>>>> set Timeout to 1000 // Every second
47251>>>>>>> //set Timer_Active_State to TRUE
47251>>>>>>> end_object
47252>>>>>>>
47252>>>>>>> object oText is a aps.TextEdit
47254>>>>>>> set size to 80 278
47255>>>>>>> set enabled_state to FALSE
47256>>>>>>> set border_style to BORDER_NONE
47257>>>>>>> set piFontSize to 220
47258>>>>>>> end_object // oTextEdit1
47259>>>>>>>
47259>>>>>>> object oBtn is a aps.Multi_Button
47261>>>>>>> on_item T.BTN.OK send close_panel
47262>>>>>>> end_object
47263>>>>>>> send aps_locate_multi_buttons
47264>>>>>>>
47264>>>>>>> procedure UpdateButtonText
47267>>>>>>> integer liSeconds
47267>>>>>>> string lsValue
47267>>>>>>> get priv.Seconds to liSeconds
47268>>>>>>> set value of oBtn to (T.BTN.OK+" ["+string(liSeconds-1) +"]")
47269>>>>>>> move (liSeconds-1) to liSeconds
47270>>>>>>> if (liSeconds<0) send close_panel
47273>>>>>>> set priv.Seconds to liSeconds
47274>>>>>>> end_procedure
47275>>>>>>>
47275>>>>>>> procedure popup.is integer liSeconds string lsValue
47278>>>>>>> set priv.Seconds to liSeconds
47279>>>>>>> set value of oText to lsValue
47280>>>>>>> send popup
47281>>>>>>> end_procedure
47282>>>>>>> end_object // oTimedObs
47283>>>>>>>end_desktop_section
47288>>>>>>>
47288>>>>>>>
47288>>>>>>>procedure TimedObs global integer liSeconds string lsVal1 string lsVal2 string lsVal3 string lsVal4 string lsVal5
47290>>>>>>> string lsValue
47290>>>>>>> move lsVal1 to lsValue
47291>>>>>>> if (NUM_ARGUMENTS>1) begin
47293>>>>>>> if (NUM_ARGUMENTS>2) move (lsValue+string(character(10))+lsVal2) to lsValue
47296>>>>>>> if (NUM_ARGUMENTS>3) move (lsValue+string(character(10))+lsVal3) to lsValue
47299>>>>>>> if (NUM_ARGUMENTS>4) move (lsValue+string(character(10))+lsVal4) to lsValue
47302>>>>>>> if (NUM_ARGUMENTS>5) move (lsValue+string(character(10))+lsVal5) to lsValue
47305>>>>>>> end
47305>>>>>>>>
47305>>>>>>> send popup.is of oTimedObs liSeconds lsValue
47306>>>>>>>end_procedure
47307>>>>>>>
47307>>>>>>>//send TimedObs 5 "Helli hallo"
47307>>>>>Use LogFile.pkg // Object for specifying log file properties
Including file: logfile.pkg (C:\Apps\VDFQuery\AppSrc\logfile.pkg)
47307>>>>>>>// Use LogFile.pkg // Object for specifying log file properties
47307>>>>>>>//
47307>>>>>>>// by Sture Andersen
47307>>>>>>>//
47307>>>>>>>Use LogFile.nui // Class for handling a log file (No User Interface)
47307>>>>>>>Use Files.utl // Utilities for handling file related stuff
Including file: files.utl (C:\Apps\VDFQuery\AppSrc\files.utl)
47307>>>>>>>>>//**********************************************************************
47307>>>>>>>>>// Use Files.utl // Utilities for handling file related stuff
47307>>>>>>>>>//
47307>>>>>>>>>// By Sture Andersen
47307>>>>>>>>>//
47307>>>>>>>>>// Create: Wed 01-02-1998
47307>>>>>>>>>// Update: Sat 02-05-1998 - Functions SEQ_FindFileAlongPath, SEQ_FileLineCount
47307>>>>>>>>>// and SEQ_FindFileAlongDFPath added.
47307>>>>>>>>>// Fri 08-05-1998 - Error in cChannelAdmin fixed. Something to do with
47307>>>>>>>>>// channel positions has changed between 3.0x and
47307>>>>>>>>>// 3.1c. On_Error trick has been taken out and a
47307>>>>>>>>>// 'sneak in' on the right position trick has been
47307>>>>>>>>>// introduced.
47307>>>>>>>>>// 09-07-1998 - Procedure SEQ_WriteRecordBuffer_LD added.
47307>>>>>>>>>// 14-07-1998 - Grave error fixed in SEQ_WriteRecordBuffer_LD
47307>>>>>>>>>// by J›rgen Legin and Torsten Balsl›w.
47307>>>>>>>>>// - SEQ_ReadRecordBuffer_LD added
47307>>>>>>>>>// 05-09-1998 - SEQ_ExtractPathFromFileName added
47307>>>>>>>>>// 06-09-1998 - SEQ_DfPath fixed
47307>>>>>>>>>// Sun 07-02-1999 - Directory selector added. Based on work of
47307>>>>>>>>>// Dennis Piccioni and Torben Lund. Function
47307>>>>>>>>>// name is SEQ_SelectDirectory. Windows only!
47307>>>>>>>>>// - aps.SelectDirForm class added. Windows only!
47307>>>>>>>>>// Fri 23-04-1999 - SEQ_DeleteFileToBin added. Based entirely on
47307>>>>>>>>>// upload from Andy Kaplan
47307>>>>>>>>>// (DAC NG user-contributed-files)
47307>>>>>>>>>// Sun 02-05-1999 - Added function SEQ_FileModTime
47307>>>>>>>>>// Mon 10-05-1999 - Fixes for VDF 6 (Vincent Oorsprong)
47307>>>>>>>>>// Mon 30-08-1999 - Function SEQ_DirectInput and SEQ_DirectOutput added
47307>>>>>>>>>// Wed 29-09-1999 - Function SEQ_SelectDirectory now converts to
47307>>>>>>>>>// OEM before returning its value.
47307>>>>>>>>>// Sat 09-10-1999 - Procedures SEQ_CloseOutput, SEQ_CloseInput and
47307>>>>>>>>>// SEQ_AppendOutput added.
47307>>>>>>>>>// Wed 01-12-1999 - Function SEQ_ReadLnProbe added.
47307>>>>>>>>>// Sun 06-02-2000 - Save- and OpenDialogs are now created dynamically
47307>>>>>>>>>// in appropriate places
47307>>>>>>>>>// Sat 11-03-2000 - Fix in SEQ_FileExists
47307>>>>>>>>>// Wed 22-03-2000 - Function SEQ_FindFileAlongPath would cause an
47307>>>>>>>>>// "Access violation" if asked to locate a file
47307>>>>>>>>>// opened exclusive by an application (including the
47307>>>>>>>>>// current). Fixed.
47307>>>>>>>>>// Mon 10-07-2000 - Function SEQ_FileSizeToString added
47307>>>>>>>>>// Wed 01-11-2000 - Functions SEQ_EraseFile, SEQ_CopyFile and
47307>>>>>>>>>// SEQ_MoveFile added.
47307>>>>>>>>>// Tue 07-11-2000 - Added function SEQ_ConvertToAbsoluteFileName
47307>>>>>>>>>// Tue 02-01-2001 - Added procedures SEQ_AppendOutputImageClose and
47307>>>>>>>>>// SEQ_AppendLineClose.
47307>>>>>>>>>// Thu 04-01-2001 - Added function SEQ_FindDataFileFromRootName
47307>>>>>>>>>// Mon 15-04-2002 - aps.dbSelectDirForm added
47307>>>>>>>>>// Mon 27-01-2003 - Function SEQ_SelectFileStartDir added
47307>>>>>>>>>// Sat 06-09-2003 - Added function SEQ_ValidateFolder
47307>>>>>>>>>// Thu 06-07-2006 - Fixed SEQ_SelectOutFile. It assumed work space
47307>>>>>>>>>// objects VDF 7 style.
47307>>>>>>>>>//
47307>>>>>>>>>//**********************************************************************
47307>>>>>>>>>use ui
47307>>>>>>>>>Use Files.nui // Utilities for handling file related stuff
47307>>>>>>>>>Use MsgBox.utl // obs procedure
47307>>>>>>>>>Use Strings.nui // String manipulation for VDF
47307>>>>>>>>>Use Dates.nui // Date manipulation for VDF
47307>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
47307>>>>>>>>>Use Version.nui
47307>>>>>>>>>Use Language
47307>>>>>>>>>
47307>>>>>>>>>Use wvaW32fh.pkg // Package by Wil van Antwerpen from www.vdf-guidance.com
47307>>>>>>>>>
47307>>>>>>>>>
47307>>>>>>>>>Use File_Dlg // DAC package
47307>>>>>>>>>integer oSEQ_OpenFlDlg# oSEQ_SaveFlDlg#
47307>>>>>>>>>move 0 to oSEQ_OpenFlDlg#
47308>>>>>>>>>move 0 to oSEQ_SaveFlDlg#
47309>>>>>>>>>class cSEQ_OpenFlDlg is a OpenDialog
47310>>>>>>>>> procedure construct_object
47312>>>>>>>>> forward send construct_object
47314>>>>>>>>> set NoChangeDir_State to true
47315>>>>>>>>> set HideReadOnly_State To True
47316>>>>>>>>> move self to oSEQ_OpenFlDlg#
47317>>>>>>>>> end_procedure
47318>>>>>>>>>end_class
47319>>>>>>>>>class cSEQ_SaveFlDlg is a SaveAsDialog
47320>>>>>>>>> procedure construct_object
47322>>>>>>>>> forward send construct_object
47324>>>>>>>>> set NoChangeDir_State to true
47325>>>>>>>>> set HideReadOnly_State To True
47326>>>>>>>>> move self to oSEQ_SaveFlDlg#
47327>>>>>>>>> end_procedure
47328>>>>>>>>> procedure set Dialog_Caption string lsCaption
47330>>>>>>>>> forward set Dialog_Caption to lsCaption
47332>>>>>>>>> end_procedure
47333>>>>>>>>>end_class
47334>>>>>>>>>
47334>>>>>>>>>procedure SEQ_Prepare_OpenDialog global
47336>>>>>>>>> integer parent# self#
47336>>>>>>>>> move (focus(desktop)) to parent#
47337>>>>>>>>> ifnot parent# move desktop to parent#
47340>>>>>>>>> if oSEQ_OpenFlDlg# send request_destroy_object to oSEQ_OpenFlDlg#
47343>>>>>>>>> move self to self#
47344>>>>>>>>> move parent# to self
47345>>>>>>>>> object oSEQ_OpenFlDlg is a cSEQ_OpenFlDlg
47347>>>>>>>>> end_object
47348>>>>>>>>> move self# to self
47349>>>>>>>>>end_procedure
47350>>>>>>>>>
47350>>>>>>>>>procedure SEQ_Prepare_SaveDialog global
47352>>>>>>>>> integer parent# self#
47352>>>>>>>>> move (focus(desktop)) to parent#
47353>>>>>>>>> ifnot parent# move desktop to parent#
47356>>>>>>>>> if oSEQ_SaveFlDlg# send request_destroy_object to oSEQ_SaveFlDlg#
47359>>>>>>>>> move self to self#
47360>>>>>>>>> move parent# to self
47361>>>>>>>>> object oSEQ_SaveFlDlg is a cSEQ_SaveFlDlg
47363>>>>>>>>> end_object
47364>>>>>>>>> move self# to self
47365>>>>>>>>>end_procedure
47366>>>>>>>>>
47366>>>>>>>>>//declare C structure struct_browseinfo
47366>>>>>>>>>//as documented in MSDN under Windows Shell API
47366>>>>>>>>>Type tFilesBrowseInfo
47366>>>>>>>>> Field tFilesBrowseInfo.hWndOwner as handle
47366>>>>>>>>> Field tFilesBrowseInfo.pIDLRoot as Pointer
47366>>>>>>>>> Field tFilesBrowseInfo.pszDisplayName as Pointer
47366>>>>>>>>> Field tFilesBrowseInfo.lpszTitle as Pointer
47366>>>>>>>>> Field tFilesBrowseInfo.ulFlags as dWord
47366>>>>>>>>> Field tFilesBrowseInfo.lpfnCallback as Pointer
47366>>>>>>>>> Field tFilesBrowseInfo.lParam as dWord
47366>>>>>>>>> Field tFilesBrowseInfo.iImage as dWord
47366>>>>>>>>>End_Type // tFilesBrowseInfo
47366>>>>>>>>>
47366>>>>>>>>>External_Function FilesSHBrowseForFolder "SHBrowseForFolder" shell32.dll pointer lpdWordx returns dWord
47367>>>>>>>>>External_Function FilesSHGetPathFromIDList "SHGetPathFromIDList" shell32.dll pointer pidList pointer lpBuffer returns dWord
47368>>>>>>>>>External_Function FilesCoTaskMemFree "CoTaskMemFree" ole32.dll pointer pv returns Integer
47369>>>>>>>>>
47369>>>>>>>>>// If function ConvertChar is not already defined we define it here:
47369>>>>>>>>>
47369>>>>>>>>>// returns folder name if a folder was selected, otherwise returns ""
47369>>>>>>>>>function SEQ_SelectDirectory global string lsCaption returns string
47371>>>>>>>>> string sFolder sBrowseInfo sTitle sRval
47371>>>>>>>>> pointer lpItemIdList lpsFolder lpsBrowseInfo lpsTitle
47371>>>>>>>>> integer iFolderSelected iObj iRetval
47371>>>>>>>>>
47371>>>>>>>>> // fill string variable with null characters
47371>>>>>>>>> ZeroType tFilesBrowseInfo to sBrowseInfo
47372>>>>>>>>>
47372>>>>>>>>> if (lsCaption<>"") begin
47374>>>>>>>>> move (ConvertChar(1,lsCaption)) to sTitle // toAnsi
47375>>>>>>>>> GetAddress of sTitle to lpsTitle
47376>>>>>>>>> put lpsTitle to sBrowseInfo at tFilesBrowseInfo.lpszTitle
47377>>>>>>>>> end
47377>>>>>>>>>>
47377>>>>>>>>>
47377>>>>>>>>> put (window_handle(focus(desktop))) to sBrowseInfo at tFilesBrowseInfo.hWndOwner
47378>>>>>>>>>
47378>>>>>>>>> GetAddress of sBrowseInfo to lpsBrowseInfo
47379>>>>>>>>>
47379>>>>>>>>> // null 128 chars into var (make space)
47379>>>>>>>>> move (repeat(character(0), 128)) to sFolder
47380>>>>>>>>> GetAddress of sFolder to lpsFolder
47381>>>>>>>>>
47381>>>>>>>>> // select folder
47381>>>>>>>>> move (FilesSHBrowseForFolder(lpsBrowseInfo)) to lpItemIdList
47382>>>>>>>>> // get selected folder name
47382>>>>>>>>> move (FilesSHGetPathFromIDList(lpItemIdList, lpsFolder)) to iFolderSelected
47383>>>>>>>>>
47383>>>>>>>>> // free memory and IDL
47383>>>>>>>>> Move (FilesCoTaskMemFree(lpItemIdList)) To iRetval
47384>>>>>>>>>
47384>>>>>>>>> if (iFolderSelected<>0) move (CString(sFolder)) to sRval
47387>>>>>>>>> else move "" to sRval
47389>>>>>>>>> function_return (ConvertChar(0,sRval))
47390>>>>>>>>>End_Function // GetSelectFolder
47391>>>>>>>>>
47391>>>>>>>>>class aps.SelectDirForm is a aps.Form
47392>>>>>>>>> procedure construct_object
47394>>>>>>>>> forward send construct_object
47396>>>>>>>>> property string pSelectDialogCaption public t.files.SelectDir
47397>>>>>>>>> set form_button item 0 to 1 // Manually add a prompt button
47398>>>>>>>>> set form_button_value item 0 to "..." // "
47399>>>>>>>>> on_key kprompt send prompt
47400>>>>>>>>> end_procedure
47401>>>>>>>>> procedure OnDirectorySelected
47403>>>>>>>>> end_procedure
47404>>>>>>>>> Procedure Prompt
47406>>>>>>>>> string sDir
47406>>>>>>>>> move (SEQ_SelectDirectory(pSelectDialogCaption(self))) to sDir
47407>>>>>>>>> if sDir ne "" begin
47409>>>>>>>>> set Value item 0 to sDir
47410>>>>>>>>> send OnDirectorySelected
47411>>>>>>>>> end
47411>>>>>>>>>>
47411>>>>>>>>> End_Procedure
47412>>>>>>>>> procedure form_button_notification integer itm#
47414>>>>>>>>> send prompt
47415>>>>>>>>> end_procedure
47416>>>>>>>>>end_class
47417>>>>>>>>>class aps.dbSelectDirForm is a aps.dbForm
47418>>>>>>>>> procedure construct_object
47420>>>>>>>>> forward send construct_object
47422>>>>>>>>> property string pSelectDialogCaption public t.files.SelectDir
47423>>>>>>>>>// set form_button item 0 to 1 // Manually add a prompt button
47423>>>>>>>>>// set form_button_value item 0 to "..." // "
47423>>>>>>>>> set prompt_button_mode to PB_PromptOn
47424>>>>>>>>> on_key kprompt send prompt
47425>>>>>>>>> end_procedure
47426>>>>>>>>> procedure OnDirectorySelected
47428>>>>>>>>> end_procedure
47429>>>>>>>>> Procedure Prompt
47431>>>>>>>>> string sDir
47431>>>>>>>>> move (SEQ_SelectDirectory(pSelectDialogCaption(self))) to sDir
47432>>>>>>>>> if sDir ne "" begin
47434>>>>>>>>> set changed_value item 0 to sDir
47435>>>>>>>>> send OnDirectorySelected
47436>>>>>>>>> end
47436>>>>>>>>>>
47436>>>>>>>>> End_Procedure
47437>>>>>>>>> procedure form_button_notification integer itm#
47439>>>>>>>>> send prompt
47440>>>>>>>>> end_procedure
47441>>>>>>>>>end_class
47442>>>>>>>>>class aps.SelectFileForm is a aps.Form
47443>>>>>>>>> procedure construct_object
47445>>>>>>>>> forward send construct_object
47447>>>>>>>>> property string psFileMask public ""
47448>>>>>>>>> property string pSelectDialogCaption public t.files.SelectFile
47449>>>>>>>>> set form_button item 0 to 1 // Manually add a prompt button
47450>>>>>>>>> set form_button_value item 0 to "..." // "
47451>>>>>>>>> on_key kprompt send prompt
47452>>>>>>>>> end_procedure
47453>>>>>>>>> Procedure Prompt
47455>>>>>>>>> string fn#
47455>>>>>>>>> get SEQ_SelectInFile (pSelectDialogCaption(self)) (psFileMask(self)) to fn#
47456>>>>>>>>> if fn# ne "" set Value item 0 to fn#
47459>>>>>>>>> End_Procedure
47460>>>>>>>>> procedure form_button_notification integer itm#
47462>>>>>>>>> send prompt
47463>>>>>>>>> end_procedure
47464>>>>>>>>>end_class
47465>>>>>>>>>
47465>>>>>>>>>function SEQ_SelectOutFile global string lsCaption string filter# returns string
47467>>>>>>>>> string fn#
47467>>>>>>>>> send SEQ_Prepare_SaveDialog
47468>>>>>>>>> set NoChangeDir_State of oSEQ_SaveFlDlg# to True
47469>>>>>>>>> set Dialog_Caption of oSEQ_SaveFlDlg# to lsCaption
47470>>>>>>>>> set Filter_String of oSEQ_SaveFlDlg# to filter#
47471>>>>>>>>> if (Show_Dialog(oSEQ_SaveFlDlg#)) move (File_Name(oSEQ_SaveFlDlg#)) to fn#
47474>>>>>>>>> else move "" to fn#
47476>>>>>>>>> function_return fn#
47477>>>>>>>>>end_function
47478>>>>>>>>>
47478>>>>>>>>>// Example of filter# values for VDF program: "Text files|*.txt|XML files|*.xml|All files|*.*"
47478>>>>>>>>>
47478>>>>>>>>>function SEQ_SelectOutFileStartDir global string lsCaption string filter# string lsStartDir returns string
47480>>>>>>>>> string fn#
47480>>>>>>>>> send SEQ_Prepare_SaveDialog
47481>>>>>>>>> set Initial_Folder of oSEQ_SaveFlDlg# to lsStartDir
47482>>>>>>>>> set NoChangeDir_State of oSEQ_SaveFlDlg# to True
47483>>>>>>>>> set Dialog_Caption of oSEQ_SaveFlDlg# to lsCaption
47484>>>>>>>>> set Filter_String of oSEQ_SaveFlDlg# to filter#
47485>>>>>>>>> if (Show_Dialog(oSEQ_SaveFlDlg#)) move (File_Name(oSEQ_SaveFlDlg#)) to fn#
47488>>>>>>>>> else move "" to fn#
47490>>>>>>>>> function_return fn#
47491>>>>>>>>>end_function
47492>>>>>>>>>
47492>>>>>>>>>function SEQ_SelectInFile global string lsCaption string filter# returns string
47494>>>>>>>>> string fn#
47494>>>>>>>>> send SEQ_Prepare_OpenDialog
47495>>>>>>>>> set NoChangeDir_State of oSEQ_OpenFlDlg# to True
47496>>>>>>>>> set Dialog_Caption of oSEQ_OpenFlDlg# to lsCaption
47497>>>>>>>>> set Filter_String of oSEQ_OpenFlDlg# to filter#
47498>>>>>>>>> if (Show_Dialog(oSEQ_OpenFlDlg#)) move (File_Name(oSEQ_OpenFlDlg#)) to fn#
47501>>>>>>>>> else move "" to fn#
47503>>>>>>>>> function_return fn#
47504>>>>>>>>>end_function
47505>>>>>>>>>
47505>>>>>>>>>function SEQ_SelectFile global string lsCaption string filter# returns string
47507>>>>>>>>> function_return (SEQ_SelectInFile(lsCaption,filter#))
47508>>>>>>>>>end_function
47509>>>>>>>>>
47509>>>>>>>>>function SEQ_SelectFileStartDir global string lsCaption string filter# string dir# returns string
47511>>>>>>>>> string fn#
47511>>>>>>>>> send SEQ_Prepare_OpenDialog
47512>>>>>>>>> set Initial_Folder of oSEQ_OpenFlDlg# to dir#
47513>>>>>>>>> set NoChangeDir_State of oSEQ_OpenFlDlg# to True //False
47514>>>>>>>>> set Dialog_Caption of oSEQ_OpenFlDlg# to lsCaption
47515>>>>>>>>> set Filter_String of oSEQ_OpenFlDlg# to filter#
47516>>>>>>>>> if (Show_Dialog(oSEQ_OpenFlDlg#)) move (File_Name(oSEQ_OpenFlDlg#)) to fn#
47519>>>>>>>>> else move "" to fn#
47521>>>>>>>>> function_return fn#
47522>>>>>>>>>end_function
47523>>>>>>>>>
47523>>>>>>>>>//[found ~found] begin
47523>>>>>>>>>// files$nothing: return
47523>>>>>>>>>//end
47523>>>>>>>>>
47523>>>>>>>>>use APS
47523>>>>>>>>>use Wait.utl
Including file: wait.utl (C:\Apps\VDFQuery\AppSrc\wait.utl)
47523>>>>>>>>>>>// **********************************************************************
47523>>>>>>>>>>>// Use Wait.utl // Something to put on screen while batching.
47523>>>>>>>>>>>//
47523>>>>>>>>>>>// By Sture Andersen & Jakob Kruse
47523>>>>>>>>>>>//
47523>>>>>>>>>>>// Create: Sat 10-05-1997 -
47523>>>>>>>>>>>// Update: Fri 03-04-1998 - Top-most-thing added by Jakob Kruse
47523>>>>>>>>>>>// Wed 03-03-1999 - Procedure batch_on now initalizes all text areas
47523>>>>>>>>>>>//
47523>>>>>>>>>>>// ***********************************************************************
47523>>>>>>>>>>>
47523>>>>>>>>>>>Use ui
47523>>>>>>>>>>>Use statpnl
47523>>>>>>>>>>>Use Strings.nui // String manipulation for VDF
47523>>>>>>>>>>>Use OldStatPnl.pkg // load the old status panel. Status_Panel is now this old object
Including file: OldStatPnl.pkg (c:\VDF12\Pkg\OldStatPnl.pkg)
47523>>>>>>>>>>>>>//************************************************************************
47523>>>>>>>>>>>>>// NOTE: As of 12.0, this is obsolete. See StatPnl.pkg for more information about this.
47523>>>>>>>>>>>>>// You encouraged to use the new cProcessStatusPanel class and Status_panel object
47523>>>>>>>>>>>>>// defined in Status_panel.pkg
47523>>>>>>>>>>>>>//
47523>>>>>>>>>>>>>// This adds support for the old Status_Panel object.
47523>>>>>>>>>>>>>// If you only need to add support for the old StatusPanel class, use OldStatusPanel.pkg
47523>>>>>>>>>>>>>// In earlier revisions, both the class and object were defined in a single file
47523>>>>>>>>>>>>>// named StatPnl.pkg. They have been moved to two files, OldStatusPanel.pkg, which
47523>>>>>>>>>>>>>// defines the class StatusPanel, and OldStatPnl.pkg (here), which defines the object
47523>>>>>>>>>>>>>//************************************************************************
47523>>>>>>>>>>>>>
47523>>>>>>>>>>>>>
47523>>>>>>>>>>>>>Use OldStatusPanel.pkg
Including file: OldStatusPanel.pkg (c:\VDF12\Pkg\OldStatusPanel.pkg)
47523>>>>>>>>>>>>>>>//************************************************************************
47523>>>>>>>>>>>>>>>// NOTE: As of 12.0, this is obsolete. See StatPnl.pkg for more information about this.
47523>>>>>>>>>>>>>>>// You encouraged to use the new cProcessStatusPanel class and Status_panel object
47523>>>>>>>>>>>>>>>// defined in Status_panel.pkg
47523>>>>>>>>>>>>>>>//
47523>>>>>>>>>>>>>>>// This adds support for the old StatusPanel class.
47523>>>>>>>>>>>>>>>// If you also need to add support for the old Status_panel object, use OldStatPnl.pkg
47523>>>>>>>>>>>>>>>// In earlier revisions, both the class and object were defined in a single file
47523>>>>>>>>>>>>>>>// named StatPnl.pkg. They have been moved to two files, OldStatusPanel.pkg, (here) which
47523>>>>>>>>>>>>>>>// defines the class StatusPanel, and OldStatPnl.pkg, which defines the object
47523>>>>>>>>>>>>>>>//************************************************************************
47523>>>>>>>>>>>>>>>
47523>>>>>>>>>>>>>>>
47523>>>>>>>>>>>>>>>
47523>>>>>>>>>>>>>>>//************************************************************************
47523>>>>>>>>>>>>>>>// Confidential Trade Secret.
47523>>>>>>>>>>>>>>>// Copyright (c) 1997 Data Access Corporation, Miami Florida
47523>>>>>>>>>>>>>>>// as an unpublished work. All rights reserved.
47523>>>>>>>>>>>>>>>// DataFlex is a registered trademark of Data Access Corporation.
47523>>>>>>>>>>>>>>>//
47523>>>>>>>>>>>>>>>//************************************************************************
47523>>>>>>>>>>>>>>>//
47523>>>>>>>>>>>>>>>// $File name : OldStatPnl.pkg
47523>>>>>>>>>>>>>>>// $File title : OldStatus Panel Support for VDF. This has been replaced in 12.0
47523>>>>>>>>>>>>>>>// Notice :
47523>>>>>>>>>>>>>>>// $Author(s) : John Tuohy
47523>>>>>>>>>>>>>>>//
47523>>>>>>>>>>>>>>>// $Rev History
47523>>>>>>>>>>>>>>>//
47523>>>>>>>>>>>>>>>// SWB 11/15/00 Changed Start_StatusPanel, so that the Sentinel program could be a long-filename.
47523>>>>>>>>>>>>>>>// JT 5/18/00 Added code to keep panel on top.
47523>>>>>>>>>>>>>>>// JT 9/22/97 Added status_params, status_default_params and changed
47523>>>>>>>>>>>>>>>// interface for no-cancel, and created interface for additional
47523>>>>>>>>>>>>>>>// parameter passing
47523>>>>>>>>>>>>>>>// JT 06/27/97 Added no-cancel support w/ Allow_cancel_state
47523>>>>>>>>>>>>>>>// JT ??/??/96 File created for VDF 4.0
47523>>>>>>>>>>>>>>>//************************************************************************
47523>>>>>>>>>>>>>>>
47523>>>>>>>>>>>>>>>
47523>>>>>>>>>>>>>>>// Host/Sentinel Status Panel
47523>>>>>>>>>>>>>>>//
47523>>>>>>>>>>>>>>>use Windows.pkg
47523>>>>>>>>>>>>>>>use SentDat.pkg // define shared data positions
Including file: Sentdat.pkg (c:\VDF12\Pkg\Sentdat.pkg)
47523>>>>>>>>>>>>>>>>>//
47523>>>>>>>>>>>>>>>>>// Sentinel/Host common shared data
47523>>>>>>>>>>>>>>>>>//
47523>>>>>>>>>>>>>>>>>
47523>>>>>>>>>>>>>>>>>DEFINE BUTTONSTART for 10
47523>>>>>>>>>>>>>>>>>DEFINE BUTTONLENGTH for 25
47523>>>>>>>>>>>>>>>>>
47523>>>>>>>>>>>>>>>>>DEFINE CAPTIONSTART for 35
47523>>>>>>>>>>>>>>>>>DEFINE CAPTIONLENGTH for 250
47523>>>>>>>>>>>>>>>>>
47523>>>>>>>>>>>>>>>>>DEFINE TITLESTART for 285
47523>>>>>>>>>>>>>>>>>DEFINE TITLELENGTH for 250
47523>>>>>>>>>>>>>>>>>
47523>>>>>>>>>>>>>>>>>DEFINE MESSAGESTART for 535
47523>>>>>>>>>>>>>>>>>DEFINE MESSAGELENGTH for 250
47523>>>>>>>>>>>>>>>>>
47523>>>>>>>>>>>>>>>>>DEFINE ACTIONSTART for 785
47523>>>>>>>>>>>>>>>>>DEFINE ACTIONLENGTH for 250
47523>>>>>>>>>>>>>>>use msgbox.pkg
47523>>>>>>>>>>>>>>>
47523>>>>>>>>>>>>>>>
47523>>>>>>>>>>>>>>>Class StatusPanel is a cObject
47524>>>>>>>>>>>>>>>
47524>>>>>>>>>>>>>>> Procedure Construct_Object
47526>>>>>>>>>>>>>>> Forward Send Construct_Object
47528>>>>>>>>>>>>>>>
47528>>>>>>>>>>>>>>> Property String Sentinel_Name "Sentinel"
47529>>>>>>>>>>>>>>> Property Integer Sentinel_Running_State False
47530>>>>>>>>>>>>>>> // progress bar stuff is not implemented
47530>>>>>>>>>>>>>>> Property Integer ProgressBar_State False
47531>>>>>>>>>>>>>>> Property Integer Progress_Minimum 0
47532>>>>>>>>>>>>>>> Property Integer Progress_Maximum 100
47533>>>>>>>>>>>>>>> Property String Private.Button_Text ""
47534>>>>>>>>>>>>>>> Property String Private.Title_Text ""
47535>>>>>>>>>>>>>>> Property String Private.Caption_Text ""
47536>>>>>>>>>>>>>>> Property String Private.Message_Text ""
47537>>>>>>>>>>>>>>> Property String Private.Action_Text ""
47538>>>>>>>>>>>>>>>
47538>>>>>>>>>>>>>>> Property Integer Allow_Cancel_State True
47539>>>>>>>>>>>>>>> // whenever a status is initialized, the default
47539>>>>>>>>>>>>>>> // is used unless a different value is passed in
47539>>>>>>>>>>>>>>> // initialize_StatusPanel
47539>>>>>>>>>>>>>>> property string Status_Params ''
47540>>>>>>>>>>>>>>> property string Status_Default_params ''
47541>>>>>>>>>>>>>>> Set Button_Text to "Cancel"
47542>>>>>>>>>>>>>>>
47542>>>>>>>>>>>>>>> End_Procedure // Construct_Object
47543>>>>>>>>>>>>>>>
47543>>>>>>>>>>>>>>> Procedure Close_Panel
47545>>>>>>>>>>>>>>> End_Procedure
47546>>>>>>>>>>>>>>>
47546>>>>>>>>>>>>>>> Procedure Initialize_StatusPanel String sCaption String sTitle ; String sMessage String sParams
47548>>>>>>>>>>>>>>> Set ProgressBar_State to False
47549>>>>>>>>>>>>>>> Set Caption_text to sCaption
47550>>>>>>>>>>>>>>> Set Title_Text to sTitle
47551>>>>>>>>>>>>>>> Set Message_Text to sMessage
47552>>>>>>>>>>>>>>> // the 4th param is optional because it was not supported
47552>>>>>>>>>>>>>>> // in vdf4. You are encouraged to supply this
47552>>>>>>>>>>>>>>> If num_arguments gt 3 ; set Status_params to sParams
47555>>>>>>>>>>>>>>> else ; set Status_params to (Status_Default_params(self))
47557>>>>>>>>>>>>>>> End_Procedure
47558>>>>>>>>>>>>>>>
47558>>>>>>>>>>>>>>> Procedure Set Caption_Text string sText
47560>>>>>>>>>>>>>>> Send DoStatusPaneltoForeground
47561>>>>>>>>>>>>>>> Set Private.Caption_Text to sText
47562>>>>>>>>>>>>>>> Set SentinelData of Desktop to sText CAPTIONSTART CAPTIONLENGTH
47563>>>>>>>>>>>>>>> End_Procedure // Set Caption_Text
47564>>>>>>>>>>>>>>>
47564>>>>>>>>>>>>>>> Function Caption_Text returns string
47566>>>>>>>>>>>>>>> Function_Return (Private.Caption_Text(self))
47567>>>>>>>>>>>>>>> End_Function // Caption_Text
47568>>>>>>>>>>>>>>>
47568>>>>>>>>>>>>>>> Procedure Set Message_Text string sText
47570>>>>>>>>>>>>>>> Send DoStatusPaneltoForeground
47571>>>>>>>>>>>>>>> Set Private.Message_Text to sText
47572>>>>>>>>>>>>>>> Set SentinelData of Desktop to sText MESSAGESTART MESSAGELENGTH
47573>>>>>>>>>>>>>>> End_Procedure // Set Message_Text
47574>>>>>>>>>>>>>>>
47574>>>>>>>>>>>>>>> Function Message_Text returns string
47576>>>>>>>>>>>>>>> Function_Return (Private.Message_Text(self))
47577>>>>>>>>>>>>>>> End_Function // Message_Text
47578>>>>>>>>>>>>>>>
47578>>>>>>>>>>>>>>> Procedure Set Action_Text string sText
47580>>>>>>>>>>>>>>> Send DoStatusPaneltoForeground
47581>>>>>>>>>>>>>>> Set Private.Action_Text to sText
47582>>>>>>>>>>>>>>> Set SentinelData of Desktop to sText ACTIONSTART ACTIONLENGTH
47583>>>>>>>>>>>>>>> End_Procedure // Set Action_Text
47584>>>>>>>>>>>>>>>
47584>>>>>>>>>>>>>>> Function Action_Text returns string
47586>>>>>>>>>>>>>>> Function_Return (Private.Action_Text(self))
47587>>>>>>>>>>>>>>> End_Function // Action_Text
47588>>>>>>>>>>>>>>>
47588>>>>>>>>>>>>>>> Procedure Set Button_Text string sText
47590>>>>>>>>>>>>>>> Send DoStatusPaneltoForeground
47591>>>>>>>>>>>>>>> Set Private.Button_Text to sText
47592>>>>>>>>>>>>>>> Set SentinelData of Desktop to sText BUTTONSTART BUTTONLENGTH
47593>>>>>>>>>>>>>>> End_Procedure // Set Button_Text
47594>>>>>>>>>>>>>>>
47594>>>>>>>>>>>>>>> Function Button_Text returns string
47596>>>>>>>>>>>>>>> Function_Return (Private.Button_Text(self))
47597>>>>>>>>>>>>>>> End_Function // Button_Text
47598>>>>>>>>>>>>>>>
47598>>>>>>>>>>>>>>> Procedure Set Title_Text string sText
47600>>>>>>>>>>>>>>> Send DoStatusPaneltoForeground
47601>>>>>>>>>>>>>>> Set Private.Title_Text to sText
47602>>>>>>>>>>>>>>> Set SentinelData of Desktop to sText TITLESTART TITLELENGTH
47603>>>>>>>>>>>>>>> End_Procedure // Set Title_Text
47604>>>>>>>>>>>>>>>
47604>>>>>>>>>>>>>>> Function Title_Text returns string
47606>>>>>>>>>>>>>>> Function_Return (Private.Title_Text(self))
47607>>>>>>>>>>>>>>> End_Function // Title_Text
47608>>>>>>>>>>>>>>>
47608>>>>>>>>>>>>>>> Procedure Start_StatusPanel
47610>>>>>>>>>>>>>>> Integer iVal
47610>>>>>>>>>>>>>>> String sParams
47610>>>>>>>>>>>>>>>
47610>>>>>>>>>>>>>>> If Not (Sentinel_Running_State(self)) Begin
47612>>>>>>>>>>>>>>> Get status_params to sParams
47613>>>>>>>>>>>>>>> If Not (Allow_Cancel_State(self)) ; Move (sParams * "-c0") to sParams
47616>>>>>>>>>>>>>>>
47616>>>>>>>>>>>>>>> Set Sentinel_Program of Desktop to ('"' + Sentinel_Name(self) +'"' * sParams)
47617>>>>>>>>>>>>>>>
47617>>>>>>>>>>>>>>> Get Start_Sentinel_Program of Desktop to iVal
47618>>>>>>>>>>>>>>> //showln "start sent = " ival
47618>>>>>>>>>>>>>>> //If iVal ;
47618>>>>>>>>>>>>>>> Set Sentinel_Running_State to TRUE
47619>>>>>>>>>>>>>>> End
47619>>>>>>>>>>>>>>>>
47619>>>>>>>>>>>>>>> End_Procedure // Start_StatusPanel
47620>>>>>>>>>>>>>>>
47620>>>>>>>>>>>>>>> Procedure Update_StatusPanel String sAction
47622>>>>>>>>>>>>>>> Set Action_Text to sAction
47623>>>>>>>>>>>>>>> End_Procedure
47624>>>>>>>>>>>>>>>
47624>>>>>>>>>>>>>>> Function Check_StatusPanel returns integer
47626>>>>>>>>>>>>>>> integer iRet
47626>>>>>>>>>>>>>>> Send DoStatusPaneltoForeground
47627>>>>>>>>>>>>>>> Get Sentinel_return_value of Desktop to iRet
47628>>>>>>>>>>>>>>> // modified to cancel the status panel if MSG_CANCEL is returned. This way you
47628>>>>>>>>>>>>>>> // don't have to remember to send Stop_StatusPanel
47628>>>>>>>>>>>>>>> If (iRet=MSG_CANCEL) Send Stop_StatusPanel
47631>>>>>>>>>>>>>>> Function_Return iRet
47632>>>>>>>>>>>>>>> End_Function
47633>>>>>>>>>>>>>>>
47633>>>>>>>>>>>>>>> // Do what we can to force the status panel to the top. If the main program gets
47633>>>>>>>>>>>>>>> // the focus force the status panel to take the focus.
47633>>>>>>>>>>>>>>> Procedure DoStatusPaneltoForeground
47635>>>>>>>>>>>>>>> integer hwStat hwMain hMain
47635>>>>>>>>>>>>>>> Get main_window of desktop to hMain
47636>>>>>>>>>>>>>>> If hMain Get window_handle of hMain to hwMain
47639>>>>>>>>>>>>>>> If hwMain Begin
47641>>>>>>>>>>>>>>> If (GetForegroundWindow()=hwMain) Begin
47643>>>>>>>>>>>>>>> Move (SentinelWindow(desktop)) to hwStat
47644>>>>>>>>>>>>>>> If hwStat Move (SetForegroundWindow(hwStat)) to hwStat
47647>>>>>>>>>>>>>>> End
47647>>>>>>>>>>>>>>>>
47647>>>>>>>>>>>>>>> End
47647>>>>>>>>>>>>>>>>
47647>>>>>>>>>>>>>>> End_procedure
47648>>>>>>>>>>>>>>>
47648>>>>>>>>>>>>>>> Procedure Stop_StatusPanel
47650>>>>>>>>>>>>>>> Integer iVal
47650>>>>>>>>>>>>>>> If (Sentinel_Running_State(self)) ; Get Stop_Sentinel_Program of Desktop to iVal
47653>>>>>>>>>>>>>>> Set Sentinel_Running_State to False
47654>>>>>>>>>>>>>>> End_Procedure
47655>>>>>>>>>>>>>>>
47655>>>>>>>>>>>>>>>End_Class
47656>>>>>>>>>>>>>
47656>>>>>>>>>>>>>Object Status_Panel is a StatusPanel
47658>>>>>>>>>>>>>End_Object
47659>>>>>>>>>>>Use buttons.utl
47659>>>>>>>>>>>
47659>>>>>>>>>>>
47659>>>>>>>>>>>class cBatchCompanion is an StatusPanel
47660>>>>>>>>>>> // in 12: class cBatchCompanion is a cProcessStatusPanel
47660>>>>>>>>>>> procedure construct_object
47662>>>>>>>>>>> forward send construct_object
47664>>>>>>>>>>> property string pCancelQuestionCaption public t.Wait.Question
47665>>>>>>>>>>> property string pCancelQuestion public t.Wait.Cancel
47666>>>>>>>>>>> set button_text to t.btn.cancel
47667>>>>>>>>>>> end_procedure
47668>>>>>>>>>>>// procedure Start_StatusPanel
47668>>>>>>>>>>>// handle hwnd#
47668>>>>>>>>>>>// integer swp#
47668>>>>>>>>>>>// string caption_text#
47668>>>>>>>>>>>// forward send Start_StatusPanel
47668>>>>>>>>>>>// get Caption_Text to Caption_Text#
47668>>>>>>>>>>>// move (StringOemToAnsi(Caption_Text#)) to Caption_Text#
47668>>>>>>>>>>>// // To make the status_panel stay-on-top, we first find it's window handle ...
47668>>>>>>>>>>>// move (FindWindow("DFDialogClass",Caption_Text#)) to hwnd#
47668>>>>>>>>>>>// // ... then we add the extended style WS_EX_TOPMOST to the window, but we use SetWindowPos
47668>>>>>>>>>>>// // to make sure the change takes effect immediately.
47668>>>>>>>>>>>// move (SetWindowPos(hwnd#, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE ior SWP_NOSIZE)) to swp#
47668>>>>>>>>>>>// // To manipulate this object further we could do
47668>>>>>>>>>>>// // get Object_From_Window hwnd# to realobj#
47668>>>>>>>>>>>// // and then work with the DFDialog object realobj#
47668>>>>>>>>>>>// end_procedure
47668>>>>>>>>>>> procedure batch_on string caption#
47670>>>>>>>>>>> set caption_text to caption#
47671>>>>>>>>>>> set title_text to ""
47672>>>>>>>>>>> set message_text to ""
47673>>>>>>>>>>> set action_text to ""
47674>>>>>>>>>>> send Start_StatusPanel
47675>>>>>>>>>>> end_procedure
47676>>>>>>>>>>> procedure batch_off
47678>>>>>>>>>>> send Stop_StatusPanel
47679>>>>>>>>>>> end_procedure
47680>>>>>>>>>>> procedure batch_update string str#
47682>>>>>>>>>>> Set Message_Text to str#
47683>>>>>>>>>>> end_procedure
47684>>>>>>>>>>> procedure batch_update2 string str#
47686>>>>>>>>>>> set Action_Text to str#
47687>>>>>>>>>>> end_procedure
47688>>>>>>>>>>> procedure batch_update3 string str#
47690>>>>>>>>>>> set title_text to str#
47691>>>>>>>>>>> end_procedure
47692>>>>>>>>>>> function batch_interrupt returns integer
47694>>>>>>>>>>> integer cancel#
47694>>>>>>>>>>> get Check_StatusPanel to cancel#
47695>>>>>>>>>>> if cancel# begin
47697>>>>>>>>>>> send stop_statuspanel
47698>>>>>>>>>>> move (yesno_box(pCancelQuestion(self),pCancelQuestionCaption(self),MB_DEFBUTTON2)) to cancel#
47699>>>>>>>>>>> move (cancel#=mbr_yes) to cancel#
47700>>>>>>>>>>> if cancel# function_return 1
47703>>>>>>>>>>> send Start_StatusPanel
47704>>>>>>>>>>> end
47704>>>>>>>>>>>>
47704>>>>>>>>>>> end_function
47705>>>>>>>>>>>end_class // cBatchCompanion
47706>>>>>>>>>>>procedure ScreenEndWait_On integer min# integer max#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
47708>>>>>>>>>>>end_procedure
47709>>>>>>>>>>>procedure ScreenEndWait_Update integer pos#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
47711>>>>>>>>>>>end_procedure
47712>>>>>>>>>>>procedure ScreenEndWait_SetText string str#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
47714>>>>>>>>>>>end_procedure
47715>>>>>>>>>>>procedure ScreenEndWait_SetText2 string str#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
47717>>>>>>>>>>>end_procedure
47718>>>>>>>>>>>procedure ScreenEndWait_Off
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
47720>>>>>>>>>>>end_procedure
47721>>>>>>>>>object oFn_Exists is a aps.ModalPanel label t.files.Warning
47724>>>>>>>>> on_key kCancel send fn_cancel
47725>>>>>>>>> property integer pResult public 0
47727>>>>>>>>> object oMsg is a aps.TextBox
47729>>>>>>>>> set p_fixed_width to 240
47730>>>>>>>>> set justification_mode to (JMODE_CENTER+JMODE_WRAP+JMODE_VCENTER)
47731>>>>>>>>> end_object
47732>>>>>>>>> procedure fn_Append
47735>>>>>>>>> set pResult to 1
47736>>>>>>>>> send close_panel
47737>>>>>>>>> end_procedure
47738>>>>>>>>> procedure fn_OverWr
47741>>>>>>>>> set pResult to 2
47742>>>>>>>>> send close_panel
47743>>>>>>>>> end_procedure
47744>>>>>>>>> procedure fn_Cancel
47747>>>>>>>>> set pResult to 3
47748>>>>>>>>> send close_panel
47749>>>>>>>>> end_procedure
47750>>>>>>>>> object oBtn_Over is a aps.Multi_Button
47752>>>>>>>>> on_item t.files.Overwrite send fn_overwr
47753>>>>>>>>> end_object
47754>>>>>>>>> object oBtn_Append is a aps.Multi_Button
47756>>>>>>>>> on_item t.files.Append send fn_append
47757>>>>>>>>> end_object
47758>>>>>>>>> object oBtn_Cancel is a aps.Multi_Button
47760>>>>>>>>> on_item t.btn.cancel send fn_cancel
47761>>>>>>>>> end_object
47762>>>>>>>>> send aps_locate_multi_buttons
47763>>>>>>>>> function iRun.si string file_name# integer allow_append# returns integer
47766>>>>>>>>> integer rval#
47766>>>>>>>>> //set shadow_state of (Btn(self)) item 1 to (not(allow_append#))
47766>>>>>>>>> set value of (oMsg(self)) to (replace("#",t.files.FileExists,file_name#))
47767>>>>>>>>> send popup
47768>>>>>>>>> get pResult to rval#
47769>>>>>>>>> if rval# eq 3 move 0 to rval#
47772>>>>>>>>> function_return rval#
47773>>>>>>>>> end_function
47774>>>>>>>>>end_object
47775>>>>>>>>>
47775>>>>>>>>>// Return value: 0=cancel, 1=append, 2=overwrite
47775>>>>>>>>>function SEQ_Filename_Exists_Action global string file_name# integer allow_append# returns integer
47777>>>>>>>>> function_return (iRun.si(oFn_Exists(self),file_name#,allow_append#))
47778>>>>>>>>>end_function
47779>>>>>>>>>
47779>>>>>>>>>procedure SEQ_WriteGridItems global integer ch# integer obj#
47781>>>>>>>>> integer itm# max# shadow# checkbox# select# aux# msg#
47781>>>>>>>>> get item_count of obj# to max#
47782>>>>>>>>> writeln channel ch# max#
47785>>>>>>>>> for itm# from 0 to (max#-1)
47791>>>>>>>>>>
47791>>>>>>>>> writeln (value(obj#,itm#))
47793>>>>>>>>> get checkbox_item_state of obj# item itm# to checkbox#
47794>>>>>>>>> get select_state of obj# item itm# to select#
47795>>>>>>>>> get item_shadow_state of obj# item itm# to shadow#
47796>>>>>>>>> get aux_value of obj# item itm# to aux#
47797>>>>>>>>> get message of obj# item itm# to msg#
47798>>>>>>>>> writeln checkbox#
47800>>>>>>>>> writeln select#
47802>>>>>>>>> writeln shadow#
47804>>>>>>>>> writeln aux#
47806>>>>>>>>> writeln msg#
47808>>>>>>>>> loop
47809>>>>>>>>>>
47809>>>>>>>>>end_procedure
47810>>>>>>>>>
47810>>>>>>>>>procedure SEQ_ReadGridItems global integer ch# integer obj#
47812>>>>>>>>> integer itm# max# shadow# checkbox# select# aux# msg#
47812>>>>>>>>> string value#
47812>>>>>>>>> send delete_data to obj#
47813>>>>>>>>> readln channel ch# max#
47815>>>>>>>>> for itm# from 0 to (max#-1)
47821>>>>>>>>>>
47821>>>>>>>>> readln value#
47822>>>>>>>>> readln checkbox#
47823>>>>>>>>> readln select#
47824>>>>>>>>> readln shadow#
47825>>>>>>>>> readln aux#
47826>>>>>>>>> readln msg#
47827>>>>>>>>> send add_item to obj# msg# value#
47828>>>>>>>>> set checkbox_item_state of obj# item itm# to checkbox#
47829>>>>>>>>> set select_state of obj# item itm# to select#
47830>>>>>>>>> set item_shadow_state of obj# item itm# to shadow#
47831>>>>>>>>> set aux_value of obj# item itm# to aux#
47832>>>>>>>>> loop
47833>>>>>>>>>>
47833>>>>>>>>> set dynamic_update_state of obj# to true
47834>>>>>>>>>end_procedure
47835>>>>>>>>>
47835>>>>>>>>>define xFO_MOVE for |CI$0001
47835>>>>>>>>>define xFO_COPY for |CI$0002
47835>>>>>>>>>define xFO_DELETE for |CI$0003
47835>>>>>>>>>define xFO_RENAME for |CI$0004
47835>>>>>>>>>
47835>>>>>>>>>define xFOF_MULTIDESTFILES for |CI$0001
47835>>>>>>>>>define xFOF_CONFIRMMOUSE for |CI$0002
47835>>>>>>>>>define xFOF_SILENT for |CI$0004 // don't create progress/report
47835>>>>>>>>>define xFOF_RENAMEONCOLLISION for |CI$0008
47835>>>>>>>>>define xFOF_NOCONFIRMATION for |CI$0010 // Don't prompt the user.
47835>>>>>>>>>define xFOF_WANTMAPPINGHANDLE for |CI$0020 // Fill in SHFILEOPSTRUCT.hNameMappings
47835>>>>>>>>> // Must be freed using SHFreeNameMappings
47835>>>>>>>>>define xFOF_ALLOWUNDO for |CI$0040
47835>>>>>>>>>define xFOF_FILESONLY for |CI$0080 // on *.*, do only files
47835>>>>>>>>>define xFOF_SIMPLEPROGRESS for |CI$0100 // means don't show names of files
47835>>>>>>>>>define xFOF_NOCONFIRMMKDIR for |CI$0200 // don't confirm making any needed dirs
47835>>>>>>>>>
47835>>>>>>>>>Type tFILES_SHFILEOPSTRUCT
47835>>>>>>>>> Field files_hWnd as Handle
47835>>>>>>>>> Field files_wFunc as Integer
47835>>>>>>>>> Field files_pFrom as Pointer
47835>>>>>>>>> Field files_pTo as Pointer
47835>>>>>>>>> Field files_fFlags as Short
47835>>>>>>>>> Field files_fAnyOperationsAborted as Short
47835>>>>>>>>> Field files_hNameMappings as Pointer
47835>>>>>>>>> Field files_lpszProgressTitle as Pointer // only used if xFOF_SIMPLEPROGRESS
47835>>>>>>>>>End_Type
47835>>>>>>>>>
47835>>>>>>>>>External_Function FILES_SHFileOperation "SHFileOperationA" Shell32.dll ; pointer lpFileOp returns integer
47836>>>>>>>>>
47836>>>>>>>>>procedure SEQ_DeleteFileToBin global string fn#
47838>>>>>>>>> string strFileOpt
47838>>>>>>>>> Pointer lpFileOpt lpFileName
47838>>>>>>>>> ZeroType tFILES_SHFILEOPSTRUCT to strFileOpt
47839>>>>>>>>> Put xFO_DELETE to strFileOpt at files_wFunc
47840>>>>>>>>> GetAddress of fn# to lpFileName
47841>>>>>>>>> Put lpFileName to strFileOpt at files_pFrom
47842>>>>>>>>> Put (xFOF_SILENT ior xFOF_NOCONFIRMATION ior xFOF_ALLOWUNDO) to strFileOpt at files_fFlags
47843>>>>>>>>> GetAddress of strFileOpt to lpFileOpt
47844>>>>>>>>> Move (FILES_SHFileOperation(lpFileOpt)) to strmark
47845>>>>>>>>>end_procedure
47846>>>>>>>>>
47846>>>>>>>>>class cSEQ_FileReader is a TS_TimeEstimator
47847>>>>>>>>> procedure construct_object integer img#
47849>>>>>>>>> forward send construct_object img#
47851>>>>>>>>>
47851>>>>>>>>> property integer pReadCount public 0 // record counter (lines or records)
47852>>>>>>>>> property string pFileName public "" // name of input file
47853>>>>>>>>> property integer pChannel public 0 // input channel
47854>>>>>>>>> property integer pPrevPos public 0 // last record was read starting
47855>>>>>>>>> // in this channel position
47855>>>>>>>>> property integer pRejectRecord public 0 //
47856>>>>>>>>>
47856>>>>>>>>> property date pReadDate public 0 // Date and time of read
47857>>>>>>>>> property string pReadTime public "" // initialization
47858>>>>>>>>>
47858>>>>>>>>> property integer pOkToCancel public 1 // Ok to interrupt?
47859>>>>>>>>> property string pCancelQuestion public t.files.StopRead
47860>>>>>>>>>
47860>>>>>>>>> property integer piInterrupted public 0
47861>>>>>>>>> end_procedure
47862>>>>>>>>>
47862>>>>>>>>> procedure display_init
47864>>>>>>>>> end_procedure
47865>>>>>>>>> procedure display_update
47867>>>>>>>>> end_procedure
47868>>>>>>>>>
47868>>>>>>>>> function iPreconditions_Direct_Input returns integer
47870>>>>>>>>> integer fn_ok# file_size# ch# itm#
47870>>>>>>>>> string fn#
47870>>>>>>>>>
47870>>>>>>>>> get pChannel to ch#
47871>>>>>>>>> get pFileName to fn#
47872>>>>>>>>> trim fn# to fn#
47873>>>>>>>>>>
47873>>>>>>>>> if fn# eq "" send obs t.files.FileNotSpec
47876>>>>>>>>> direct_input channel ch# fn#
47878>>>>>>>>> [ SeqEof] move 0 to fn_ok#
47879>>>>>>>>> [~SeqEof] move 1 to fn_ok#
47880>>>>>>>>> close_input
47881>>>>>>>>> ifnot fn_ok# begin
47883>>>>>>>>> send obs (replace("#",t.files.FileNotFound,fn#))
47884>>>>>>>>> function_return 0
47885>>>>>>>>> end
47885>>>>>>>>>>
47885>>>>>>>>> else begin
47886>>>>>>>>> append_output channel ch# fn#
47888>>>>>>>>> get_channel_position ch# to file_size#
47889>>>>>>>>>>
47889>>>>>>>>> set piMin to 0
47890>>>>>>>>> set piMax to file_size#
47891>>>>>>>>> close_output channel ch#
47893>>>>>>>>> end
47893>>>>>>>>>>
47893>>>>>>>>>
47893>>>>>>>>> set piInterrupted to 0
47894>>>>>>>>> function_return 1
47895>>>>>>>>> end_function
47896>>>>>>>>>
47896>>>>>>>>> function iDirect_Input returns integer
47898>>>>>>>>> integer ch#
47898>>>>>>>>> string fn#
47898>>>>>>>>> if (iPreconditions_Direct_Input(self)) begin
47900>>>>>>>>> send display_init
47901>>>>>>>>> get pChannel to ch#
47902>>>>>>>>> get pFileName to fn#
47903>>>>>>>>> direct_input channel ch# fn#
47905>>>>>>>>> set pReadCount to 0 // initialize counter
47906>>>>>>>>> set pReadDate to (dSysDate())
47907>>>>>>>>> set pReadTime to (sSysTime())
47908>>>>>>>>> set pPrevPos to 0
47909>>>>>>>>> function_return 1
47910>>>>>>>>> end
47910>>>>>>>>>>
47910>>>>>>>>> function_return 0
47911>>>>>>>>> end_function
47912>>>>>>>>>
47912>>>>>>>>> procedure read_reset
47914>>>>>>>>> set_channel_position (pChannel(self)) to (pPrevPos(self))
47915>>>>>>>>>>
47915>>>>>>>>> end_procedure
47916>>>>>>>>>
47916>>>>>>>>> procedure read_header returns integer // augment this
47918>>>>>>>>> procedure_return 0
47919>>>>>>>>> end_procedure
47920>>>>>>>>>
47920>>>>>>>>> procedure read_one returns integer // augment this
47922>>>>>>>>> procedure_return 1
47923>>>>>>>>> end_procedure
47924>>>>>>>>>
47924>>>>>>>>> function iUserInterrupt returns integer
47926>>>>>>>>> end_function
47927>>>>>>>>>
47927>>>>>>>>> procedure roll_back // augment this to undo the effect
47929>>>>>>>>> end_procedure // of a interrupted read
47930>>>>>>>>>
47930>>>>>>>>> procedure read_begin
47932>>>>>>>>> end_procedure
47933>>>>>>>>> procedure read_end
47935>>>>>>>>> end_procedure
47936>>>>>>>>>
47936>>>>>>>>> procedure run string fn#
47938>>>>>>>>> integer finish# ch# PrevPos#
47938>>>>>>>>> if Num_Arguments gt 0 set pFileName to fn#
47941>>>>>>>>> if (iDirect_Input(self)) begin
47943>>>>>>>>> get pChannel to ch#
47944>>>>>>>>> send read_begin
47945>>>>>>>>> get msg_read_header to finish#
47946>>>>>>>>> ifnot finish# begin
47948>>>>>>>>> repeat
47948>>>>>>>>>>
47948>>>>>>>>> set pRejectRecord to false
47949>>>>>>>>> get msg_read_one to finish#
47950>>>>>>>>> ifnot finish# begin
47952>>>>>>>>> get_channel_position ch# to PrevPos#
47953>>>>>>>>>>
47953>>>>>>>>> set pPrevPos to PrevPos#
47954>>>>>>>>> set pReadCount to (pReadCount(self)+1)
47955>>>>>>>>> send display_update
47956>>>>>>>>> end
47956>>>>>>>>>>
47956>>>>>>>>> if (iUserInterrupt(self)) move 1 to finish# // keypress
47959>>>>>>>>> if (piInterrupted(self)) move 1 to finish# // program interrupt
47962>>>>>>>>> until finish#
47964>>>>>>>>> end
47964>>>>>>>>>>
47964>>>>>>>>> close_input channel ch#
47966>>>>>>>>> send read_end
47967>>>>>>>>> if (piInterrupted(self)) send roll_back
47970>>>>>>>>> end
47970>>>>>>>>>>
47970>>>>>>>>> end_procedure
47971>>>>>>>>>end_class // cSEQ_FileReader
47972>>>>>>>>>
47972>>>>>>>>>define xMAX_PATH for 200
47972>>>>>>>>>External_function Files_GetWindowsDirectory "GetWindowsDirectoryA" kernel32.dll Pointer lpBuffer Integer nSize returns integer
47973>>>>>>>>>function SEQ_WindowsDirectory global returns string
47975>>>>>>>>> string sVal
47975>>>>>>>>> integer iGrb
47975>>>>>>>>> pointer pVal
47975>>>>>>>>> ZeroString xMAX_PATH to sVal
47976>>>>>>>>> GetAddress of sVal to pVal
47977>>>>>>>>> move (Files_GetWindowsDirectory(pVal, xMAX_PATH)) to iGrb
47978>>>>>>>>> function_return sVal
47979>>>>>>>>>end_function
47980>>>>>>>>>
47980>>>>>>>>>enumeration_list
47980>>>>>>>>> define VALIDFOLDER_CREATE_FALSE
47980>>>>>>>>> define VALIDFOLDER_CREATE_PROMPT
47980>>>>>>>>> define VALIDFOLDER_CREATE_QUIET
47980>>>>>>>>>end_enumeration_list
47980>>>>>>>>>enumeration_list
47980>>>>>>>>> define VALIDFOLDER_EXISTS // The folder exists
47980>>>>>>>>> define VALIDFOLDER_NAME_IS_FILE // The specified name points to a file
47980>>>>>>>>> define VALIDFOLDER_CREATION_FAILED // Folder could not be created
47980>>>>>>>>> define VALIDFOLDER_NO_FOLDER_SPECIFIED // Folder not specified
47980>>>>>>>>> define VALIDFOLDER_USER_CANCEL // User cancelled directory create
47980>>>>>>>>> define VALIDFOLDER_PARENT_PATH_NOT_FOUND // Path to parent folder not found
47980>>>>>>>>> define VALIDFOLDER_PATH_NOT_FOUND // Path to parent folder not found
47980>>>>>>>>>end_enumeration_list
47980>>>>>>>>>
47980>>>>>>>>>function SEQ_ValidateFolder_ErrorText global integer liError returns string
47982>>>>>>>>> if (liError=VALIDFOLDER_EXISTS) function_return ""
47985>>>>>>>>> if (liError=VALIDFOLDER_NAME_IS_FILE) function_return t.files.Error1
47988>>>>>>>>> if (liError=VALIDFOLDER_CREATION_FAILED) function_return t.files.Error2
47991>>>>>>>>> if (liError=VALIDFOLDER_NO_FOLDER_SPECIFIED) function_return t.files.Error3
47994>>>>>>>>> if (liError=VALIDFOLDER_PATH_NOT_FOUND) function_return t.files.Error5
47997>>>>>>>>> if (liError=VALIDFOLDER_PARENT_PATH_NOT_FOUND) function_return t.files.Error5
48000>>>>>>>>>end_function
48001>>>>>>>>>
48001>>>>>>>>>function SEQ_ValidateFolder global string lsFolder integer liAllowCreate integer lbNoErrorMsg returns integer
48003>>>>>>>>> integer liError liExists lbCreate liGarbage
48003>>>>>>>>> string lsParentFolder lsError
48003>>>>>>>>> move (trim(lsFolder)) to lsFolder
48004>>>>>>>>> if (lsFolder="") move VALIDFOLDER_NO_FOLDER_SPECIFIED to liError // Error: No folder specified
48007>>>>>>>>> else begin
48008>>>>>>>>> if (length(lsFolder)>1 and right(lsFolder,2)=(":"+sysconf(SYSCONF_DIR_SEPARATOR))) ; move (StringLeftBut(lsFolder,1)) to lsFolder
48011>>>>>>>>> get SEQ_FileExists lsFolder to liExists
48012>>>>>>>>> if (liExists=SEQIT_FILE) move VALIDFOLDER_NAME_IS_FILE to liError // Error: it's a file
48015>>>>>>>>> else begin
48016>>>>>>>>> if (liExists=SEQIT_DIRECTORY) move VALIDFOLDER_EXISTS to liError // All is well!
48019>>>>>>>>> else begin
48020>>>>>>>>> if (liAllowCreate<>VALIDFOLDER_CREATE_FALSE) begin
48022>>>>>>>>> get SEQ_ExtractPathFromFileName lsFolder to lsParentFolder
48023>>>>>>>>> get SEQ_FileExists lsParentFolder to liExists // Does parent folder exist?
48024>>>>>>>>> if (liExists=SEQIT_DIRECTORY) begin
48026>>>>>>>>> if (liAllowCreate=VALIDFOLDER_CREATE_PROMPT) get MB_Verify4 t.files.PromptDirCreate1 ("("+lsFolder+")") t.files.PromptDirCreate2 "" 1 to lbCreate
48029>>>>>>>>> else move 1 to lbCreate
48031>>>>>>>>> if lbCreate begin
48033>>>>>>>>> get wvaWin32_CreateDirectory (ToAnsi(lsFolder)) to liGarbage
48034>>>>>>>>> get SEQ_FileExists lsFolder to liExists // Does the folder exist now?
48035>>>>>>>>> if (liExists=SEQIT_DIRECTORY) move VALIDFOLDER_EXISTS to liError
48038>>>>>>>>> else move VALIDFOLDER_CREATION_FAILED to liError
48040>>>>>>>>> end
48040>>>>>>>>>>
48040>>>>>>>>> else move VALIDFOLDER_USER_CANCEL to liError
48042>>>>>>>>> end
48042>>>>>>>>>>
48042>>>>>>>>> else move VALIDFOLDER_PARENT_PATH_NOT_FOUND to liError
48044>>>>>>>>> end
48044>>>>>>>>>>
48044>>>>>>>>> else move VALIDFOLDER_PATH_NOT_FOUND to liError
48046>>>>>>>>> end
48046>>>>>>>>>>
48046>>>>>>>>> end
48046>>>>>>>>>>
48046>>>>>>>>> end
48046>>>>>>>>>>
48046>>>>>>>>> ifnot lbNoErrorMsg begin
48048>>>>>>>>> get SEQ_ValidateFolder_ErrorText liError to lsError
48049>>>>>>>>> if (liError=VALIDFOLDER_NAME_IS_FILE) send obs lsError lsFolder
48052>>>>>>>>> if (liError=VALIDFOLDER_CREATION_FAILED) send obs lsError lsFolder
48055>>>>>>>>> if (liError=VALIDFOLDER_NO_FOLDER_SPECIFIED) send obs lsError
48058>>>>>>>>> if (liError=VALIDFOLDER_PARENT_PATH_NOT_FOUND) send obs lsError lsParentFolder
48061>>>>>>>>> if (liError=VALIDFOLDER_PATH_NOT_FOUND) send obs lsError lsFolder
48064>>>>>>>>> end
48064>>>>>>>>>>
48064>>>>>>>>> function_return liError
48065>>>>>>>>>end_function // SEQ_ValidateFolder
48066>>>>>>>>>
48066>>>>>>>>>
48066>>>>>>>Use Output.utl // Basic sequential output service
Including file: output.utl (C:\Apps\VDFQuery\AppSrc\output.utl)
48066>>>>>>>>>// Use Output.utl // Sequential output to whatever
48066>>>>>>>>>
48066>>>>>>>>>Use Aps
48066>>>>>>>>> Use DFWinRpt
48066>>>>>>>>>
48066>>>>>>>>>
48066>>>>>>>>>Use Dates.utl // Date manipulation for VDF
Including file: dates.utl (C:\Apps\VDFQuery\AppSrc\dates.utl)
48066>>>>>>>>>>>// **********************************************************************
48066>>>>>>>>>>>// Use Dates.utl // Date manipulation for VDF and DF3.2
48066>>>>>>>>>>>//
48066>>>>>>>>>>>// by Sture Andersen (sa1@vd.dk)
48066>>>>>>>>>>>//
48066>>>>>>>>>>>// The file contains a number of global functions for manipulating
48066>>>>>>>>>>>// dates. The package may be used with DataFlex 3.1 and Visual DataFlex.
48066>>>>>>>>>>>// This package is public domain.
48066>>>>>>>>>>>//
48066>>>>>>>>>>>// The package file is accompanied by a Word document (dfutil.doc)
48066>>>>>>>>>>>// listing the functions and their use.
48066>>>>>>>>>>>//
48066>>>>>>>>>>>//
48066>>>>>>>>>>>// Create: Fri 06-06-1997 - Merger of s_utl020, 021, 022, 023, 024, 025.
48066>>>>>>>>>>>// Update: Thu 26-06-1997 - Fixes for strange behavior when date4_state is set.
48066>>>>>>>>>>>// - Addition of popup_calendar to VDF.
48066>>>>>>>>>>>// Sun 29-06-1997 - Character mode popup calender.
48066>>>>>>>>>>>// Fri 04-07-1997 - Function WeekToDate added.
48066>>>>>>>>>>>// Thu 10-07-1997 - Fixes.
48066>>>>>>>>>>>// Mon 11-08-1997 - WeekToDate fixed.
48066>>>>>>>>>>>// Sun 24-08-1997 - Character mode popup calender finished.
48066>>>>>>>>>>>// Mon 15-12-1997 - Procedure Request_Popup_Calendar added.
48066>>>>>>>>>>>// Mon 29-12-1997 - Procedures ItemYear2to4, ItemDate2to4 and
48066>>>>>>>>>>>// ItemSysdate added.
48066>>>>>>>>>>>// Mon 29-12-1997 - Procedures FieldYear2to4, FieldDate2to4 and
48066>>>>>>>>>>>// FieldSysdate added.
48066>>>>>>>>>>>// Sun 01-02-1998 - Functions Module_Compile_Date and
48066>>>>>>>>>>>// Module_Compile_Time added.
48066>>>>>>>>>>>// Wed 25-02-1998 - Request_Popup in calendar object now only
48066>>>>>>>>>>>// responds if entry_state of the calling object
48066>>>>>>>>>>>// is true (VDF version). (No apparent effect)
48066>>>>>>>>>>>// Sat 28-03-1998 - Added the following functions:
48066>>>>>>>>>>>// TS_SysTime TS_ExtractDate
48066>>>>>>>>>>>// TS_ExtractTime TS_ConvertToString
48066>>>>>>>>>>>// Tue 26-05-1998 - Procedure TS_UI_Update added
48066>>>>>>>>>>>// Sat 01-08-1998 - mask_date_window taken into account
48066>>>>>>>>>>>// Mon 10-08-1998 - Functions Module_Start_Date and
48066>>>>>>>>>>>// Module_Start_Time added.
48066>>>>>>>>>>>// Wed 02-09-1998 - Parameter for Module_Start_Date removed
48066>>>>>>>>>>>// Mon 12-10-1998 - Portuguese added
48066>>>>>>>>>>>// Wed 04-11-1998 - TS_TimeEstimator class added
48066>>>>>>>>>>>// Tue 29-12-1998 - Function DateAsString added
48066>>>>>>>>>>>// Wed 13-01-1999 - Function DateWeekNumber changed according to
48066>>>>>>>>>>>// Kjetil Johanson
48066>>>>>>>>>>>// Mon 18-01-1999 - Function DateWeekNumber changed according to
48066>>>>>>>>>>>// Kjetil Johanson (again)
48066>>>>>>>>>>>// Tue 19-01-1999 - Changed procedure names in TS_TimeEstimator
48066>>>>>>>>>>>// class (Continue->TS_Continue and Pause->
48066>>>>>>>>>>>// TS_Pause)
48066>>>>>>>>>>>// Thu 21-01-1999 - Procedures DateFormatAsString and DateFormatName
48066>>>>>>>>>>>// added.
48066>>>>>>>>>>>// - Procedures DateCurrentSeparator and
48066>>>>>>>>>>>// DateCurrentFormat added.
48066>>>>>>>>>>>// Tue 13-04-1999 - Julian constants added: Jan1st1900, Jan1st2000
48066>>>>>>>>>>>// Jan1st1000 and Jan1st100
48066>>>>>>>>>>>// Mon 26-04-1999 - Changed procedure FieldYear2to4 and ItemYear2to4
48066>>>>>>>>>>>// to trap 3 digit years.
48066>>>>>>>>>>>// Wed 27-04-1999 - Changed Dutch abbriviated day names (to 2 characters)
48066>>>>>>>>>>>// Sun 02-05-1999 - Added function TS_Compose2
48066>>>>>>>>>>>// - Fixed error in TS_ConvertToString
48066>>>>>>>>>>>// Tue 01-06-1999 - Added procedure popup_no_export to calendar.
48066>>>>>>>>>>>// Thu 15-06-1999 - Fixed Date4to2 function and exporting dates
48066>>>>>>>>>>>// from the calendar to forms with no form_margin.
48066>>>>>>>>>>>// Tue 07-09-1999 - Added function DateAsText
48066>>>>>>>>>>>// Wed 27-10-1999 - Temporary fix for Module_Compile_Date function
48066>>>>>>>>>>>// in combination with y2k.
48066>>>>>>>>>>>// Wed 19-12-1999 - Function StringToDate added.
48066>>>>>>>>>>>// - Existing function DateAsString renamed to
48066>>>>>>>>>>>// DateToString.
48066>>>>>>>>>>>// Mon 03-01-2000 - Fix for VDF4. Popup calendar on empty date field
48066>>>>>>>>>>>// would result in seeding the calendar on year 100.
48066>>>>>>>>>>>// This error was caused by the fact that VDF 4
48066>>>>>>>>>>>// ignores SYSDATE4_STATE such that the sysdate
48066>>>>>>>>>>>// command returns 03-01-100
48066>>>>>>>>>>>// Wed 01-02-2000 - Define instead of #REPLACE
48066>>>>>>>>>>>// Wed 23-08-2000 - Function TS_Module_Compile_Time added
48066>>>>>>>>>>>// Sat 04-08-2001 - Function StringToDate in Dates.nui fixed by Paul
48066>>>>>>>>>>>// Cooling
48066>>>>>>>>>>>// Sat 30-08-2003 - Odd date thing fixed by Wil van Antwherpen. (Search: **WvA:)
48066>>>>>>>>>>>//
48066>>>>>>>>>>>// NOTE: There is language dependent string constants in this file.
48066>>>>>>>>>>>// Currently there are sections for dutch, english, danish, swedish,
48066>>>>>>>>>>>// norwegian, spanish, german and portuguese
48066>>>>>>>>>>>//
48066>>>>>>>>>>>// These sections may be identified by searching the symbol LNG_DEFAULT
48066>>>>>>>>>>>//
48066>>>>>>>>>>>// ***********************************************************************
48066>>>>>>>>>>>Use Dates.nui // Date routines (No User Interface)
48066>>>>>>>>>>>Use ErrorHnd.nui // cErrorHandlerRedirector class and oErrorHandlerQuiet object (No User Interface)
48066>>>>>>>>>>>
48066>>>>>>>>>>>define DATES_INCLUDE_POPUP for 1 // If set to 0 the popup calendar will not be included
48066>>>>>>>>>>>
48066>>>>>>>>>>>procedure ItemSysdate for desktop integer liItm
48068>>>>>>>>>>> date ldDate
48068>>>>>>>>>>> get value item liItm to ldDate
48069>>>>>>>>>>> if ldDate eq 0 begin
48071>>>>>>>>>>> sysdate4 ldDate
48072>>>>>>>>>>> set changed_value item liItm to ldDate
48073>>>>>>>>>>> end
48073>>>>>>>>>>>>
48073>>>>>>>>>>>end_procedure
48074>>>>>>>>>>>
48074>>>>>>>>>>>procedure ItemDate2to4 for desktop integer liItm
48076>>>>>>>>>>> integer liYear
48076>>>>>>>>>>> date ldDate ldNewDate
48076>>>>>>>>>>> send ErrorHnd_Quiet_Activate
48077>>>>>>>>>>> get value item liItm to ldDate
48078>>>>>>>>>>> send ErrorHnd_Quiet_Deactivate
48079>>>>>>>>>>>
48079>>>>>>>>>>> move (DateSegment(ldDate,DS_YEAR)) to liYear
48080>>>>>>>>>>> if (liYear=0 and ldDate<>0) move (DateIncrement(ldDate,3,iSysYear())) to ldNewDate
48083>>>>>>>>>>> else move ldDate to ldNewDate
48085>>>>>>>>>>>
48085>>>>>>>>>>> move (Date2to4(ldNewDate)) to ldNewDate
48086>>>>>>>>>>> move (DateSegment(ldNewDate,3)) to liYear
48087>>>>>>>>>>> if (liYear>99 and liYear<1000) begin
48089>>>>>>>>>>> error 15 // Illegal entry in this window
48090>>>>>>>>>>>>
48090>>>>>>>>>>> procedure_return 1
48091>>>>>>>>>>> end
48091>>>>>>>>>>>>
48091>>>>>>>>>>> if ldNewDate ne ldDate set value item liItm to ldNewDate
48094>>>>>>>>>>>end_procedure
48095>>>>>>>>>>>
48095>>>>>>>>>>>procedure ItemYear2to4 for desktop integer liItm
48097>>>>>>>>>>> integer liYear liNewYear
48097>>>>>>>>>>> get value item liItm to liYear
48098>>>>>>>>>>> if (liYear>99 and liYear<1000) begin
48100>>>>>>>>>>> error 15 // Illegal entry in this window
48101>>>>>>>>>>>>
48101>>>>>>>>>>> procedure_return 1
48102>>>>>>>>>>> end
48102>>>>>>>>>>>>
48102>>>>>>>>>>> move (Year2to4(liYear)) to liNewYear
48103>>>>>>>>>>> if liNewYear ne liYear set value item liItm to liNewYear
48106>>>>>>>>>>>end_procedure
48107>>>>>>>>>>>
48107>>>>>>>>>>>
48107>>>>>>>>>>> register_procedure NotifyPopupCalendarChange date ldDate
48107>>>>>>>>>>> register_procedure NotifyPopupCalendarSelect date ldDate
48107>>>>>>>>>>>
48107>>>>>>>>>>> use DFAllent
48107>>>>>>>>>>> class calendar.textbox is a textbox
48108>>>>>>>>>>> procedure construct_object
48110>>>>>>>>>>> forward send construct_object
48112>>>>>>>>>>> Set Auto_Size_State To DFFALSE
48113>>>>>>>>>>> Set Justification_Mode To (JMODE_VCENTER+JMODE_CENTER)
48114>>>>>>>>>>> end_procedure
48115>>>>>>>>>>> end_class
48116>>>>>>>>>>>
48116>>>>>>>>>>> register_object oBtn1
48116>>>>>>>>>>> register_object oBtn6
48116>>>>>>>>>>>
48116>>>>>>>>>>> class calendar.button is a button
48117>>>>>>>>>>>
48117>>>>>>>>>>> procedure construct_object
48119>>>>>>>>>>> forward send construct_object
48121>>>>>>>>>>> set size to 15 18
48122>>>>>>>>>>> on_key kleftarrow send prev_day
48123>>>>>>>>>>> on_key krightarrow send next_day
48124>>>>>>>>>>> on_key kuparrow send prev_week
48125>>>>>>>>>>> on_key kdownarrow send next_week
48126>>>>>>>>>>> property date pdAssignedDate public 0
48127>>>>>>>>>>> end_procedure
48128>>>>>>>>>>>
48128>>>>>>>>>>> procedure switch // This makes all 42 buttons act as if they are one focus
48130>>>>>>>>>>> send activate to (oBtn1(self))
48131>>>>>>>>>>> end_procedure
48132>>>>>>>>>>> procedure switch_back
48134>>>>>>>>>>> send activate to (oBtn6(self))
48135>>>>>>>>>>> end_procedure
48136>>>>>>>>>>>
48136>>>>>>>>>>> procedure mouse_down
48138>>>>>>>>>>> integer lhSelf
48138>>>>>>>>>>> forward send mouse_down
48140>>>>>>>>>>> move self to lhSelf
48141>>>>>>>>>>> delegate set pdCurrentDate to (pdAssignedDate(lhSelf))
48143>>>>>>>>>>> end_procedure
48144>>>>>>>>>>> end_class
48145>>>>>>>>>>>
48145>>>>>>>>>>> desktop_section
48150>>>>>>>>>>> object popup_calendar is a ModalPanel
48152>>>>>>>>>>> set size to 160 250
48153>>>>>>>>>>> property date pdCurrentDate public 0
48155>>>>>>>>>>> property integer p_current_year public -1
48157>>>>>>>>>>> property integer p_current_month public -1
48159>>>>>>>>>>> property integer pExportState public 1
48161>>>>>>>>>>>
48161>>>>>>>>>>> on_key key_ctrl+key_pgup send prev_year
48162>>>>>>>>>>> on_key key_ctrl+key_pgdn send next_year
48163>>>>>>>>>>> on_key key_pgup send prev_month
48164>>>>>>>>>>> on_key key_pgdn send next_month
48165>>>>>>>>>>> on_key key_ctrl+key_d send go_today
48166>>>>>>>>>>> on_key kcancel send cancel
48167>>>>>>>>>>>
48167>>>>>>>>>>> object oCont3d is a container3d
48169>>>>>>>>>>> set location to 5 5
48170>>>>>>>>>>> set size to 120 237
48171>>>>>>>>>>> object oTextboxYear is a calendar.textbox
48173>>>>>>>>>>> set location to 5 5
48174>>>>>>>>>>> set size to 15 30
48175>>>>>>>>>>> set border_style to BORDER_STATICEDGE
48176>>>>>>>>>>> procedure display
48179>>>>>>>>>>> set value to (p_current_year(self))
48180>>>>>>>>>>> end_procedure
48181>>>>>>>>>>> end_object
48182>>>>>>>>>>> object oDaynameHeader is a container3d
48184>>>>>>>>>>> set location to 5 39
48185>>>>>>>>>>> set size to 15 126
48186>>>>>>>>>>> set border_style to BORDER_STATICEDGE
48187>>>>>>>>>>> procedure initialize
48190>>>>>>>>>>> integer liItm
48190>>>>>>>>>>> for liItm from 0 to 6
48196>>>>>>>>>>>>
48196>>>>>>>>>>> object oTxt is a calendar.textbox
48198>>>>>>>>>>> set size to 12 17
48199>>>>>>>>>>> set location to 0 (liItm*17.6+1)
48200>>>>>>>>>>> set value to (left(DayName(liItm+1),3))
48201>>>>>>>>>>> end_object
48202>>>>>>>>>>> loop
48203>>>>>>>>>>>>
48203>>>>>>>>>>> end_procedure
48204>>>>>>>>>>> send initialize
48205>>>>>>>>>>> end_object
48206>>>>>>>>>>> object oWeekNumberHeader is a container3d
48208>>>>>>>>>>> set location to 24 5
48209>>>>>>>>>>> set size to 89 30
48210>>>>>>>>>>> set border_style to BORDER_STATICEDGE
48211>>>>>>>>>>> object oObjIdArray is an array
48213>>>>>>>>>>> end_object
48214>>>>>>>>>>> procedure initialize
48217>>>>>>>>>>> integer liItm lhObj
48217>>>>>>>>>>> move (oObjIdArray(self)) to lhObj
48218>>>>>>>>>>> for liItm from 0 to 5
48224>>>>>>>>>>>>
48224>>>>>>>>>>> object oTxt is a textbox
48226>>>>>>>>>>> set size to 15 30
48227>>>>>>>>>>> set location to (liItm*15+1) 1
48228>>>>>>>>>>> set value of lhObj item (item_count(lhObj)) to self
48229>>>>>>>>>>> end_object
48230>>>>>>>>>>> loop
48231>>>>>>>>>>>>
48231>>>>>>>>>>> end_procedure
48232>>>>>>>>>>> procedure display
48235>>>>>>>>>>> integer liItm lhObj
48235>>>>>>>>>>> date ldDate ldLastDate
48235>>>>>>>>>>> move (oObjIdArray(self)) to lhObj
48236>>>>>>>>>>> get pdCurrentDate to ldDate
48237>>>>>>>>>>> move (FirstDayInMonth(ldDate)) to ldDate
48238>>>>>>>>>>> move (LastDayInMonth(ldDate)) to ldLastDate
48239>>>>>>>>>>> move (ldDate-DateDayNumber(ldDate)+1) to ldDate
48240>>>>>>>>>>> for liItm from 0 to 5
48246>>>>>>>>>>>>
48246>>>>>>>>>>> if (liItm*7+ldDate) le ldLastDate ; set value of (integer(value(lhObj,liItm))) to (t.calendar.week*string(DateWeekNumber(liItm*7+ldDate)))
48249>>>>>>>>>>> else set value of (integer(value(lhObj,liItm))) to ""
48251>>>>>>>>>>> loop
48252>>>>>>>>>>>>
48252>>>>>>>>>>> end_procedure
48253>>>>>>>>>>> send initialize
48254>>>>>>>>>>> end_object
48255>>>>>>>>>>> object oDaysGrid is a container3d
48257>>>>>>>>>>> set location to 23 39
48258>>>>>>>>>>> set size to 100 127
48259>>>>>>>>>>> set border_style to BORDER_NONE
48260>>>>>>>>>>> object oBtnArray is an array
48262>>>>>>>>>>> end_object
48263>>>>>>>>>>> procedure initialize
48266>>>>>>>>>>> integer liRow liCol lhBtnArray
48266>>>>>>>>>>> move (oBtnArray(self)) to lhBtnArray
48267>>>>>>>>>>> for liRow from 0 to 5
48273>>>>>>>>>>>>
48273>>>>>>>>>>> for liCol from 0 to 6
48279>>>>>>>>>>>>
48279>>>>>>>>>>> object oBtn is a calendar.button
48281>>>>>>>>>>> set location to (liRow*15) (liCol*18)
48282>>>>>>>>>>> set value of lhBtnArray item (item_count(lhBtnArray)) to self
48283>>>>>>>>>>> on_item "" send move_value_out_ok
48284>>>>>>>>>>> end_object
48285>>>>>>>>>>> loop
48286>>>>>>>>>>>>
48286>>>>>>>>>>> loop
48287>>>>>>>>>>>>
48287>>>>>>>>>>> end_procedure
48288>>>>>>>>>>> send initialize
48289>>>>>>>>>>>
48289>>>>>>>>>>> procedure display.iii integer liItm integer liDay integer lbActivate
48292>>>>>>>>>>> integer lhObj liCurrentDay
48292>>>>>>>>>>> move (integer(value(oBtnArray(self),liItm))) to lhObj
48293>>>>>>>>>>> move (DateSegment(pdCurrentDate(self),DS_DAY)) to liCurrentDay
48294>>>>>>>>>>> if lbActivate begin
48296>>>>>>>>>>> if liDay eq liCurrentDay send activate to lhObj
48299>>>>>>>>>>> end
48299>>>>>>>>>>>>
48299>>>>>>>>>>> else begin
48300>>>>>>>>>>> if liDay begin
48302>>>>>>>>>>> set value of lhObj to liDay
48303>>>>>>>>>>> set visible_state of lhObj to DFTRUE
48304>>>>>>>>>>> set pdAssignedDate of lhObj to (DateCompose(liDay,p_current_month(self),p_current_year(self)))
48305>>>>>>>>>>> end
48305>>>>>>>>>>>>
48305>>>>>>>>>>> else set visible_state of lhObj to DFFALSE
48307>>>>>>>>>>> end
48307>>>>>>>>>>>>
48307>>>>>>>>>>> end_procedure
48308>>>>>>>>>>>
48308>>>>>>>>>>> procedure display integer lbActivate
48311>>>>>>>>>>> integer liFirstItem liLastItem liItm liDay liDate
48311>>>>>>>>>>> get pdCurrentDate to liDate
48312>>>>>>>>>>> move (FirstDayInMonth(liDate)) to liDate
48313>>>>>>>>>>> move (DateDayNumber(liDate)-1) to liFirstItem
48314>>>>>>>>>>> // **WvA: 27-08-2003 VDF9.1 Needs the integer datevalue to be casted to
48314>>>>>>>>>>> // a date before the expression can be evaluated.
48314>>>>>>>>>>> move (LastDayInMonth(liDate)-date(liDate)+liFirstItem) to liLastItem
48315>>>>>>>>>>> // **
48315>>>>>>>>>>> ifnot lbActivate begin
48317>>>>>>>>>>> for liItm from 0 to (liFirstItem-1)
48323>>>>>>>>>>>>
48323>>>>>>>>>>> send display.iii liItm 0 0
48324>>>>>>>>>>> loop
48325>>>>>>>>>>>>
48325>>>>>>>>>>> end
48325>>>>>>>>>>>>
48325>>>>>>>>>>> move 1 to liDay
48326>>>>>>>>>>> for liItm from liFirstItem to liLastItem
48332>>>>>>>>>>>>
48332>>>>>>>>>>> send display.iii liItm liDay lbActivate
48333>>>>>>>>>>> increment liDay
48334>>>>>>>>>>> loop
48335>>>>>>>>>>>>
48335>>>>>>>>>>> ifnot lbActivate begin
48337>>>>>>>>>>> for liItm from (liLastItem+1) to 41
48343>>>>>>>>>>>>
48343>>>>>>>>>>> send display.iii liItm 0 0
48344>>>>>>>>>>> loop
48345>>>>>>>>>>>>
48345>>>>>>>>>>> end
48345>>>>>>>>>>>>
48345>>>>>>>>>>> end_procedure
48346>>>>>>>>>>> end_object
48347>>>>>>>>>>> object oTxtMonth is a calendar.textbox
48349>>>>>>>>>>> set size to 12 27
48350>>>>>>>>>>> set location to 25 185
48351>>>>>>>>>>> set value to t.calendar.month
48352>>>>>>>>>>> end_object
48353>>>>>>>>>>> object oBtn1 is a button
48355>>>>>>>>>>> set size to 12 12
48356>>>>>>>>>>> set location to 40 185
48357>>>>>>>>>>> on_item "" send prev_month
48358>>>>>>>>>>> set bitmap to "prev.bmp"
48359>>>>>>>>>>> procedure switch_back
48362>>>>>>>>>>> send display_main
48363>>>>>>>>>>> end_procedure
48364>>>>>>>>>>> end_object
48365>>>>>>>>>>> object oBtn2 is a button
48367>>>>>>>>>>> set size to 12 12
48368>>>>>>>>>>> set location to 40 200
48369>>>>>>>>>>> on_item "" send next_month
48370>>>>>>>>>>> set bitmap to "next.bmp"
48371>>>>>>>>>>> end_object
48372>>>>>>>>>>> object oTxtYear is a calendar.textbox
48374>>>>>>>>>>> set size to 12 27
48375>>>>>>>>>>> set location to 70 185
48376>>>>>>>>>>> set value to t.calendar.year
48377>>>>>>>>>>> end_object
48378>>>>>>>>>>> object oBtn3 is a button
48380>>>>>>>>>>> set size to 12 12
48381>>>>>>>>>>> set location to 85 185
48382>>>>>>>>>>> on_item "" send prev_year
48383>>>>>>>>>>> set bitmap to "prev.bmp"
48384>>>>>>>>>>> end_object
48385>>>>>>>>>>> object oBtn4 is a button
48387>>>>>>>>>>> set size to 12 12
48388>>>>>>>>>>> set location to 85 200
48389>>>>>>>>>>> on_item "" send next_year
48390>>>>>>>>>>> set bitmap to "next.bmp"
48391>>>>>>>>>>> end_object
48392>>>>>>>>>>> end_object
48393>>>>>>>>>>> object oBtn5 is a button
48395>>>>>>>>>>> set size to 14 60
48396>>>>>>>>>>> set location to 129 115
48397>>>>>>>>>>> on_item t.calendar.ok send move_value_out_ok
48398>>>>>>>>>>> end_object
48399>>>>>>>>>>> object oBtn6 is a button
48401>>>>>>>>>>> set size to 14 60
48402>>>>>>>>>>> set location to 129 182
48403>>>>>>>>>>> on_item t.calendar.cancel send cancel
48404>>>>>>>>>>> procedure switch
48407>>>>>>>>>>> send display_main
48408>>>>>>>>>>> end_procedure
48409>>>>>>>>>>> end_object
48410>>>>>>>>>>> procedure next_year
48413>>>>>>>>>>> set pdCurrentDate to (DateIncrement(pdCurrentDate(self),DS_YEAR,1))
48414>>>>>>>>>>> send display_main
48415>>>>>>>>>>> end_procedure
48416>>>>>>>>>>> procedure prev_year
48419>>>>>>>>>>> set pdCurrentDate to (DateIncrement(pdCurrentDate(self),DS_YEAR,-1))
48420>>>>>>>>>>> send display_main
48421>>>>>>>>>>> end_procedure
48422>>>>>>>>>>> procedure next_month
48425>>>>>>>>>>> set pdCurrentDate to (DateIncrement(pdCurrentDate(self),DS_MONTH,1))
48426>>>>>>>>>>> send display_main
48427>>>>>>>>>>> end_procedure
48428>>>>>>>>>>> procedure prev_month
48431>>>>>>>>>>> set pdCurrentDate to (DateIncrement(pdCurrentDate(self),DS_MONTH,-1))
48432>>>>>>>>>>> send display_main
48433>>>>>>>>>>> end_procedure
48434>>>>>>>>>>> procedure next_week
48437>>>>>>>>>>> set pdCurrentDate to (DateIncrement(pdCurrentDate(self),DS_WEEK,1))
48438>>>>>>>>>>> send display_main
48439>>>>>>>>>>> end_procedure
48440>>>>>>>>>>> procedure prev_week
48443>>>>>>>>>>> set pdCurrentDate to (DateIncrement(pdCurrentDate(self),DS_WEEK,-1))
48444>>>>>>>>>>> send display_main
48445>>>>>>>>>>> end_procedure
48446>>>>>>>>>>> procedure next_day
48449>>>>>>>>>>> set pdCurrentDate to (DateIncrement(pdCurrentDate(self),DS_DAY,1))
48450>>>>>>>>>>> send display_main
48451>>>>>>>>>>> end_procedure
48452>>>>>>>>>>> procedure prev_day
48455>>>>>>>>>>> set pdCurrentDate to (DateIncrement(pdCurrentDate(self),DS_DAY,-1))
48456>>>>>>>>>>> send display_main
48457>>>>>>>>>>> end_procedure
48458>>>>>>>>>>> procedure go_today
48461>>>>>>>>>>> date ldDate
48461>>>>>>>>>>> sysdate4 ldDate
48462>>>>>>>>>>> set pdCurrentDate to ldDate
48463>>>>>>>>>>> send display_main
48464>>>>>>>>>>> end_procedure
48465>>>>>>>>>>> property integer invoking_object_id public 0
48467>>>>>>>>>>> procedure OnChange date ldDate
48470>>>>>>>>>>> integer lhFocus lbDelegationMode
48470>>>>>>>>>>> get invoking_object_id to lhFocus
48471>>>>>>>>>>> if lhFocus gt desktop begin
48473>>>>>>>>>>> get delegation_mode of lhFocus to lbDelegationMode
48474>>>>>>>>>>> set delegation_mode of lhFocus to no_delegate_or_error
48475>>>>>>>>>>> send NotifyPopupCalendarChange to lhFocus ldDate
48476>>>>>>>>>>> set delegation_mode of lhFocus to lbDelegationMode
48477>>>>>>>>>>> end
48477>>>>>>>>>>>>
48477>>>>>>>>>>> end_procedure
48478>>>>>>>>>>> procedure display
48481>>>>>>>>>>> integer liDate liMonth liYear
48481>>>>>>>>>>> get pdCurrentDate to liDate
48482>>>>>>>>>>> send OnChange liDate
48483>>>>>>>>>>> move (DateSegment(liDate,DS_YEAR)) to liYear
48484>>>>>>>>>>> move (DateSegment(liDate,DS_MONTH)) to liMonth
48485>>>>>>>>>>> if (p_current_year(self)<>liYear or p_current_month(self)<>liMonth) begin
48487>>>>>>>>>>> set p_current_year to liYear
48488>>>>>>>>>>> set p_current_month to liMonth
48489>>>>>>>>>>> set value to (t.calendar.calendar_popup+", "+MonthName(liMonth))
48490>>>>>>>>>>> send display to (oTextboxYear(oCont3d(self)))
48491>>>>>>>>>>> send display to (oWeekNumberHeader(oCont3d(self)))
48492>>>>>>>>>>> send display to (oDaysGrid(oCont3d(self))) 0
48493>>>>>>>>>>> end
48493>>>>>>>>>>>>
48493>>>>>>>>>>> end_procedure
48494>>>>>>>>>>> procedure display_main
48497>>>>>>>>>>> send display
48498>>>>>>>>>>> send display to (oDaysGrid(oCont3d(self))) 1
48499>>>>>>>>>>> end_procedure
48500>>>>>>>>>>> procedure popup_no_export
48503>>>>>>>>>>> set pExportState to DFFALSE
48504>>>>>>>>>>> send popup
48505>>>>>>>>>>> set pExportState to DFTRUE
48506>>>>>>>>>>> end_procedure
48507>>>>>>>>>>>
48507>>>>>>>>>>> procedure popup_group
48510>>>>>>>>>>> integer lhFocus
48510>>>>>>>>>>> date ldDate
48510>>>>>>>>>>> move (focus(desktop)) to lhFocus
48511>>>>>>>>>>> set invoking_object_id to lhFocus
48512>>>>>>>>>>> get value of lhFocus item current to ldDate
48513>>>>>>>>>>> ifnot (integer(ldDate)) move (dSysdate()) to ldDate
48516>>>>>>>>>>> move (Date2to4(ldDate)) to ldDate
48517>>>>>>>>>>> set pdCurrentDate to ldDate
48518>>>>>>>>>>> send display
48519>>>>>>>>>>> forward send popup_group
48521>>>>>>>>>>> send display to (oDaysGrid(oCont3d(self))) 1
48522>>>>>>>>>>> end_procedure
48523>>>>>>>>>>>
48523>>>>>>>>>>> procedure move_value_out
48526>>>>>>>>>>> integer lhFocus lbDelegationMode liMargin liDataType
48526>>>>>>>>>>>// if (pExportState(self)) begin
48526>>>>>>>>>>> get invoking_object_id to lhFocus
48527>>>>>>>>>>> if lhFocus gt desktop begin
48529>>>>>>>>>>> get delegation_mode of lhFocus to lbDelegationMode
48530>>>>>>>>>>> set delegation_mode of lhFocus to no_delegate_or_error
48531>>>>>>>>>>> send NotifyPopupCalendarSelect to lhFocus (pdCurrentDate(self))
48532>>>>>>>>>>> get form_margin of lhFocus item current to liMargin
48533>>>>>>>>>>> get form_datatype of lhFocus item current to liDataType
48534>>>>>>>>>>> set delegation_mode of lhFocus to lbDelegationMode
48535>>>>>>>>>>> if (pExportState(self)) begin
48537>>>>>>>>>>> if (liMargin>=10 or liDataType=mask_date_window or liDataType=date_window) set value of lhFocus item current to (pdCurrentDate(self))
48540>>>>>>>>>>> else set value of lhFocus item current to (Date4to2(pdCurrentDate(self)))
48542>>>>>>>>>>> set item_changed_state of lhFocus item current to DFTRUE
48543>>>>>>>>>>> end
48543>>>>>>>>>>>>
48543>>>>>>>>>>> end
48543>>>>>>>>>>>>
48543>>>>>>>>>>>// end
48543>>>>>>>>>>> end_procedure
48544>>>>>>>>>>>
48544>>>>>>>>>>> procedure move_value_out_ok
48547>>>>>>>>>>> send move_value_out
48548>>>>>>>>>>> send deactivate
48549>>>>>>>>>>> end_procedure
48550>>>>>>>>>>>
48550>>>>>>>>>>> procedure request_popup
48553>>>>>>>>>>> integer lhFocus liType lbDelegationMode
48553>>>>>>>>>>> move (focus(desktop)) to lhFocus
48554>>>>>>>>>>> if lhFocus gt desktop begin
48556>>>>>>>>>>> get delegation_mode of lhFocus to lbDelegationMode
48557>>>>>>>>>>> set delegation_mode of lhFocus to no_delegate_or_error
48558>>>>>>>>>>> get form_datatype of lhFocus item current to liType
48559>>>>>>>>>>> if (liType=date_window or liType=mask_date_window) send popup
48562>>>>>>>>>>> set delegation_mode of lhFocus to lbDelegationMode
48563>>>>>>>>>>> end
48563>>>>>>>>>>>>
48563>>>>>>>>>>> end_procedure
48564>>>>>>>>>>> end_object
48565>>>>>>>>>>> end_desktop_section
48570>>>>>>>>>>> // If the procedure below was not defined "for BaseClass" its symbolic
48570>>>>>>>>>>> // substitute would become negative (because located on the desktop). This
48570>>>>>>>>>>> // would result in the toolbar object not being able to handle it. Therefore:
48570>>>>>>>>>>> procedure request_popup_calendar for BaseClass
48572>>>>>>>>>>> send request_popup to (popup_calendar(self))
48573>>>>>>>>>>> end_procedure
48574>>>>>>>>>>> procedure popup_calendar_no_export
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
48576>>>>>>>>>>> send popup_no_export to (popup_calendar(self))
48577>>>>>>>>>>> end_procedure
48578>>>>>>>>>>> register_procedure Add_Toolbar_Button_Bitmap string lsBmp string lsTip string lsStatusHelp integer liMsg integer lhObj
48578>>>>>>>>>>> procedure Add_Calendar_tbButton integer lhToolButton
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
48580>>>>>>>>>>> send Add_Toolbar_Button_Bitmap to lhToolButton "DfCalend.bmp" t.calendar.calendar_popup t.calendar.Activate msg_request_popup_calendar
48581>>>>>>>>>>> end_procedure
48582>>>>>>>>>>> function s.calendar returns integer // Backwards compatible!!
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
48584>>>>>>>>>>> function_return (popup_calendar(self))
48585>>>>>>>>>>> end_function
48586>>>>>>>>>>>
48586>>>>>>>>>>>// Karl,
48586>>>>>>>>>>>// Structure is as follows,
48586>>>>>>>>>>>//
48586>>>>>>>>>>>// //put this code in the top portion of the view code or in the program
48586>>>>>>>>>>>// code.
48586>>>>>>>>>>>//
48586>>>>>>>>>>>// Type SystemTime
48586>>>>>>>>>>>// field SystemTime.iYear As Word
48586>>>>>>>>>>>// field SystemTime.iMonth As Word
48586>>>>>>>>>>>// field SystemTime.iDayOfWeek As Word
48586>>>>>>>>>>>// field SystemTime.iDay As Word
48586>>>>>>>>>>>// field SystemTime.iHour As Word
48586>>>>>>>>>>>// field SystemTime.iMinute As Word
48586>>>>>>>>>>>// field SystemTime.iSecond As Word
48586>>>>>>>>>>>// field SystemTime.iMilliseconds As Word
48586>>>>>>>>>>>// End_Type
48586>>>>>>>>>>>//
48586>>>>>>>>>>>// external_function GetSystemTime "GetSystemTime" kernel32.dll Pointer lpGST Returns VOID_TYPE
48586>>>>>>>>>>>//
48586>>>>>>>>>>>// //put this code in an onClick or wherever
48586>>>>>>>>>>>// procedure onclick
48586>>>>>>>>>>>// integer iRetVal
48586>>>>>>>>>>>// string TimeData
48586>>>>>>>>>>>// pointer GST
48586>>>>>>>>>>>//
48586>>>>>>>>>>>// ZeroType SystemTime to TimeData
48586>>>>>>>>>>>// getAddress from TimeData to GST
48586>>>>>>>>>>>//
48586>>>>>>>>>>>// move (GetSystemTime(GST)) to iRetVal
48586>>>>>>>>>>>// end_procedure
48586>>>>>>>>>>>//
48586>>>>>>>>>>>// To extract the data from the Structure after calling the function use
48586>>>>>>>>>>>// the getbuff command as follows:
48586>>>>>>>>>>>//
48586>>>>>>>>>>>// getbuff from TimeData as SystemTime.IVAL to var
48586>>>>>>>>>>>//
48586>>>>>>>>>>>// where IVAL is one of the vars such as iYear or iDay, etc.
48586>>>>>>>>>>>//
48586>>>>>>>>>>>// OLIVER NELSON
48586>>>>>>>>>>>//
48586>>>>>>>>>>>//
48586>>>>>>>>>Use Files.utl // Utilities for handling file related stuff
48586>>>>>>>>>Use MsgBox.utl // obs procedure
48586>>>>>>>>>Use Seq_Chnl // Defines global sequential device management operations (DAC)
48586>>>>>>>>>Use Language.pkg // Default language setup
48586>>>>>>>>>Use API_Attr.nui // Functions for querying API attributes (No User Interface)
Including file: api_attr.nui (C:\Apps\VDFQuery\AppSrc\api_attr.nui)
48586>>>>>>>>>>>// Use API_Attr.nui // Functions for querying API attributes (No User Interface)
48586>>>>>>>>>>>// Part of VDFQuery by Sture ApS
48586>>>>>>>>>>>//
48586>>>>>>>>>>>// Create: Mon 25-10-1999
48586>>>>>>>>>>>// Update: Fri 10-11-1999 - Changed
48586>>>>>>>>>>>// Sat 15-01-2000 - Sysconf atributes added
48586>>>>>>>>>>>// Tue 16-02-2000 - OA_DFPATH taken out. Made superfluous by DF_OPEN_PATH
48586>>>>>>>>>>>// Wed 22-03-2000 - Internal workings simplified
48586>>>>>>>>>>>// Wed 27-06-2001 - OA_COLLATE_PATH, OA_COLLATE_SIZE and
48586>>>>>>>>>>>// OA_COLLATE_TIME changed
48586>>>>>>>>>>>// Tue 07-08-2001 - OA_CURRENT_USER_COUNT added
48586>>>>>>>>>>>// Mon 13-08-2001 - DF_FILE_REVISION changed from DF_BCD to DF_ASCII
48586>>>>>>>>>>>// Sat 11-09-2004 - OA_LOCK_COUNT added
48586>>>>>>>>>>>
48586>>>>>>>>>>>//> pkgdoc.begin
48586>>>>>>>>>>>//> This package defines a number of functions designed to replace
48586>>>>>>>>>>>//> the GET_ATTRIBUTE command. Now, the GET_ATTRIBUTE is very very (very)
48586>>>>>>>>>>>//> flexible in that it allows you to query any attribute whether it is
48586>>>>>>>>>>>//> file-, field- or index related.
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> However, the attributes are so different in nature that it is useful
48586>>>>>>>>>>>//> to group them into categories. Actually, the attribute names that are
48586>>>>>>>>>>>//> used as first parameter to the GET_ATTRIBUTE command in any case,
48586>>>>>>>>>>>//> indicates a grouping of the attributes:
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> Example of file related attributes:
48586>>>>>>>>>>>//> <code>
48586>>>>>>>>>>>//> DF_FILE_MAX_RECORDS
48586>>>>>>>>>>>//> DF_FILE_LOCK_TYPE
48586>>>>>>>>>>>//> </code>
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> and field related dittos:
48586>>>>>>>>>>>//> <code>
48586>>>>>>>>>>>//> DF_FIELD_NAME
48586>>>>>>>>>>>//> DF_FIELD_TYPE
48586>>>>>>>>>>>//> </code>
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> and global attributes (for the entire application):
48586>>>>>>>>>>>//> <code>
48586>>>>>>>>>>>//> DF_DECIMAL_SEPARATOR
48586>>>>>>>>>>>//> DF_OPEN_PATH
48586>>>>>>>>>>>//> </code>
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> As you can see, the first part of the name indicates which group Data
48586>>>>>>>>>>>//> Access considers it belongs to.
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> But, their grouping is not strong enough (for my purpose anyway). Consider
48586>>>>>>>>>>>//> these attributes:
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> <code>
48586>>>>>>>>>>>//> 1: DF_FILE_RECORD_LENGTH
48586>>>>>>>>>>>//> 2: DF_FILE_DISPLAY_NAME
48586>>>>>>>>>>>//> 3: DF_FILE_NEXT_EMPTY
48586>>>>>>>>>>>//> </code>
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> According to their names they all belong in the group of file related
48586>>>>>>>>>>>//> attributes. But in reality only the DF_FILE_RECORD_LENGTH returns
48586>>>>>>>>>>>//> an attribute of the file definition itself. The DF_FILE_DISPLAY_NAME
48586>>>>>>>>>>>//> attribute (together with DF_FILE_LOGICAL_NAME and DF_FILE_ROOT_NAME)
48586>>>>>>>>>>>//> returns an attribute of FILELIST.CFG. The same could be said about
48586>>>>>>>>>>>//> DF_FILE_NEXT_EMPTY but again it differs from the two others in that
48586>>>>>>>>>>>//> it returns the next entry (relative to its parameter) in FILELIST.CFG
48586>>>>>>>>>>>//> that is currently not used (empty root name).
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> Therefore this package divides the attributes into the following groups:
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> <code>
48586>>>>>>>>>>>//> ATTRTYPE_GLOBAL Attributes not related to tables or drivers
48586>>>>>>>>>>>//> ATTRTYPE_FILELIST Filelist attributes (root name, display name and
48586>>>>>>>>>>>//> logical name)
48586>>>>>>>>>>>//> ATTRTYPE_FILE Table attributes
48586>>>>>>>>>>>//> ATTRTYPE_FIELD Field attributes
48586>>>>>>>>>>>//> ATTRTYPE_INDEX Index attributes
48586>>>>>>>>>>>//> ATTRTYPE_IDXSEG Index segment attributes
48586>>>>>>>>>>>//> ATTRTYPE_DRIVER Driver attributes
48586>>>>>>>>>>>//> ATTRTYPE_DRVSRV Server attributes
48586>>>>>>>>>>>//> ATTRTYPE_SPECIAL1 Used to figure out whether 2 fields overlap each
48586>>>>>>>>>>>//> other
48586>>>>>>>>>>>//> ATTRTYPE_FLSTNAV Filelist.cfg navigation (next empty, next used,
48586>>>>>>>>>>>//> next open)
48586>>>>>>>>>>>//> </code>
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> If you want to retrieve an attribute value using one of the functions in
48586>>>>>>>>>>>//> this package, you have to know which type of attribute you are querying
48586>>>>>>>>>>>//> in order to use the correct function:
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> <code>
48586>>>>>>>>>>>//> Type Function
48586>>>>>>>>>>>//> ------------------ -----------------------
48586>>>>>>>>>>>//> ATTRTYPE_GLOBAL API_AttrValue_GLOBAL
48586>>>>>>>>>>>//> ATTRTYPE_FILELIST API_AttrValue_FILELIST
48586>>>>>>>>>>>//> ATTRTYPE_FILE API_AttrValue_FILE
48586>>>>>>>>>>>//> ATTRTYPE_FIELD API_AttrValue_FIELD
48586>>>>>>>>>>>//> ATTRTYPE_INDEX API_AttrValue_INDEX
48586>>>>>>>>>>>//> ATTRTYPE_IDXSEG API_AttrValue_IDXSEG
48586>>>>>>>>>>>//> ATTRTYPE_DRIVER API_AttrValue_DRIVER
48586>>>>>>>>>>>//> ATTRTYPE_DRVSRV API_AttrValue_DRVSRV
48586>>>>>>>>>>>//> ATTRTYPE_SPECIAL1 API_AttrValue_SPECIAL1
48586>>>>>>>>>>>//> ATTRTYPE_FLSTNAV API_AttrValue_FLSTNAV
48586>>>>>>>>>>>//> </code>
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> These functions are defined like this:
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> </code>
48586>>>>>>>>>>>//> FUNCTION API_AttrValue_GLOBAL global INTEGER attr# RETURNS string
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> FUNCTION API_AttrValue_FILELIST global INTEGER attr# integer file# ;
48586>>>>>>>>>>>//> RETURNS string
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> FUNCTION API_AttrValue_FILE global INTEGER attr# INTEGER file# ;
48586>>>>>>>>>>>//> RETURNS string
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> FUNCTION API_AttrValue_FIELD global INTEGER attr# INTEGER file# ;
48586>>>>>>>>>>>//> INTEGER field# RETURNS string
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> FUNCTION API_AttrValue_INDEX global INTEGER attr# INTEGER file# ;
48586>>>>>>>>>>>//> INTEGER index# RETURNS string
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> FUNCTION API_AttrValue_IDXSEG global INTEGER attr# INTEGER file# ;
48586>>>>>>>>>>>//> INTEGER index# INTEGER segment# RETURNS string
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> FUNCTION API_AttrValue_DRIVER global INTEGER attr# INTEGER driver# ;
48586>>>>>>>>>>>//> RETURNS string
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> FUNCTION API_AttrValue_DRVSRV global INTEGER attr# INTEGER driver# ;
48586>>>>>>>>>>>//> INTEGER server# RETURNS string
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> FUNCTION API_AttrValue_SPECIAL1 global INTEGER attr# INTEGER file# ;
48586>>>>>>>>>>>//> INTEGER field1# INTEGER field2# RETURNS string
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> FUNCTION API_AttrValue_FLSTNAV global INTEGER attr# INTEGER file# ;
48586>>>>>>>>>>>//> RETURNS string
48586>>>>>>>>>>>//> </code>
48586>>>>>>>>>>>//>
48586>>>>>>>>>>>//> Take a moment to convince yourself that each function takes a reasonable
48586>>>>>>>>>>>//> number of parameters. Note that even if these functions most often will
48586>>>>>>>>>>>//> return an integer (some indeed always return integers) their return type
48586>>>>>>>>>>>//> is string. This was done for reasons of simplicity.
48586>>>>>>>>>>>//> pkgdoc.end
48586>>>>>>>>>>>
48586>>>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
48586>>>>>>>>>>>Use Files.nui // Utilities for handling file related stuff
48586>>>>>>>>>>>Use DBMS.nui // Basic DBMS functions
Including file: dbms.nui (C:\Apps\VDFQuery\AppSrc\dbms.nui)
48586>>>>>>>>>>>>>//**********************************************************************
48586>>>>>>>>>>>>>// Use DBMS.nui // Basic DBMS functions (No User Interface)
48586>>>>>>>>>>>>>//
48586>>>>>>>>>>>>>// By Sture Andersen
48586>>>>>>>>>>>>>//
48586>>>>>>>>>>>>>// Create: Mon 10-11-1997
48586>>>>>>>>>>>>>// Update: Wed 10-12-1997 - Added DBMS_OpenFileAs, DBMS_OpenFileBrowse
48586>>>>>>>>>>>>>// and DBMS_IsOpen functions
48586>>>>>>>>>>>>>// Thu 18-12-1997 - Function DBMS_IsOpenedAsFile added
48586>>>>>>>>>>>>>// Wed 03-02-1999 - Functions DBMS_Driver_UserName and
48586>>>>>>>>>>>>>// DBMS_DriverNameToType added
48586>>>>>>>>>>>>>// Sat 29-05-1999 - DBMS_Callback_FilelistEntries added
48586>>>>>>>>>>>>>// Thu 16-09-1999 - ON ERROR error fixed
48586>>>>>>>>>>>>>// Thu 04-11-1999 - Procedure DBMS_CallBack_FileFields added
48586>>>>>>>>>>>>>// Tue 04-01-2000 - Function DBMS_NextNotOpen added
48586>>>>>>>>>>>>>// Wed 19-04-2000 - Function DBMS_StripPathAndDriver added
48586>>>>>>>>>>>>>// Wed 02-04-2003 - Function DBMS_TablePath added
48586>>>>>>>>>>>>>// Sun 21-12-2003 - DBMS_Callback_FilelistEntries enhanced.
48586>>>>>>>>>>>>>// - Function DBMS_EraseDfFile added
48586>>>>>>>>>>>>>// Mon 17-01-2005 - Procedures DBMS_SetFieldValueMax and
48586>>>>>>>>>>>>>// DBMS_SetFieldValueMin added
48586>>>>>>>>>>>>>// Fri 21-01-2005 - Procedure DBMS_FindByRecnum added
48586>>>>>>>>>>>>>//**********************************************************************
48586>>>>>>>>>>>>>// Useful pastry:
48586>>>>>>>>>>>>>//
48586>>>>>>>>>>>>>// Set_Attribute DF_FILE_ALIAS Customer2.File_number to DF_FILE_IS_ALIAS
48586>>>>>>>>>>>>>// Set_Attribute DF_FILE_ALIAS Customer.File_number to DF_FILE_IS_MASTER
48586>>>>>>>>>>>>>Use Strings.nui // String manipulation for VDF
48586>>>>>>>>>>>>>Use Files.nui // Utilities for handling file related stuff (No User Interface)
48586>>>>>>>>>>>>>Use Dates.nui // Date routines (No User Interface)
48586>>>>>>>>>>>>>
48586>>>>>>>>>>>>>define DBMS_MaxFileListEntry for 4095 // 255
48586>>>>>>>>>>>>>
48586>>>>>>>>>>>>>enumeration_list // Driver ID's
48586>>>>>>>>>>>>> define DBMS_DRIVER_ERROR
48586>>>>>>>>>>>>> define DBMS_DRIVER_UNKNOWN
48586>>>>>>>>>>>>> define DBMS_DRIVER_DATAFLEX
48586>>>>>>>>>>>>> define DBMS_DRIVER_PERVASIVE
48586>>>>>>>>>>>>> define DBMS_DRIVER_ORACLE
48586>>>>>>>>>>>>> define DBMS_DRIVER_MS_SQL
48586>>>>>>>>>>>>> define DBMS_DRIVER_DB2
48586>>>>>>>>>>>>> define DBMS_DRIVER_ODBC
48586>>>>>>>>>>>>> define DBMS_DRIVER_PERVASIVE_MODRT
48586>>>>>>>>>>>>> define DBMS_DRIVER_MS_SQL_DAW
48586>>>>>>>>>>>>> define DBMS_DRIVER_MAX // Points to the highest known driver ID
48586>>>>>>>>>>>>>end_enumeration_list
48586>>>>>>>>>>>>>
48586>>>>>>>>>>>>>function DBMS_Driver_UserName global integer liType returns string
48588>>>>>>>>>>>>> if liType eq DBMS_DRIVER_ERROR function_return "Unknown (Error)"
48591>>>>>>>>>>>>> if liType eq DBMS_DRIVER_UNKNOWN function_return "Unknown"
48594>>>>>>>>>>>>> if liType eq DBMS_DRIVER_DATAFLEX function_return "DataFlex"
48597>>>>>>>>>>>>> if liType eq DBMS_DRIVER_PERVASIVE function_return "Pervasive"
48600>>>>>>>>>>>>> if liType eq DBMS_DRIVER_ORACLE function_return "Oracle"
48603>>>>>>>>>>>>> if liType eq DBMS_DRIVER_MS_SQL function_return "MS SQL (MT)"
48606>>>>>>>>>>>>> if liType eq DBMS_DRIVER_DB2 function_return "DB/2"
48609>>>>>>>>>>>>> if liType eq DBMS_DRIVER_MS_SQL_DAW function_return "MS SQL (DAW)"
48612>>>>>>>>>>>>> if liType eq DBMS_DRIVER_ODBC function_return "ODBC Connectivity"
48615>>>>>>>>>>>>> if liType eq DBMS_DRIVER_PERVASIVE_MODRT function_return "Pervasive (mod/rt)"
48618>>>>>>>>>>>>>end_function
48619>>>>>>>>>>>>>
48619>>>>>>>>>>>>>function DBMS_DriverNameToType global string lsDriver returns integer
48621>>>>>>>>>>>>> uppercase lsDriver
48622>>>>>>>>>>>>>>
48622>>>>>>>>>>>>> if lsDriver eq "DATAFLEX" function_return DBMS_DRIVER_DATAFLEX
48625>>>>>>>>>>>>> if lsDriver eq "ORA_DRV" function_return DBMS_DRIVER_ORACLE
48628>>>>>>>>>>>>> if lsDriver eq "SQL_DRV" function_return DBMS_DRIVER_MS_SQL
48631>>>>>>>>>>>>> if lsDriver eq "DFBTRDRV" function_return DBMS_DRIVER_PERVASIVE
48634>>>>>>>>>>>>> if lsDriver eq "MSSQLDRV" function_return DBMS_DRIVER_MS_SQL_DAW
48637>>>>>>>>>>>>> if lsDriver eq "ODBC_DRV" function_return DBMS_DRIVER_ODBC
48640>>>>>>>>>>>>> function_return DBMS_DRIVER_UNKNOWN // is not zero!
48641>>>>>>>>>>>>>end_function
48642>>>>>>>>>>>>>
48642>>>>>>>>>>>>>function DBMS_TypeToDriverName global integer liType returns string
48644>>>>>>>>>>>>> if liType eq DBMS_DRIVER_DATAFLEX function_return "DATAFLEX"
48647>>>>>>>>>>>>> if liType eq DBMS_DRIVER_ORACLE function_return "ORA_DRV"
48650>>>>>>>>>>>>> if liType eq DBMS_DRIVER_MS_SQL function_return "SQL_DRV"
48653>>>>>>>>>>>>> if liType eq DBMS_DRIVER_MS_SQL_DAW function_return "MSSQLDRV"
48656>>>>>>>>>>>>> if liType eq DBMS_DRIVER_PERVASIVE function_return "DFBTRDRV"
48659>>>>>>>>>>>>> if liType eq DBMS_DRIVER_ODBC function_return "ODBC_DRV"
48662>>>>>>>>>>>>> function_return "Unknown" // Must return this value!
48663>>>>>>>>>>>>>end_function
48664>>>>>>>>>>>>>
48664>>>>>>>>>>>>>function DBMS_FileDriverType global integer liFile returns integer
48666>>>>>>>>>>>>> string lsDriver
48666>>>>>>>>>>>>> get_attribute DF_FILE_DRIVER of liFile to lsDriver
48669>>>>>>>>>>>>> function_return (DBMS_DriverNameToType(lsDriver))
48670>>>>>>>>>>>>>end_function
48671>>>>>>>>>>>>>
48671>>>>>>>>>>>>>if dfFalse begin
48673>>>>>>>>>>>>> DBMS_OpenError: move DBMS_DRIVER_ERROR to windowindex // DBMS_DRIVER_ERROR is 0
48674>>>>>>>>>>>>> return
48675>>>>>>>>>>>>>end
48675>>>>>>>>>>>>>>
48675>>>>>>>>>>>>>
48675>>>>>>>>>>>>>//> This function is used to find out if a file is currently open. If not
48675>>>>>>>>>>>>>//> it will return 0 (false) and if it is opened a driver ID like
48675>>>>>>>>>>>>>//> DBMS_DRIVER_DATAFLEX or DBMS_DRIVER_ORACLE will be returned.
48675>>>>>>>>>>>>>function DBMS_IsOpenFile global integer liFile returns integer
48677>>>>>>>>>>>>> integer liRval liHandleType
48677>>>>>>>>>>>>> string lsDriver
48677>>>>>>>>>>>>> get_attribute DF_FILE_HANDLE_TYPE of liFile to liHandleType
48680>>>>>>>>>>>>> if (liHandleType=DF_FILE_HANDLE_EXISTING_RESTRUCTURE or liHandleType=DF_FILE_HANDLE_NEW_RESTRUCTURE) function_return 1
48683>>>>>>>>>>>>> get_attribute DF_FILE_OPENED of liFile to liRval
48686>>>>>>>>>>>>> if liRval begin
48688>>>>>>>>>>>>> get_attribute DF_FILE_DRIVER of liFile to lsDriver
48691>>>>>>>>>>>>> get DBMS_DriverNameToType lsDriver to liRval
48692>>>>>>>>>>>>> end
48692>>>>>>>>>>>>>>
48692>>>>>>>>>>>>> function_return liRval
48693>>>>>>>>>>>>>end_function
48694>>>>>>>>>>>>>
48694>>>>>>>>>>>>>function DBMS_IsOpenedAsFile global integer liFile returns integer
48696>>>>>>>>>>>>> integer lbOpen
48696>>>>>>>>>>>>> string lsPhysName lsRootName
48696>>>>>>>>>>>>> get_attribute DF_FILE_OPENED of liFile to lbOpen
48699>>>>>>>>>>>>> if lbOpen begin
48701>>>>>>>>>>>>> get_attribute DF_FILE_PHYSICAL_NAME of liFile to lsPhysName
48704>>>>>>>>>>>>> get_attribute DF_FILE_ROOT_NAME of liFile to lsRootName
48707>>>>>>>>>>>>> if (uppercase(lsPhysName)) ne (uppercase(lsRootName)) function_return 1
48710>>>>>>>>>>>>> end
48710>>>>>>>>>>>>>>
48710>>>>>>>>>>>>> function_return 0
48711>>>>>>>>>>>>>end_function
48712>>>>>>>>>>>>>
48712>>>>>>>>>>>>>function DBMS_RootNameWhichDriver global string lsRootName returns integer
48714>>>>>>>>>>>>> // This function analyses the rootname and determines which driver should
48714>>>>>>>>>>>>> // be used to open it.
48714>>>>>>>>>>>>> integer liRval
48714>>>>>>>>>>>>> string lsDriver
48714>>>>>>>>>>>>> if ".INT" in (uppercase(lsRootName)) move DBMS_DRIVER_UNKNOWN to liRval
48717>>>>>>>>>>>>> else if ":" in lsRootName begin
48720>>>>>>>>>>>>> move (uppercase(ExtractWord(lsRootName,":",1))) to lsDriver
48721>>>>>>>>>>>>> if (length(trim(lsDriver))) eq 1 move DBMS_DRIVER_DATAFLEX to liRval
48724>>>>>>>>>>>>> else get DBMS_DriverNameToType lsDriver to liRval
48726>>>>>>>>>>>>> end
48726>>>>>>>>>>>>>>
48726>>>>>>>>>>>>> else move DBMS_DRIVER_DATAFLEX to liRval
48728>>>>>>>>>>>>> function_return liRval
48729>>>>>>>>>>>>>end_function
48730>>>>>>>>>>>>>
48730>>>>>>>>>>>>>function DBMS_AutoLoadDriver global string lsRootName returns integer
48732>>>>>>>>>>>>> // This function returns the ID for the driver loaded, if successful.
48732>>>>>>>>>>>>> integer liDriver liRval
48732>>>>>>>>>>>>> get DBMS_RootNameWhichDriver lsRootName to liDriver
48733>>>>>>>>>>>>> if (liDriver<>DBMS_DRIVER_DATAFLEX and ; liDriver<>DBMS_DRIVER_ERROR and ; liDriver<>DBMS_DRIVER_UNKNOWN) begin
48735>>>>>>>>>>>>>
48735>>>>>>>>>>>>> end
48735>>>>>>>>>>>>>>
48735>>>>>>>>>>>>> else move 0 to liRval
48737>>>>>>>>>>>>>// send obs (DBMS_Driver_UserName(lsDriver))
48737>>>>>>>>>>>>>end_function
48738>>>>>>>>>>>>>
48738>>>>>>>>>>>>>// The function returns the driver ID for that DB if the table could be
48738>>>>>>>>>>>>>// opened. If the table could not be opened 0 is returned.
48738>>>>>>>>>>>>>function DBMS_OpenFile global integer liFile integer liMode integer liBufIndex returns integer
48740>>>>>>>>>>>>> integer liRval liWindowIndex
48740>>>>>>>>>>>>> string lsDriver lsRoot
48740>>>>>>>>>>>>>// send obs "OpenFile" (string(liFile)) (string(liMode)) (string(liBufIndex))
48740>>>>>>>>>>>>> move windowindex to liWindowIndex
48741>>>>>>>>>>>>> move |VI31 to |VI32 //copy ON ERROR label
48742>>>>>>>>>>>>> on error gosub DBMS_OpenError
48743>>>>>>>>>>>>> indicate err false
48744>>>>>>>>>>>>> move DBMS_DRIVER_UNKNOWN to windowindex
48745>>>>>>>>>>>>> if liBufIndex open liFile mode liMode liBufIndex
48749>>>>>>>>>>>>> else open liFile mode liMode
48752>>>>>>>>>>>>> move |VI32 to |VI31 //restore original ON ERROR label
48753>>>>>>>>>>>>> move windowindex to liRval // If an error was triggered the
48754>>>>>>>>>>>>> indicate err false // subroutine will have changed windowindex
48755>>>>>>>>>>>>> move liWindowIndex to windowindex
48756>>>>>>>>>>>>> if liRval begin
48758>>>>>>>>>>>>> get_attribute DF_FILE_DRIVER of liFile to lsDriver
48761>>>>>>>>>>>>> get DBMS_DriverNameToType lsDriver to liRval
48762>>>>>>>>>>>>> end
48762>>>>>>>>>>>>>>
48762>>>>>>>>>>>>>// if DBMS_DRIVER_UNKNOWN eq liRval send obs ("UNKNOWN DRIVER: "+string(liRval)+" "+string(liFile))
48762>>>>>>>>>>>>> ifnot liRval begin
48764>>>>>>>>>>>>> if liFile begin
48766>>>>>>>>>>>>> get_attribute DF_FILE_ROOT_NAME of liFile to lsRoot
48769>>>>>>>>>>>>> //get DBMS_AutoLoadDriver lsRoot to liRval
48769>>>>>>>>>>>>> end
48769>>>>>>>>>>>>>>
48769>>>>>>>>>>>>> end
48769>>>>>>>>>>>>>>
48769>>>>>>>>>>>>> function_return liRval
48770>>>>>>>>>>>>>end_function
48771>>>>>>>>>>>>>
48771>>>>>>>>>>>>>function DBMS_OpenFileAs global string lsFileName integer liFile integer liMode integer liBufIndex returns integer
48773>>>>>>>>>>>>> integer liRval liWindowIndex
48773>>>>>>>>>>>>> string lsDriver
48773>>>>>>>>>>>>> if (DBMS_IsOpenFile(liFile)) close liFile
48776>>>>>>>>>>>>> move (ToAnsi(lsFileName)) to lsFileName
48777>>>>>>>>>>>>> if lsFileName eq "" function_return DBMS_DRIVER_ERROR
48780>>>>>>>>>>>>> move windowindex to liWindowIndex
48781>>>>>>>>>>>>> move |VI31 to |VI32 //copy ON ERROR label
48782>>>>>>>>>>>>> on error gosub DBMS_OpenError
48783>>>>>>>>>>>>> indicate err false
48784>>>>>>>>>>>>> move DBMS_DRIVER_UNKNOWN to windowindex
48785>>>>>>>>>>>>> if liBufIndex open lsFileName as liFile mode liMode liBufIndex
48789>>>>>>>>>>>>> else open lsFileName as liFile mode liMode
48792>>>>>>>>>>>>> move |VI32 to |VI31 //restore original ON ERROR label
48793>>>>>>>>>>>>> move windowindex to liRval // If an error was triggered the
48794>>>>>>>>>>>>> indicate err false // subroutine will have changed windowindex
48795>>>>>>>>>>>>> move liWindowIndex to windowindex
48796>>>>>>>>>>>>> if liRval begin
48798>>>>>>>>>>>>> get_attribute DF_FILE_DRIVER of liFile to lsDriver
48801>>>>>>>>>>>>> get DBMS_DriverNameToType lsDriver to liRval
48802>>>>>>>>>>>>> end
48802>>>>>>>>>>>>>>
48802>>>>>>>>>>>>> function_return liRval
48803>>>>>>>>>>>>>end_function
48804>>>>>>>>>>>>>
48804>>>>>>>>>>>>>procedure DBMS_CloseFile global integer liFile
48806>>>>>>>>>>>>> integer lbOpen
48806>>>>>>>>>>>>> if liFile begin
48808>>>>>>>>>>>>> get_attribute DF_FILE_OPENED of liFile to lbOpen
48811>>>>>>>>>>>>> if lbOpen close liFile
48814>>>>>>>>>>>>> end
48814>>>>>>>>>>>>>>
48814>>>>>>>>>>>>>end_procedure
48815>>>>>>>>>>>>>
48815>>>>>>>>>>>>>function DBMS_StripPathAndDriver global string lsRoot returns string
48817>>>>>>>>>>>>> integer liPos
48817>>>>>>>>>>>>> string lsChar
48817>>>>>>>>>>>>> move (sysconf(SYSCONF_DIR_SEPARATOR)) to lsChar
48818>>>>>>>>>>>>> if lsChar in lsRoot begin
48820>>>>>>>>>>>>> move (pos(lsChar,lsRoot)) to liPos
48821>>>>>>>>>>>>> move (StringRightBut(lsRoot,liPos)) to lsRoot
48822>>>>>>>>>>>>> end
48822>>>>>>>>>>>>>>
48822>>>>>>>>>>>>> move ":" to lsChar
48823>>>>>>>>>>>>> if lsChar in lsRoot begin
48825>>>>>>>>>>>>> move (pos(lsChar,lsRoot)) to liPos
48826>>>>>>>>>>>>> move (StringRightBut(lsRoot,liPos)) to lsRoot
48827>>>>>>>>>>>>> end
48827>>>>>>>>>>>>>>
48827>>>>>>>>>>>>> if "." in lsRoot get StripFromLastOccurance lsRoot "." to lsRoot
48830>>>>>>>>>>>>> function_return lsRoot
48831>>>>>>>>>>>>>end_function
48832>>>>>>>>>>>>>
48832>>>>>>>>>>>>>function DBMS_TablePath global integer liFile returns string
48834>>>>>>>>>>>>> integer lbIsOpenedAs liType
48834>>>>>>>>>>>>> string lsDriver lsRval lsCurrentDir lsDirSep lsPath
48834>>>>>>>>>>>>>
48834>>>>>>>>>>>>> move (sysconf(SYSCONF_DIR_SEPARATOR)) to lsDirSep // "/" or "\"
48835>>>>>>>>>>>>>
48835>>>>>>>>>>>>> get_attribute DF_FILE_DRIVER of liFile to lsDriver
48838>>>>>>>>>>>>> get DBMS_DriverNameToType lsDriver to liType
48839>>>>>>>>>>>>>
48839>>>>>>>>>>>>> get DBMS_IsOpenedAsFile liFile to lbIsOpenedAs
48840>>>>>>>>>>>>>
48840>>>>>>>>>>>>> if lbIsOpenedAs get_attribute DF_FILE_PHYSICAL_NAME of liFile to lsRval
48845>>>>>>>>>>>>> else get_attribute DF_FILE_ROOT_NAME of liFile to lsRval
48849>>>>>>>>>>>>>
48849>>>>>>>>>>>>> if liType eq DBMS_DRIVER_DATAFLEX move (lsRval+".dat") to lsRval
48852>>>>>>>>>>>>> else begin
48853>>>>>>>>>>>>> replace (lsDriver+":") in lsRval with ""
48855>>>>>>>>>>>>> ifnot ".INT" in (uppercase(lsRval)) move (lsRval+".int") to lsRval
48858>>>>>>>>>>>>> end
48858>>>>>>>>>>>>>>
48858>>>>>>>>>>>>> ifnot (lsRval contains lsDirSep) get_file_path lsRval to lsRval
48861>>>>>>>>>>>>> if (left(lsRval,2)=("."+lsDirSep)) begin
48863>>>>>>>>>>>>> get_current_directory to lsCurrentDir
48864>>>>>>>>>>>>> replace "." in lsRval with lsCurrentDir
48866>>>>>>>>>>>>> end
48866>>>>>>>>>>>>>>
48866>>>>>>>>>>>>> function_return lsRval
48867>>>>>>>>>>>>>end_function
48868>>>>>>>>>>>>>
48868>>>>>>>>>>>>>Use WinBase
48868>>>>>>>>>>>>>// This one probably requires the file to open?
48868>>>>>>>>>>>>>function DBMS_Rootname_Path global integer liFile returns string
48870>>>>>>>>>>>>> integer liType
48870>>>>>>>>>>>>> string lsStr lsCurDir lsDriver
48870>>>>>>>>>>>>> get_current_directory to lsCurDir
48871>>>>>>>>>>>>> get_attribute DF_FILE_DRIVER of liFile to lsDriver
48874>>>>>>>>>>>>> get DBMS_DriverNameToType lsDriver to liType
48875>>>>>>>>>>>>>
48875>>>>>>>>>>>>> get_attribute DF_FILE_ROOT_NAME of liFile to lsStr
48878>>>>>>>>>>>>> if liType eq DBMS_DRIVER_DATAFLEX move (lsStr+".dat") to lsStr
48881>>>>>>>>>>>>> else begin
48882>>>>>>>>>>>>> replace (lsDriver+":") in lsStr with ""
48884>>>>>>>>>>>>> ifnot ".INT" in (uppercase(lsStr)) move (lsStr+".int") to lsStr
48887>>>>>>>>>>>>> end
48887>>>>>>>>>>>>>>
48887>>>>>>>>>>>>> ifnot "\" in lsStr get_file_path lsStr to lsStr
48890>>>>>>>>>>>>> if (left(lsStr,2)) eq ".\" replace "." in lsStr with lsCurDir
48894>>>>>>>>>>>>> function_return (uppercase(lsStr))
48895>>>>>>>>>>>>>end_function
48896>>>>>>>>>>>>>
48896>>>>>>>>>>>>>function DBMS_Rootname global integer liFile returns string
48898>>>>>>>>>>>>> string lsRval
48898>>>>>>>>>>>>> get_attribute DF_FILE_ROOT_NAME of liFile to lsRval
48901>>>>>>>>>>>>> function_return lsRval
48902>>>>>>>>>>>>>end_function
48903>>>>>>>>>>>>>function DBMS_DFName global integer liFile returns string
48905>>>>>>>>>>>>> string lsRval
48905>>>>>>>>>>>>> get_attribute DF_FILE_LOGICAL_NAME of liFile to lsRval
48908>>>>>>>>>>>>> function_return lsRval
48909>>>>>>>>>>>>>end_function
48910>>>>>>>>>>>>>function DBMS_DisplayName global integer liFile returns string
48912>>>>>>>>>>>>> string lsRval
48912>>>>>>>>>>>>> get_attribute DF_FILE_DISPLAY_NAME of liFile to lsRval
48915>>>>>>>>>>>>> function_return (rtrim(lsRval))
48916>>>>>>>>>>>>>end_function
48917>>>>>>>>>>>>>function DBMS_FieldValue global integer liFile integer liField returns string
48919>>>>>>>>>>>>> string lsRval
48919>>>>>>>>>>>>> get_field_value liFile liField to lsRval
48922>>>>>>>>>>>>> function_return lsRval
48923>>>>>>>>>>>>>end_function
48924>>>>>>>>>>>>>function DBMS_FieldName global integer liFile integer liField returns string
48926>>>>>>>>>>>>> integer lbOpen lbWasOpen
48926>>>>>>>>>>>>> string lsRval
48926>>>>>>>>>>>>> move (DBMS_IsOpenFile(liFile)) to lbWasOpen
48927>>>>>>>>>>>>> ifnot lbWasOpen move (DBMS_OpenFile(liFile,DF_SHARE,0)) to lbOpen
48930>>>>>>>>>>>>> if (lbWasOpen or lbOpen) get_attribute DF_FIELD_NAME of liFile liField to lsRval
48935>>>>>>>>>>>>> else move ("FILE"+string(liFile)+"."+string(liField)+" N/A") to lsRval
48937>>>>>>>>>>>>> if (lbOpen and not(lbWasOpen)) close liFile
48940>>>>>>>>>>>>> function_return lsRval
48941>>>>>>>>>>>>>end_function
48942>>>>>>>>>>>>>
48942>>>>>>>>>>>>>// OBS! Functions DBMS_FieldInfo and DBMS_FileInfo will go away some day
48942>>>>>>>>>>>>>
48942>>>>>>>>>>>>> // 0=field type ÄÄÄÄ¿
48942>>>>>>>>>>>>> // 1=field length ÄÄ´
48942>>>>>>>>>>>>> // 2=#dec points ÄÄÄ´
48942>>>>>>>>>>>>> // 3=relating file Ä´
48942>>>>>>>>>>>>> // 4=relating fieldÄ´
48942>>>>>>>>>>>>> // 5=main indexÄÄÄÄÄ
48942>>>>>>>>>>>>>function DBMS_FieldInfo global integer liFile integer liField integer liItem returns integer
48944>>>>>>>>>>>>> integer liRval
48944>>>>>>>>>>>>> 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
48949>>>>>>>>>>>>> if liItem eq 1 get_attribute DF_FIELD_LENGTH of liFile liField to liRval
48954>>>>>>>>>>>>> if liItem eq 2 get_attribute DF_FIELD_PRECISION of liFile liField to liRval
48959>>>>>>>>>>>>> if liItem eq 3 get_attribute DF_FIELD_RELATED_FILE of liFile liField to liRval
48964>>>>>>>>>>>>> if liItem eq 4 get_attribute DF_FIELD_RELATED_FIELD of liFile liField to liRval
48969>>>>>>>>>>>>> if liItem eq 5 get_attribute DF_FIELD_INDEX of liFile liField to liRval
48974>>>>>>>>>>>>> function_return liRval
48975>>>>>>>>>>>>>end_function // 0=max records ÄÄÄ¿
48976>>>>>>>>>>>>> // 1=current recs ÄÄ´
48976>>>>>>>>>>>>> // 2=rec length ÄÄÄÄ´
48976>>>>>>>>>>>>> // 3=rec length used´
48976>>>>>>>>>>>>> // 4=number of fldsÄ
48976>>>>>>>>>>>>>function DBMS_FileInfo global integer liFile integer liItem returns integer
48978>>>>>>>>>>>>> integer liRval
48978>>>>>>>>>>>>> if liItem eq 0 get_attribute DF_FILE_MAX_RECORDS of liFile to liRval
48983>>>>>>>>>>>>> if liItem eq 1 get_attribute DF_FILE_RECORDS_USED of liFile to liRval
48988>>>>>>>>>>>>> if liItem eq 2 get_attribute DF_FILE_RECORD_LENGTH of liFile to liRval
48993>>>>>>>>>>>>> if liItem eq 3 get_attribute DF_FILE_RECORD_LENGTH_USED of liFile to liRval
48998>>>>>>>>>>>>> if liItem eq 4 get_attribute DF_FILE_NUMBER_FIELDS of liFile to liRval
49003>>>>>>>>>>>>> function_return liRval
49004>>>>>>>>>>>>>end_function
49005>>>>>>>>>>>>>
49005>>>>>>>>>>>>>// Function DBMS_Relating_Field returns the number of the field in liFile
49005>>>>>>>>>>>>>// that relates to liRelFile. The search for the field is started at field
49005>>>>>>>>>>>>>// number liStartField plus one. If no such field is found 0 is returned.
49005>>>>>>>>>>>>>function DBMS_Relating_Field global integer liFile integer liRelFile integer liStartField returns integer
49007>>>>>>>>>>>>> integer liRval liField liMax lbFin lbTmp
49007>>>>>>>>>>>>> move liStartField to liField
49008>>>>>>>>>>>>> move 0 to lbFin
49009>>>>>>>>>>>>> move 0 to liRval
49010>>>>>>>>>>>>> get_attribute DF_FILE_NUMBER_FIELDS of liFile to liMax
49013>>>>>>>>>>>>> repeat
49013>>>>>>>>>>>>>>
49013>>>>>>>>>>>>> increment liField
49014>>>>>>>>>>>>> if liField gt liMax move 1 to lbFin
49017>>>>>>>>>>>>> ifnot lbFin begin
49019>>>>>>>>>>>>> get_attribute DF_FIELD_RELATED_FILE of liFile liField to lbTmp
49022>>>>>>>>>>>>> if lbTmp eq liRelFile begin
49024>>>>>>>>>>>>> move liField to liRval
49025>>>>>>>>>>>>> move 1 to lbFin
49026>>>>>>>>>>>>> end
49026>>>>>>>>>>>>>>
49026>>>>>>>>>>>>> end
49026>>>>>>>>>>>>>>
49026>>>>>>>>>>>>> until lbFin
49028>>>>>>>>>>>>> function_return liRval
49029>>>>>>>>>>>>>end_function
49030>>>>>>>>>>>>>
49030>>>>>>>>>>>>>function DBMS_CanOpenFile global integer liFile returns integer
49032>>>>>>>>>>>>> integer lbOpen liRval
49032>>>>>>>>>>>>> string lsDriver
49032>>>>>>>>>>>>> move 0 to liRval
49033>>>>>>>>>>>>> get_attribute DF_FILE_OPENED of liFile to lbOpen
49036>>>>>>>>>>>>> if lbOpen begin
49038>>>>>>>>>>>>> ifnot (DBMS_IsOpenedAsFile(liFile)) begin // Return false if file is opened AS
49040>>>>>>>>>>>>> get_attribute DF_FILE_DRIVER of liFile to lsDriver
49043>>>>>>>>>>>>> get DBMS_DriverNameToType lsDriver to liRval
49044>>>>>>>>>>>>> //send obs "DBMS_CanOpenFile" liFile lsDriver liRval
49044>>>>>>>>>>>>> end
49044>>>>>>>>>>>>>>
49044>>>>>>>>>>>>> end
49044>>>>>>>>>>>>>>
49044>>>>>>>>>>>>> else move (DBMS_OpenFile(liFile,DF_SHARE,0)) to liRval
49046>>>>>>>>>>>>> if (liRval and not(lbOpen)) close liFile
49049>>>>>>>>>>>>> function_return liRval
49050>>>>>>>>>>>>>end_function
49051>>>>>>>>>>>>>
49051>>>>>>>>>>>>>function DBMS_CanOpenFileAs global string lsFileName integer liFile returns integer
49053>>>>>>>>>>>>> integer lbOpen liRval
49053>>>>>>>>>>>>> string lsDriver
49053>>>>>>>>>>>>> move 0 to liRval
49054>>>>>>>>>>>>> get_attribute DF_FILE_OPENED of liFile to lbOpen
49057>>>>>>>>>>>>> if lbOpen begin
49059>>>>>>>>>>>>> get_attribute DF_FILE_DRIVER of liFile to lsDriver
49062>>>>>>>>>>>>> get DBMS_DriverNameToType lsDriver to liRval
49063>>>>>>>>>>>>> end
49063>>>>>>>>>>>>>>
49063>>>>>>>>>>>>> else move (DBMS_OpenFileAs(lsFileName,liFile,DF_SHARE,0)) to liRval
49065>>>>>>>>>>>>> if (liRval and not(lbOpen)) close liFile
49068>>>>>>>>>>>>> function_return liRval
49069>>>>>>>>>>>>>end_function
49070>>>>>>>>>>>>>
49070>>>>>>>>>>>>>function DBMS_NextNotOpen global integer liFile returns integer
49072>>>>>>>>>>>>> integer liRval
49072>>>>>>>>>>>>> move 0 to liRval
49073>>>>>>>>>>>>> increment liFile
49074>>>>>>>>>>>>> while (liFile<=DBMS_MaxFileListEntry and liRval=0)
49078>>>>>>>>>>>>> ifnot (DBMS_IsOpenFile(liFile)) move liFile to liRval
49081>>>>>>>>>>>>> increment liFile
49082>>>>>>>>>>>>> end
49083>>>>>>>>>>>>>>
49083>>>>>>>>>>>>> function_return liRval
49084>>>>>>>>>>>>>end_function
49085>>>>>>>>>>>>>
49085>>>>>>>>>>>>>// Filelist Entry Classes
49085>>>>>>>>>>>>>define FLEC_ALL for 1
49085>>>>>>>>>>>>>define FLEC_NOT_BAD for 2
49085>>>>>>>>>>>>>define FLEC_BAD for 4
49085>>>>>>>>>>>>>define FLEC_NO_ALIAS for 8
49085>>>>>>>>>>>>>define FLEC_EMPTY for 10
49085>>>>>>>>>>>>>define FLEC_EMPTY_NOT_OPEN for 11
49085>>>>>>>>>>>>>
49085>>>>>>>>>>>>>procedure DBMS_Callback_FilelistEntries global integer liFlec integer liMsg integer lhObj
49087>>>>>>>>>>>>> integer liFile lbOk
49087>>>>>>>>>>>>> string lsRoot lsRootNames
49087>>>>>>>>>>>>> if (liFlec=FLEC_EMPTY or liFlec=FLEC_EMPTY_NOT_OPEN) begin
49089>>>>>>>>>>>>> repeat
49089>>>>>>>>>>>>>>
49089>>>>>>>>>>>>> get_attribute DF_FILE_NEXT_EMPTY of liFile to liFile
49092>>>>>>>>>>>>> if liFile begin
49094>>>>>>>>>>>>> if (liFlec=FLEC_EMPTY_NOT_OPEN) begin
49096>>>>>>>>>>>>> get_attribute DF_FILE_OPENED of liFile to lbOK
49099>>>>>>>>>>>>> move (not(lbOK)) to lbOK
49100>>>>>>>>>>>>> end
49100>>>>>>>>>>>>>>
49100>>>>>>>>>>>>> else move 1 to lbOK
49102>>>>>>>>>>>>> if lbOk send liMsg to lhObj liFile
49105>>>>>>>>>>>>> end
49105>>>>>>>>>>>>>>
49105>>>>>>>>>>>>> until liFile eq 0
49107>>>>>>>>>>>>> end
49107>>>>>>>>>>>>>>
49107>>>>>>>>>>>>> else begin
49108>>>>>>>>>>>>> move " " to lsRootNames
49109>>>>>>>>>>>>> move 0 to liFile
49110>>>>>>>>>>>>> repeat
49110>>>>>>>>>>>>>>
49110>>>>>>>>>>>>> get_attribute DF_FILE_NEXT_USED of liFile to liFile
49113>>>>>>>>>>>>> if liFile begin
49115>>>>>>>>>>>>> move 1 to lbOk
49116>>>>>>>>>>>>> ifnot (liFlec iand FLEC_ALL) begin
49118>>>>>>>>>>>>> ifnot (liFlec iand FLEC_BAD ) move (DBMS_CanOpenFile(liFile)) to lbOk
49121>>>>>>>>>>>>> ifnot (liFlec iand FLEC_NOT_BAD) move (not(DBMS_CanOpenFile(liFile))) to lbOk
49124>>>>>>>>>>>>> end
49124>>>>>>>>>>>>>>
49124>>>>>>>>>>>>> if lbOk begin
49126>>>>>>>>>>>>> if (liFlec iand FLEC_NO_ALIAS) begin
49128>>>>>>>>>>>>> get_attribute DF_FILE_ROOT_NAME of liFile to lsRoot
49131>>>>>>>>>>>>> move (lowercase(lsRoot)) to lsRoot
49132>>>>>>>>>>>>> if (" "+lsRoot+" ") in lsRootNames move 0 to lbOk
49135>>>>>>>>>>>>> else move (lsRootNames+lsRoot+" ") to lsRootNames
49137>>>>>>>>>>>>> end
49137>>>>>>>>>>>>>>
49137>>>>>>>>>>>>> if lbOk send liMsg to lhObj liFile
49140>>>>>>>>>>>>> end
49140>>>>>>>>>>>>>>
49140>>>>>>>>>>>>> end
49140>>>>>>>>>>>>>>
49140>>>>>>>>>>>>> until liFile eq 0
49142>>>>>>>>>>>>> end
49142>>>>>>>>>>>>>>
49142>>>>>>>>>>>>>end_procedure
49143>>>>>>>>>>>>>
49143>>>>>>>>>>>>>procedure DBMS_CallBack_FileFields global integer liFile integer liMsg integer lhObj
49145>>>>>>>>>>>>> integer liType liLen liDec liRelFile liRelField liOffset liField liMax liIdx
49145>>>>>>>>>>>>> string lsName
49145>>>>>>>>>>>>> get_attribute DF_FILE_NUMBER_FIELDS of liFile to liMax
49148>>>>>>>>>>>>> for liField from 1 to liMax
49154>>>>>>>>>>>>>>
49154>>>>>>>>>>>>> get_attribute DF_FIELD_NAME of liFile liField to lsName
49157>>>>>>>>>>>>> get_attribute DF_FIELD_TYPE of liFile liField to liType
49160>>>>>>>>>>>>> get_attribute DF_FIELD_LENGTH of liFile liField to liLen
49163>>>>>>>>>>>>> get_attribute DF_FIELD_PRECISION of liFile liField to liDec
49166>>>>>>>>>>>>> get_attribute DF_FIELD_INDEX of liFile liField to liIdx
49169>>>>>>>>>>>>> get_attribute DF_FIELD_RELATED_FILE of liFile liField to liRelFile
49172>>>>>>>>>>>>> get_attribute DF_FIELD_RELATED_FIELD of liFile liField to liRelField
49175>>>>>>>>>>>>> get_attribute DF_FIELD_OFFSET of liFile liField to liOffset
49178>>>>>>>>>>>>> send liMsg to lhObj liFile liField lsName liType liLen liDec liIdx liRelFile liRelField liOffset
49179>>>>>>>>>>>>> loop
49180>>>>>>>>>>>>>>
49180>>>>>>>>>>>>>end_procedure
49181>>>>>>>>>>>>>
49181>>>>>>>>>>>>>function DBMS_GetFieldNumber global integer liFile integer liField returns integer
49183>>>>>>>>>>>>> function_return liField
49184>>>>>>>>>>>>>end_function
49185>>>>>>>>>>>>>
49185>>>>>>>>>>>>>function DBMS_EraseDfFile global integer liFile string lsRoot returns integer
49187>>>>>>>>>>>>> integer liRval
49187>>>>>>>>>>>>> string lsDatFile lsPath
49187>>>>>>>>>>>>> if liFile get_attribute DF_FILE_ROOT_NAME of liFile to lsRoot
49192>>>>>>>>>>>>> move (lowercase(lsRoot)) to lsRoot
49193>>>>>>>>>>>>> move (lsRoot+".dat") to lsDatFile
49194>>>>>>>>>>>>> move (SEQ_FindFileAlongDFPath(lsDatFile)) to lsPath
49195>>>>>>>>>>>>> get Files_AppendPath lsPath lsRoot to lsRoot
49196>>>>>>>>>>>>>
49196>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".dat") to liRval
49197>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".tag") to liRval
49198>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".vld") to liRval
49199>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".hdr") to liRval
49200>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".k1") to liRval
49201>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".k2") to liRval
49202>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".k3") to liRval
49203>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".k4") to liRval
49204>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".k5") to liRval
49205>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".k6") to liRval
49206>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".k7") to liRval
49207>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".k8") to liRval
49208>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".k9") to liRval
49209>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".k10") to liRval
49210>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".k11") to liRval
49211>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".k12") to liRval
49212>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".k13") to liRval
49213>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".k14") to liRval
49214>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".k15") to liRval
49215>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".def") to liRval
49216>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".fd") to liRval
49217>>>>>>>>>>>>> function_return 1
49218>>>>>>>>>>>>>end_function
49219>>>>>>>>>>>>>
49219>>>>>>>>>>>>>//> Sets a field to its highest possible value
49219>>>>>>>>>>>>>procedure DBMS_SetFieldValueMax global integer liFile integer liField
49221>>>>>>>>>>>>> integer liType liLen liDecs
49221>>>>>>>>>>>>> number lnValue
49221>>>>>>>>>>>>> string lsChar lsValue
49221>>>>>>>>>>>>> get_attribute DF_FIELD_TYPE of liFile liField to liType
49224>>>>>>>>>>>>> if (liType=DF_DATE) set_field_value liFile liField to LargestPossibleDate
49229>>>>>>>>>>>>> else begin
49230>>>>>>>>>>>>> get_attribute DF_FIELD_LENGTH of liFile liField to liLen
49233>>>>>>>>>>>>> if (liType=DF_ASCII) begin
49235>>>>>>>>>>>>> move (left(trim(gs$CollateString),1)) to lsChar // Highest possible collating value
49236>>>>>>>>>>>>> set_field_value liFile liField to (repeat(lsChar,liLen))
49239>>>>>>>>>>>>> end
49239>>>>>>>>>>>>>>
49239>>>>>>>>>>>>> if (liType=DF_BCD) begin
49241>>>>>>>>>>>>> get_attribute DF_FIELD_PRECISION of liFile liField to liDecs
49244>>>>>>>>>>>>> move (liLen-liDecs) to liLen
49245>>>>>>>>>>>>> if liDecs move (repeat("9",liLen)+CurrentDecimalSeparator()+repeat("9",liDecs)) to lsValue
49248>>>>>>>>>>>>> else move (repeat("9",liLen)) to lsValue
49250>>>>>>>>>>>>> move lsValue to lnValue
49251>>>>>>>>>>>>> set_field_value liFile liField to lnValue
49254>>>>>>>>>>>>> end
49254>>>>>>>>>>>>>>
49254>>>>>>>>>>>>> end
49254>>>>>>>>>>>>>>
49254>>>>>>>>>>>>>end_procedure
49255>>>>>>>>>>>>>
49255>>>>>>>>>>>>>//> Sets a field to its lowest possible value
49255>>>>>>>>>>>>>procedure DBMS_SetFieldValueMin global integer liFile integer liField
49257>>>>>>>>>>>>> integer liType liLen liDecs
49257>>>>>>>>>>>>> number lnValue
49257>>>>>>>>>>>>> string lsChar lsValue
49257>>>>>>>>>>>>> get_attribute DF_FIELD_TYPE of liFile liField to liType
49260>>>>>>>>>>>>> if (liType=DF_DATE) set_field_value liFile liField to 0
49265>>>>>>>>>>>>> else begin
49266>>>>>>>>>>>>> get_attribute DF_FIELD_LENGTH of liFile liField to liLen
49269>>>>>>>>>>>>> if (liType=DF_ASCII) begin
49271>>>>>>>>>>>>> set_field_value liFile liField to (repeat(" ",liLen))
49274>>>>>>>>>>>>> end
49274>>>>>>>>>>>>>>
49274>>>>>>>>>>>>> if (liType=DF_BCD) begin
49276>>>>>>>>>>>>> if liField begin // Not RECNUM
49278>>>>>>>>>>>>> get_attribute DF_FIELD_PRECISION of liFile liField to liDecs
49281>>>>>>>>>>>>> move (liLen-liDecs) to liLen
49282>>>>>>>>>>>>> decrement liLen
49283>>>>>>>>>>>>> if liDecs move ("-"+repeat("9",liLen)+CurrentDecimalSeparator()+repeat("9",liDecs)) to lsValue
49286>>>>>>>>>>>>> else move ("-"+repeat("9",liLen)) to lsValue
49288>>>>>>>>>>>>> move lsValue to lnValue
49289>>>>>>>>>>>>> set_field_value liFile liField to lnValue
49292>>>>>>>>>>>>> end
49292>>>>>>>>>>>>>>
49292>>>>>>>>>>>>> else set_field_value liFile liField to 0 // If RECNUM field
49296>>>>>>>>>>>>> end
49296>>>>>>>>>>>>>>
49296>>>>>>>>>>>>> end
49296>>>>>>>>>>>>>>
49296>>>>>>>>>>>>>end_procedure
49297>>>>>>>>>>>>>
49297>>>>>>>>>>>>>procedure DBMS_FindByRecnum global integer liFile integer liRecnum
49299>>>>>>>>>>>>> clear liFile
49300>>>>>>>>>>>>> if liRecnum begin
49302>>>>>>>>>>>>> set_field_value liFile 0 to liRecnum
49305>>>>>>>>>>>>> vfind liFile 0 EQ
49307>>>>>>>>>>>>> end
49307>>>>>>>>>>>>>>
49307>>>>>>>>>>>>>end_procedure
49308>>>>>>>>>>>>>
49308>>>>>>>>>>>>>
49308>>>>>>>>>>>Use AppFolders.nui // Function AppFolder returns the absolute folder name of strategic folders
Including file: AppFolders.nui (C:\Apps\VDFQuery\AppSrc\AppFolders.nui)
49308>>>>>>>>>>>>>// Use AppFolders.nui // Function AppFolder returns the absolute folder name of strategic folders
49308>>>>>>>>>>>>>//
49308>>>>>>>>>>>>>// Not very sophisticated! Everything is based on the location of filelist.cfg. Should really
49308>>>>>>>>>>>>>// examine the -ws file. Well, let's see how VDF 12 works before exhausting ourselves.
49308>>>>>>>>>>>>>
49308>>>>>>>>>>>>>use files.nui
49308>>>>>>>>>>>>>
49308>>>>>>>>>>>>>enumeration_list
49308>>>>>>>>>>>>> define APPFOLDER_HTML
49308>>>>>>>>>>>>> define APPFOLDER_FILELIST
49308>>>>>>>>>>>>> define APPFOLDER_PROGRAM
49308>>>>>>>>>>>>> define APPFOLDER_VDF_ROOT
49308>>>>>>>>>>>>> define APPFOLDER_MAX
49308>>>>>>>>>>>>>end_enumeration_list
49308>>>>>>>>>>>>>
49308>>>>>>>>>>>>>
49308>>>>>>>>>>>>>function AppFolder global integer liWhich returns string
49310>>>>>>>>>>>>> string lsValue
49310>>>>>>>>>>>>> if (liWhich=APPFOLDER_VDF_ROOT) begin // VDF Root dir
49312>>>>>>>>>>>>> get_profile_string "Defaults" "VdfRootDir" To lsValue
49315>>>>>>>>>>>>> end
49315>>>>>>>>>>>>>>
49315>>>>>>>>>>>>> if (liWhich=APPFOLDER_FILELIST) begin // Filelist.cfg
49317>>>>>>>>>>>>> get SEQ_FindFileAlongDFPath "filelist.cfg" to lsValue
49318>>>>>>>>>>>>> end
49318>>>>>>>>>>>>>>
49318>>>>>>>>>>>>> if (liWhich=APPFOLDER_PROGRAM) begin // Filelist.cfg
49320>>>>>>>>>>>>> get appfolder APPFOLDER_FILELIST to lsValue
49321>>>>>>>>>>>>> get SEQ_ExtractPathFromFileName lsValue to lsValue
49322>>>>>>>>>>>>> get Files_AppendPath lsValue "Programs" to lsValue
49323>>>>>>>>>>>>> end
49323>>>>>>>>>>>>>>
49323>>>>>>>>>>>>> if (liWhich=APPFOLDER_HTML) begin // Filelist.cfg
49325>>>>>>>>>>>>> get appfolder APPFOLDER_FILELIST to lsValue
49326>>>>>>>>>>>>> get SEQ_ExtractPathFromFileName lsValue to lsValue
49327>>>>>>>>>>>>> get Files_AppendPath lsValue "AppHtml" to lsValue
49328>>>>>>>>>>>>> end
49328>>>>>>>>>>>>>>
49328>>>>>>>>>>>>> function_return lsValue
49329>>>>>>>>>>>>>end_function
49330>>>>>>>>>>>>>
49330>>>>>>>>>>>>>function AppSubFolder global integer liWhich string lsSubFolder returns string
49332>>>>>>>>>>>>> string lsValue
49332>>>>>>>>>>>>> get AppFolder liWhich to lsValue
49333>>>>>>>>>>>>> get Files_AppendPath lsValue lsSubFolder to lsValue
49334>>>>>>>>>>>>> function_return lsValue
49335>>>>>>>>>>>>>end_function
49336>>>>>>>>>>>>>
49336>>>>>>>>>>>>>// Translate absolute disk folder (or file) into relative HTML folder (or file).
49336>>>>>>>>>>>>>function AppFolder_DiskToHtml global string lsDiskFolder returns string
49338>>>>>>>>>>>>> string lsHtmlRootFolder lsRelativeFolder
49338>>>>>>>>>>>>> get AppFolder APPFOLDER_HTML to lsHtmlRootFolder
49339>>>>>>>>>>>>> move (lowercase(lsDiskFolder)) to lsDiskFolder
49340>>>>>>>>>>>>> move (lowercase(lsHtmlRootFolder)) to lsHtmlRootFolder
49341>>>>>>>>>>>>> move (replace(lsHtmlRootFolder,lsDiskFolder,"")) to lsRelativeFolder
49342>>>>>>>>>>>>>
49342>>>>>>>>>>>>> if (left(lsRelativeFolder,1)="\") move (replace("\",lsRelativeFolder,"")) to lsRelativeFolder
49345>>>>>>>>>>>>> move (replaces("\",lsRelativeFolder,"/")) to lsRelativeFolder
49346>>>>>>>>>>>>> function_return lsRelativeFolder
49347>>>>>>>>>>>>>end_function
49348>>>>>>>>>>>enumeration_list // Global read only attributes from sysconf and other (OA = Other Attributes)
49348>>>>>>>>>>> define OA_REG_NAME
49348>>>>>>>>>>> define OA_SERIAL_NUMBER
49348>>>>>>>>>>> define OA_MAX_USERS
49348>>>>>>>>>>> define OA_DATAFLEX_REV
49348>>>>>>>>>>> define OA_OS_SHORT_NAME
49348>>>>>>>>>>> define OA_OS_MAJOR_REV
49348>>>>>>>>>>> define OA_OS_MINOR_REV
49348>>>>>>>>>>> define OA_OS_NAME
49348>>>>>>>>>>> define OA_MACHINE_NAME
49348>>>>>>>>>>> define OA_WORKDIR
49348>>>>>>>>>>> define OA_PATH
49348>>>>>>>>>>> define OA_DIR_SEPARATOR // "/" or "\"
49348>>>>>>>>>>> define OA_FILE_MASK
49348>>>>>>>>>>> define OA_SYSTEM_NAME
49348>>>>>>>>>>> define OA_PATH_SEPARATOR // ":" or ";"
49348>>>>>>>>>>> define OA_DATE4_STATE
49348>>>>>>>>>>> define OA_SYSDATE4_STATE
49348>>>>>>>>>>> define OA_EPOCH_VALUE
49348>>>>>>>>>>> define OA_TIMER_RESOLUTION
49348>>>>>>>>>>> define OA_COLLATE_PATH // Path to COLLATE.CFG (excluding the file name itself)
49348>>>>>>>>>>> define OA_COLLATE_SIZE // Size of COLLATE.CFG in bytes
49348>>>>>>>>>>> define OA_COLLATE_TIME // Time stamp of COLLATE.CFG in TS-number format (see DATES.UTL)
49348>>>>>>>>>>> define OA_RUNTIME_NAME // SYSCONF_RUNTIME_NAME
49348>>>>>>>>>>> define OA_UTC_TIME_OFFSET // SYSCONF_UTC_TIME_OFFSET
49348>>>>>>>>>>> define OA_MAX_ARGUMENT_SIZE
49348>>>>>>>>>>> define OA_CURRENT_USER_COUNT
49348>>>>>>>>>>> define OA_DFPRINTER
49348>>>>>>>>>>> define OA_LOCK_COUNT
49348>>>>>>>>>>>
49348>>>>>>>>>>> define OA_FOLDER_VDF_ROOT
49348>>>>>>>>>>> define OA_FOLDER_FILELIST
49348>>>>>>>>>>> define OA_FOLDER_HTML
49348>>>>>>>>>>> define OA_FOLDER_PROGRAM
49348>>>>>>>>>>>
49348>>>>>>>>>>> define OA_MAX // Pointer to highest OA index+1 (formerly OA_PATH_MAX)
49348>>>>>>>>>>>end_enumeration_list
49348>>>>>>>>>>>
49348>>>>>>>>>>>enumeration_list // Enumerate attribute types
49348>>>>>>>>>>> define ATTRTYPE_NONE // Not an attribute type
49348>>>>>>>>>>> define ATTRTYPE_GLOBAL // No parameters
49348>>>>>>>>>>> define ATTRTYPE_DRIVER // 1: Driver number
49348>>>>>>>>>>> define ATTRTYPE_DRVSRV // 1: Driver number 2: Server number
49348>>>>>>>>>>> define ATTRTYPE_FILELIST // 1: File (No changes to structure, filelist only)
49348>>>>>>>>>>> define ATTRTYPE_FILE // 1: File
49348>>>>>>>>>>> define ATTRTYPE_FIELD // 1: File 2: Field
49348>>>>>>>>>>> define ATTRTYPE_INDEX // 1: File 2: Index
49348>>>>>>>>>>> define ATTRTYPE_IDXSEG // 1: File 2: Index 3: Segment
49348>>>>>>>>>>> define ATTRTYPE_SPECIAL1 // 1: File 2/3: Field/Field (overlap check)
49348>>>>>>>>>>> define ATTRTYPE_FLSTNAV // 1: File (for navigating filelist)
49348>>>>>>>>>>>end_enumeration_list
49348>>>>>>>>>>>
49348>>>>>>>>>>>desktop_section // Compile as if on desktop
49353>>>>>>>>>>> object oAPI_AttributeTypes is a cArray no_image
49355>>>>>>>>>>> item_property_list
49355>>>>>>>>>>> item_property string psName.i
49355>>>>>>>>>>> item_property integer piParams.i // Number of parameters (DFScript feature)
49355>>>>>>>>>>> end_item_property_list
#REM 49392 DEFINE FUNCTION PIPARAMS.I INTEGER LIROW RETURNS INTEGER
#REM 49397 DEFINE PROCEDURE SET PIPARAMS.I INTEGER LIROW INTEGER VALUE
#REM 49402 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 49407 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
49413>>>>>>>>>>> procedure DefAttrType integer type# string name# integer params#
49416>>>>>>>>>>> set psName.i type# to name#
49417>>>>>>>>>>> set piParams.i type# to params#
49418>>>>>>>>>>> end_procedure // Number of parametersŽŽ
49419>>>>>>>>>>> send DefAttrType ATTRTYPE_GLOBAL "Global" 0
49420>>>>>>>>>>> send DefAttrType ATTRTYPE_DRIVER "Driver" 1
49421>>>>>>>>>>> send DefAttrType ATTRTYPE_DRVSRV "Server" 2
49422>>>>>>>>>>> send DefAttrType ATTRTYPE_FILELIST "Filelist" 1
49423>>>>>>>>>>> send DefAttrType ATTRTYPE_FILE "File" 1
49424>>>>>>>>>>> send DefAttrType ATTRTYPE_FIELD "Field" 2
49425>>>>>>>>>>> send DefAttrType ATTRTYPE_INDEX "Index" 2
49426>>>>>>>>>>> send DefAttrType ATTRTYPE_IDXSEG "Index segment" 3
49427>>>>>>>>>>> send DefAttrType ATTRTYPE_SPECIAL1 "Special1" 3
49428>>>>>>>>>>> send DefAttrType ATTRTYPE_FLSTNAV "Filelist navigation" 1
49429>>>>>>>>>>> end_object
49430>>>>>>>>>>> class cAPI_AttrValueArray is a cArray
49431>>>>>>>>>>> item_property_list
49431>>>>>>>>>>> item_property integer piValue.i // Actual value
49431>>>>>>>>>>> item_property string psCodeName.i // Value as written in code
49431>>>>>>>>>>> item_property string psDisplayName.i // Value as presented to an unknowing user
49431>>>>>>>>>>> end_item_property_list cAPI_AttrValueArray
#REM 49466 DEFINE FUNCTION PSDISPLAYNAME.I INTEGER LIROW RETURNS STRING
#REM 49470 DEFINE PROCEDURE SET PSDISPLAYNAME.I INTEGER LIROW STRING VALUE
#REM 49474 DEFINE FUNCTION PSCODENAME.I INTEGER LIROW RETURNS STRING
#REM 49478 DEFINE PROCEDURE SET PSCODENAME.I INTEGER LIROW STRING VALUE
#REM 49482 DEFINE FUNCTION PIVALUE.I INTEGER LIROW RETURNS INTEGER
#REM 49486 DEFINE PROCEDURE SET PIVALUE.I INTEGER LIROW INTEGER VALUE
49491>>>>>>>>>>> procedure add_value integer value# string codename# string displayname#
49493>>>>>>>>>>> integer row#
49493>>>>>>>>>>> get row_count to row#
49494>>>>>>>>>>> set piValue.i row# to value#
49495>>>>>>>>>>> set psCodeName.i row# to codename#
49496>>>>>>>>>>> set psDisplayName.i row# to displayname#
49497>>>>>>>>>>> end_procedure
49498>>>>>>>>>>> function iValue2Row.i integer value# returns integer
49500>>>>>>>>>>> integer row# max#
49500>>>>>>>>>>> get row_count to max#
49501>>>>>>>>>>> for row# from 0 to (max#-1)
49507>>>>>>>>>>>>
49507>>>>>>>>>>> if (piValue.i(self,row#)) eq value# function_return row#
49510>>>>>>>>>>> loop
49511>>>>>>>>>>>>
49511>>>>>>>>>>> function_return -1
49512>>>>>>>>>>> end_function
49513>>>>>>>>>>> end_class // cAPI_AttrValueArray
49514>>>>>>>>>>> object oAPI_Attributes is a cArray no_image
49516>>>>>>>>>>> item_property_list
49516>>>>>>>>>>> item_property string psName.i
49516>>>>>>>>>>> item_property integer piAttrType.i // Attribute type
49516>>>>>>>>>>> item_property string psDisplayName.i // Attribute display name
49516>>>>>>>>>>> item_property integer piWrite.i // Write access?
49516>>>>>>>>>>> item_property integer piOnlyDAC.i // Internal DAC use
49516>>>>>>>>>>> item_property integer piValueType.i // DF_BCD or DF_ASCII
49516>>>>>>>>>>> item_property integer piValueArray.i // Legal values
49516>>>>>>>>>>> item_property integer piRuntimeOnly.i // Runtime only attribute (FILE attr)
49516>>>>>>>>>>> end_item_property_list
#REM 49571 DEFINE FUNCTION PIRUNTIMEONLY.I INTEGER LIROW RETURNS INTEGER
#REM 49576 DEFINE PROCEDURE SET PIRUNTIMEONLY.I INTEGER LIROW INTEGER VALUE
#REM 49581 DEFINE FUNCTION PIVALUEARRAY.I INTEGER LIROW RETURNS INTEGER
#REM 49586 DEFINE PROCEDURE SET PIVALUEARRAY.I INTEGER LIROW INTEGER VALUE
#REM 49591 DEFINE FUNCTION PIVALUETYPE.I INTEGER LIROW RETURNS INTEGER
#REM 49596 DEFINE PROCEDURE SET PIVALUETYPE.I INTEGER LIROW INTEGER VALUE
#REM 49601 DEFINE FUNCTION PIONLYDAC.I INTEGER LIROW RETURNS INTEGER
#REM 49606 DEFINE PROCEDURE SET PIONLYDAC.I INTEGER LIROW INTEGER VALUE
#REM 49611 DEFINE FUNCTION PIWRITE.I INTEGER LIROW RETURNS INTEGER
#REM 49616 DEFINE PROCEDURE SET PIWRITE.I INTEGER LIROW INTEGER VALUE
#REM 49621 DEFINE FUNCTION PSDISPLAYNAME.I INTEGER LIROW RETURNS STRING
#REM 49626 DEFINE PROCEDURE SET PSDISPLAYNAME.I INTEGER LIROW STRING VALUE
#REM 49631 DEFINE FUNCTION PIATTRTYPE.I INTEGER LIROW RETURNS INTEGER
#REM 49636 DEFINE PROCEDURE SET PIATTRTYPE.I INTEGER LIROW INTEGER VALUE
#REM 49641 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 49646 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
49652>>>>>>>>>>>
49652>>>>>>>>>>> procedure callback_attrtype.iii integer attrtype# integer msg# integer lhObj
49655>>>>>>>>>>> integer max# attr#
49655>>>>>>>>>>> get row_count to max#
49656>>>>>>>>>>> for attr# from 0 to (max#-1)
49662>>>>>>>>>>>>
49662>>>>>>>>>>> if (piAttrType.i(self,attr#)=attrtype#) send msg# to lhObj attr#
49665>>>>>>>>>>> loop
49666>>>>>>>>>>>>
49666>>>>>>>>>>> end_procedure
49667>>>>>>>>>>>
49667>>>>>>>>>>> procedure callback_attrvalue.iii integer attr# integer msg# integer lhObj
49670>>>>>>>>>>> integer arr# max# row#
49670>>>>>>>>>>> get piValueArray.i attr# to arr#
49671>>>>>>>>>>> if arr# begin
49673>>>>>>>>>>> get row_count of arr# to max#
49674>>>>>>>>>>> for row# from 0 to (max#-1)
49680>>>>>>>>>>>>
49680>>>>>>>>>>> send msg# to lhObj (piValue.i(arr#,row#)) (psCodeName.i(arr#,row#)) (psDisplayName.i(arr#,row#))
49681>>>>>>>>>>> loop
49682>>>>>>>>>>>>
49682>>>>>>>>>>> end
49682>>>>>>>>>>>>
49682>>>>>>>>>>> end_procedure
49683>>>>>>>>>>>
49683>>>>>>>>>>> function iAttrValueArrayObj integer attr# returns integer
49686>>>>>>>>>>> integer rval#
49686>>>>>>>>>>> get piValueArray.i attr# to rval#
49687>>>>>>>>>>> ifnot rval# begin
49689>>>>>>>>>>> object oAPI_AttrValueArray is a cAPI_AttrValueArray no_image
49691>>>>>>>>>>> move self to rval#
49692>>>>>>>>>>> end_object
49693>>>>>>>>>>> set piValueArray.i attr# to rval#
49694>>>>>>>>>>> end
49694>>>>>>>>>>>>
49694>>>>>>>>>>> function_return rval#
49695>>>>>>>>>>> end_function
49696>>>>>>>>>>>
49696>>>>>>>>>>> procedure AddAttrValue integer attr# integer value# string codename# string displayname#
49699>>>>>>>>>>> integer lhObj
49699>>>>>>>>>>> get iAttrValueArrayObj attr# to lhObj
49700>>>>>>>>>>> send add_value to lhObj value# codename# displayname#
49701>>>>>>>>>>> end_procedure
49702>>>>>>>>>>>
49702>>>>>>>>>>> send AddAttrValue DF_FIELD_TYPE DF_ASCII "DF_ASCII" "Ascii"
49703>>>>>>>>>>> send AddAttrValue DF_FIELD_TYPE DF_BCD "DF_BCD" "Bcd"
49704>>>>>>>>>>> send AddAttrValue DF_FIELD_TYPE DF_DATE "DF_DATE" "Date"
49705>>>>>>>>>>> send AddAttrValue DF_FIELD_TYPE DF_OVERLAP "DF_OVERLAP" "Overlap"
49706>>>>>>>>>>> send AddAttrValue DF_FIELD_TYPE DF_TEXT "DF_TEXT" "Text"
49707>>>>>>>>>>> send AddAttrValue DF_FIELD_TYPE DF_BINARY "DF_BINARY" "Binary"
49708>>>>>>>>>>>
49708>>>>>>>>>>> send AddAttrValue DF_FILE_HANDLE_TYPE DF_FILE_HANDLE_BAD "DF_FILE_HANDLE_BAD" "Bad"
49709>>>>>>>>>>> send AddAttrValue DF_FILE_HANDLE_TYPE DF_FILE_HANDLE_CLOSED "DF_FILE_HANDLE_CLOSED" "Closed"
49710>>>>>>>>>>> send AddAttrValue DF_FILE_HANDLE_TYPE DF_FILE_HANDLE_OPENED "DF_FILE_HANDLE_OPENED" "Opened"
49711>>>>>>>>>>> send AddAttrValue DF_FILE_HANDLE_TYPE DF_FILE_HANDLE_EXISTING_RESTRUCTURE "DF_FILE_HANDLE_EXISTING_RESTRUCTURE" "Existing restructure"
49712>>>>>>>>>>> send AddAttrValue DF_FILE_HANDLE_TYPE DF_FILE_HANDLE_NEW_RESTRUCTURE "DF_FILE_HANDLE_NEW_RESTRUCTURE" "New restructure"
49713>>>>>>>>>>>
49713>>>>>>>>>>> send AddAttrValue DF_DATE_FORMAT DF_DATE_USA "DF_DATE_USA" "USA (mm/dd/yyyy)"
49714>>>>>>>>>>> send AddAttrValue DF_DATE_FORMAT DF_DATE_EUROPEAN "DF_DATE_EUROPEAN" "European (dd/mm/yyyy)"
49715>>>>>>>>>>> send AddAttrValue DF_DATE_FORMAT DF_DATE_MILITARY "DF_DATE_MILITARY" "Military (yyyy/mm/dd)"
49716>>>>>>>>>>>
49716>>>>>>>>>>> send AddAttrValue DF_FILE_LOCK_TYPE DF_LOCK_TYPE_NONE "DF_LOCK_TYPE_NONE" "None"
49717>>>>>>>>>>> send AddAttrValue DF_FILE_LOCK_TYPE DF_LOCK_TYPE_FILE "DF_LOCK_TYPE_FILE" "File"
49718>>>>>>>>>>> send AddAttrValue DF_FILE_LOCK_TYPE DF_LOCK_TYPE_RECORD "DF_LOCK_TYPE_RECORD" "Record"
49719>>>>>>>>>>>
49719>>>>>>>>>>> send AddAttrValue DF_FILE_OPEN_MODE DF_SHARE "DF_SHARE" "Share"
49720>>>>>>>>>>> send AddAttrValue DF_FILE_OPEN_MODE DF_EXCLUSIVE "DF_EXCLUSIVE" "Exclusive"
49721>>>>>>>>>>>
49721>>>>>>>>>>> send AddAttrValue DF_FILE_COMPRESSION DF_FILE_COMPRESS_NONE "DF_FILE_COMPRESS_NONE" "None"
49722>>>>>>>>>>> send AddAttrValue DF_FILE_COMPRESSION DF_FILE_COMPRESS_FAST "DF_FILE_COMPRESS_FAST" "Fast"
49723>>>>>>>>>>> send AddAttrValue DF_FILE_COMPRESSION DF_FILE_COMPRESS_STANDARD "DF_FILE_COMPRESS_STANDARD" "Standard"
49724>>>>>>>>>>> send AddAttrValue DF_FILE_COMPRESSION DF_FILE_COMPRESS_CUSTOM "DF_FILE_COMPRESS_CUSTOM" "Custom"
49725>>>>>>>>>>>
49725>>>>>>>>>>> send AddAttrValue DF_FILE_TRANSACTION DF_FILE_TRANSACTION_NONE "DF_FILE_TRANSACTION_NONE" "None"
49726>>>>>>>>>>> send AddAttrValue DF_FILE_TRANSACTION DF_FILE_TRANSACTION_CLIENT_ATOMIC "DF_FILE_TRANSACTION_CLIENT_ATOMIC" "Client atomic"
49727>>>>>>>>>>> send AddAttrValue DF_FILE_TRANSACTION DF_FILE_TRANSACTION_SERVER_ATOMIC "DF_FILE_TRANSACTION_SERVER_ATOMIC" "Server atomic"
49728>>>>>>>>>>> send AddAttrValue DF_FILE_TRANSACTION DF_FILE_TRANSACTION_SERVER_LOGGED "DF_FILE_TRANSACTION_SERVER_LOGGED" "Server logged"
49729>>>>>>>>>>>
49729>>>>>>>>>>> send AddAttrValue DF_FILE_STATUS DF_FILE_INACTIVE "DF_FILE_INACTIVE" "Inactive"
49730>>>>>>>>>>> send AddAttrValue DF_FILE_STATUS DF_FILE_ACTIVE "DF_FILE_ACTIVE" "Active"
49731>>>>>>>>>>> send AddAttrValue DF_FILE_STATUS DF_FILE_ACTIVE_CHANGED "DF_FILE_ACTIVE_CHANGED" "Changed"
49732>>>>>>>>>>>
49732>>>>>>>>>>> send AddAttrValue DF_FILE_COMMITTED DFTRUE "DFTRUE" "True"
49733>>>>>>>>>>> send AddAttrValue DF_FILE_COMMITTED DFFALSE "DFFALSE" "False"
49734>>>>>>>>>>>
49734>>>>>>>>>>> send AddAttrValue DF_FILE_RESTRUCTURE DF_NO_RESTRUCTURE "DF_NO_RESTRUCTURE" "None"
49735>>>>>>>>>>> send AddAttrValue DF_FILE_RESTRUCTURE DF_RESTRUCTURE_FILE "DF_RESTRUCTURE_FILE" "File"
49736>>>>>>>>>>> send AddAttrValue DF_FILE_RESTRUCTURE DF_RESTRUCTURE_INDEX "DF_RESTRUCTURE_INDEX" "Index"
49737>>>>>>>>>>> send AddAttrValue DF_FILE_RESTRUCTURE DF_RESTRUCTURE_BOTH "DF_RESTRUCTURE_BOTH" "File/Index"
49738>>>>>>>>>>>
49738>>>>>>>>>>> send AddAttrValue DF_FILE_MULTIUSER DF_FILE_USER_SINGLE "DF_FILE_USER_SINGLE" "Single user"
49739>>>>>>>>>>> send AddAttrValue DF_FILE_MULTIUSER DF_FILE_USER_MULTI "DF_FILE_USER_MULTI" "Multi user"
49740>>>>>>>>>>>
49740>>>>>>>>>>> send AddAttrValue DF_FILE_MODE DF_FILE_ALIAS_DEFAULT "DF_FILE_ALIAS_DEFAULT" "Default"
49741>>>>>>>>>>> send AddAttrValue DF_FILE_MODE DF_FILE_IS_MASTER "DF_FILE_IS_MASTER" "Master"
49742>>>>>>>>>>> send AddAttrValue DF_FILE_MODE DF_FILE_IS_ALIAS "DF_FILE_IS_ALIAS" "Alias"
49743>>>>>>>>>>>
49743>>>>>>>>>>> send AddAttrValue DF_FILE_REUSE_DELETED DF_FILE_DELETED_NOREUSE "DF_FILE_DELETED_NOREUSE" "No reuse"
49744>>>>>>>>>>> send AddAttrValue DF_FILE_REUSE_DELETED DF_FILE_DELETED_REUSE "DF_FILE_DELETED_REUSE" "Reuse"
49745>>>>>>>>>>>
49745>>>>>>>>>>> send AddAttrValue DF_FILE_INTEGRITY_CHECK DFTRUE "DFTRUE" "True"
49746>>>>>>>>>>> send AddAttrValue DF_FILE_INTEGRITY_CHECK DFFALSE "DFFALSE" "False"
49747>>>>>>>>>>>
49747>>>>>>>>>>> send AddAttrValue DF_INDEX_TYPE DF_INDEX_TYPE_ONLINE "DF_INDEX_TYPE_ONLINE" "Online"
49748>>>>>>>>>>> send AddAttrValue DF_INDEX_TYPE DF_INDEX_TYPE_BATCH "DF_INDEX_TYPE_BATCH" "Batch"
49749>>>>>>>>>>>
49749>>>>>>>>>>> send AddAttrValue DF_INDEX_SEGMENT_DIRECTION DF_ASCENDING "DF_ASCENDING" "Ascending"
49750>>>>>>>>>>> send AddAttrValue DF_INDEX_SEGMENT_DIRECTION DF_DESCENDING "DF_DESCENDING" "Descending"
49751>>>>>>>>>>>
49751>>>>>>>>>>> send AddAttrValue DF_INDEX_SEGMENT_CASE DF_CASE_USED "DF_CASE_USED" "Case used"
49752>>>>>>>>>>> send AddAttrValue DF_INDEX_SEGMENT_CASE DF_CASE_IGNORED "DF_CASE_IGNORED" "Case ignored"
49753>>>>>>>>>>>
49753>>>>>>>>>>> function sValueRead_separator.i integer value# returns string
49756>>>>>>>>>>> function_return (character(value#)+" ("+string(value#)+")")
49757>>>>>>>>>>> end_function
49758>>>>>>>>>>>
49758>>>>>>>>>>> procedure DefAttr integer attr# string name# integer attrtype# string dname# integer write# integer onlyDAC# integer valuetype# integer rt_only#
49761>>>>>>>>>>> set psName.i attr# to name#
49762>>>>>>>>>>> set piAttrType.i attr# to attrtype#
49763>>>>>>>>>>> set psDisplayName.i attr# to dname#
49764>>>>>>>>>>> set piWrite.i attr# to write#
49765>>>>>>>>>>> set piOnlyDAC.i attr# to onlyDAC#
49766>>>>>>>>>>> set piValueType.i attr# to valuetype#
49767>>>>>>>>>>> set piRuntimeOnly.i attr# to rt_only#
49768>>>>>>>>>>> end_procedure
49769>>>>>>>>>>> // Runtime onlyÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄRuntime onlyÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
49769>>>>>>>>>>> // Value typeÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄValue typeÄÄÄÄÄÄÄÄÄÄÄ¿ ³
49769>>>>>>>>>>> // Internal DAC?ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄInternal DAC?ÄÄÄÄÄÄ¿ ³ ³
49769>>>>>>>>>>> // Write access?ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄWrite access?ÄÄÄÄ
49769>>>>>>>>>>> send DefAttr DF_LOCK_DELAY "DF_LOCK_DELAY" ATTRTYPE_GLOBAL "Lock delay" 1 0 DF_BCD 0
49770>>>>>>>>>>> send DefAttr DF_LOCK_TIMEOUT "DF_LOCK_TIMEOUT" ATTRTYPE_GLOBAL "Lock timeout" 1 0 DF_BCD 0
49771>>>>>>>>>>> send DefAttr DF_OPEN_PATH "DF_OPEN_PATH" ATTRTYPE_GLOBAL "Open path" 1 0 DF_ASCII 0
49772>>>>>>>>>>> send DefAttr DF_DATE_FORMAT "DF_DATE_FORMAT" ATTRTYPE_GLOBAL "Date format" 1 0 DF_BCD 0
49773>>>>>>>>>>> send DefAttr DF_DATE_SEPARATOR "DF_DATE_SEPARATOR" ATTRTYPE_GLOBAL "Date separator" 1 0 DF_BCD 0
49774>>>>>>>>>>> send DefAttr DF_DECIMAL_SEPARATOR "DF_DECIMAL_SEPARATOR" ATTRTYPE_GLOBAL "Decimal separator" 1 0 DF_BCD 0
49775>>>>>>>>>>> send DefAttr DF_THOUSANDS_SEPARATOR "DF_THOUSANDS_SEPARATOR" ATTRTYPE_GLOBAL "Thousands separator" 1 0 DF_BCD 0
49776>>>>>>>>>>> send DefAttr DF_ALL_FILES_TOUCHED "DF_ALL_FILES_TOUCHED" ATTRTYPE_GLOBAL "All files touched" 0 0 DF_BCD 0
49777>>>>>>>>>>> send DefAttr DF_HIGH_DATA_INTEGRITY "DF_HIGH_DATA_INTEGRITY" ATTRTYPE_GLOBAL "High data integrity" 1 0 DF_BCD 0
49778>>>>>>>>>>> send DefAttr DF_TRAN_COUNT "DF_TRAN_COUNT" ATTRTYPE_GLOBAL "Transact. nest. level" 0 0 DF_BCD 0
49779>>>>>>>>>>> send DefAttr DF_TRANSACTION_ABORT "DF_TRANSACTION_ABORT" ATTRTYPE_GLOBAL "Transaction abort" 0 0 DF_BCD 0
49780>>>>>>>>>>> send DefAttr DF_REREAD_REQUIRED "DF_REREAD_REQUIRED" ATTRTYPE_GLOBAL "Reread required" 0 0 DF_BCD 0
49781>>>>>>>>>>> send DefAttr DF_FILELIST_NAME "DF_FILELIST_NAME" ATTRTYPE_GLOBAL "Filelist name" 1 0 DF_ASCII 0
49782>>>>>>>>>>> send DefAttr DF_REPORT_UNSUPPORTED_ATTRIBUTES ; "DF_REPORT_UNSUPPORTED_ATTRIBUTES" ; ATTRTYPE_GLOBAL "Report unsup. attr." 1 0 DF_BCD 0
49783>>>>>>>>>>> send DefAttr DF_STRICT_ATTRIBUTES "DF_STRICT_ATTRIBUTES" ATTRTYPE_GLOBAL "Strict attributes" 1 0 DF_BCD 0
49784>>>>>>>>>>> send DefAttr DF_NUMBER_DRIVERS "DF_NUMBER_DRIVERS" ATTRTYPE_GLOBAL "Number drivers" 0 0 DF_BCD 0
49785>>>>>>>>>>> send DefAttr DF_DRIVER_NAME "DF_DRIVER_NAME" ATTRTYPE_DRIVER "Driver name" 0 0 DF_ASCII 0
49786>>>>>>>>>>> send DefAttr DF_DRIVER_NUMBER_SERVERS "DF_DRIVER_NUMBER_SERVERS" ATTRTYPE_DRIVER "Driver number servers" 0 0 DF_BCD 0
49787>>>>>>>>>>> send DefAttr DF_DRIVER_SERVER_NAME "DF_DRIVER_SERVER_NAME" ATTRTYPE_DRVSRV "Driver server name" 0 0 DF_ASCII 0
49788>>>>>>>>>>> send DefAttr DF_API_DISABLED "DF_API_DISABLED" ATTRTYPE_GLOBAL "API disabled" 0 1 DF_BCD 0
49789>>>>>>>>>>> send DefAttr DF_API_DISABLED_ERROR "DF_API_DISABLED_ERROR" ATTRTYPE_GLOBAL "API disabled error" 0 1 DF_BCD 0
49790>>>>>>>>>>>
49790>>>>>>>>>>> send DefAttr DF_FILE_STATUS "DF_FILE_STATUS" ATTRTYPE_FILE "Status" 0 0 DF_BCD 1
49791>>>>>>>>>>> send DefAttr DF_FILE_MODE "DF_FILE_MODE" ATTRTYPE_FILE "Mode" 1 0 DF_BCD 1
49792>>>>>>>>>>> send DefAttr DF_FILE_MAX_RECORDS "DF_FILE_MAX_RECORDS" ATTRTYPE_FILE "Max records" 1 0 DF_BCD 0
49793>>>>>>>>>>> send DefAttr DF_FILE_RECORDS_USED "DF_FILE_RECORDS_USED" ATTRTYPE_FILE "Records used" 0 0 DF_BCD 0
49794>>>>>>>>>>> send DefAttr DF_FILE_TYPE "DF_FILE_TYPE" ATTRTYPE_FILE "Type" 0 0 DF_BCD 0
49795>>>>>>>>>>> send DefAttr DF_FILE_MULTIUSER "DF_FILE_MULTIUSER" ATTRTYPE_FILE "Multiuser" 1 0 DF_BCD 0
49796>>>>>>>>>>> send DefAttr DF_FILE_REUSE_DELETED "DF_FILE_REUSE_DELETED" ATTRTYPE_FILE "Reuse deleted" 1 0 DF_BCD 0
49797>>>>>>>>>>> send DefAttr DF_FILE_NUMBER "DF_FILE_NUMBER" ATTRTYPE_FILE "Number" 0 0 DF_BCD 1
49798>>>>>>>>>>> send DefAttr DF_FILE_COMPRESSION "DF_FILE_COMPRESSION" ATTRTYPE_FILE "Compression" 1 0 DF_BCD 0
49799>>>>>>>>>>> send DefAttr DF_FILE_LAST_INDEX_NUMBER "DF_FILE_LAST_INDEX_NUMBER" ATTRTYPE_FILE "Last index number" 0 0 DF_BCD 0
49800>>>>>>>>>>> send DefAttr DF_FILE_NUMBER_FIELDS "DF_FILE_NUMBER_FIELDS" ATTRTYPE_FILE "Number fields" 0 0 DF_BCD 0
49801>>>>>>>>>>> // Max 8 characters:
49801>>>>>>>>>>> send DefAttr DF_FILE_LOGICAL_NAME "DF_FILE_LOGICAL_NAME" ATTRTYPE_FILELIST "Logical name" 1 0 DF_ASCII 0
49802>>>>>>>>>>> // Max 40 characters:
49802>>>>>>>>>>> send DefAttr DF_FILE_ROOT_NAME "DF_FILE_ROOT_NAME" ATTRTYPE_FILELIST "Root name" 1 0 DF_ASCII 0
49803>>>>>>>>>>> send DefAttr DF_FILE_CHANGED "DF_FILE_CHANGED" ATTRTYPE_FILE "Changed" 0 0 DF_BCD 1
49804>>>>>>>>>>> send DefAttr DF_FILE_ALIAS "DF_FILE_ALIAS" ATTRTYPE_FILE "Alias" 1 0 DF_BCD 1
49805>>>>>>>>>>> send DefAttr DF_FILE_TOUCHED "DF_FILE_TOUCHED" ATTRTYPE_FILE "Touched" 0 0 DF_BCD 1
49806>>>>>>>>>>> send DefAttr DF_FILE_TRANSACTION "DF_FILE_TRANSACTION" ATTRTYPE_FILE "Transaction" 1 0 DF_BCD 0
49807>>>>>>>>>>> send DefAttr DF_FILE_OPENED "DF_FILE_OPENED" ATTRTYPE_FILE "Opened" 0 0 DF_BCD 1
49808>>>>>>>>>>> // Max 32 characters:
49808>>>>>>>>>>> send DefAttr DF_FILE_DISPLAY_NAME "DF_FILE_DISPLAY_NAME" ATTRTYPE_FILELIST "Display name" 1 0 DF_ASCII 0
49809>>>>>>>>>>> send DefAttr DF_FILE_PHYSICAL_NAME "DF_FILE_PHYSICAL_NAME" ATTRTYPE_FILE "Physical name" 0 0 DF_ASCII 0
49810>>>>>>>>>>> send DefAttr DF_FILE_NEXT_OPENED "DF_FILE_NEXT_OPENED" ATTRTYPE_FLSTNAV "Next opened" 0 0 DF_BCD 0
49811>>>>>>>>>>> send DefAttr DF_FILE_NEXT_USED "DF_FILE_NEXT_USED" ATTRTYPE_FLSTNAV "Next used" 0 0 DF_BCD 0
49812>>>>>>>>>>> send DefAttr DF_FILE_NEXT_EMPTY "DF_FILE_NEXT_EMPTY" ATTRTYPE_FLSTNAV "Next empty" 0 0 DF_BCD 0
49813>>>>>>>>>>> send DefAttr DF_FILE_RECORD_LENGTH "DF_FILE_RECORD_LENGTH" ATTRTYPE_FILE "Record length" 1 0 DF_BCD 0
49814>>>>>>>>>>> send DefAttr DF_FILE_RESTRUCTURE "DF_FILE_RESTRUCTURE" ATTRTYPE_FILE "Restructure" 0 0 DF_BCD 1
49815>>>>>>>>>>> send DefAttr DF_FILE_OPEN_MODE "DF_FILE_OPEN_MODE" ATTRTYPE_FILE "Open mode" 0 0 DF_BCD 1
49816>>>>>>>>>>> send DefAttr DF_FILE_INTEGRITY_CHECK "DF_FILE_INTEGRITY_CHECK" ATTRTYPE_FILE "Integrity check" 1 0 DF_BCD 0
49817>>>>>>>>>>> send DefAttr DF_FILE_OWNER "DF_FILE_OWNER" ATTRTYPE_FILE "Owner" 0 0 DF_ASCII 1
49818>>>>>>>>>>> send DefAttr DF_FILE_IS_SYSTEM_FILE "DF_FILE_IS_SYSTEM_FILE" ATTRTYPE_FILE "Is system file" 0 0 DF_BCD 0
49819>>>>>>>>>>> send DefAttr DF_FILE_LOCK_TYPE "DF_FILE_LOCK_TYPE" ATTRTYPE_FILE "Lock type" 0 0 DF_BCD 0
49820>>>>>>>>>>> send DefAttr DF_FILE_COMMITTED "DF_FILE_COMMITTED" ATTRTYPE_FILE "Committed" 0 0 DF_BCD 1
49821>>>>>>>>>>> send DefAttr DF_FILE_DRIVER "DF_FILE_DRIVER" ATTRTYPE_FILE "Driver" 0 0 DF_ASCII 0
49822>>>>>>>>>>> send DefAttr DF_FILE_RECORD_LENGTH_USED "DF_FILE_RECORD_LENGTH_USED" ATTRTYPE_FILE "Record length used" 0 0 DF_BCD 0
49823>>>>>>>>>>> send DefAttr DF_FILE_HANDLE_TYPE "DF_FILE_HANDLE_TYPE" ATTRTYPE_FILE "Handle type" 0 1 DF_BCD 1
49824>>>>>>>>>>> send DefAttr DF_FILE_RECORD_IDENTITY "DF_FILE_RECORD_IDENTITY" ATTRTYPE_FILE "Record identity" 1 0 DF_BCD 0
49825>>>>>>>>>>> send DefAttr DF_FILE_LOGIN "DF_FILE_LOGIN" ATTRTYPE_FILE "Login" 1 0 DF_ASCII 1
49826>>>>>>>>>>> send DefAttr DF_FILE_RECORD_PRIVILEGE "DF_FILE_RECORD_PRIVILEGE" ATTRTYPE_FILE "Record privilege" 0 1 DF_BCD 1
49827>>>>>>>>>>> send DefAttr DF_FILE_PRIVILEGE "DF_FILE_PRIVILEGE" ATTRTYPE_FILE "Privilege" 0 1 DF_BCD 1
49828>>>>>>>>>>> send DefAttr DF_FILE_CREATION_SERIAL "DF_FILE_CREATION_SERIAL" ATTRTYPE_FILE "Creation serial" 0 1 DF_BCD 1
49829>>>>>>>>>>> send DefAttr DF_FILE_REVISION "DF_FILE_REVISION" ATTRTYPE_FILE "Revision" 0 0 DF_ASCII 0
49830>>>>>>>>>>> send DefAttr DF_FILE_RELATED_COUNT "DF_FILE_RELATED_COUNT" ATTRTYPE_FILE "Related count" 0 1 DF_BCD 1
49831>>>>>>>>>>> send DefAttr DF_FILE_RELATED_FIELDS "DF_FILE_RELATED_FIELDS" ATTRTYPE_FILE "Related fields" 0 1 DF_BCD 1
49832>>>>>>>>>>> send DefAttr DF_FILE_SYSTEM_FILE "DF_FILE_SYSTEM_FILE" ATTRTYPE_FILE "System file" 0 1 DF_BCD 1
49833>>>>>>>>>>> send DefAttr DF_FILE_SYSTEM_FIELD "DF_FILE_SYSTEM_FIELD" ATTRTYPE_FILE "System field" 0 1 DF_BCD 1
49834>>>>>>>>>>> send DefAttr DF_FILE_RECORD_REREAD "DF_FILE_RECORD_REREAD" ATTRTYPE_FILE "Record reread" 0 1 DF_BCD 1
49835>>>>>>>>>>> send DefAttr DF_FIELD_NUMBER "DF_FIELD_NUMBER" ATTRTYPE_FIELD "Number" 0 1 DF_BCD 0
49836>>>>>>>>>>> send DefAttr DF_FIELD_TYPE "DF_FIELD_TYPE" ATTRTYPE_FIELD "Type" 1 0 DF_BCD 0
49837>>>>>>>>>>> send DefAttr DF_FIELD_LENGTH "DF_FIELD_LENGTH" ATTRTYPE_FIELD "Length" 1 0 DF_BCD 0
49838>>>>>>>>>>> send DefAttr DF_FIELD_PRECISION "DF_FIELD_PRECISION" ATTRTYPE_FIELD "Precision" 1 0 DF_BCD 0
49839>>>>>>>>>>> send DefAttr DF_FIELD_RELATED_FILE "DF_FIELD_RELATED_FILE" ATTRTYPE_FIELD "Related file" 1 0 DF_BCD 0
49840>>>>>>>>>>> send DefAttr DF_FIELD_RELATED_FIELD "DF_FIELD_RELATED_FIELD" ATTRTYPE_FIELD "Related field" 1 0 DF_BCD 0
49841>>>>>>>>>>> send DefAttr DF_FIELD_NAME "DF_FIELD_NAME" ATTRTYPE_FIELD "Name" 1 0 DF_ASCII 0
49842>>>>>>>>>>> send DefAttr DF_FIELD_INDEX "DF_FIELD_INDEX" ATTRTYPE_FIELD "Index" 1 0 DF_BCD 0
49843>>>>>>>>>>> send DefAttr DF_FIELD_OFFSET "DF_FIELD_OFFSET" ATTRTYPE_FIELD "Offset" 1 0 DF_BCD 0
49844>>>>>>>>>>> send DefAttr DF_FIELD_OLD_NUMBER "DF_FIELD_OLD_NUMBER" ATTRTYPE_FIELD "Old number" 0 0 DF_BCD 0
49845>>>>>>>>>>> send DefAttr DF_FIELD_OVERLAP "DF_FIELD_OVERLAP" ATTRTYPE_SPECIAL1 "Overlap" 0 0 DF_BCD 0
49846>>>>>>>>>>> send DefAttr DF_FIELD_NATIVE_LENGTH "DF_FIELD_NATIVE_LENGTH" ATTRTYPE_FIELD "Native length" 0 0 DF_BCD 0
49847>>>>>>>>>>>
49847>>>>>>>>>>> send DefAttr DF_INDEX_NUMBER_SEGMENTS "DF_INDEX_NUMBER_SEGMENTS" ATTRTYPE_INDEX "Number segments" 1 0 DF_BCD 0
49848>>>>>>>>>>> send DefAttr DF_INDEX_NUMBER_BUFFERS "DF_INDEX_NUMBER_BUFFERS" ATTRTYPE_INDEX "Number buffers" 0 0 DF_BCD 0
49849>>>>>>>>>>> send DefAttr DF_INDEX_TYPE "DF_INDEX_TYPE" ATTRTYPE_INDEX "Type" 1 0 DF_BCD 0
49850>>>>>>>>>>> send DefAttr DF_INDEX_LEVELS "DF_INDEX_LEVELS" ATTRTYPE_INDEX "Levels" 0 0 DF_BCD 0
49851>>>>>>>>>>> send DefAttr DF_INDEX_KEY_LENGTH "DF_INDEX_KEY_LENGTH" ATTRTYPE_INDEX "Key length" 0 0 DF_BCD 0
49852>>>>>>>>>>>
49852>>>>>>>>>>> send DefAttr DF_INDEX_SEGMENT_DIRECTION "DF_INDEX_SEGMENT_DIRECTION" ATTRTYPE_IDXSEG "Segment direction" 1 0 DF_BCD 0
49853>>>>>>>>>>> send DefAttr DF_INDEX_SEGMENT_CASE "DF_INDEX_SEGMENT_CASE" ATTRTYPE_IDXSEG "Segment case" 1 0 DF_BCD 0
49854>>>>>>>>>>> send DefAttr DF_INDEX_SEGMENT_FIELD "DF_INDEX_SEGMENT_FIELD" ATTRTYPE_IDXSEG "Segment field" 1 0 DF_BCD 0
49855>>>>>>>>>>> function sAttrCodeValueText.is integer attr# string value# returns string
49858>>>>>>>>>>> integer arr# row#
49858>>>>>>>>>>> get piValueArray.i attr# to arr#
49859>>>>>>>>>>> if arr# begin
49861>>>>>>>>>>> get iValue2Row.i of arr# value# to row#
49862>>>>>>>>>>> if row# eq -1 move "Unknown" to value#
49865>>>>>>>>>>> else move (psCodeName.i(arr#,row#)) to value#
49867>>>>>>>>>>> end
49867>>>>>>>>>>>>
49867>>>>>>>>>>> function_return value#
49868>>>>>>>>>>> end_function
49869>>>>>>>>>>> function sAttrReadValueText.is integer attr# string value# returns string
49872>>>>>>>>>>> integer arr# row#
49872>>>>>>>>>>> get piValueArray.i attr# to arr#
49873>>>>>>>>>>> if arr# begin
49875>>>>>>>>>>> get iValue2Row.i of arr# value# to row#
49876>>>>>>>>>>> if row# eq -1 move "Unknown" to value#
49879>>>>>>>>>>> else move (psDisplayName.i(arr#,row#)) to value#
49881>>>>>>>>>>> end
49881>>>>>>>>>>>>
49881>>>>>>>>>>> function_return value#
49882>>>>>>>>>>> end_function
49883>>>>>>>>>>> end_object // oAPI_Attributes
49884>>>>>>>>>>>end_desktop_section
49889>>>>>>>>>>>
49889>>>>>>>>>>>function API_AttrType_Count global returns integer
49891>>>>>>>>>>> function_return (row_count(oAPI_AttributeTypes(self)))
49892>>>>>>>>>>>end_function
49893>>>>>>>>>>>function API_AttrType_Name global integer type# returns string
49895>>>>>>>>>>> function_return (psName.i(oAPI_AttributeTypes(self),type#))
49896>>>>>>>>>>>end_function
49897>>>>>>>>>>>function API_AttrType_Params global integer type# returns integer
49899>>>>>>>>>>> function_return (piParams.i(oAPI_AttributeTypes(self),type#))
49900>>>>>>>>>>>end_function
49901>>>>>>>>>>>
49901>>>>>>>>>>>function API_Attr_Count global returns integer
49903>>>>>>>>>>> function_return (row_count(oAPI_Attributes(self)))
49904>>>>>>>>>>>end_function
49905>>>>>>>>>>>function API_Attr_WriteAccess global integer attr# returns integer
49907>>>>>>>>>>> function_return (piWrite.i(oAPI_Attributes(self),attr#))
49908>>>>>>>>>>>end_function
49909>>>>>>>>>>>function API_Attr_Name global integer attr# returns string
49911>>>>>>>>>>> function_return (psName.i(oAPI_Attributes(self),attr#))
49912>>>>>>>>>>>end_function
49913>>>>>>>>>>>function API_Attr_DisplayName global integer attr# returns string
49915>>>>>>>>>>> function_return (psDisplayName.i(oAPI_Attributes(self),attr#))
49916>>>>>>>>>>>end_function
49917>>>>>>>>>>>function API_Attr_ValueName global integer attr# string value# returns string
49919>>>>>>>>>>> function_return (sAttrCodeValueText.is(oAPI_Attributes(self),attr#,value#))
49920>>>>>>>>>>>end_function
49921>>>>>>>>>>>function API_Attr_DisplayValueName global integer attr# string value# returns string
49923>>>>>>>>>>> function_return (sAttrReadValueText.is(oAPI_Attributes(self),attr#,value#))
49924>>>>>>>>>>>end_function
49925>>>>>>>>>>>function API_Attr_NumberOfParams global integer attr# returns integer
49927>>>>>>>>>>> function_return (API_AttrType_Params(piAttrType.i(oAPI_Attributes(self),attr#)))
49928>>>>>>>>>>>end_function
49929>>>>>>>>>>>function API_AttrType global integer attr# returns integer
49931>>>>>>>>>>> function_return (piAttrType.i(oAPI_Attributes(self),attr#))
49932>>>>>>>>>>>end_function
49933>>>>>>>>>>>function API_AttrValueType global integer attr# returns integer
49935>>>>>>>>>>> function_return (piValueType.i(oAPI_Attributes(self),attr#))
49936>>>>>>>>>>>end_function
49937>>>>>>>>>>>function API_AttrRuntimeOnly global integer attr# returns integer
49939>>>>>>>>>>> function_return (piRuntimeOnly.i(oAPI_Attributes(self),attr#))
49940>>>>>>>>>>>end_function
49941>>>>>>>>>>>//> Is the attribute represented by a set of (symbolic) discrete values?
49941>>>>>>>>>>>function API_AttrDiscreteValues global integer attr# returns integer
49943>>>>>>>>>>> function_return (piValueArray.i(oAPI_Attributes(self),attr#))
49944>>>>>>>>>>>end_function
49945>>>>>>>>>>>procedure API_AttrType_Callback global integer attrtype# integer msg# integer lhObj
49947>>>>>>>>>>> send callback_attrtype.iii to (oAPI_Attributes(self)) attrtype# msg# lhObj
49948>>>>>>>>>>>end_procedure
49949>>>>>>>>>>>procedure API_AttrValue_Callback global integer attr# integer msg# integer lhObj
49951>>>>>>>>>>> send callback_attrvalue.iii to (oAPI_Attributes(self)) attr# msg# lhObj
49952>>>>>>>>>>>end_procedure
49953>>>>>>>>>>>
49953>>>>>>>>>>>//> Returns true if Attribute queried is relevant to restructure
49953>>>>>>>>>>>//> oprations.
49953>>>>>>>>>>>function API_AttrWorksOnStructure global integer attr# returns integer
49955>>>>>>>>>>> integer type#
49955>>>>>>>>>>> get API_AttrType attr# to type#
49956>>>>>>>>>>> if type# eq ATTRTYPE_FILE function_return 1
49959>>>>>>>>>>> if type# eq ATTRTYPE_FIELD function_return 1
49962>>>>>>>>>>> if type# eq ATTRTYPE_INDEX function_return 1
49965>>>>>>>>>>> if type# eq ATTRTYPE_IDXSEG function_return 1
49968>>>>>>>>>>> if type# eq ATTRTYPE_SPECIAL1 function_return 1
49971>>>>>>>>>>> // function_return 0
49971>>>>>>>>>>>end_function
49972>>>>>>>>>>>
49972>>>>>>>>>>>function API_ShortFieldTypeName global integer type# returns string
49974>>>>>>>>>>> if type# eq DF_ASCII function_return "Asc"
49977>>>>>>>>>>> if type# eq DF_BCD function_return "Num"
49980>>>>>>>>>>> if type# eq DF_DATE function_return "Dat"
49983>>>>>>>>>>> if type# eq DF_OVERLAP function_return "Ove"
49986>>>>>>>>>>> if type# eq DF_TEXT function_return "Tex"
49989>>>>>>>>>>> if type# eq DF_BINARY function_return "Bin"
49992>>>>>>>>>>>end_function
49993>>>>>>>>>>>
49993>>>>>>>>>>>function API_AttrValue_GLOBAL global integer attr# returns string
49995>>>>>>>>>>> string rval#
49995>>>>>>>>>>> if (API_AttrType(attr#)=ATTRTYPE_GLOBAL) get_attribute attr# to rval#
50000>>>>>>>>>>> else begin
50001>>>>>>>>>>> error 666 "Attribute queried is not of GLOBAL type"
50002>>>>>>>>>>>>
50002>>>>>>>>>>> move "" to rval#
50003>>>>>>>>>>> end
50003>>>>>>>>>>>>
50003>>>>>>>>>>> function_return rval#
50004>>>>>>>>>>>end_function
50005>>>>>>>>>>>function API_AttrValue_FILELIST global integer attr# integer file# returns string
50007>>>>>>>>>>> string rval#
50007>>>>>>>>>>> if (API_AttrType(attr#)=ATTRTYPE_FILELIST) get_attribute attr# of file# to rval#
50012>>>>>>>>>>> else begin
50013>>>>>>>>>>> //send obs (API_Attr_Name(attr#)+" on file "+string(file#))
50013>>>>>>>>>>> error 666 "Attribute queried is not of FILELIST type"
50014>>>>>>>>>>>>
50014>>>>>>>>>>> move "" to rval#
50015>>>>>>>>>>> end
50015>>>>>>>>>>>>
50015>>>>>>>>>>> function_return rval#
50016>>>>>>>>>>>end_function
50017>>>>>>>>>>>function API_AttrValue_FILE global integer attr# integer file# returns string
50019>>>>>>>>>>> string rval#
50019>>>>>>>>>>> if (API_AttrType(attr#)=ATTRTYPE_FILE) get_attribute attr# of file# to rval#
50024>>>>>>>>>>> else begin
50025>>>>>>>>>>> //send obs (API_Attr_Name(attr#)+" on file "+string(file#))
50025>>>>>>>>>>> error 666 ("Attribute queried is not of FILE type")
50026>>>>>>>>>>>>
50026>>>>>>>>>>> move "" to rval#
50027>>>>>>>>>>> end
50027>>>>>>>>>>>>
50027>>>>>>>>>>> function_return rval#
50028>>>>>>>>>>>end_function
50029>>>>>>>>>>>function API_AttrValue_FIELD global integer attr# integer file# integer field# returns string
50031>>>>>>>>>>> string rval#
50031>>>>>>>>>>> if (API_AttrType(attr#)=ATTRTYPE_FIELD) get_attribute attr# of file# field# to rval#
50036>>>>>>>>>>> else begin
50037>>>>>>>>>>> error 666 "Attribute queried is not of FIELD type"
50038>>>>>>>>>>>>
50038>>>>>>>>>>> move "" to rval#
50039>>>>>>>>>>> end
50039>>>>>>>>>>>>
50039>>>>>>>>>>> function_return rval#
50040>>>>>>>>>>>end_function
50041>>>>>>>>>>>function API_AttrValue_INDEX global integer attr# integer file# integer index# returns string
50043>>>>>>>>>>> string rval# lsDriver
50043>>>>>>>>>>> if (API_AttrType(attr#)=ATTRTYPE_INDEX) begin
50045>>>>>>>>>>> get_attribute DF_FILE_DRIVER of file# to lsDriver
50048>>>>>>>>>>> if lsDriver eq "ODBC_DRV" function_return ""
50051>>>>>>>>>>> get_attribute attr# of file# index# to rval#
50054>>>>>>>>>>> end
50054>>>>>>>>>>>>
50054>>>>>>>>>>> else begin
50055>>>>>>>>>>> error 666 "Attribute queried is not of INDEX type"
50056>>>>>>>>>>>>
50056>>>>>>>>>>> move "" to rval#
50057>>>>>>>>>>> end
50057>>>>>>>>>>>>
50057>>>>>>>>>>> function_return rval#
50058>>>>>>>>>>>end_function
50059>>>>>>>>>>>function API_AttrValue_IDXSEG global integer attr# integer file# integer index# integer segment# returns string
50061>>>>>>>>>>> string rval#
50061>>>>>>>>>>> if (API_AttrType(attr#)=ATTRTYPE_IDXSEG) get_attribute attr# of file# index# segment# to rval#
50066>>>>>>>>>>> else begin
50067>>>>>>>>>>> error 666 "Attribute queried is not of IDXSEG type"
50068>>>>>>>>>>>>
50068>>>>>>>>>>> move "" to rval#
50069>>>>>>>>>>> end
50069>>>>>>>>>>>>
50069>>>>>>>>>>> function_return rval#
50070>>>>>>>>>>>end_function
50071>>>>>>>>>>>function API_AttrValue_SPECIAL1 global integer attr# integer file# integer field1# integer field2# returns string
50073>>>>>>>>>>> string rval#
50073>>>>>>>>>>> if (API_AttrType(attr#)=ATTRTYPE_SPECIAL1) get_attribute attr# of file# field1# field2# to rval#
50078>>>>>>>>>>> else begin
50079>>>>>>>>>>> error 666 "Attribute queried is not of SPECIAL1 type"
50080>>>>>>>>>>>>
50080>>>>>>>>>>> move "" to rval#
50081>>>>>>>>>>> end
50081>>>>>>>>>>>>
50081>>>>>>>>>>> function_return rval#
50082>>>>>>>>>>>end_function
50083>>>>>>>>>>>function API_AttrValue_FLSTNAV global integer attr# integer file# returns string
50085>>>>>>>>>>> string rval#
50085>>>>>>>>>>> if (API_AttrType(attr#)=ATTRTYPE_FLSTNAV) get_attribute attr# of file# to rval#
50090>>>>>>>>>>> else begin
50091>>>>>>>>>>> error 666 "Attribute queried is not of FLSTNAV type"
50092>>>>>>>>>>>>
50092>>>>>>>>>>> move "" to rval#
50093>>>>>>>>>>> end
50093>>>>>>>>>>>>
50093>>>>>>>>>>> function_return rval#
50094>>>>>>>>>>>end_function
50095>>>>>>>>>>>function API_AttrValue_DRIVER global integer attr# integer driver# returns string
50097>>>>>>>>>>> string rval#
50097>>>>>>>>>>> if (API_AttrType(attr#)=ATTRTYPE_DRIVER) get_attribute attr# of driver# to rval#
50102>>>>>>>>>>> else begin
50103>>>>>>>>>>> error 666 "Attribute queried is not of DRIVER type"
50104>>>>>>>>>>>>
50104>>>>>>>>>>> move "" to rval#
50105>>>>>>>>>>> end
50105>>>>>>>>>>>>
50105>>>>>>>>>>> function_return rval#
50106>>>>>>>>>>>end_function
50107>>>>>>>>>>>function API_AttrValue_DRVSRV global integer attr# integer driver# integer server# returns string
50109>>>>>>>>>>> string rval#
50109>>>>>>>>>>> if (API_AttrType(attr#)=ATTRTYPE_DRVSRV) get_attribute attr# of driver# server# to rval#
50114>>>>>>>>>>> else begin
50115>>>>>>>>>>> error 666 "Attribute queried is not of DRVSRV type"
50116>>>>>>>>>>>>
50116>>>>>>>>>>> move "" to rval#
50117>>>>>>>>>>> end
50117>>>>>>>>>>>>
50117>>>>>>>>>>> function_return rval#
50118>>>>>>>>>>>end_function
50119>>>>>>>>>>>
50119>>>>>>>>>>>function API_FieldNameToNumber global integer file# string name# returns integer
50121>>>>>>>>>>> integer max# field#
50121>>>>>>>>>>> move (API_AttrValue_FILE(DF_FILE_NUMBER_FIELDS,file#)) to max#
50122>>>>>>>>>>> for field# from 1 to max#
50128>>>>>>>>>>>>
50128>>>>>>>>>>> if name# eq (API_AttrValue_FIELD(DF_FIELD_NAME,file#,field#)) function_return field#
50131>>>>>>>>>>> loop
50132>>>>>>>>>>>>
50132>>>>>>>>>>> //function_return 0
50132>>>>>>>>>>>end_function
50133>>>>>>>>>>>
50133>>>>>>>>>>>desktop_section // Compile as if on desktop
50138>>>>>>>>>>> object oFilesThatCanBeOpened is a cArray NO_IMAGE
50140>>>>>>>>>>> property integer piValidContents public 0
50142>>>>>>>>>>> procedure reset
50145>>>>>>>>>>> set piValidContents to false
50146>>>>>>>>>>> send delete_data
50147>>>>>>>>>>> end_procedure
50148>>>>>>>>>>> procedure RegisterValidEntries
50151>>>>>>>>>>> integer file#
50151>>>>>>>>>>> send reset
50152>>>>>>>>>>> move 0 to file#
50153>>>>>>>>>>> repeat
50153>>>>>>>>>>>>
50153>>>>>>>>>>> move (API_AttrValue_FLSTNAV(DF_FILE_NEXT_USED,file#)) to file#
50154>>>>>>>>>>> if file# set value item file# to (DBMS_CanOpenFile(file#))
50157>>>>>>>>>>> until (not(file#))
50159>>>>>>>>>>> set piValidContents to true
50160>>>>>>>>>>> end_procedure
50161>>>>>>>>>>> function iNextFileThatCanOpen integer file# returns integer
50164>>>>>>>>>>> integer itm# max#
50164>>>>>>>>>>> ifnot (piValidContents(self)) send RegisterValidEntries
50167>>>>>>>>>>> get item_count to max#
50168>>>>>>>>>>> move (file#+1) to itm#
50169>>>>>>>>>>> while itm# lt max#
50173>>>>>>>>>>> if (value(self,itm#)) ne 0 function_return itm#
50176>>>>>>>>>>> increment itm#
50177>>>>>>>>>>> end
50178>>>>>>>>>>>>
50178>>>>>>>>>>> //function_return 0
50178>>>>>>>>>>> end_function
50179>>>>>>>>>>> end_object // oFilesThatCanBeOpened
50180>>>>>>>>>>>end_desktop_section
50185>>>>>>>>>>>
50185>>>>>>>>>>>function API_NextFileThatCanOpen global integer liFile returns integer
50187>>>>>>>>>>> function_return (iNextFileThatCanOpen(oFilesThatCanBeOpened(self),liFile))
50188>>>>>>>>>>>end_function
50189>>>>>>>>>>>procedure API_ResetListOfFilesThatCanOpen global
50191>>>>>>>>>>> send reset to (oFilesThatCanBeOpened(self))
50192>>>>>>>>>>>end_procedure
50193>>>>>>>>>>>
50193>>>>>>>>>>>function API_OtherAttr_Value global integer liScAttr returns string
50195>>>>>>>>>>> string lsRval lsValue
50195>>>>>>>>>>> if liScAttr eq OA_DIR_SEPARATOR function_return (SysConf(SYSCONF_DIR_SEPARATOR))
50198>>>>>>>>>>> if liScAttr eq OA_TIMER_RESOLUTION function_return (SysConf(SYSCONF_TIMER_RESOLUTION))
50201>>>>>>>>>>> if liScAttr eq OA_OS_SHORT_NAME function_return (SysConf(SYSCONF_OS_SHORT_NAME))
50204>>>>>>>>>>> if liScAttr eq OA_OS_MAJOR_REV function_return (SysConf(SYSCONF_OS_MAJOR_REV))
50207>>>>>>>>>>> if liScAttr eq OA_OS_MINOR_REV function_return (SysConf(SYSCONF_OS_MINOR_REV))
50210>>>>>>>>>>> if liScAttr eq OA_OS_NAME function_return (SysConf(SYSCONF_OS_NAME))
50213>>>>>>>>>>> if liScAttr eq OA_MACHINE_NAME function_return (SysConf(SYSCONF_MACHINE_NAME))
50216>>>>>>>>>>> if liScAttr eq OA_FILE_MASK function_return (SysConf(SYSCONF_FILE_MASK))
50219>>>>>>>>>>> if liScAttr eq OA_DATAFLEX_REV function_return (SysConf(SYSCONF_DATAFLEX_REV))
50222>>>>>>>>>>> if liScAttr eq OA_SYSTEM_NAME function_return (SysConf(SYSCONF_SYSTEM_NAME))
50225>>>>>>>>>>> if liScAttr eq OA_PATH_SEPARATOR function_return (SysConf(SYSCONF_PATH_SEPARATOR))
50228>>>>>>>>>>> if liScAttr eq OA_SERIAL_NUMBER registration lsValue lsRval
50231>>>>>>>>>>> if liScAttr eq OA_REG_NAME registration lsRval lsValue
50234>>>>>>>>>>> if liScAttr eq OA_WORKDIR begin
50236>>>>>>>>>>> get_current_directory to lsRval
50237>>>>>>>>>>> move (ToOem(lsRval)) to lsRval
50238>>>>>>>>>>> end
50238>>>>>>>>>>>>
50238>>>>>>>>>>> if liScAttr eq OA_PATH begin
50240>>>>>>>>>>> get_environment "PATH" to lsRval
50241>>>>>>>>>>>>
50241>>>>>>>>>>> move (ToOem(lsRval)) to lsRval
50242>>>>>>>>>>> end
50242>>>>>>>>>>>>
50242>>>>>>>>>>> if liScAttr eq OA_MAX_USERS get_licensed_max_users to lsRval
50245>>>>>>>>>>> if liScAttr eq OA_DATE4_STATE get_date_attribute DATE4_STATE to lsRval
50248>>>>>>>>>>> if liScAttr eq OA_SYSDATE4_STATE get_date_attribute SYSDATE4_STATE to lsRval
50251>>>>>>>>>>> if liScAttr eq OA_EPOCH_VALUE get_date_attribute EPOCH_VALUE to lsRval
50254>>>>>>>>>>> //if liScAttr eq OA_COLLATE_PATH move (SEQ_FindFileAlongDFPath("collate.cfg")) to lsRval
50254>>>>>>>>>>> if liScAttr eq OA_COLLATE_PATH begin
50256>>>>>>>>>>> get_profile_string "defaults" "VDFRootDir" to lsRval
50259>>>>>>>>>>> get SEQ_ComposeAbsoluteFileName lsRval "\bin\" to lsRval
50260>>>>>>>>>>> if (SEQ_FileExists(lsRval+"\collate.cfg")=SEQIT_FILE) function_return lsRval
50263>>>>>>>>>>> move (SEQ_FindFileAlongPath(API_OtherAttr_Value(OA_PATH),"collate.cfg")) to lsRval
50264>>>>>>>>>>> end
50264>>>>>>>>>>>>
50264>>>>>>>>>>> if liScAttr eq OA_COLLATE_SIZE move (SEQ_FileSize(SEQ_ComposeAbsoluteFileName(API_OtherAttr_Value(OA_COLLATE_PATH),"collate.cfg"))) to lsRval
50267>>>>>>>>>>> if liScAttr eq OA_COLLATE_TIME move (SEQ_FileModTime(SEQ_ComposeAbsoluteFileName(API_OtherAttr_Value(OA_COLLATE_PATH),"collate.cfg"))) to lsRval
50270>>>>>>>>>>> if liScAttr eq OA_RUNTIME_NAME function_return (ToOem(SysConf(SYSCONF_RUNTIME_NAME)))
50273>>>>>>>>>>> if liScAttr eq OA_UTC_TIME_OFFSET function_return (SysConf(SYSCONF_UTC_TIME_OFFSET))
50276>>>>>>>>>>> if liScAttr eq OA_MAX_ARGUMENT_SIZE get_argument_size to lsRval
50279>>>>>>>>>>> if liScAttr eq OA_CURRENT_USER_COUNT move -1 to lsRval //get_current_user_count to lsRval
50282>>>>>>>>>>> if liScAttr eq OA_DFPRINTER get_environment "DFPRINTER" to lsRval
50285>>>>>>>>>>> if liScAttr eq OA_LOCK_COUNT get_current_lockcount to lsRval
50288>>>>>>>>>>>
50288>>>>>>>>>>>
50288>>>>>>>>>>> if liScAttr eq OA_FOLDER_FILELIST get AppFolder APPFOLDER_FILELIST to lsRval
50291>>>>>>>>>>> if liScAttr eq OA_FOLDER_PROGRAM get AppFolder APPFOLDER_PROGRAM to lsRval
50294>>>>>>>>>>> if liScAttr eq OA_FOLDER_HTML get AppFolder APPFOLDER_HTML to lsRval
50297>>>>>>>>>>> if liScAttr eq OA_FOLDER_VDF_ROOT get AppFolder APPFOLDER_VDF_ROOT to lsRval
50300>>>>>>>>>>> function_return lsRval
50301>>>>>>>>>>>end_function // API_OtherAttr_Value
50302>>>>>>>>>>>function OtherAttr_ValueDisplayName global integer liScAttr string lsValue returns string
50304>>>>>>>>>>> if liScAttr eq OA_DIR_SEPARATOR function_return lsValue
50307>>>>>>>>>>> if liScAttr eq OA_TIMER_RESOLUTION function_return lsValue
50310>>>>>>>>>>> if liScAttr eq OA_OS_SHORT_NAME function_return lsValue
50313>>>>>>>>>>> if liScAttr eq OA_OS_MAJOR_REV function_return lsValue
50316>>>>>>>>>>> if liScAttr eq OA_OS_MINOR_REV function_return lsValue
50319>>>>>>>>>>> if liScAttr eq OA_OS_NAME function_return lsValue
50322>>>>>>>>>>> if liScAttr eq OA_MACHINE_NAME function_return lsValue
50325>>>>>>>>>>> if liScAttr eq OA_FILE_MASK function_return lsValue
50328>>>>>>>>>>> if liScAttr eq OA_DATAFLEX_REV function_return lsValue
50331>>>>>>>>>>> if liScAttr eq OA_SYSTEM_NAME function_return lsValue
50334>>>>>>>>>>> if liScAttr eq OA_PATH_SEPARATOR function_return lsValue
50337>>>>>>>>>>> if liScAttr eq OA_SERIAL_NUMBER function_return lsValue
50340>>>>>>>>>>> if liScAttr eq OA_REG_NAME function_return lsValue
50343>>>>>>>>>>> if liScAttr eq OA_WORKDIR function_return lsValue
50346>>>>>>>>>>> if liScAttr eq OA_PATH function_return lsValue
50349>>>>>>>>>>> if liScAttr eq OA_MAX_USERS function_return lsValue
50352>>>>>>>>>>> if liScAttr eq OA_DATE4_STATE function_return (if(integer(lsValue),"True","False"))
50355>>>>>>>>>>> if liScAttr eq OA_SYSDATE4_STATE function_return (if(integer(lsValue),"True","False"))
50358>>>>>>>>>>> if liScAttr eq OA_EPOCH_VALUE function_return lsValue
50361>>>>>>>>>>> if liScAttr eq OA_COLLATE_PATH function_return lsValue
50364>>>>>>>>>>> if liScAttr eq OA_COLLATE_SIZE function_return (lsValue+" bytes")
50367>>>>>>>>>>> if liScAttr eq OA_COLLATE_TIME function_return (TS_ConvertToString(lsValue))
50370>>>>>>>>>>> if liScAttr eq OA_RUNTIME_NAME function_return lsValue
50373>>>>>>>>>>> if liScAttr eq OA_UTC_TIME_OFFSET function_return (TS_ExtractTime(lsValue))
50376>>>>>>>>>>> if liScAttr eq OA_MAX_ARGUMENT_SIZE function_return lsValue
50379>>>>>>>>>>> if liScAttr eq OA_CURRENT_USER_COUNT function_return lsValue
50382>>>>>>>>>>> if liScAttr eq OA_DFPRINTER function_return lsValue
50385>>>>>>>>>>> if liScAttr eq OA_LOCK_COUNT function_return lsValue
50388>>>>>>>>>>> if liScAttr eq OA_FOLDER_HTML function_return lsValue
50391>>>>>>>>>>> if liScAttr eq OA_FOLDER_FILELIST function_return lsValue
50394>>>>>>>>>>> if liScAttr eq OA_FOLDER_PROGRAM function_return lsValue
50397>>>>>>>>>>> if liScAttr eq OA_FOLDER_VDF_ROOT function_return lsValue
50400>>>>>>>>>>>end_function
50401>>>>>>>>>>>function OtherAttr_DisplayName global integer liScAttr returns string
50403>>>>>>>>>>> if liScAttr eq OA_DIR_SEPARATOR function_return "Dir separator"
50406>>>>>>>>>>> if liScAttr eq OA_TIMER_RESOLUTION function_return "Timer resolution"
50409>>>>>>>>>>> if liScAttr eq OA_OS_SHORT_NAME function_return "OS short name"
50412>>>>>>>>>>> if liScAttr eq OA_OS_MAJOR_REV function_return "OS major rev."
50415>>>>>>>>>>> if liScAttr eq OA_OS_MINOR_REV function_return "OS minor rev."
50418>>>>>>>>>>> if liScAttr eq OA_OS_NAME function_return "OS name"
50421>>>>>>>>>>> if liScAttr eq OA_MACHINE_NAME function_return "Machine name"
50424>>>>>>>>>>> if liScAttr eq OA_FILE_MASK function_return "File mask"
50427>>>>>>>>>>> if liScAttr eq OA_DATAFLEX_REV function_return "DF revision"
50430>>>>>>>>>>> if liScAttr eq OA_SYSTEM_NAME function_return "System name"
50433>>>>>>>>>>> if liScAttr eq OA_PATH_SEPARATOR function_return "Path separator"
50436>>>>>>>>>>> if liScAttr eq OA_SERIAL_NUMBER function_return "Serial number"
50439>>>>>>>>>>> if liScAttr eq OA_REG_NAME function_return "Registration name"
50442>>>>>>>>>>> if liScAttr eq OA_WORKDIR function_return "Working dir."
50445>>>>>>>>>>> if liScAttr eq OA_PATH function_return "Search path"
50448>>>>>>>>>>> if liScAttr eq OA_MAX_USERS function_return "Max. users"
50451>>>>>>>>>>> if liScAttr eq OA_DATE4_STATE function_return "Date4 state"
50454>>>>>>>>>>> if liScAttr eq OA_SYSDATE4_STATE function_return "Sysdate4 state"
50457>>>>>>>>>>> if liScAttr eq OA_EPOCH_VALUE function_return "Epoch value"
50460>>>>>>>>>>> if liScAttr eq OA_COLLATE_PATH function_return "Collate file"
50463>>>>>>>>>>> if liScAttr eq OA_COLLATE_SIZE function_return "Collate size"
50466>>>>>>>>>>> if liScAttr eq OA_COLLATE_TIME function_return "Collate timestamp"
50469>>>>>>>>>>> if liScAttr eq OA_RUNTIME_NAME function_return "Module path & name"
50472>>>>>>>>>>> if liScAttr eq OA_UTC_TIME_OFFSET function_return "Seconds from Meridian"
50475>>>>>>>>>>> if liScAttr eq OA_MAX_ARGUMENT_SIZE function_return "Max string size"
50478>>>>>>>>>>> if liScAttr eq OA_CURRENT_USER_COUNT function_return "Current user count"
50481>>>>>>>>>>> if liScAttr eq OA_DFPRINTER function_return "Default printer (DF3.2)"
50484>>>>>>>>>>> if liScAttr eq OA_LOCK_COUNT function_return "Current lock count"
50487>>>>>>>>>>> if liScAttr eq OA_FOLDER_HTML function_return "HTML folder"
50490>>>>>>>>>>> if liScAttr eq OA_FOLDER_FILELIST function_return "Filelist folder"
50493>>>>>>>>>>> if liScAttr eq OA_FOLDER_PROGRAM function_return "Programs folder"
50496>>>>>>>>>>> if liScAttr eq OA_FOLDER_VDF_ROOT function_return "VDF root folder"
50499>>>>>>>>>>>end_function
50500>>>>>>>>>>>
50500>>>>>>>>>>>procedure API_OtherAttributes_CallBack global integer lhMsg integer lhObj
50502>>>>>>>>>>> integer liAttr
50502>>>>>>>>>>> for liAttr from 0 to (OA_MAX-1)
50508>>>>>>>>>>>>
50508>>>>>>>>>>> send lhMsg to lhObj (OtherAttr_DisplayName(liAttr)) (OtherAttr_ValueDisplayName(liAttr,API_OtherAttr_Value(liAttr)))
50509>>>>>>>>>>> loop
50510>>>>>>>>>>>>
50510>>>>>>>>>>>end_procedure
50511>>>>>>>>>Use Strings.nui // String manipulation for VDF (No User Interface)
50511>>>>>>>>>
50511>>>>>>>>>// ===========================================================================
50511>>>>>>>>>// LANGUAGE DEPENDANT TEXT CONSTANTS
50511>>>>>>>>>// ===========================================================================
50511>>>>>>>>>
50511>>>>>>>>> define t.output.GoPg_Label for "Go to page"
50511>>>>>>>>> define t.output.Find for "Find"
50511>>>>>>>>> define t.output.Search_string for "Search string"
50511>>>>>>>>> define t.output.Case_sensitive for "Case sensitive"
50511>>>>>>>>> define t.output.Searching for "Searching for string..."
50511>>>>>>>>> define t.output.PressAnyKey for "Press any key to interrupt"
50511>>>>>>>>> define t.output.CancelSearch for "Cancel search?"
50511>>>>>>>>> define t.output.TextNotFound for "' not found!"
50511>>>>>>>>> define t.output.NotToScreen for "Not screen!"
50511>>>>>>>>> define t.output.Main1 for " &Exit"
50511>>>>>>>>> define t.output.Main1_1 for "&Exit\aEsc"
50511>>>>>>>>> define t.output.Main2 for " &Navigate"
50511>>>>>>>>> define t.output.Main2_1 for "&Prev. page \aPgUp"
50511>>>>>>>>> define t.output.Main2_2 for "&Next page \aPgDn"
50511>>>>>>>>> define t.output.Main2_3 for "16 lines &Up\a-"
50511>>>>>>>>> define t.output.Main2_4 for "16 lines &Down\a+"
50511>>>>>>>>> define t.output.Main2_5 for "First page \aCtrl+PgUp"
50511>>>>>>>>> define t.output.Main2_6 for "Last page \aCtrl+PgDn"
50511>>>>>>>>> define t.output.Main2_7 for "&Go to page\aAlt-G"
50511>>>>>>>>> define t.output.Main2_8 for "Line start\aHome"
50511>>>>>>>>> define t.output.Main2_9 for "Left"
50511>>>>>>>>> define t.output.Main2_10 for "Right"
50511>>>>>>>>> define t.output.Main2_11 for "Linie end\aEnd"
50511>>>>>>>>> define t.output.Main3 for " &Search"
50511>>>>>>>>> define t.output.Main3_1 for "&Search\aF2"
50511>>>>>>>>> define t.output.Main3_2 for "&Find next\aSF2"
50511>>>>>>>>> define t.output.Main4 for " &Print"
50511>>>>>>>>> define t.output.Main4_1 for "&Print report"
50511>>>>>>>>>
50511>>>>>>>>>// ===========================================================================
50511>>>>>>>>>// CONSTANTS DECLARATIONS
50511>>>>>>>>>// ===========================================================================
50511>>>>>>>>>
50511>>>>>>>>>define DEST_NONE for 0
50511>>>>>>>>>define DEST_PRINTER for 1
50511>>>>>>>>>define DEST_SCREEN for 2
50511>>>>>>>>>define DEST_FILE for 3
50511>>>>>>>>>define DEST_HTML for 4
50511>>>>>>>>>define DEST_EDITOR for 5
50511>>>>>>>>>define DEST_EMAIL for 6
50511>>>>>>>>>
50511>>>>>>>>>define FILEEXISTS_CANCEL for 0
50511>>>>>>>>>define FILEEXISTS_APPEND for 1
50511>>>>>>>>>define FILEEXISTS_OVERWRITE for 2
50511>>>>>>>>>define FILEEXISTS_PROMPT for 3 // Ask the operator
50511>>>>>>>>>
50511>>>>>>>>>// ===========================================================================
50511>>>>>>>>>// BASIC OUTPUT CLASS
50511>>>>>>>>>// ===========================================================================
50511>>>>>>>>>
50511>>>>>>>>>indicator output$move_up?
50511>>>>>>>>>string output$code
50511>>>>>>>>>string output$symbollist 255
50511>>>>>>>>>integer output$idx
50511>>>>>>>>>integer seq.object#
50511>>>>>>>>>
50511>>>>>>>>>
50511>>>>>>>>>goto output$skip_definition
50512>>>>>>>>>>
50512>>>>>>>>>output$code_move:
50512>>>>>>>>> Enumeration_List
50512>>>>>>>>> output.define_code _nop "<nop>"
50518>>>>>>>>> output.define_code _initialize "<INI>"
50524>>>>>>>>> output.define_code _reset "<RST>"
50530>>>>>>>>> output.define_code _bold_on "<BLD>"
50536>>>>>>>>> output.define_code _bold_off "<bld>"
50542>>>>>>>>> output.define_code _italics_on "<ITL>"
50548>>>>>>>>> output.define_code _italics_off "<itl>"
50554>>>>>>>>> output.define_code _underline_on "<UND>"
50560>>>>>>>>> output.define_code _underline_off "<und>"
50566>>>>>>>>> output.define_code _user_on "<USR>"
50572>>>>>>>>> output.define_code _user_off "<usr>"
50578>>>>>>>>> output.define_code _cpi10 "<C10>"
50584>>>>>>>>> output.define_code _cpi12 "<C12>"
50590>>>>>>>>> output.define_code _cpi17 "<C17>"
50596>>>>>>>>> output.define_code _lpi03 "<L03>"
50602>>>>>>>>> output.define_code _lpi06 "<L06>"
50608>>>>>>>>> output.define_code _lpi08 "<L08>"
50614>>>>>>>>> output.define_code _lpi12 "<L12>"
50620>>>>>>>>> output.define_code _lpi72 "<L72>"
50626>>>>>>>>> output.define_code _macro_def_pre "<MDF>"
50632>>>>>>>>> output.define_code _macro_def_post "<mdf>"
50638>>>>>>>>> output.define_code _macro_call_pre "<MCL>"
50644>>>>>>>>> output.define_code _macro_call_post "<mcl>"
50650>>>>>>>>> output.define_code _macro_kill_pre "<MKL>"
50656>>>>>>>>> output.define_code _macro_kill_post "<mkl>"
50662>>>>>>>>> output.define_code _paper_tray_1 "<PT1>"
50668>>>>>>>>> output.define_code _paper_tray_2 "<PT2>"
50674>>>>>>>>> output.define_code _paper_tray_3 "<PT3>"
50680>>>>>>>>> output.define_code _paper_tray_4 "<PT4>"
50686>>>>>>>>> output.define_code _pos_push "<PSH>"
50692>>>>>>>>> output.define_code _pos_pop "<POP>"
50698>>>>>>>>> End_Enumeration_List
50698>>>>>>>>>return
50699>>>>>>>>>output$skip_definition:
50699>>>>>>>>>
50699>>>>>>>>>
50699>>>>>>>>>move "" to OUTPUT$SYMBOLLIST
50700>>>>>>>>>BUILD_CODE_SYMBOLS
50731>>>>>>>>>
50731>>>>>>>>>procedure output.get_code integer code#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
50733>>>>>>>>> indicate output$move_up? true
50734>>>>>>>>> move code# to output$idx
50735>>>>>>>>> gosub output$code_move
50736>>>>>>>>>>
50736>>>>>>>>>end_procedure
50737>>>>>>>>>procedure output.set_code integer code#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
50739>>>>>>>>> indicate output$move_up? false
50740>>>>>>>>> move code# to output$idx
50741>>>>>>>>> gosub output$code_move
50742>>>>>>>>>>
50742>>>>>>>>>end_procedure
50743>>>>>>>>>procedure output.zero_codes
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
50745>>>>>>>>> integer code#
50745>>>>>>>>> move "" to output$code
50746>>>>>>>>> for code# from 0 to output$max_code
50752>>>>>>>>>>
50752>>>>>>>>> send output.set_code code#
50753>>>>>>>>> loop
50754>>>>>>>>>>
50754>>>>>>>>>end_procedure
50755>>>>>>>>>send output.zero_codes
50756>>>>>>>>>function output.replace_codes global string str# returns string
50758>>>>>>>>> integer code#
50758>>>>>>>>> string symb#
50758>>>>>>>>> if "<" in str# begin
50760>>>>>>>>> for code# from 0 to output$max_code
50766>>>>>>>>>>
50766>>>>>>>>> send output.get_code code#
50767>>>>>>>>> move (replaces(mid(output$symbollist,5,code#*5+1),str#,output$code)) to str#
50768>>>>>>>>> loop
50769>>>>>>>>>>
50769>>>>>>>>> end
50769>>>>>>>>>>
50769>>>>>>>>> function_return str#
50770>>>>>>>>>end_function
50771>>>>>>>>>function output.remove_codes global string str# returns string
50773>>>>>>>>> integer code#
50773>>>>>>>>> string symb#
50773>>>>>>>>> if "<" in str# begin
50775>>>>>>>>> for code# from 0 to output$max_code
50781>>>>>>>>>>
50781>>>>>>>>> move (replaces(mid(output$symbollist,5,code#*5+1),str#,"")) to str#
50782>>>>>>>>> loop
50783>>>>>>>>>>
50783>>>>>>>>> end
50783>>>>>>>>>>
50783>>>>>>>>> function_return str#
50784>>>>>>>>>end_function
50785>>>>>>>>>
50785>>>>>>>>>class cBasicSequentialOutputEMailRecipients is a cArray
50786>>>>>>>>> item_property_list
50786>>>>>>>>> item_property string psName.i
50786>>>>>>>>> item_property string psAddress.i
50786>>>>>>>>> end_item_property_list cBasicSequentialOutputEMailRecipients
#REM 50818 DEFINE FUNCTION PSADDRESS.I INTEGER LIROW RETURNS STRING
#REM 50822 DEFINE PROCEDURE SET PSADDRESS.I INTEGER LIROW STRING VALUE
#REM 50826 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 50830 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
50835>>>>>>>>> procedure add_recipient string lsName string lsAddress
50837>>>>>>>>> integer liRow
50837>>>>>>>>> get row_count to liRow
50838>>>>>>>>> set psName.i liRow to lsName
50839>>>>>>>>> set psAddress.i liRow to lsAddress
50840>>>>>>>>> end_procedure
50841>>>>>>>>>end_class // cBasicSequentialOutputEMailRecipients
50842>>>>>>>>>
50842>>>>>>>>>class cBasicSequentialOutput is a cArray
50843>>>>>>>>> procedure construct_object integer img#
50845>>>>>>>>> forward send construct_object img#
50847>>>>>>>>> set delegation_mode to delegate_to_parent
50848>>>>>>>>> move self to seq.object#
50849>>>>>>>>> property string pTitle public "Un-titled"
50850>>>>>>>>> property date pInitDate public 0
50851>>>>>>>>> property string pInitTime public ""
50852>>>>>>>>> property integer pDestination public DEST_SCREEN
50853>>>>>>>>>
50853>>>>>>>>> property integer pOutputChannel public -1
50854>>>>>>>>>
50854>>>>>>>>> property string pPrinterPort public "LPT1:"
50855>>>>>>>>> property string pOutFileName public "dataflex.txt"
50856>>>>>>>>> property string pScreenTmpFile public "" // Used when printing to screen AND *email*
50857>>>>>>>>> property integer pFileExistsAction public FILEEXISTS_OVERWRITE // If set to FILEEXISTS_CANCEL the report will refuse to print to an existing file!
50858>>>>>>>>> property integer pOmitFormFeed public 0
50859>>>>>>>>>
50859>>>>>>>>> property integer pLineCount public 0
50860>>>>>>>>> property integer pPageCount public 0
50861>>>>>>>>> property integer pPageLength public 50 // 0 means continous
50862>>>>>>>>> property integer pBytesWritten public 0
50863>>>>>>>>>
50863>>>>>>>>> property integer phMsg_Object public 0
50864>>>>>>>>>
50864>>>>>>>>> property integer pHeader_image public 0
50865>>>>>>>>> property integer pHeader_height public 0 // number of lines in header.
50866>>>>>>>>> property integer pHeader_msg public 0
50867>>>>>>>>>
50867>>>>>>>>> property integer pSubHeader_image public 0
50868>>>>>>>>> property integer pSubHeader_height public 0 // number of lines in subheader.
50869>>>>>>>>> property integer pSubHeader_msg public 0
50870>>>>>>>>>
50870>>>>>>>>> property integer pFooter_image public 0
50871>>>>>>>>> property integer pFooter_height public 0 // number of lines in footer.
50872>>>>>>>>> property integer pFooter_msg public 0
50873>>>>>>>>> property integer pFooterFill_image public 0
50874>>>>>>>>>
50874>>>>>>>>> property integer pOnceOnly_image public 0
50875>>>>>>>>> property integer pOnceOnly_height public 0
50876>>>>>>>>> property integer pOnceOnly_msg public 0
50877>>>>>>>>>
50877>>>>>>>>> property integer pInUseState public false
50878>>>>>>>>> property integer pWidth public 77
50879>>>>>>>>> property integer pbOemToAnsi public 0
50880>>>>>>>>>
50880>>>>>>>>> object oPageOffSets is an array no_image
50882>>>>>>>>> end_object
50883>>>>>>>>> object oChannelAdmin is a cChannelAdmin no_image
50885>>>>>>>>> end_object
50886>>>>>>>>> object oEmailRecipients is a cBasicSequentialOutputEMailRecipients
50888>>>>>>>>> end_object
50889>>>>>>>>> // ". /dfds01/appl/scripts/sendfile #F# #A#"
50889>>>>>>>>> property string psSendMailProgramPath public ""
50890>>>>>>>>> end_procedure
50891>>>>>>>>>
50891>>>>>>>>> procedure add_recipient string lsName string lsAddress
50893>>>>>>>>> send add_recipient to (oEmailRecipients(self)) lsName lsAddress
50894>>>>>>>>> end_procedure
50895>>>>>>>>>
50895>>>>>>>>> procedure reset_recipients
50897>>>>>>>>> send delete_data to (oEmailRecipients(self))
50898>>>>>>>>> end_procedure
50899>>>>>>>>>
50899>>>>>>>>> function iUseSequentialChannel returns integer
50901>>>>>>>>> integer destination#
50901>>>>>>>>> get pDestination to destination#
50902>>>>>>>>> function_return (destination#=DEST_FILE or destination#=DEST_HTML or destination#=DEST_EDITOR)
50903>>>>>>>>> end_function // iUseSequentialChannel
50904>>>>>>>>>
50904>>>>>>>>> function iPageBreakNeeded integer lines# returns integer
50906>>>>>>>>> integer pageend#
50906>>>>>>>>> get pPageLength to pageend#
50907>>>>>>>>> if pageend# eq 0 function_return 0
50910>>>>>>>>> function_return (lines#>(pageend#-pLineCount(self)-pFooter_height(self)))
50911>>>>>>>>> end_function
50912>>>>>>>>>
50912>>>>>>>>> function iAvailablePageLength returns integer
50914>>>>>>>>> integer pageend# headerlines# subheaderlines# footerlines#
50914>>>>>>>>> get pPageLength to pageend#
50915>>>>>>>>> get pHeader_height to headerlines#
50916>>>>>>>>> get pSubHeader_height to subheaderlines#
50917>>>>>>>>> get pFooter_height to footerlines#
50918>>>>>>>>> function_return (pageend#-headerlines#-subheaderlines#-footerlines#)
50919>>>>>>>>> end_function
50920>>>>>>>>>
50920>>>>>>>>> function Remaining_Lines returns integer
50922>>>>>>>>> integer pageend# linecount# footerlines#
50922>>>>>>>>> get pPageLength to pageend#
50923>>>>>>>>> get pLineCount to linecount#
50924>>>>>>>>> get pFooter_height to footerlines#
50925>>>>>>>>> function_return (pageend#-linecount#-footerlines#)
50926>>>>>>>>> end_function
50927>>>>>>>>>
50927>>>>>>>>> function iResource_Reserve returns integer
50929>>>>>>>>> integer ch1# ch2# rval# UseSequentialChannel#
50929>>>>>>>>> get iUseSequentialChannel to UseSequentialChannel# // Do we need a channel?
50930>>>>>>>>> if UseSequentialChannel# get Seq_New_Channel to ch1#
50933>>>>>>>>> else move 0 to ch1#
50935>>>>>>>>> get Seq_New_Channel to ch2#
50936>>>>>>>>> move (ch1#>=0 and ch2#>=0) to rval#
50937>>>>>>>>> if rval# begin
50939>>>>>>>>> if UseSequentialChannel# set pOutputChannel to ch1#
50942>>>>>>>>> set pChannel of (oChannelAdmin(self)) to ch2#
50943>>>>>>>>> end
50943>>>>>>>>>>
50943>>>>>>>>> else begin
50944>>>>>>>>> if UseSequentialChannel# if ch1# ge 0 send Seq_Release_Channel ch1#
50949>>>>>>>>> if ch2# ge 0 send Seq_Release_Channel ch2#
50952>>>>>>>>> end
50952>>>>>>>>>>
50952>>>>>>>>> function_return rval#
50953>>>>>>>>> end_function
50954>>>>>>>>>
50954>>>>>>>>> procedure Resource_Release
50956>>>>>>>>> if (iUseSequentialChannel(self)) ; send Seq_Release_Channel (pOutputChannel(self))
50959>>>>>>>>> send Seq_Release_Channel (pChannel(oChannelAdmin(self)))
50960>>>>>>>>> end_procedure
50961>>>>>>>>>
50961>>>>>>>>> procedure Page_Eject_No_Footer.i integer ff#
50963>>>>>>>>> integer obj# ch# Destination#
50963>>>>>>>>> integer pos# UseSequentialChannel#
50963>>>>>>>>> if (pLineCount(self)) begin
50965>>>>>>>>> get iUseSequentialChannel to UseSequentialChannel#
50966>>>>>>>>> if UseSequentialChannel# begin
50968>>>>>>>>> get pOutputChannel to ch#
50969>>>>>>>>> get_channel_position ch# to pos#
50970>>>>>>>>>>
50970>>>>>>>>> set pBytesWritten to pos#
50971>>>>>>>>> end
50971>>>>>>>>>>
50971>>>>>>>>> get pDestination to Destination#
50972>>>>>>>>> if Destination# eq DEST_SCREEN begin //screen
50974>>>>>>>>>// winprint, newpage
50974>>>>>>>>> end
50974>>>>>>>>>>
50974>>>>>>>>> else begin
50975>>>>>>>>> if UseSequentialChannel# begin
50977>>>>>>>>> if ff# begin
50979>>>>>>>>> if Destination# eq DEST_HTML write channel ch# (replace("#",'<BR><BR><A NAME="EndOfSection#"></A>',string(pPageCount(self))))
50983>>>>>>>>> else write channel ch# (character(12))
50986>>>>>>>>> end
50986>>>>>>>>>>
50986>>>>>>>>> end
50986>>>>>>>>>>
50986>>>>>>>>> end
50986>>>>>>>>>>
50986>>>>>>>>> set pPageCount to (pPageCount(self)+1)
50987>>>>>>>>> set pLineCount to 0
50988>>>>>>>>> move 0 to linecount
50989>>>>>>>>> end
50989>>>>>>>>>>
50989>>>>>>>>> end_procedure
50990>>>>>>>>>
50990>>>>>>>>> procedure page_eject.i integer ff#
50992>>>>>>>>> integer line# linecount# pageend# footerlines# footer_img# footerfill_img#
50992>>>>>>>>> get pLineCount to linecount#
50993>>>>>>>>> if linecount# begin // only if something has been written
50995>>>>>>>>> get pFooter_image to footer_img#
50996>>>>>>>>> if footer_img# begin // If 'footer' has been set
50998>>>>>>>>> get pPageLength to pageend#
50999>>>>>>>>> get pFooter_height to footerlines#
51000>>>>>>>>> get pFooterFill_image to footerfill_img#
51001>>>>>>>>> for line# from linecount# to (pageend#-1-footerlines#)
51007>>>>>>>>>>
51007>>>>>>>>> if footerfill_img# send output_image_aux footerfill_img#
51010>>>>>>>>> else send writeln_no_headers ""
51012>>>>>>>>> loop
51013>>>>>>>>>>
51013>>>>>>>>> send message.i (pFooter_msg(self))
51014>>>>>>>>> send output_image_aux footer_img#
51015>>>>>>>>> end
51015>>>>>>>>>>
51015>>>>>>>>> send page_eject_no_footer.i ff#
51016>>>>>>>>> end
51016>>>>>>>>>>
51016>>>>>>>>> end_procedure
51017>>>>>>>>>
51017>>>>>>>>> procedure new_page
51019>>>>>>>>> send page_eject.i 1
51020>>>>>>>>> end_procedure
51021>>>>>>>>>
51021>>>>>>>>> procedure cmdline_start
51023>>>>>>>>> end_procedure
51024>>>>>>>>> procedure cmdline_stop
51026>>>>>>>>> end_procedure
51027>>>>>>>>>
51027>>>>>>>>> function iPreconditions_Direct_Output returns integer
51029>>>>>>>>> integer rval#
51029>>>>>>>>> get iResource_Reserve to rval#
51030>>>>>>>>> function_return rval#
51031>>>>>>>>> end_function
51032>>>>>>>>>
51032>>>>>>>>> function iDirect_Output returns integer
51034>>>>>>>>> integer rval# dest# exists_action#
51034>>>>>>>>> string tmp_fn# fn#
51034>>>>>>>>> move 1 to rval#
51035>>>>>>>>> if (iPreconditions_Direct_Output(self)) begin
51037>>>>>>>>> get pDestination to dest#
51038>>>>>>>>> set pInitDate to (dSysDate())
51039>>>>>>>>> set pInitTime to (sSysTime())
51040>>>>>>>>> if dest# eq DEST_PRINTER begin // Printer
51042>>>>>>>>> set pOmitFormFeed to true
51043>>>>>>>>> end
51043>>>>>>>>>>
51043>>>>>>>>> if dest# eq DEST_SCREEN begin // Screen
51045>>>>>>>>> set pOmitFormFeed to true
51046>>>>>>>>> end
51046>>>>>>>>>>
51046>>>>>>>>> if dest# eq DEST_FILE begin // File
51048>>>>>>>>> get pOutFileName to fn#
51049>>>>>>>>> move 2 to exists_action# // 0=cancel 1=append, 2=overwrite
51050>>>>>>>>> if (SEQ_FileExists(fn#)) begin
51052>>>>>>>>> get pFileExistsAction to exists_action#
51053>>>>>>>>> // if exists_action# eq FILEEXISTS_PROMPT move (SEQ_FileExistsAction(fn#,1)) to exists_action#
51053>>>>>>>>> end
51053>>>>>>>>>>
51053>>>>>>>>> if exists_action# begin
51055>>>>>>>>> if exists_action# eq 1 append_output channel (pOutputChannel(self)) ("cr: 13 eol: 10 "+fn#) //append
51059>>>>>>>>> if exists_action# eq 2 direct_output channel (pOutputChannel(self)) ("cr: 13 eol: 10 "+fn#) //overwrite
51063>>>>>>>>> end
51063>>>>>>>>>>
51063>>>>>>>>> else move 0 to rval#
51065>>>>>>>>> end
51065>>>>>>>>>>
51065>>>>>>>>> if dest# eq DEST_EMAIL begin // EMAIL
51067>>>>>>>>>
51067>>>>>>>>>// get SEQ_UniqueFileName "mail" to fn#
51067>>>>>>>>> get SEQ_UniqueFileNamePathAndExt "" "mail" "txt" to fn#
51068>>>>>>>>> if fn# ne "" begin
51070>>>>>>>>> set pScreenTmpFile to fn#
51071>>>>>>>>> if (API_OtherAttr_Value(OA_OS_SHORT_NAME)="WIN32CM") begin
51073>>>>>>>>> direct_output channel (pOutputChannel(self)) fn#
51075>>>>>>>>> end
51075>>>>>>>>>>
51075>>>>>>>>> else begin
51076>>>>>>>>> direct_output channel (pOutputChannel(self)) ("pc-text: "+fn#)
51078>>>>>>>>> end
51078>>>>>>>>>>
51078>>>>>>>>> end
51078>>>>>>>>>>
51078>>>>>>>>> else begin
51079>>>>>>>>> send obs "Outfile failure (source: output.utl)" "(E-mail)"
51080>>>>>>>>> move 0 to rval#
51081>>>>>>>>> end
51081>>>>>>>>>>
51081>>>>>>>>> end
51081>>>>>>>>>>
51081>>>>>>>>> if dest# eq DEST_HTML begin // HTML
51083>>>>>>>>> end
51083>>>>>>>>>>
51083>>>>>>>>> set pPageCount to 0
51084>>>>>>>>> set pBytesWritten to 0
51085>>>>>>>>> set pLineCount to 0
51086>>>>>>>>> end
51086>>>>>>>>>>
51086>>>>>>>>> else move 0 to rval#
51088>>>>>>>>> if rval# begin
51090>>>>>>>>> set pInUseState to true
51091>>>>>>>>> send Report_Wait_On
51092>>>>>>>>> send Initialize_Output
51093>>>>>>>>> end
51093>>>>>>>>>>
51093>>>>>>>>> else begin
51094>>>>>>>>> set pInUseState to false
51095>>>>>>>>> send Resource_Release
51096>>>>>>>>> end
51096>>>>>>>>>>
51096>>>>>>>>> function_return rval#
51097>>>>>>>>> end_function
51098>>>>>>>>> function iDirect_Output_Title string title# returns integer
51100>>>>>>>>> integer rval#
51100>>>>>>>>> set pTitle to title#
51101>>>>>>>>> get iDirect_Output to rval#
51102>>>>>>>>> if rval# begin
51104>>>>>>>>> set pHeader_image to 0
51105>>>>>>>>> set pHeader_height to 0
51106>>>>>>>>> set pHeader_msg to 0
51107>>>>>>>>> set pSubHeader_image to 0
51108>>>>>>>>> set pSubHeader_height to 0
51109>>>>>>>>> set pSubHeader_msg to 0
51110>>>>>>>>> set pFooter_image to 0
51111>>>>>>>>> set pFooter_height to 0
51112>>>>>>>>> set pFooter_msg to 0
51113>>>>>>>>> set pFooterFill_image to 0
51114>>>>>>>>> set pOnceOnly_image to 0
51115>>>>>>>>> set pOnceOnly_height to 0
51116>>>>>>>>> set pOnceOnly_msg to 0
51117>>>>>>>>> end
51117>>>>>>>>>>
51117>>>>>>>>> function_return rval#
51118>>>>>>>>> end_function
51119>>>>>>>>> procedure Initialize_Output
51121>>>>>>>>> end_procedure
51122>>>>>>>>>
51122>>>>>>>>> procedure DoSendEmails string lsFile
51124>>>>>>>>> integer lhEmailRecipients liMax liRow
51124>>>>>>>>> string lsName lsAddress lsSendMailProgramPath
51124>>>>>>>>>
51124>>>>>>>>> get psSendMailProgramPath to lsSendMailProgramPath
51125>>>>>>>>> if (lsSendMailProgramPath<>"") begin
51127>>>>>>>>>
51127>>>>>>>>> move (oEmailRecipients(self)) to lhEmailRecipients
51128>>>>>>>>> get row_count of lhEmailRecipients to liMax
51129>>>>>>>>> decrement liMax
51130>>>>>>>>> for liRow from 0 to liMax
51136>>>>>>>>>>
51136>>>>>>>>> get psSendMailProgramPath to lsSendMailProgramPath
51137>>>>>>>>> move (replace("#A#",lsSendMailProgramPath,psAddress.i(lhEmailRecipients,liRow))) to lsSendMailProgramPath
51138>>>>>>>>> move (replace("#F#",lsSendMailProgramPath,lsFile)) to lsSendMailProgramPath
51139>>>>>>>>> //send obs lsSendMailProgramPath
51139>>>>>>>>> runprogram wait lsSendMailProgramPath
51140>>>>>>>>> loop
51141>>>>>>>>>>
51141>>>>>>>>> end
51141>>>>>>>>>>
51141>>>>>>>>> else send obs "E-mail program path not specified."
51143>>>>>>>>> end_procedure
51144>>>>>>>>>
51144>>>>>>>>> procedure Close_Output
51146>>>>>>>>> integer ch# dest# pos#
51146>>>>>>>>> string lsFileName
51146>>>>>>>>> if (pInUseState(self)) begin
51148>>>>>>>>> if (pLineCount(self)) send page_eject.i (not(pOmitFormFeed(self)))
51151>>>>>>>>>
51151>>>>>>>>> if (iUseSequentialChannel(self)) begin
51153>>>>>>>>> send write_no_headers "<RST>"
51154>>>>>>>>> get pOutputChannel to ch#
51155>>>>>>>>> get_channel_position ch# to pos#
51156>>>>>>>>>>
51156>>>>>>>>> set pBytesWritten to pos#
51157>>>>>>>>> despool
51158>>>>>>>>>>
51158>>>>>>>>> close_output channel ch#
51160>>>>>>>>> end
51160>>>>>>>>>>
51160>>>>>>>>>
51160>>>>>>>>> get pDestination to dest#
51161>>>>>>>>> if dest# eq DEST_PRINTER begin
51163>>>>>>>>> send cmdline_stop
51164>>>>>>>>>// WinPrint, print doc
51164>>>>>>>>> end
51164>>>>>>>>>>
51164>>>>>>>>> if dest# eq DEST_EMAIL begin
51166>>>>>>>>> //send obs "Haps, min fine ven"
51166>>>>>>>>> send report_wait_update "Sending e-mails..."
51167>>>>>>>>> get pScreenTmpFile to lsFileName
51168>>>>>>>>> get SEQ_ConvertToAbsoluteFileName lsFileName to lsFileName
51169>>>>>>>>> send DoSendEmails lsFileName
51170>>>>>>>>> erasefile lsFileName
51171>>>>>>>>>>
51171>>>>>>>>> end
51171>>>>>>>>>>
51171>>>>>>>>> send report_wait_off
51172>>>>>>>>> if dest# eq DEST_SCREEN begin
51174>>>>>>>>>// WinPrint, print doc
51174>>>>>>>>> end
51174>>>>>>>>>>
51174>>>>>>>>> else send report_done
51176>>>>>>>>> set pInUseState to false
51177>>>>>>>>> send Resource_Release
51178>>>>>>>>> end
51178>>>>>>>>>>
51178>>>>>>>>>
51178>>>>>>>>> end_procedure
51179>>>>>>>>>
51179>>>>>>>>> procedure message.i integer msg#
51181>>>>>>>>> integer lhObj
51181>>>>>>>>> if msg# begin
51183>>>>>>>>> get phMsg_Object to lhObj
51184>>>>>>>>> if lhObj send msg# to lhObj
51187>>>>>>>>> else send msg#
51189>>>>>>>>> end
51189>>>>>>>>>>
51189>>>>>>>>> end_procedure
51190>>>>>>>>>
51190>>>>>>>>> function replace_header_codes string str# returns string
51192>>>>>>>>> integer pagecount#
51192>>>>>>>>> date date#
51192>>>>>>>>> string page#
51192>>>>>>>>> get pInitDate to date#
51193>>>>>>>>> move (pPageCount(self)+1) to pagecount#
51194>>>>>>>>> move (replaces("<date---->",str#,string(date#))) to str#
51195>>>>>>>>> move (replaces("<time-->",str#,pInitTime(self))) to str# //time
51196>>>>>>>>> if "<pg>" in str# begin // page number
51198>>>>>>>>> move pagecount# to page#
51199>>>>>>>>> if pagecount# le 999 insert " " in page# at 1
51203>>>>>>>>> pad page# to page# 4
51205>>>>>>>>>>
51205>>>>>>>>> move (replaces("<pg>",str#,page#)) to str# //time
51206>>>>>>>>> end
51206>>>>>>>>>>
51206>>>>>>>>> if "<p>" in str# begin // page number
51208>>>>>>>>> move pagecount# to page#
51209>>>>>>>>> if pagecount# le 99 insert " " in page# at 1
51213>>>>>>>>> if pagecount# le 9 insert " " in page# at 1
51217>>>>>>>>> move (replaces("<p>",str#,page#)) to str#
51218>>>>>>>>> end
51218>>>>>>>>>>
51218>>>>>>>>> function_return str#
51219>>>>>>>>> end_function
51220>>>>>>>>>
51220>>>>>>>>> function replace_codes string str# returns string
51222>>>>>>>>> // If e-mail remove codes, else insert code values
51222>>>>>>>>> if (pDestination(self)=DEST_EMAIL) function_return (output.replace_codes(str#))
51225>>>>>>>>> function_return (output.remove_codes(str#))
51226>>>>>>>>> end_function
51227>>>>>>>>>
51227>>>>>>>>> procedure output_image_help integer img# integer header_codes#
51229>>>>>>>>> integer seqeof# obj# ch#
51229>>>>>>>>> string str#
51229>>>>>>>>> move (seqeof) to seqeof#
51230>>>>>>>>> move (oChannelAdmin(self)) to obj#
51231>>>>>>>>> get pChannel of obj# to ch#
51232>>>>>>>>> send direct_xput to obj# 1 ("image: "+string(img#))
51233>>>>>>>>> repeat
51233>>>>>>>>>>
51233>>>>>>>>> readln channel ch# str#
51235>>>>>>>>> [~seqeof] begin
51237>>>>>>>>>>
51237>>>>>>>>> if header_codes# send writeln_no_headers (replace_header_codes(self,str#))
51240>>>>>>>>> else send writeln str#
51242>>>>>>>>> end
51242>>>>>>>>>>
51242>>>>>>>>> [~seqeof] loop
51243>>>>>>>>>>
51243>>>>>>>>> send close_xput to obj#
51244>>>>>>>>> indicate seqeof as seqeof#
51245>>>>>>>>> end_procedure
51246>>>>>>>>>
51246>>>>>>>>> procedure output_image_aux integer img#
51248>>>>>>>>> send output_image_help img# 1
51249>>>>>>>>> end_procedure
51250>>>>>>>>>
51250>>>>>>>>> procedure output_image integer img# integer check_space_tmp#
51252>>>>>>>>> integer check_space#
51252>>>>>>>>> if num_arguments gt 1 move check_space_tmp# to check_space#
51255>>>>>>>>> else move 0 to check_space#
51257>>>>>>>>> if (iPageBreakNeeded(self,check_space#)) send page_eject.i 0
51260>>>>>>>>> send output_image_help img# 0
51261>>>>>>>>> end_procedure
51262>>>>>>>>>
51262>>>>>>>>> procedure output_image_wrap integer img# // Won't work! (BLANKFORM img#)
51264>>>>>>>>> send output_image_help img# 0
51266>>>>>>>>> indicate copy_122 as [ |122]
51267>>>>>>>>> send output_image img#
51270>>>>>>>>> indicate copy_122 as [ |122]
51271>>>>>>>>> [not copy_122] repeat
51273>>>>>>>>>>
51273>>>>>>>>> send output_image img#
51275>>>>>>>>> indicate copy_122 as [ |122]
51276>>>>>>>>> [not copy_122] loop
51277>>>>>>>>>>
51277>>>>>>>>> end_procedure
51278>>>>>>>>>
51278>>>>>>>>> procedure write.i string str# integer do_headers#
51280>>>>>>>>> integer header_img# subheader_img# onceonly_img# pagecount# pageend#
51280>>>>>>>>> string page_init#
51280>>>>>>>>> if do_headers# begin
51282>>>>>>>>> get pHeader_image to header_img#
51283>>>>>>>>> get pSubHeader_image to subheader_img#
51284>>>>>>>>> get pOnceOnly_image to onceonly_img#
51285>>>>>>>>> get pPageCount to pagecount#
51286>>>>>>>>> get pPageLength to pageend#
51287>>>>>>>>>
51287>>>>>>>>> if (iPageBreakNeeded(self,1)) send page_eject.i 0
51290>>>>>>>>>
51290>>>>>>>>> // if we are at the top of a new page print header and subheader:
51290>>>>>>>>> if (pLineCount(self)) eq 0 begin
51292>>>>>>>>>
51292>>>>>>>>> send message.i (pHeader_msg(self))
51293>>>>>>>>> if header_img# send output_image_aux header_img#
51296>>>>>>>>>
51296>>>>>>>>> send message.i (pSubHeader_msg(self))
51297>>>>>>>>> if subheader_img# send output_image_aux subheader_img#
51300>>>>>>>>> end
51300>>>>>>>>>>
51300>>>>>>>>> if onceonly_img# begin
51302>>>>>>>>> send message.i (pOnceOnly_msg(self))
51303>>>>>>>>> set pOnceOnly_image to 0
51304>>>>>>>>> send output_image onceonly_img#
51305>>>>>>>>> end
51305>>>>>>>>>>
51305>>>>>>>>> end
51305>>>>>>>>>>
51305>>>>>>>>> move (replace_codes(self,str#)) to str#
51306>>>>>>>>> if (iUseSequentialChannel(self)) write channel (pOutputChannel(self)) str#
51310>>>>>>>>> else begin
51311>>>>>>>>> end
51311>>>>>>>>>>
51311>>>>>>>>> end_procedure
51312>>>>>>>>>
51312>>>>>>>>> procedure write_no_headers string str#
51314>>>>>>>>> send write.i str# 0
51315>>>>>>>>> end_procedure
51316>>>>>>>>>
51316>>>>>>>>> procedure write string str#
51318>>>>>>>>> send write.i str# 1
51319>>>>>>>>> end_procedure
51320>>>>>>>>>
51320>>>>>>>>> procedure writeln string str#
51322>>>>>>>>> send write.i str# 1
51323>>>>>>>>> if (iUseSequentialChannel(self)) writeln channel (pOutputChannel(self)) (if(pDestination(self)=DEST_HTML,"<BR>",""))
51328>>>>>>>>> else begin
51329>>>>>>>>> end
51329>>>>>>>>>>
51329>>>>>>>>> set pLineCount to (pLineCount(self)+1)
51330>>>>>>>>> end_procedure
51331>>>>>>>>>
51331>>>>>>>>> procedure writeln_no_headers string str#
51333>>>>>>>>> send write.i str# 0
51334>>>>>>>>> writeln channel (pOutputChannel(self))
51336>>>>>>>>> set pLineCount to (pLineCount(self)+1)
51337>>>>>>>>> end_procedure
51338>>>>>>>>>
51338>>>>>>>>> procedure make_horizontal_line
51340>>>>>>>>> integer destination#
51340>>>>>>>>> get pDestination to Destination#
51341>>>>>>>>>
51341>>>>>>>>>// if (destination#=DEST_PRINTER or destination#=DEST_SCREEN) winprint, draw line
51341>>>>>>>>> else begin
51342>>>>>>>>> if destination# eq DEST_HTML send writeln "<HR>" // Horizontal ruler
51345>>>>>>>>> else send writeln (repeat(" ",pWidth(self)))
51347>>>>>>>>> end
51347>>>>>>>>>>
51347>>>>>>>>> end_procedure
51348>>>>>>>>>
51348>>>>>>>>> procedure call_viewer
51350>>>>>>>>> integer self#
51350>>>>>>>>> move self to self#
51351>>>>>>>>> send output.CallViewer (pScreenTmpFile(self)) self#
51352>>>>>>>>> end_procedure
51353>>>>>>>>>
51353>>>>>>>>> procedure Report_Wait_On
51355>>>>>>>>> end_procedure
51356>>>>>>>>> procedure Report_Wait_Off
51358>>>>>>>>> end_procedure
51359>>>>>>>>> procedure Report_Wait_Update string str#
51361>>>>>>>>> end_procedure
51362>>>>>>>>> procedure Report_Wait_Update2 string str#
51364>>>>>>>>> end_procedure
51365>>>>>>>>> function iReport_Cancel returns integer
51367>>>>>>>>> end_function
51368>>>>>>>>> procedure Report_Done
51370>>>>>>>>> send obs "Done"
51371>>>>>>>>> end_procedure
51372>>>>>>>>>end_class // cBasicSequentialOutput
51373>>>>>>>>>
51373>>>>>>>>>object oBasicSequentialOutput is a cBasicSequentialOutput NO_IMAGE
51375>>>>>>>>>end_object
51376>>>>>>>>>
51376>>>>>>>>>
51376>>>>>>>>>// seq.output <image> [lines]
51376>>>>>>>>>
51376>>>>>>>>>
51376>>>>>>>>>
51376>>>>>>>>>
51376>>>>>>>>>
51376>>>>>>>>>
51376>>>>>>>>>
51376>>>>>>>>>// ===========================================================================
51376>>>>>>>>>// ********************* CHARACTER MODE PREVIEW OBJECT *********************
51376>>>>>>>>>// ===========================================================================
51376>>>>>>>>>
51376>>>>>>>>>use Aps // Auto Position and Sizing classes for Visual DataFlex 4.0
51376>>>>>>>>>use file_dlg // OpenDialog class
51376>>>>>>>>>register_abstract_field_type aft_AppLinkPath50 50 ascii_window
51378>>>>>>>>>
51378>>>>>>>>>object WordPadLinkSetup is a aps.ModalPanel label "WordPad kommunikation"
51381>>>>>>>>> object FlDlg is a OpenDialog
51383>>>>>>>>> set NoChangeDir_State to true
51384>>>>>>>>> end_object
51385>>>>>>>>> object cont is a aps.container3D
51387>>>>>>>>> object frm1 is a aps.Form label "WordPadPath:" abstract aft_AppLinkPath50
51391>>>>>>>>> set p_extra_internal_width to -100
51392>>>>>>>>> set form_button item 0 to 1
51393>>>>>>>>> set form_button_value item 0 to "..."
51394>>>>>>>>> procedure form_button_notification integer itm#
51397>>>>>>>>> integer obj#
51397>>>>>>>>> move (FlDlg(self)) to obj#
51398>>>>>>>>> set Dialog_Caption of obj# to "Locate WORDPAD.EXE"
51399>>>>>>>>> Set Filter_String of obj# to ; "Standard (WORDPAD.EXE)|WORDPAD.EXE|EXE files|*.exe|All files|*.*"
51400>>>>>>>>> if (Show_Dialog(obj#)) set value item 0 to (File_Name(obj#))
51403>>>>>>>>> end_procedure
51404>>>>>>>>> end_object
51405>>>>>>>>> end_object
51406>>>>>>>>> procedure activate
51409>>>>>>>>> ifnot (active_state(self)) send retrieve_values
51412>>>>>>>>> forward send activate
51414>>>>>>>>> end_procedure
51415>>>>>>>>> procedure retrieve_values
51418>>>>>>>>> string str#
51418>>>>>>>>> get_profile_string "APPLICATION_LINKS" "WordPadPath" to str#
51421>>>>>>>>> set value of (frm1(cont(self))) item 0 to str#
51422>>>>>>>>> end_procedure
51423>>>>>>>>> procedure store_values
51426>>>>>>>>> set_profile_string "APPLICATION_LINKS" "WordPadPath" to (value(frm1(cont(self)),0))
51429>>>>>>>>> send close_panel
51430>>>>>>>>> end_procedure
51431>>>>>>>>> object btn1 is a aps.multi_button
51433>>>>>>>>> on_item "OK" send store_values
51434>>>>>>>>> end_object
51435>>>>>>>>> object btn2 is a aps.multi_button
51437>>>>>>>>> on_item "Cancel" send close_panel
51438>>>>>>>>> end_object
51439>>>>>>>>> send aps_locate_multi_buttons
51440>>>>>>>>>end_object
51441>>>>>>>>>procedure activate_wordpad_setup
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
51443>>>>>>>>> send popup to (WordPadLinkSetup(self))
51444>>>>>>>>>end_procedure
51445>>>>>>>>>
51445>>>>>>>>>procedure output.CallViewer global string fn# integer obj#
51447>>>>>>>>> string str#
51447>>>>>>>>> get_profile_string "APPLICATION_LINKS" "WordPadPath" to str#
51450>>>>>>>>> move (str#*fn#) to str#
51451>>>>>>>>> runprogram wait str#
51452>>>>>>>>>end_procedure
51453>>>>>>>>>
51453>>>>>>>>>procedure output.display_file global string fn#
51455>>>>>>>>> integer ch# fin# liPos
51455>>>>>>>>> integer liSearchPrnLine // Find this line (in .PRN file)
51455>>>>>>>>> integer liFileLine // Line number currently being loaded
51455>>>>>>>>> integer liResultLine // desired item found in this line in the file
51455>>>>>>>>> string lsTmpPrnLine //
51455>>>>>>>>> string str# dir#
51455>>>>>>>>> get Seq_New_Channel to ch#
51456>>>>>>>>> direct_input channel ch# fn#
51458>>>>>>>>> if [seqeof] send obs ("File not found ("+fn#+")")
51461>>>>>>>>> else begin
51462>>>>>>>>> get SEQ_ExtractPathFromFileName fn# to dir#
51463>>>>>>>>> if (dir#="") move (SEQ_FindFileAlongDFPath(fn#)) to dir#
51466>>>>>>>>> if (dir#=".") get_current_directory to dir#
51469>>>>>>>>> set pDestination of seq.object# to DEST_SCREEN
51470>>>>>>>>> if (iDirect_Output_Title(seq.object#,fn#+" "+"("+dir#+")")) begin
51472>>>>>>>>> move 0 to fin#
51473>>>>>>>>> move 0 to liFileLine
51474>>>>>>>>> move 0 to liResultLine
51475>>>>>>>>> repeat
51475>>>>>>>>>>
51475>>>>>>>>> readln channel ch# str#
51477>>>>>>>>> move (seqeof) to fin#
51478>>>>>>>>> ifnot fin# begin
51480>>>>>>>>>
51480>>>>>>>>> increment liFileLine
51481>>>>>>>>>
51481>>>>>>>>> // *** PRN file search ***
51481>>>>>>>>> if liSearchPrnLine begin // If we're searching for a PRN line
51483>>>>>>>>> ifnot liResultLine begin // If we didn't find it yet
51485>>>>>>>>> if ("0123456789" contains left(str#,1)) begin
51487>>>>>>>>> move (pos(">",str#)) to liPos
51488>>>>>>>>> if (liPos>0 and liPos<8) begin
51490>>>>>>>>> move (left(str#,liPos-1)) to lsTmpPrnLine
51491>>>>>>>>> if (StringIsInteger(lsTmpPrnLine) and integer(lsTmpPrnLine)>=liSearchPrnLine) begin
51493>>>>>>>>> move liFileLine to liResultLine
51494>>>>>>>>> move 0 to liSearchPrnLine
51495>>>>>>>>> end
51495>>>>>>>>>>
51495>>>>>>>>> end
51495>>>>>>>>>>
51495>>>>>>>>> end
51495>>>>>>>>>>
51495>>>>>>>>> end
51495>>>>>>>>>>
51495>>>>>>>>> end
51495>>>>>>>>>>
51495>>>>>>>>>
51495>>>>>>>>> seq.writeln str#
51497>>>>>>>>> end
51497>>>>>>>>>>
51497>>>>>>>>> until fin#
51499>>>>>>>>> seq.close_output
51500>>>>>>>>> end
51500>>>>>>>>>>
51500>>>>>>>>> end
51500>>>>>>>>>>
51500>>>>>>>>> send Seq_Release_Channel ch#
51501>>>>>>>>>end_procedure
51502>>>>>>>>>
51502>>>>>>>>>procedure output.run_dfindex_all global
51504>>>>>>>>> send output.display_file "dfsort.log"
51505>>>>>>>>>end_procedure
51506>>>>>>>Use Dates.nui // Date routines (No User Interface)
51506>>>>>>>
51506>>>>>>>Use APS // Auto Positioning and Sizing classes for VDF
51506>>>>>>>Use Buttons.utl // Button texts
51506>>>>>>>register_object oFrm1
51506>>>>>>>register_object oFrm2
51506>>>>>>>register_object oFrm3
51506>>>>>>>object oLogFilePropertiesPanel is a aps.ModalPanel label "Log fil"
51509>>>>>>> set locate_mode to CENTER_ON_SCREEN
51510>>>>>>> property integer phLogFile public 0
51512>>>>>>> on_key kcancel send close_panel
51513>>>>>>> object oFrm1 is a aps.Form abstract AFT_ASCII60 label "Current log file is:"
51517>>>>>>> set label_justification_mode to JMODE_TOP
51518>>>>>>> set object_shadow_state to DFTRUE
51519>>>>>>> end_object
51520>>>>>>> send aps_new_field_row
51521>>>>>>> send aps_make_row_space 5
51522>>>>>>> object oFrm2 is a aps.Form abstract AFT_ASCII15 label "Size:"
51526>>>>>>> set object_shadow_state to DFTRUE
51527>>>>>>> end_object
51528>>>>>>> procedure DoUpdateFile
51531>>>>>>> integer lhLogFile
51531>>>>>>> string lsFile
51531>>>>>>> get phLogFile to lhLogFile
51532>>>>>>> get psFileName of lhLogFile to lsFile
51533>>>>>>> set value of (oFrm1(self)) item 0 to lsFile
51534>>>>>>> if (SEQ_FileExists(lsFile)=SEQIT_FILE) begin
51536>>>>>>> set value of (oFrm2(self)) item 0 to (SEQ_FileSizeToString(SEQ_FileSize(lsFile)))
51537>>>>>>> set value of (oFrm3(self)) item 0 to (TS_ConvertToString(SEQ_FileModTime(lsFile)))
51538>>>>>>> end
51538>>>>>>>>
51538>>>>>>> else begin
51539>>>>>>> set value of (oFrm2(self)) item 0 to "-"
51540>>>>>>> set value of (oFrm3(self)) item 0 to "-"
51541>>>>>>> end
51541>>>>>>>>
51541>>>>>>> end_procedure
51542>>>>>>>
51542>>>>>>> procedure DoView
51545>>>>>>> runprogram BACKGROUND ("notepad "+psFileName(phLogFile(self)))
51546>>>>>>> end_procedure
51547>>>>>>> procedure DoReset
51550>>>>>>> send DeleteFile to (phLogFile(self))
51551>>>>>>> send DoUpdateFile
51552>>>>>>> end_procedure
51553>>>>>>> object oFrm3 is a aps.Form abstract AFT_ASCII25 label "Tidsstempling:" snap SL_RIGHT_SPACE
51558>>>>>>> set object_shadow_state to DFTRUE
51559>>>>>>> end_object
51560>>>>>>> object oBtn1 is a aps.Multi_Button
51562>>>>>>> on_item "View file" send DoView
51563>>>>>>> end_object
51564>>>>>>> object oBtn1 is a aps.Multi_Button
51566>>>>>>> on_item "Reset file" send DoReset
51567>>>>>>> end_object
51568>>>>>>> object oBtn1 is a aps.Multi_Button
51570>>>>>>> on_item t.btn.close send close_panel
51571>>>>>>> end_object
51572>>>>>>> send aps_locate_multi_buttons
51573>>>>>>> procedure popup.i integer lhLogFile
51576>>>>>>> integer rval#
51576>>>>>>> set phLogFile to lhLogFile
51577>>>>>>> send DoUpdateFile
51578>>>>>>> send popup
51579>>>>>>> end_procedure
51580>>>>>>>end_object // oLogFilePropertiesPanel
51581>>>>>>>
51581>>>>>>>procedure Popup_LogFileProperties global integer lhLogFile
51583>>>>>>> send popup.i to (oLogFilePropertiesPanel(self)) lhLogFile
51584>>>>>>>end_procedure
51585>>>>>Use Dates.nui // Date routines (No User Interface)
51585>>>>>Use OpenStat.nui // cTablesOpenStatus class (formely cFileAllFiles) (No User Interface)
Including file: openstat.nui (C:\Apps\VDFQuery\AppSrc\openstat.nui)
51585>>>>>>>// Use OpenStat.nui // cTablesOpenStatus class (formely cFileAllFiles) (No User Interface)
51585>>>>>>>
51585>>>>>>>//> Usually when a DataFlex program is running a number of data tables
51585>>>>>>>//> have been opened (with the open command). Each open table is assigned
51585>>>>>>>//> a number usually identical to the number of the entry in FILELIST.CFG.
51585>>>>>>>//>
51585>>>>>>>//> An object of the cTablesOpenStatus is capable of taking a snapshot
51585>>>>>>>//> of which tables are open. After a 'snapshop' has been taken you may
51585>>>>>>>//> open new tables or change the open mode of already open tables.
51585>>>>>>>//>
51585>>>>>>>//> At this point the object is capable of restoring the status to the
51585>>>>>>>//> the time of the snapshot.
51585>>>>>>>//>
51585>>>>>>>//>
51585>>>>>>>//> object oOpenStat is a cTablesOpenStatus
51585>>>>>>>//> end_object
51585>>>>>>>//>
51585>>>>>>>//> send RegisterCurrentOpenFiles to (oOpenStat(self)) // Snap!
51585>>>>>>>//> open this
51585>>>>>>>//> close that
51585>>>>>>>//> send RestoreFiles to (oOpenStat(self)) // Restore
51585>>>>>>>
51585>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
51585>>>>>>>Use DBMS.nui // Basic DBMS functions
51585>>>>>>>
51585>>>>>>> class cTablesOpenPrepareList is an cArray // This must be embedded in a cTablesOpenStatus object
51586>>>>>>> item_property_list
51586>>>>>>> item_property integer piFile.i
51586>>>>>>> item_property integer piMode.i
51586>>>>>>> item_property integer piIdx.i
51586>>>>>>> item_property string psRootName.i
51586>>>>>>> end_item_property_list cTablesOpenPrepareList
#REM 51624 DEFINE FUNCTION PSROOTNAME.I INTEGER LIROW RETURNS STRING
#REM 51628 DEFINE PROCEDURE SET PSROOTNAME.I INTEGER LIROW STRING VALUE
#REM 51632 DEFINE FUNCTION PIIDX.I INTEGER LIROW RETURNS INTEGER
#REM 51636 DEFINE PROCEDURE SET PIIDX.I INTEGER LIROW INTEGER VALUE
#REM 51640 DEFINE FUNCTION PIMODE.I INTEGER LIROW RETURNS INTEGER
#REM 51644 DEFINE PROCEDURE SET PIMODE.I INTEGER LIROW INTEGER VALUE
#REM 51648 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 51652 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
51657>>>>>>> procedure prepare_open integer liFile integer liMode integer liIndex string lsRootName
51659>>>>>>> integer liRow
51659>>>>>>> get row_count to liRow
51660>>>>>>> set piFile.i liRow to liFile
51661>>>>>>> set piMode.i liRow to liMode
51662>>>>>>> set piIdx.i liRow to liIndex
51663>>>>>>> set psRootName.i liRow to lsRootName
51664>>>>>>> end_procedure
51665>>>>>>> //> Function iOpen_Prepared will return 0 if all tables in the set
51665>>>>>>> //> was opened as specified. If this cannot be done the function
51665>>>>>>> //> will return the number of the first table, that could not be
51665>>>>>>> //> opened. If the function returns a non zero value, the number of
51665>>>>>>> //> tables actually opened by the function is undefined.
51665>>>>>>> function iOpen_Prepared.i integer lbQuiet returns integer
51667>>>>>>> integer liRval liMax liRow lbStop
51667>>>>>>> integer liFile liMode liIndex lbOpen
51667>>>>>>> string lsRootName
51667>>>>>>> get row_count to liMax
51668>>>>>>> move 0 to liRval
51669>>>>>>> move 0 to liRow
51670>>>>>>> move 0 to lbStop
51671>>>>>>> repeat
51671>>>>>>>>
51671>>>>>>> if liRow lt liMax begin
51673>>>>>>> get piFile.i liRow to liFile
51674>>>>>>> get piMode.i liRow to liMode
51675>>>>>>> get piIdx.i liRow to liIndex
51676>>>>>>> get psRootName.i liRow to lsRootName
51677>>>>>>> if lsRootName eq "" get iOpen_File.ii liFile liMode to lbOpen
51680>>>>>>> else get DBMS_OpenFileAs lsRootName liFile liMode liIndex to lbOpen
51682>>>>>>>
51682>>>>>>> ifnot lbOpen begin
51684>>>>>>> move 1 to lbStop
51685>>>>>>> ifnot lbQuiet error 772 ("File: "+string(liFile)+" can't be opened ("+lsRootName+")")
51688>>>>>>> move liFile to liRval
51689>>>>>>> end
51689>>>>>>>>
51689>>>>>>> else increment liRow
51691>>>>>>> end
51691>>>>>>>>
51691>>>>>>> else move 1 to lbStop
51693>>>>>>> until lbStop
51695>>>>>>> function_return liRval
51696>>>>>>> end_function
51697>>>>>>>
51697>>>>>>> function sRootName_Prepared integer liFile returns string
51699>>>>>>> integer liRow liMax lbFin
51699>>>>>>> string lsRval
51699>>>>>>> get row_count to liMax
51700>>>>>>> move 0 to lbFin
51701>>>>>>> move 0 to liRow
51702>>>>>>> move "" to lsRval
51703>>>>>>> if liMax begin
51705>>>>>>> repeat
51705>>>>>>>>
51705>>>>>>> if (piFile.i(self,liRow)=liFile) begin
51707>>>>>>> move (psRootName.i(self,liRow)) to lsRval
51708>>>>>>> if lsRval eq "" get_attribute DF_FILE_ROOT_NAME of liFile to lsRval
51713>>>>>>> move 1 to lbFin
51714>>>>>>> end
51714>>>>>>>>
51714>>>>>>> ifnot lbFin increment liRow
51717>>>>>>> if liRow ge liMax move 1 to lbFin
51720>>>>>>> until lbFin
51722>>>>>>> end
51722>>>>>>>>
51722>>>>>>> function_return lsRval
51723>>>>>>> end_function
51724>>>>>>> end_class // cTablesOpenPrepareList
51725>>>>>>>
51725>>>>>>>class cTablesOpenStatus is a cArray
51726>>>>>>> procedure construct_object
51728>>>>>>> forward send construct_object
51730>>>>>>> object oFilesToOpen is a cTablesOpenPrepareList no_image
51732>>>>>>> end_object
51733>>>>>>> property integer pbRestoreOpened private 0
51734>>>>>>> property integer pbQuiet private 0
51735>>>>>>> end_procedure
51736>>>>>>>
51736>>>>>>> item_property_list
51736>>>>>>> item_property integer piIsOpen.i // 1=Yes, 0=No
51736>>>>>>> item_property integer piOpenMode.i // DF_SHARE, DF_EXCLUSIVE
51736>>>>>>> item_property integer piFilemode.i // DF_FILE_ALIAS_DEFAULT, DF_FILE_IS_MASTER, DF_FILE_IS_ALIAS
51736>>>>>>> item_property integer piFileAlias.i // Is it an alias file?
51736>>>>>>> item_property string psPhysicalName.i // Runtimes idea of the root name of the file
51736>>>>>>> item_property string psRootName.i // Filelist.cfg's idea of the root name
51736>>>>>>> item_property integer piDriver.i // Comes from the DBMS_FileDriverType function (dbms.nui)
51736>>>>>>> item_property integer psWhereIsIt.i // Sture's private investigation to figure out where the data file is.
51736>>>>>>> end_item_property_list cTablesOpenStatus
#REM 51786 DEFINE FUNCTION PSWHEREISIT.I INTEGER LIROW RETURNS INTEGER
#REM 51790 DEFINE PROCEDURE SET PSWHEREISIT.I INTEGER LIROW INTEGER VALUE
#REM 51794 DEFINE FUNCTION PIDRIVER.I INTEGER LIROW RETURNS INTEGER
#REM 51798 DEFINE PROCEDURE SET PIDRIVER.I INTEGER LIROW INTEGER VALUE
#REM 51802 DEFINE FUNCTION PSROOTNAME.I INTEGER LIROW RETURNS STRING
#REM 51806 DEFINE PROCEDURE SET PSROOTNAME.I INTEGER LIROW STRING VALUE
#REM 51810 DEFINE FUNCTION PSPHYSICALNAME.I INTEGER LIROW RETURNS STRING
#REM 51814 DEFINE PROCEDURE SET PSPHYSICALNAME.I INTEGER LIROW STRING VALUE
#REM 51818 DEFINE FUNCTION PIFILEALIAS.I INTEGER LIROW RETURNS INTEGER
#REM 51822 DEFINE PROCEDURE SET PIFILEALIAS.I INTEGER LIROW INTEGER VALUE
#REM 51826 DEFINE FUNCTION PIFILEMODE.I INTEGER LIROW RETURNS INTEGER
#REM 51830 DEFINE PROCEDURE SET PIFILEMODE.I INTEGER LIROW INTEGER VALUE
#REM 51834 DEFINE FUNCTION PIOPENMODE.I INTEGER LIROW RETURNS INTEGER
#REM 51838 DEFINE PROCEDURE SET PIOPENMODE.I INTEGER LIROW INTEGER VALUE
#REM 51842 DEFINE FUNCTION PIISOPEN.I INTEGER LIROW RETURNS INTEGER
#REM 51846 DEFINE PROCEDURE SET PIISOPEN.I INTEGER LIROW INTEGER VALUE
51851>>>>>>>
51851>>>>>>> //> This procedure resets the set of files to be openend by the
51851>>>>>>> //> iOpen_Prepared function.
51851>>>>>>> procedure reset_prepared
51853>>>>>>> send delete_data to (oFilesToOpen(self))
51854>>>>>>> end_procedure
51855>>>>>>> procedure reset
51857>>>>>>> send reset_prepared
51858>>>>>>> send delete_data
51859>>>>>>> end_procedure
51860>>>>>>> //> When you want a set of files to be openend in exclusive mode or
51860>>>>>>> //> if you want to open a set of files different the ones currently
51860>>>>>>> //> opened you may use the Prepare_Open message to register which
51860>>>>>>> //> files you want opened in what entries (1-4095).
51860>>>>>>> procedure prepare_open integer liFile integer liMode integer liIndex string lsRootName
51862>>>>>>> send prepare_open to (oFilesToOpen(self)) liFile liMode liIndex lsRootName
51863>>>>>>> end_procedure
51864>>>>>>>
51864>>>>>>> procedure prepare_open_all_registered_tables_exclusive
51866>>>>>>> integer liMax liTable
51866>>>>>>> get row_count to liMax
51867>>>>>>> decrement liMax
51868>>>>>>> for liTable from 0 to liMax
51874>>>>>>>>
51874>>>>>>> if (piIsOpen.i(self,liTable)) begin
51876>>>>>>> if (piFileAlias.i(self,litable)<>DF_FILE_IS_ALIAS) begin
51878>>>>>>> send prepare_open liTable DF_EXCLUSIVE 0 (psPhysicalName.i(self,liTable))
51879>>>>>>> end
51879>>>>>>>>
51879>>>>>>> end
51879>>>>>>>>
51879>>>>>>> loop
51880>>>>>>>>
51880>>>>>>> end_procedure
51881>>>>>>>
51881>>>>>>> function iOpen_Prepared returns integer
51883>>>>>>> function_return (iOpen_Prepared.i(oFilesToOpen(self),0))
51884>>>>>>> end_function
51885>>>>>>> function iOpen_Prepared_Quiet returns integer
51887>>>>>>> function_return (iOpen_Prepared.i(oFilesToOpen(self),1))
51888>>>>>>> end_function
51889>>>>>>> function sRootName_Prepared integer liFile returns string
51891>>>>>>> function_return (sRootName_Prepared(oFilesToOpen(self),liFile))
51892>>>>>>> end_function
51893>>>>>>>
51893>>>>>>> //> Takes a snap shot of open files.
51893>>>>>>> procedure RegisterCurrentOpenFiles
51895>>>>>>> integer liFile lbOpen liFileOpenMode liFileMode liFileAlias
51895>>>>>>> string lsPhysicalName lsRootName lsWhereIsIt
51895>>>>>>> send delete_data
51896>>>>>>> move 0 to liFile
51897>>>>>>> repeat
51897>>>>>>>>
51897>>>>>>> get_attribute DF_FILE_NEXT_OPENED of liFile to liFile
51900>>>>>>> if liFile begin
51902>>>>>>> get_attribute DF_FILE_OPEN_MODE of liFile to liFileOpenMode // DF_SHARE, DF_EXCLUSIVE
51905>>>>>>> get_attribute DF_FILE_MODE of liFile to liFileMode // DF_FILE_ALIAS_DEFAULT, DF_FILE_IS_MASTER, DF_FILE_IS_ALIAS
51908>>>>>>> get_attribute DF_FILE_ALIAS of liFile to liFileAlias // I don't know what this is!
51911>>>>>>> get_attribute DF_FILE_PHYSICAL_NAME of liFile to lsPhysicalName // Runtimes idea of the root name of the file
51914>>>>>>> get_attribute DF_FILE_ROOT_NAME of liFile to lsRootName // Filelist.cfg's idea of the root name
51917>>>>>>>
51917>>>>>>> get DBMS_TablePath liFile to lsWhereIsIt
51918>>>>>>>
51918>>>>>>> set piIsOpen.i liFile to 1 // Open!
51919>>>>>>> set piOpenMode.i liFile to liFileOpenMode
51920>>>>>>> set piFilemode.i liFile to liFileMode
51921>>>>>>> set piFileAlias.i liFile to liFileAlias
51922>>>>>>> set psPhysicalName.i liFile to lsPhysicalName
51923>>>>>>> set psRootName.i liFile to lsRootName
51924>>>>>>> set piDriver.i liFile to (DBMS_FileDriverType(liFile))
51925>>>>>>> set psWhereIsIt.i liFile to lsWhereIsIt
51926>>>>>>> end
51926>>>>>>>>
51926>>>>>>> until liFile eq 0
51928>>>>>>> end_procedure
51929>>>>>>> procedure CloseAllFiles
51931>>>>>>> Close DF_ALL
51932>>>>>>> end_procedure
51933>>>>>>> procedure CloseAllFilesOnDriver integer liDriver
51935>>>>>>> integer liFile
51935>>>>>>> move 0 to liFile
51936>>>>>>> repeat
51936>>>>>>>>
51936>>>>>>> get_attribute DF_FILE_NEXT_OPENED of liFile to liFile
51939>>>>>>> if liFile if (DBMS_FileDriverType(liFile)) eq liDriver close liFile
51944>>>>>>> until liFile eq 0
51946>>>>>>> end_procedure
51947>>>>>>> //> Close the ones that weren't open at the time of the last snapshot
51947>>>>>>> procedure RestoreClosed
51949>>>>>>> integer liFile
51949>>>>>>> move 0 to liFile
51950>>>>>>> repeat
51950>>>>>>>>
51950>>>>>>> get_attribute DF_FILE_NEXT_OPENED of liFile to liFile
51953>>>>>>> if liFile ifnot (piIsOpen.i(self,liFile)) close liFile
51958>>>>>>> until liFile eq 0
51960>>>>>>> end_procedure
51961>>>>>>> //> Open the ones that were open at the time of the last snapshot
51961>>>>>>> procedure RestoreOpened
51963>>>>>>> integer liFile lbOpen liFileOpenMode liFileMode liFileAlias liMax lbQuiet
51963>>>>>>> string lsPhysicalName lsRootName
51963>>>>>>> get cTablesOpenStatus.pbQuiet to lbQuiet
51964>>>>>>> get row_count to liMax
51965>>>>>>> decrement liMax
51966>>>>>>> for liFile from 1 to liMax
51972>>>>>>>>
51972>>>>>>> get piIsOpen.i liFile to lbOpen
51973>>>>>>> if lbOpen begin
51975>>>>>>> get piOpenMode.i liFile to liFileOpenMode
51976>>>>>>> get piFilemode.i liFile to liFileMode
51977>>>>>>> get piFileAlias.i liFile to liFileAlias
51978>>>>>>> get psPhysicalName.i liFile to lsPhysicalName
51979>>>>>>> get psRootName.i liFile to lsRootName
51980>>>>>>> if (uppercase(lsPhysicalName)) ne (uppercase(lsRootName)) begin
51982>>>>>>> move (DBMS_OpenFileAs(lsPhysicalName,liFile,liFileOpenMode,0)) to lbOpen
51983>>>>>>> ifnot lbOpen begin
51985>>>>>>> ifnot lbQuiet begin
51987>>>>>>> error 666 ("Can't restore open files (file: "+string(liFile)+")")
51988>>>>>>>>
51988>>>>>>> error 666 ("Name: "+lsPhysicalName+"!")
51989>>>>>>>>
51989>>>>>>> end
51989>>>>>>>>
51989>>>>>>> set cTablesOpenStatus.pbRestoreOpened to false
51990>>>>>>> end
51990>>>>>>>>
51990>>>>>>> end
51990>>>>>>>>
51990>>>>>>> else move (DBMS_OpenFile(liFile,liFileOpenMode,0)) to lbOpen
51992>>>>>>> if lbOpen begin
51994>>>>>>> set_attribute DF_FILE_MODE of liFile to liFileMode
51997>>>>>>> set_attribute DF_FILE_ALIAS of liFile to liFileAlias
52000>>>>>>> //send obs "File Mode:" (string(liFileMode)) "File Alias:" (string(liFileAlias))
52000>>>>>>> end
52000>>>>>>>>
52000>>>>>>> else begin
52001>>>>>>> ifnot lbQuiet begin
52003>>>>>>> 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))
52004>>>>>>>>
52004>>>>>>> end
52004>>>>>>>>
52004>>>>>>> set cTablesOpenStatus.pbRestoreOpened to false
52005>>>>>>> end
52005>>>>>>>>
52005>>>>>>> end
52005>>>>>>>>
52005>>>>>>> loop
52006>>>>>>>>
52006>>>>>>> end_procedure
52007>>>>>>> function bRestoreOpened integer lbQuiet returns integer
52009>>>>>>> integer lbRval
52009>>>>>>> set cTablesOpenStatus.pbRestoreOpened to true
52010>>>>>>> set cTablesOpenStatus.pbQuiet to lbQuiet
52011>>>>>>> send RestoreOpened
52012>>>>>>> get cTablesOpenStatus.pbRestoreOpened to lbRval
52013>>>>>>> set cTablesOpenStatus.pbQuiet to false
52014>>>>>>> function_return lbRval
52015>>>>>>> end_function
52016>>>>>>>
52016>>>>>>> // This may be used to make sure that the file_mode and file_alias attributes
52016>>>>>>> // are identical before and after reindexing a file.
52016>>>>>>> procedure write_file
52018>>>>>>> integer liFile liChannel liFileMode liFileAlias
52018>>>>>>> get Seq_New_Channel to liChannel
52019>>>>>>> direct_output channel liChannel "openstat.txt"
52021>>>>>>> move 0 to liFile
52022>>>>>>> repeat
52022>>>>>>>>
52022>>>>>>> get_attribute DF_FILE_NEXT_OPENED of liFile to liFile
52025>>>>>>> if liFile begin
52027>>>>>>> get_attribute DF_FILE_MODE of liFile to liFileMode
52030>>>>>>> get_attribute DF_FILE_ALIAS of liFile to liFileAlias
52033>>>>>>> writeln channel liChannel ("File:"+string(liFile))
52036>>>>>>> writeln "File Mode:" (string(liFileMode)) "File Alias:" (string(liFileAlias))
52041>>>>>>> end
52041>>>>>>>>
52041>>>>>>> until liFile eq 0
52043>>>>>>> close_output channel liChannel
52045>>>>>>> send Seq_Release_Channel liChannel
52046>>>>>>> end_procedure
52047>>>>>>>
52047>>>>>>> procedure RestoreFiles
52049>>>>>>> send RestoreClosed
52050>>>>>>> send RestoreOpened
52051>>>>>>> end_procedure
52052>>>>>>> //> Open a file of the previous snapshot in a new and exciting mode.
52052>>>>>>> function iOpen_File.ii integer liFile integer liMode returns integer
52054>>>>>>> string lsPhysicalName
52054>>>>>>> get psPhysicalName.i liFile to lsPhysicalName
52055>>>>>>> if lsPhysicalName ne "" function_return (DBMS_OpenFileAs(lsPhysicalName,liFile,liMode,0))
52058>>>>>>> function_return (DBMS_OpenFile(liFile,liMode,0))
52059>>>>>>> end_function
52060>>>>>>>end_class // cTablesOpenStatus
52061>>>>>>>
52061>>>>>>>desktop_section
52066>>>>>>> object oTablesOpenStatus_Global is a cTablesOpenStatus
52068>>>>>>> end_object
52069>>>>>>>end_desktop_section
52074>>>>>>>
52074>>>>>>>procedure OpenStat_RegisterFiles global
52076>>>>>>> send RegisterCurrentOpenFiles to (oTablesOpenStatus_Global(self))
52077>>>>>>>end_procedure
52078>>>>>>>procedure OpenStat_CloseAllFiles global
52080>>>>>>> send CloseAllFiles to (oTablesOpenStatus_Global(self))
52081>>>>>>>end_procedure
52082>>>>>>>procedure OpenStat_RestoreFiles global
52084>>>>>>> send RestoreFiles to (oTablesOpenStatus_Global(self))
52085>>>>>>>end_procedure
52086>>>>>>>
52086>>>>>>>function OpenStat_RestoreFilesFunction global integer lbQuiet returns integer
52088>>>>>>> integer lbRval
52088>>>>>>> send RestoreClosed to (oTablesOpenStatus_Global(self))
52089>>>>>>> get bRestoreOpened of (oTablesOpenStatus_Global(self)) lbQuiet to lbRval
52090>>>>>>> function_return lbRval
52091>>>>>>>end_function
52092>>>>>>>
52092>>>>>>>//> Calling this procedure will close and re-open all embedded database tables currently open
52092>>>>>>>//> by the application. I can't remember why I did it, but here it is.
52092>>>>>>>procedure FlushAllDataFlexBuffers global
52094>>>>>>> integer lhObj
52094>>>>>>> move (oTablesOpenStatus_Global(self)) to lhObj
52095>>>>>>> send RegisterCurrentOpenFiles to lhObj
52096>>>>>>> send CloseAllFilesOnDriver to lhObj DBMS_DRIVER_DATAFLEX
52097>>>>>>> send RestoreOpened to lhObj
52098>>>>>>>end_procedure
52099>>>>>>>
52099>>>>>Use RGB.nui // Some basic RGB color functions
52099>>>>>Use MsgBox.utl // obs procedure
52099>>>>>
52099>>>>>desktop_section
52104>>>>>object oAutoSystemDowner is a cSystemDowner
52106>>>>> set piDownPhaseNumber to 1 // Includes a warning
52107>>>>> procedure OnAppEntryDenied
52110>>>>> string lsFile
52110>>>>> get sFileNameAddPath (psDownNowFile(self)) to lsFile
52111>>>>> send timedobs 1 "The system has been shut down" ("Lock file: "+lsFile)
52112>>>>> end_procedure
52113>>>>> procedure OnBeginWaitForExit
52116>>>>> integer liSecs
52116>>>>> get piCheckInterval to liSecs
52117>>>>> move (liSecs/1000) to liSecs
52118>>>>> send timedobs liSecs "System is being shut down"
52119>>>>> end_procedure
52120>>>>> procedure CheckKeepSystemDowned
52123>>>>> integer lbKeepFile lbGrb
52123>>>>> string lsDownNowFile
52123>>>>> if (priv.pbImTheOneWhoStartedIt(self)) begin
52125>>>>> if (DownNowState(self)) begin
52127>>>>> get psDownNowFile to lsDownNowFile
52128>>>>> get sFileNameAddPath lsDownNowFile to lsDownNowFile
52129>>>>> get MB_Verify4 "Do you want the system to remain shut down, when this program is terminated?" "" "If you answer YES you must delete the file below to open it up again" lsDownNowFile 0 to lbKeepFile
52130>>>>> ifnot lbKeepFile begin
52132>>>>> get bFileDelete (psDownNowFile(self)) to lbGrb
52133>>>>> end
52133>>>>>>
52133>>>>> end
52133>>>>>>
52133>>>>> end
52133>>>>>>
52133>>>>> end_procedure
52134>>>>> procedure Notify_Exit_Application
52137>>>>> send CheckKeepSystemDowned
52138>>>>> end_procedure
52139>>>>> procedure Broadcast_Notify_Exit_Application
52142>>>>> send CheckKeepSystemDowned
52143>>>>> end_procedure
52144>>>>> function Exit_Application_Check returns integer // CM check
52147>>>>> send CheckKeepSystemDowned
52148>>>>> function_return 0 // No changes
52149>>>>> end_function
52150>>>>>end_object
52151>>>>>
52151>>>>>object oDownSystemMonitorPanel is a aps.ModalPanel
52153>>>>> set locate_mode to CENTER_ON_SCREEN
52154>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
52155>>>>> on_key KCANCEL send close_panel
52156>>>>> property number pnShutDownStart public 0
52158>>>>> object oLogFileDisplay is a aps.TextEdit
52160>>>>> set size to 105 300
52161>>>>> set read_only_state to TRUE
52162>>>>> set psTypeFace to "Courier"
52163>>>>> set pbWrap to False
52164>>>>> set peAnchors to (anBottom+anRight+anLeft+anTop)
52165>>>>> end_object
52166>>>>> object oSwitch is a aps.RadioGroup label "System state"
52169>>>>> set peAnchors to (anRight+anTop)
52170>>>>> object oRad1 is a aps.Radio label "Running"
52173>>>>> end_object
52174>>>>> object oRad2 is a aps.Radio label "Downing"
52177>>>>> end_object
52178>>>>> procedure notify_select_state integer liTo integer liFrom
52181>>>>> if (liTo=0) send SystemUp
52184>>>>> else send SystemDown
52186>>>>> end_procedure
52187>>>>> end_object
52188>>>>> object oInfo is a aps.Group label "" snap SL_DOWN
52192>>>>> set peAnchors to (anBottom+anRight+anTop)
52193>>>>> set p_auto_column to 0
52194>>>>> object oForm1 is a aps.Form label "Downing time:" abstract AFT_ASCII14
52198>>>>> set label_justification_mode to JMODE_TOP
52199>>>>> set form_border to BORDER_NONE
52200>>>>> set enabled_state to FALSE
52201>>>>> set form_justification_mode to FORM_DISPLAYCENTER
52202>>>>> end_object
52203>>>>> send aps_goto_max_row
52204>>>>> object oForm2 is a aps.Form label "Exclusive table access:" abstract AFT_ASCII14
52208>>>>> set label_justification_mode to JMODE_TOP
52209>>>>> set form_border to BORDER_NONE
52210>>>>> set enabled_state to FALSE
52211>>>>> end_object
52212>>>>> end_object
52213>>>>> send APS_SIZE_IDENTICAL_MAX (oSwitch(self)) (oInfo(self)) SL_HORIZONTAL
52214>>>>>
52214>>>>> procedure UpdateDisplay_Watch
52217>>>>> integer liDiff
52217>>>>> number lnShutDownStart
52217>>>>> get pnShutDownStart to lnShutDownStart
52218>>>>> if (lnShutDownStart=0) set value of oForm1 to ""
52221>>>>> else begin
52222>>>>> move (TS_SysTime()-lnShutDownStart) to liDiff
52223>>>>> set value of oForm1 to (TS_ExtractTime(liDiff))
52224>>>>> end
52224>>>>>>
52224>>>>> end_procedure
52225>>>>>
52225>>>>> object oTablesOpenStatus is a cTablesOpenStatus
52227>>>>> function bCheckExclusivity returns integer
52230>>>>> integer liRval
52230>>>>> send reset
52231>>>>> send RegisterCurrentOpenFiles
52232>>>>> send CloseAllFiles
52233>>>>> send reset_prepared
52234>>>>> send prepare_open_all_registered_tables_exclusive
52235>>>>> get iOpen_Prepared_Quiet to liRval
52236>>>>> send CloseAllFiles
52237>>>>> send RestoreFiles
52238>>>>> function_return (liRval=0)
52239>>>>> end_function
52240>>>>> end_object
52241>>>>>
52241>>>>> procedure UpdateDisplay_Tables
52244>>>>> integer lbExclusive liColor
52244>>>>> number lnShutDownStart
52244>>>>> string lsValue
52244>>>>> get pnShutDownStart to lnShutDownStart
52245>>>>> if (lnShutDownStart=0) begin
52247>>>>> move clBtnFace to liColor
52248>>>>> move "" to lsValue
52249>>>>> end
52249>>>>>>
52249>>>>> else begin
52250>>>>> get bCheckExclusivity of oTablesOpenStatus to lbExclusive
52251>>>>> if lbExclusive begin
52253>>>>> move (RGB_Brighten(clGreen,50)) to liColor
52254>>>>> move "Obtained" to lsValue
52255>>>>> end
52255>>>>>>
52255>>>>> else begin
52256>>>>> move (RGB_Brighten(clRed,50)) to liColor
52257>>>>> move "Failed" to lsValue
52258>>>>> end
52258>>>>>>
52258>>>>> end
52258>>>>>>
52258>>>>> set color of oForm2 to liColor
52259>>>>> set value of oForm2 to lsValue
52260>>>>> end_procedure
52261>>>>>
52261>>>>> procedure UpdateDisplay
52264>>>>> integer lhSystemDowner
52264>>>>> string lsValue
52264>>>>> move oAutoSystemDowner to lhSystemDowner
52265>>>>> get sLogFileTextSinceDowning of lhSystemDowner to lsValue
52266>>>>> set value of oLogFileDisplay to lsValue
52267>>>>> send UpdateDisplay_Watch
52268>>>>> send UpdateDisplay_Tables
52269>>>>> end_procedure
52270>>>>>
52270>>>>> object oTimer is a DFTimer
52272>>>>> set Auto_Start_State to TRUE //<- If this is set to TRUE to timer is activated when
52273>>>>> set Auto_Stop_State to TRUE // the applications start regardless of the oTimedObs "activeness".
52274>>>>> set Timer_Message to msg_UpdateDisplay
52275>>>>> set Timer_Object to self
52276>>>>> set Timeout to 2000 // Every other second
52277>>>>> end_object
52278>>>>>
52278>>>>> procedure SystemDown
52281>>>>> set pnShutDownStart to (TS_SysTime())
52282>>>>> set DownNowState of oAutoSystemDowner to TRUE
52283>>>>> send UpdateDisplay
52284>>>>> end_procedure
52285>>>>> procedure SystemUp
52288>>>>> set pnShutDownStart to 0
52289>>>>> set DownNowState of oAutoSystemDowner to FALSE
52290>>>>> send UpdateDisplay
52291>>>>> end_procedure
52292>>>>>
52292>>>>> send aps_goto_max_row
52293>>>>> object oLine is a aps.LineControl
52295>>>>> set peAnchors to (anBottom+anRight+anLeft)
52296>>>>> end_object
52297>>>>>
52297>>>>> object oBtn1 is a aps.Multi_Button
52299>>>>> set peAnchors to (anBottom+anRight)
52300>>>>> procedure ViewLog
52303>>>>> integer lhLogFile
52303>>>>> move (oLogFile(oAutoSystemDowner(self))) to lhLogFile
52304>>>>> send Popup_LogFileProperties lhLogFile
52305>>>>> end_procedure
52306>>>>> on_item "View log file" send ViewLog
52307>>>>> end_object
52308>>>>>
52308>>>>> object oBtn2 is a aps.Multi_Button
52310>>>>> set peAnchors to (anBottom+anRight)
52311>>>>> on_item t.btn.close send close_panel
52312>>>>> end_object
52313>>>>> send aps_locate_multi_buttons
52314>>>>>
52314>>>>> procedure aps_beautify
52317>>>>> send APS_ALIGN_INSIDE_CONTAINER_BY_SIZING (oLine(self)) SL_ALIGN_RIGHT
52318>>>>> end_procedure
52319>>>>> procedure popup
52322>>>>> string lsFolder
52322>>>>> send DoSetLogFileName of oAutoSystemDowner
52323>>>>> get FLIST_CurrentFileListFolder to lsFolder
52324>>>>> set label to ("System downing"+" ("+lsFolder+")")
52325>>>>> send UpdateDisplay
52326>>>>> forward send popup
52328>>>>> end_procedure
52329>>>>>end_object
52330>>>>>send aps_SetMinimumDialogSize (oDownSystemMonitorPanel(self)) // Set minimum size
52331>>>>>end_desktop_section
52336>>>>>
52336>>>>>procedure popup_systemdowner global
52338>>>>> send popup of oDownSystemMonitorPanel
52339>>>>>end_procedure
52340>>>>>
52340>>>>>//Eksklusiv tabel adgang: Opn†et/Ikke opn†et
52340>>>>>//Exclusive table access: Achieved/Not achieved
52340>>>>>
52340>>>
52340>>>function FV_AdminMode global returns integer
52342>>> integer liParam
52342>>> get CmdLineFindParamValue "-USER" DFTRUE to liParam
52343>>> function_return (liParam=-1)
52344>>>end_function
52345>>>
52345>>>function FV_NoLoad global returns integer
52347>>> integer liParam
52347>>> get CmdLineFindParamValue "-NOLOAD" DFTRUE to liParam
52348>>> function_return (liParam<>-1)
52349>>>end_function
52350>>>
52350>>>function FV_CmdLineWS global returns string
52352>>> integer liParam
52352>>> string lsWS
52352>>> get CmdLineFindParamValue "-WS" DFTRUE to liParam
52353>>> if (liParam<>-1) begin
52355>>> get CmdLineParamValue (liParam+1) to lsWS
52356>>> end
52356>>>>
52356>>> else move "" to lsWS
52358>>> function_return lsWS
52359>>>end_function
52360>>>
52360>>>function FV_CmdLineFileList global returns string
52362>>> integer liParam
52362>>> string lsWS
52362>>> get CmdLineFindParamValue "-FILELIST" DFTRUE to liParam
52363>>> if (liParam<>-1) begin
52365>>> get CmdLineParamValue (liParam+1) to lsWS
52366>>> end
52366>>>>
52366>>> else move "" to lsWS
52368>>> function_return lsWS
52369>>>end_function
52370>>>
52370>>>function FV_CmdLineView global returns string
52372>>> integer liParam
52372>>> string lsWS
52372>>> get CmdLineFindParamValue "-VIEW" DFTRUE to liParam
52373>>> if (liParam<>-1) begin
52375>>> get CmdLineParamValue (liParam+1) to lsWS
52376>>> if (lowercase(right(lsWS,4))<>".fvw") move (lsWS+".fvw") to lsWS
52379>>> end
52379>>>>
52379>>> else move "" to lsWS
52381>>> function_return lsWS
52382>>>end_function
52383>>>
52383>>>function FV_CmdLineViewCollection global returns string
52385>>> integer liParam
52385>>> string lsWS
52385>>> get CmdLineFindParamValue "-COLLECTION" DFTRUE to liParam
52386>>> if (liParam<>-1) begin
52388>>> get CmdLineParamValue (liParam+1) to lsWS
52389>>> if (lowercase(right(lsWS,4))<>".fvc") move (lsWS+".fvc") to lsWS
52392>>> end
52392>>>>
52392>>> else move "" to lsWS
52394>>> function_return lsWS
52395>>>end_function
52396>>>
52396>>>Use MdiExt.utl
Including file: mdiext.utl (C:\Apps\VDFQuery\AppSrc\mdiext.utl)
52396>>>>>// **********************************************************************
52396>>>>>// Use MdiExt.utl // MDI Extensions
52396>>>>>//
52396>>>>>// By Sture Andersen
52396>>>>>//
52396>>>>>// Create: Mon 15-12-1997
52396>>>>>//
52396>>>>>//
52396>>>>>// Usage:
52396>>>>>//
52396>>>>>// Substitute:
52396>>>>>//
52396>>>>>// Use dfStdBtn
52396>>>>>//
52396>>>>>// for:
52396>>>>>//
52396>>>>>// Object Tool_Bar is a cSturesToolBar
52396>>>>>// send Add_Standard_Toolbar_Buttons // Adds the standard buttons
52396>>>>>// //send Add_Space
52396>>>>>// //send Add_Calendar_tbButton self // Add calendar button
52396>>>>>// //send Add_LinkView_tbButton self // Add link view button
52396>>>>>// End_Object
52396>>>>>//
52396>>>>>// and:
52396>>>>>//
52396>>>>>// Use DfStdSbr
52396>>>>>//
52396>>>>>// for:
52396>>>>>//
52396>>>>>// Object Status_Bar is a cStatusBar
52396>>>>>// End_Object
52396>>>>>//
52396>>>>>// ***********************************************************************
52396>>>>>
52396>>>>>Use DFMainBt // Standard dfMain_ButtonBar (DAC)
Including file: Dfmainbt.pkg (c:\VDF12\Pkg\Dfmainbt.pkg)
52396>>>>>>>//-------------------------------------------------------------------------
52396>>>>>>>// DFMainBt.pkg - DfMain_ButtonBar class
52396>>>>>>>//
52396>>>>>>>//
52396>>>>>>>// 07/23/96 JJT - New Class names
52396>>>>>>>//-------------------------------------------------------------------------
52396>>>>>>>
52396>>>>>>>Use Dfabtbar.pkg
52396>>>>>>>
52396>>>>>>>Class ToolBar is a AppToolBar
52397>>>>>>>
52397>>>>>>> Function Is_Function Integer MsgId Integer ObjId Integer DelegateFg Returns Integer
52399>>>>>>> integer rval MainObj#
52399>>>>>>> Get Main_Panel_id to MainObj#
52400>>>>>>> If (ObjId>Desktop AND MainObj#) ; Get Is_Function of MainObj# MsgId ObjId DelegateFg to rVal
52403>>>>>>> Function_Return rVal
52404>>>>>>> End_Function
52405>>>>>>>
52405>>>>>>> Procedure Redirect_Button_Message integer Itm
52407>>>>>>> integer Msg# Aux# rval Understood
52407>>>>>>> If (Shadow_State(self,itm)) Procedure_Return
52410>>>>>>> Get Message item itm to Msg#
52411>>>>>>> Get Aux_Value item itm to Aux#
52412>>>>>>> If Msg# Begin
52414>>>>>>> If Aux# eq 0 Begin
52416>>>>>>> Get Focus of desktop to Aux#
52417>>>>>>> Get Is_Function Get_DEO_Object Aux# TRUE to Understood
52418>>>>>>> If Not Understood Move 0 to Aux#
52421>>>>>>> End
52421>>>>>>>>
52421>>>>>>> If Aux# Get Msg# of Aux# to rval
52424>>>>>>> Procedure_return rval
52425>>>>>>> end
52425>>>>>>>>
52425>>>>>>> End_Procedure // Redirect_Message
52426>>>>>>>
52426>>>>>>>End_Class
52427>>>>>>>
52427>>>>>>>
52427>>>>>Use DFMainSt // Standard Status bar class (DAC)
Including file: Dfmainst.pkg (c:\VDF12\Pkg\Dfmainst.pkg)
52427>>>>>>>// 07/23/96 JJT - New Class names
52427>>>>>>>// 12/13/2001 JJT - Updated Syntax Add_item to AddPane (suggested syntax)
52427>>>>>>>Use LanguageText.pkg
52427>>>>>>>Use dfAstbar.pkg
52427>>>>>>>
52427>>>>>>>Class StatusBar is a AppStatusBar
52428>>>>>>>
52428>>>>>>> Procedure Construct_Object
52430>>>>>>> Forward Send Construct_Object
52432>>>>>>> //
52432>>>>>>> Send AddPane 350 '' sbLOWERED // micro-help
52433>>>>>>> Send AddPane 40 C_$View sbNORMAL
52434>>>>>>> Send AddPane 200 '' sbLOWERED // view name
52435>>>>>>> Send AddPane 0 '' sbNORMAL // spring 'normal' to end
52436>>>>>>>
52436>>>>>>> End_Procedure // Construct_Object
52437>>>>>>>
52437>>>>>>> Procedure Show_View_Name String sName
52439>>>>>>> Set Value item 2 to sName
52440>>>>>>> End_Procedure
52441>>>>>>>
52441>>>>>>>End_Class
52442>>>>>Use FieldInf // Global field info objects
52442>>>>>Use MsgBox // DAC class
52442>>>>>Use Language // Set default languange if not set by compiler command line
52442>>>>>Use API_Attr.utl // Functions for querying API attributes
Including file: api_attr.utl (C:\Apps\VDFQuery\AppSrc\api_attr.utl)
52442>>>>>>>Use API_Attr.nui // Functions for querying API attributes (No User Interface)
52442>>>>>
52442>>>>> define t.TbBtn.Bgn.Tip for "Beginning of file"
52442>>>>> define t.TbBtn.Bgn.StHlp for "Find the First record (Ctrl+Home)"
52442>>>>> define t.TbBtn.Prev.Tip for "Find Previous"
52442>>>>> define t.TbBtn.Prev.StHlp for "Find the Previous record (F7)"
52442>>>>> define t.TbBtn.Next.Tip for "Find Next"
52442>>>>> define t.TbBtn.Next.StHlp for "Find the Next record (F8)"
52442>>>>> define t.TbBtn.End.Tip for "End of File"
52442>>>>> define t.TbBtn.End.StHlp for "Find the Last record (Ctrl+End)"
52442>>>>> define t.TbBtn.Prompt.Tip for "Prompt"
52442>>>>> define t.TbBtn.Prompt.StHlp for "Show available selections (F4)"
52442>>>>> define t.TbBtn.Print.Tip for "Print"
52442>>>>> define t.TbBtn.Print.StHlp for "Print report (Shift+F4)"
52442>>>>> define t.TbBtn.Clear.Tip for "Clear"
52442>>>>> define t.TbBtn.Clear.StHlp for "Clear current record / Add a new record (F5)"
52442>>>>> define t.TbBtn.ClearA.Tip for "Clear All"
52442>>>>> define t.TbBtn.ClearA.StHlp for "Clear all data from view (Ctrl+F5)"
52442>>>>> define t.TbBtn.Save.Tip for "Save"
52442>>>>> define t.TbBtn.Save.StHlp for "Save the current record (F2)"
52442>>>>> define t.TbBtn.Del.Tip for "Delete"
52442>>>>> define t.TbBtn.Del.StHlp for "Delete the current record (Shift+F2)"
52442>>>>> define t.TbBtn.Cut.Tip for "Cut"
52442>>>>> define t.TbBtn.Cut.StHlp for "Cuts the selection and puts it on the Clipboard"
52442>>>>> define t.TbBtn.Copy.Tip for "Copy"
52442>>>>> define t.TbBtn.Copy.StHlp for "Copies the selection and puts it on the Clipboard"
52442>>>>> define t.TbBtn.Paste.Tip for "Paste"
52442>>>>> define t.TbBtn.Paste.StHlp for "Inserts Clipboard contents"
52442>>>>> define t.LnkVw.NotDefined for "Linked view not defined for '#'"
52442>>>>> define t.LnkVw.ToolTip for "Jump to linked view"
52442>>>>> define t.LnkVw.StatusHelp for "Jumps to linked view (Ctrl+O)"
52442>>>>> define t.LnkVw.DoesNotExist for "Linked view does not exist (#)"
52442>>>>>
52442>>>>>// Return the object ID of the prompt list attached to obj#, if any:
52442>>>>>function iDDPrompt_Object global integer obj# returns integer
52444>>>>> integer dm# svr# file# fld# rval#
52444>>>>> get delegation_mode of obj# to dm#
52445>>>>> set delegation_mode of obj# to no_delegate_or_error
52446>>>>> get data_file of obj# item CURRENT to file#
52447>>>>> get data_field of obj# item CURRENT to fld#
52448>>>>> set delegation_mode of obj# to dm#
52449>>>>> if (file#*fld#) begin
52451>>>>> get server of obj# to svr#
52452>>>>> if svr# begin
52454>>>>> if (main_file(svr#)<>file#) get which_data_set of svr# file# to svr#
52457>>>>> if svr# begin // This way we will not error if we are dealing a data_set
52459>>>>> get delegation_mode of svr# to dm#
52460>>>>> set delegation_mode of svr# to no_delegate_or_error
52461>>>>> get field_prompt_object of svr# fld# to rval#
52462>>>>> set delegation_mode of svr# to dm#
52463>>>>> end
52463>>>>>>
52463>>>>> end
52463>>>>>>
52463>>>>> end
52463>>>>>>
52463>>>>> function_return rval#
52464>>>>>end_function
52465>>>>>
52465>>>>>class cAvailableFileObjects is an array
52466>>>>> // An object of this class is meant to hold an object and a corresponding
52466>>>>> // access method per file in filelist.cfg. These objects are added to the
52466>>>>> // list via the add_data_file_object message.
52466>>>>>
52466>>>>> procedure construct_object
52468>>>>> forward send construct_object
52470>>>>> property string pErrMsgNotAvail public ""
52471>>>>> end_procedure
52472>>>>>
52472>>>>> procedure add_data_file_object integer file# integer msg# integer tmp_obj#
52474>>>>> integer obj#
52474>>>>> if num_arguments gt 1 move tmp_obj# to obj#
52477>>>>> else move 0 to obj#
52479>>>>> set value item (file#*2) to obj#
52480>>>>> set value item (file#*2+1) to msg#
52481>>>>> end_procedure
52482>>>>>
52482>>>>> procedure exec_data_file_object integer file#
52484>>>>> integer obj# msg#
52484>>>>> string str# err#
52484>>>>> get value item (file#*2) to obj#
52485>>>>> get value item (file#*2+1) to msg#
52486>>>>> if msg# begin
52488>>>>> if obj# send msg# to obj#
52491>>>>> else send msg#
52493>>>>> end
52493>>>>>>
52493>>>>> else begin
52494>>>>> get File_Display_Name file# to str#
52495>>>>> get pErrMsgNotAvail to err#
52496>>>>> send Info_Box (replace("#",err#,str#))
52497>>>>> end
52497>>>>>>
52497>>>>> end_procedure
52498>>>>>
52498>>>>> function exists_data_file_object integer file# returns integer
52500>>>>> function_return (integer(value(self,file#*2+1)))
52501>>>>> end_function
52502>>>>>end_class // cAvailableFileObjects
52503>>>>>
52503>>>>>object oAvailableFileViews is a cAvailableFileObjects
52505>>>>> set pErrMsgNotAvail to t.LnkVw.NotDefined
52506>>>>>end_object
52507>>>>>
52507>>>>>procedure Add_LinkView_File for BaseClass integer file# integer msg# integer tmp_obj#
52509>>>>> integer obj#
52509>>>>> if num_arguments gt 2 move tmp_obj# to obj#
52512>>>>> else move self to obj#
52514>>>>> send add_data_file_object to (oAvailableFileViews(self)) file# msg# obj#
52515>>>>>end_procedure
52516>>>>>
52516>>>>>register_function iLinkViewFile integer itm# returns integer
52516>>>>>procedure Activate_LinkView for BaseClass
52518>>>>> integer file# dm# obj# itm#
52518>>>>> move (focus(desktop)) to obj# // Which object has the focus?
52519>>>>> if obj# gt desktop begin
52521>>>>> get delegation_mode of obj# to dm# // Make sure that the object does not make
52522>>>>> set delegation_mode of obj# to no_delegate_or_error // noise when asked below.
52523>>>>> get current_item of obj# to itm#
52524>>>>> get iLinkViewFile of obj# itm# to file#
52525>>>>> ifnot file# get data_file of obj# item itm# to file# // Get 'filenumber'
52528>>>>> set delegation_mode of obj# to dm# // Restore delegation mode.
52529>>>>> send exec_data_file_object to (oAvailableFileViews(self)) file#
52530>>>>> end
52530>>>>>>
52530>>>>>end_procedure
52531>>>>>
52531>>>>>procedure Activate_LinkView_File integer file#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
52533>>>>> send exec_data_file_object to (oAvailableFileViews(self)) file#
52534>>>>>end_procedure
52535>>>>>
52535>>>>>function Exists_LinkView returns integer
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
52537>>>>> integer rval# file# dm# obj# itm#
52537>>>>> move (focus(desktop)) to obj# // Which object has the focus?
52538>>>>> if obj# gt desktop begin
52540>>>>> get delegation_mode of obj# to dm# // Make sure that the object does not make
52541>>>>> set delegation_mode of obj# to no_delegate_or_error // noise when asked below.
52542>>>>> get current_item of obj# to itm#
52543>>>>> get iLinkViewFile of obj# itm# to file#
52544>>>>> ifnot file# get data_file of obj# item current to file# // Get 'filenumber'
52547>>>>> set delegation_mode of obj# to dm# // Restore delegation mode.
52548>>>>> get exists_data_file_object of (oAvailableFileViews(self)) file# to rval#
52549>>>>> end
52549>>>>>>
52549>>>>> function_return rval#
52550>>>>>end_function
52551>>>>>
52551>>>>>function Exists_LinkView_File integer file# returns integer
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
52553>>>>> integer rval#
52553>>>>> get exists_data_file_object of (oAvailableFileViews(self)) file# to rval#
52554>>>>> function_return rval#
52555>>>>>end_function
52556>>>>>
52556>>>>>procedure Add_LinkView_tbButton integer oTb#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
52558>>>>> send Add_Toolbar_Button_Bitmap to oTb# "tbvwlnsm.bmp" t.LnkVw.ToolTip t.LnkVw.StatusHelp msg_Activate_LinkView
52559>>>>>end_procedure
52560>>>>>
52560>>>>>// For backwards compatibility:
52560>>>>>
52560>>>>>// If automatic promptlists (AutoPrmpt.utl) has been used prior to this package
52560>>>>>// we hook up on to it:
52560>>>>>
52560>>>>>integer oToolBar#
52560>>>>>move 0 to oToolBar#
52561>>>>>
52561>>>>> Class cSturesToolBar is a ToolBar
52562>>>>> Procedure construct_object
52564>>>>> forward send construct_object
52566>>>>> ifnot oToolBar# move self to oToolBar#
52569>>>>> property integer pImageList_Item_Count public 0
52570>>>>> property integer pAutoShadow_State public 1
52571>>>>>// Set default_icons to (IDB_STANDARD IOR IDB_VIEW IOR IDB_LARGE)
52571>>>>> Send ImageList_Add 'bgn.bmp' // 0
52572>>>>> Send ImageList_Add 'end.bmp' // 1
52573>>>>> Send ImageList_Add 'next.bmp' // 2
52574>>>>> Send ImageList_Add 'prev.bmp' // 3
52575>>>>> Send ImageList_Add 'clr.bmp' // 4
52576>>>>> Send ImageList_Add 'clra.bmp' // 5
52577>>>>> End_Procedure
52578>>>>>
52578>>>>> Procedure end_construct_object
52580>>>>> forward send end_construct_object
52582>>>>> ifnot (item_count(self)) send Add_Standard_Toolbar_Buttons
52585>>>>> send Update_Toolbar_Shadow_States
52586>>>>> End_Procedure
52587>>>>>
52587>>>>> Procedure ImageList_Add string bmp_fn#
52589>>>>> forward send ImageList_Add bmp_fn#
52591>>>>> set pImageList_Item_Count to (pImageList_Item_Count(self)+1)
52592>>>>> End_Procedure
52593>>>>>
52593>>>>> Procedure Add_Toolbar_Button integer ico# string Tip# string StHlp# integer msg# integer obj#
52595>>>>> if num_arguments gt 4 send Add_button ico# msg# obj#
52598>>>>> else send Add_button ico# msg#
52600>>>>> send Add_ToolTip Tip#
52601>>>>> set Status_Help To StHlp#
52602>>>>> End_Procedure
52603>>>>>
52603>>>>> // If a "normal" prompt list object we send message prompt to the object.
52603>>>>> // Otherwise we attempt to popup the default selection list.
52603>>>>> register_procedure Request_Popup_DefaultPromptList
52603>>>>> procedure Extended_Prompt
52605>>>>> integer NormalPrompt# foc# obj#
52605>>>>> move (focus(desktop)) to foc#
52606>>>>> get iDDPrompt_Object foc# to NormalPrompt#
52607>>>>> if NormalPrompt# send prompt to foc#
52610>>>>> else send Request_Popup_DefaultPromptList
52612>>>>> end_procedure
52613>>>>>
52613>>>>> Procedure Print_Report
52615>>>>> send Print_Report to (focus(desktop))
52616>>>>> End_Procedure
52617>>>>>
52617>>>>> Procedure Add_Toolbar_Button_Bitmap string bmp# string Tip# string StHlp# integer msg# integer obj#
52619>>>>> integer ico#
52619>>>>> send ImageList_Add bmp#
52620>>>>> move (ICO_USER+pImageList_Item_Count(self)-1) to ico#
52621>>>>> if num_arguments gt 4 send Add_Toolbar_Button ico# Tip# StHlp# msg# obj#
52624>>>>> else send Add_Toolbar_Button ico# Tip# StHlp# msg#
52626>>>>> End_Procedure
52627>>>>>
52627>>>>> Procedure Add_Print_Button
52629>>>>> send Add_Toolbar_Button ICO_STD_PRINT t.TbBtn.Print.Tip t.TbBtn.Print.StHlp msg_Print_Report self
52630>>>>> End_Procedure
52631>>>>>
52631>>>>> // This procedure adds the standard tool bar buttons.
52631>>>>> Procedure Add_Standard_Toolbar_Buttons
52633>>>>> send Add_Space
52634>>>>> send Add_Toolbar_Button (ICO_USER+0) t.TbBtn.Bgn.Tip t.TbBtn.Bgn.StHlp msg_Beginning_Of_Data
52635>>>>> send Add_Toolbar_Button (ICO_USER+3) t.TbBtn.Prev.Tip t.TbBtn.Prev.StHlp msg_Find_Previous
52636>>>>> send Add_Toolbar_Button (ICO_USER+2) t.TbBtn.Next.Tip t.TbBtn.Next.StHlp msg_Find_Next
52637>>>>> send Add_Toolbar_Button (ICO_USER+1) t.TbBtn.End.Tip t.TbBtn.End.StHlp msg_End_Of_Data
52638>>>>> send Add_Space
52639>>>>> send Add_Toolbar_Button ICO_STD_FIND t.TbBtn.Prompt.Tip t.TbBtn.Prompt.StHlp msg_Extended_Prompt self
52640>>>>> send Add_Toolbar_Button (ICO_USER+4) t.TbBtn.Clear.Tip t.TbBtn.Clear.StHlp msg_Request_Clear
52641>>>>> send Add_Toolbar_Button (ICO_USER+5) t.TbBtn.ClearA.Tip t.TbBtn.ClearA.StHlp msg_Request_Clear_All
52642>>>>> send Add_Space
52643>>>>> send Add_Toolbar_Button ICO_STD_FILESAVE t.TbBtn.Save.Tip t.TbBtn.Save.StHlp msg_Request_Save
52644>>>>> send Add_Toolbar_Button ICO_STD_DELETE t.TbBtn.Del.Tip t.TbBtn.Del.StHlp msg_Request_Delete
52645>>>>> send Add_Space
52646>>>>> send Add_Toolbar_Button ICO_STD_CUT t.TbBtn.Cut.Tip t.TbBtn.Cut.StHlp msg_Cut
52647>>>>> send Add_Toolbar_Button ICO_STD_COPY t.TbBtn.Copy.Tip t.TbBtn.Copy.StHlp msg_Copy
52648>>>>> send Add_Toolbar_Button ICO_STD_PASTE t.TbBtn.Paste.Tip t.TbBtn.Paste.StHlp msg_Paste
52649>>>>> End_Procedure
52650>>>>>End_Class
52651>>>>>
52651>>>>>
52651>>>>>register_function iAllowRequestFind returns integer
52651>>>>>register_function iDisAllowRequestFind returns integer
52651>>>>>function iFieldOptions.i integer obj# returns integer
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
52653>>>>> integer rval# dm# file# fld# tmp# svr# findok# not_findok#
52653>>>>> integer link_to_file#
52653>>>>> get delegation_mode of obj# to dm#
52654>>>>> set delegation_mode of obj# to no_delegate_or_error
52655>>>>> get data_file of obj# item CURRENT to file#
52656>>>>> get iLinkViewFile of obj# item CURRENT to link_to_file#
52657>>>>> get data_field of obj# item CURRENT to fld#
52658>>>>> get iAllowRequestFind of obj# to findok#
52659>>>>> get iDisAllowRequestFind of obj# to not_findok#
52660>>>>> move 0 to rval#
52661>>>>> get form_datatype of obj# item CURRENT to tmp#
52662>>>>> move (tmp#=DATE_WINDOW) to tmp#
52663>>>>> if tmp# move (rval#+FLDOPT_DATE) to rval#
52666>>>>> if (file#*fld#) begin
52668>>>>> if (integer(API_AttrValue_FILE(DF_FILE_OPENED,file#))) begin
52670>>>>> ifnot not_findok# ifnot findok# get_attribute DF_FIELD_INDEX of file# fld# to findok#
52677>>>>> if (should_save(obj#)) move (rval#+FLDOPT_SAVE) to rval#
52680>>>>> get server of obj# to svr#
52681>>>>> if svr# move (current_record(svr#)) to tmp#
52684>>>>> if tmp# move (rval#+FLDOPT_DELETE) to rval#
52687>>>>> if link_to_file# get Exists_LinkView_File link_to_file# to tmp#
52690>>>>> else get Exists_LinkView_File file# to tmp#
52692>>>>> if tmp# move (rval#+FLDOPT_LINKVW) to rval#
52695>>>>> end
52695>>>>>>
52695>>>>> end
52695>>>>>>
52695>>>>> if findok# move (rval#+FLDOPT_FIND) to rval#
52698>>>>> set delegation_mode of obj# to dm#
52699>>>>> function_return rval#
52700>>>>>end_function
52701>>>>>
52701>>>>>register_procedure Request_Popup_Calendar
52701>>>>>
52701>>>>>Procedure Update_Toolbar_Shadow_States
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
52703>>>>> integer foc# itm# max# msg# opt#
52703>>>>> if oToolBar# begin
52705>>>>> if (pAutoShadow_State(oToolBar#)) begin
52707>>>>> move (focus(desktop)) to foc#
52708>>>>> if foc# gt desktop get iFieldOptions.i foc# to opt#
52711>>>>> get item_count of oToolBar# to max#
52712>>>>> for itm# from 0 to (max#-1)
52718>>>>>>
52718>>>>> get message of oToolBar# item itm# to msg#
52719>>>>> 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))
52722>>>>> //if (msg#=msg_Request_Save) set shadow_state of oToolBar# item itm# to (not(opt# iAND FLDOPT_SAVE))
52722>>>>> //if (msg#=msg_Request_Clear) set shadow_state of oToolBar# item itm# to (not((opt# iAND FLDOPT_SAVE) or (opt# iAND FLDOPT_DELETE)))
52722>>>>> //if (msg#=msg_Request_Delete) set shadow_state of oToolBar# item itm# to (not(opt# iAND FLDOPT_DELETE))
52722>>>>> if (msg#=msg_Request_Popup_Calendar) set shadow_state of oToolBar# item itm# to (not(opt# iAND FLDOPT_DATE))
52725>>>>> if (msg#=msg_Activate_LinkView) set shadow_state of oToolBar# item itm# to (not(opt# iAND FLDOPT_LINKVW))
52728>>>>> loop
52729>>>>>>
52729>>>>> end
52729>>>>>>
52729>>>>> end
52729>>>>>>
52729>>>>>End_Procedure
52730>>>>>
52730>>>>>Class cSturesStatusBar is a StatusBar
52731>>>>> Procedure Show_Status_Help string str#
52733>>>>> forward send Show_Status_Help str#
52735>>>>> send Update_Toolbar_Shadow_States
52736>>>>> End_Procedure
52737>>>>>End_Class
52738>>>>>
52738>>>>>class cViewPopupMenu is a ViewPopupMenu
52739>>>>> procedure construct_object
52741>>>>> forward send construct_object
52743>>>>> property string pTitle public ""
52744>>>>> property string pStatus_Help public ""
52745>>>>> end_procedure
52746>>>>> procedure end_construct_object
52748>>>>> integer itm# self#
52748>>>>> string title# status_help#
52748>>>>> get pTitle to title#
52749>>>>> get pStatus_Help to status_help#
52750>>>>> forward send end_construct_object
52752>>>>> move self to self#
52753>>>>> delegate send add_item 0 title# // 0 betyder aktiver child menu
52755>>>>> get item_count of (parent(self)) to itm#
52756>>>>> set aux_value of (parent(self)) item (itm#-1) to self#
52757>>>>> set status_help of (parent(self)) item (itm#-1) to status_help#
52758>>>>> end_procedure
52759>>>>> function Message integer itm# returns integer
52761>>>>> integer rVal#
52761>>>>> Forward Get message item itm# to rVal#
52763>>>>> // Apparantly global messages cannot be represented via the add_item
52763>>>>> // message. Therefore we have to do this:
52763>>>>> if rval# gt 10000 move (rval#-65536) to rval#
52766>>>>> function_return rval#
52767>>>>> end_function
52768>>>>> procedure add_menu_item integer msg# string label# string status_help# integer tmp_aux#
52770>>>>> integer aux#
52770>>>>> if num_arguments begin
52772>>>>> send add_item msg# label#
52773>>>>> if num_arguments gt 3 move tmp_aux# to aux#
52776>>>>> else move -1 to aux# // -1 will automatically get replaced with client_id
52778>>>>> set aux_value item (item_count(self)-1) to aux#
52779>>>>> set status_help item (item_count(self)-1) to status_help#
52780>>>>> end
52780>>>>>>
52780>>>>> else send add_item msg_none ""
52782>>>>> end_procedure
52783>>>>> procedure add_standard_menu_items
52785>>>>> end_procedure
52786>>>>>end_class
52787>>>Use OpenStat.nui // cTablesOpenStatus class
52787>>>
52787>>>Use Version.nui
52787>>>
52787>>>
52787>>>// ****************************************************************************
52787>>>// *** Control the print interface *****************************************
52787>>>// ****************************************************************************
52787>>>// If you use WinPrint2:
52787>>>Use VDFQuery.utl // DFQUERY for Visual DataFlex (WinPrint2 version)
Including file: vdfquery.utl (C:\Apps\VDFQuery\AppSrc\vdfquery.utl)
52787>>>>>//**********************************************************************
52787>>>>>// Use VdfQuery.utl // DFQUERY for Visual DataFlex
52787>>>>>//
52787>>>>>// Version: 2.4
52787>>>>>//
52787>>>>>// This package is a 'Public Domain' contribution to the DataFlex community.
52787>>>>>//
52787>>>>>//
52787>>>>>// Recommendations:
52787>>>>>//
52787>>>>>// * This package and all other files in the download should be placed in a
52787>>>>>// directory by itself separate from all other source code making up your
52787>>>>>// applications.
52787>>>>>//
52787>>>>>// * You should not make ANY modifications to the source code without
52787>>>>>// very clearly marking your changes both in the header of the package
52787>>>>>// file in question and next to the lines that you alter. In fact, the
52787>>>>>// marking made in the header of the file should be in capital letters
52787>>>>>// at the very first line of the file so that one glance at the file
52787>>>>>// in an editor will reveal that it has been modified. Furthermore, you
52787>>>>>// should maintain a separate log-file (changes.log) mentioning all
52787>>>>>// changes done to the packages. This will help you when upgrading to
52787>>>>>// newer versions of the software and other programmers that in the
52787>>>>>// future will have to maintain your system.
52787>>>>>//
52787>>>>>// * If you have suggestions or questions about the functions in here you
52787>>>>>// should pose them at the Data Access newgroups at news.dataaccess.com:
52787>>>>>//
52787>>>>>// news://dataaccess.com/visual-dataflex
52787>>>>>//
52787>>>>>// You should put the name of the package file in the the subject line
52787>>>>>// of your question.
52787>>>>>//
52787>>>>>// Sture Andersen
52787>>>>>// Sture ApS
52787>>>>>//
52787>>>>>//
52787>>>>>// To get rid of user specific folders: set VdfQuery_OldFolders_State to TRUE
52787>>>>>//
52787>>>>>//**********************************************************************
52787>>>>>
52787>>>>>Use Version.nui
52787>>>>>
52787>>>>>Use APS // Auto Positioning and Sizing classes for VDF
52787>>>>>Use ObjGroup.utl // Defining groups of objects
52787>>>>>Use FdxField.utl // FDX Field things
Including file: fdxfield.utl (C:\Apps\VDFQuery\AppSrc\fdxfield.utl)
52787>>>>>>>Use FdxField.nui // FDX Field things
Including file: fdxfield.nui (C:\Apps\VDFQuery\AppSrc\fdxfield.nui)
52787>>>>>>>>>// Use FdxField.nui // FDX Field things
52787>>>>>>>>>//
52787>>>>>>>>>// Wed 10-09-2003 - Added FDX_ReadRecordBufferToArray_LD
52787>>>>>>>>>
52787>>>>>>>>>Use Fdx_Attr.nui // FDX compatible attribute functions
Including file: fdx_attr.nui (C:\Apps\VDFQuery\AppSrc\fdx_attr.nui)
52787>>>>>>>>>>>// Use FDX_Attr.nui // FDX compatible attribute functions
52787>>>>>>>>>>>//
52787>>>>>>>>>>>//> The functions defined in this class allows you to query the setting
52787>>>>>>>>>>>//> of all the API attrbutes whether from the current runtime or from
52787>>>>>>>>>>>//> an FDX object, using the same calling syntax.
52787>>>>>>>>>>>
52787>>>>>>>>>>>
52787>>>>>>>>>>>Use API_Attr.nui // Database API attributes characteristics
52787>>>>>>>>>>>Use DBMS.nui // Basic DBMS functions
52787>>>>>>>>>>>
52787>>>>>>>>>>>// The functions below are only declared if FDX.nui is used.
52787>>>>>>>>>>>register_function AttrValue_GLOBAL integer attr# returns string
52787>>>>>>>>>>>register_function AttrValue_FILELIST integer attr# integer file# returns string
52787>>>>>>>>>>>register_function AttrValue_FILE integer attr# integer file# returns string
52787>>>>>>>>>>>register_function AttrValue_FIELD integer attr# integer file# integer field# returns string
52787>>>>>>>>>>>register_function AttrValue_INDEX integer attr# integer file# integer index# returns string
52787>>>>>>>>>>>register_function AttrValue_IDXSEG integer attr# integer file# integer index# integer segment# returns string
52787>>>>>>>>>>>register_function AttrValue_SPECIAL1 integer attr# integer file# integer field1# integer field2# returns string
52787>>>>>>>>>>>register_function AttrValue_FLSTNAV integer attr# integer file# returns string
52787>>>>>>>>>>>register_function AttrValue_DRIVER integer attr# integer driver# returns string
52787>>>>>>>>>>>register_function AttrValue_DRVSRV integer attr# integer driver# integer server# returns string
52787>>>>>>>>>>>register_function OtherAttr_Value integer attr# returns string
52787>>>>>>>>>>>register_function piFileDefObject.i integer file# returns integer
52787>>>>>>>>>>>register_function psFileName returns string
52787>>>>>>>>>>>register_function iNextFileThatCanOpen integer file# returns integer
52787>>>>>>>>>>>
52787>>>>>>>>>>>function FDX_AttrValue_GLOBAL global integer oFDX# integer attr# returns string
52789>>>>>>>>>>> if oFDX# function_return (AttrValue_GLOBAL(oFDX#,attr#))
52792>>>>>>>>>>> else function_return (API_AttrValue_GLOBAL(attr#))
52794>>>>>>>>>>>end_function
52795>>>>>>>>>>>function FDX_AttrValue_FILELIST global integer oFDX# integer attr# integer file# returns string
52797>>>>>>>>>>> if oFDX# function_return (AttrValue_FILELIST(oFDX#,attr#,file#))
52800>>>>>>>>>>> else function_return (API_AttrValue_FILELIST(attr#,file#))
52802>>>>>>>>>>>end_function
52803>>>>>>>>>>>function FDX_AttrValue_FILE global integer oFDX# integer attr# integer file# returns string
52805>>>>>>>>>>> if oFDX# function_return (AttrValue_FILE(oFDX#,attr#,file#))
52808>>>>>>>>>>> else function_return (API_AttrValue_FILE(attr#,file#))
52810>>>>>>>>>>>end_function
52811>>>>>>>>>>>function FDX_AttrValue_FIELD global integer oFDX# integer attr# integer file# integer field# returns string
52813>>>>>>>>>>> if oFDX# function_return (AttrValue_FIELD(oFDX#,attr#,file#,field#))
52816>>>>>>>>>>> else function_return (API_AttrValue_FIELD(attr#,file#,field#))
52818>>>>>>>>>>>end_function
52819>>>>>>>>>>>function FDX_AttrValue_INDEX global integer oFDX# integer attr# integer file# integer index# returns string
52821>>>>>>>>>>> if oFDX# function_return (AttrValue_INDEX(oFDX#,attr#,file#,index#))
52824>>>>>>>>>>> else function_return (API_AttrValue_INDEX(attr#,file#,index#))
52826>>>>>>>>>>>end_function
52827>>>>>>>>>>>function FDX_AttrValue_IDXSEG global integer oFDX# integer attr# integer file# integer index# integer segment# returns string
52829>>>>>>>>>>> if oFDX# function_return (AttrValue_IDXSEG(oFDX#,attr#,file#,index#,segment#))
52832>>>>>>>>>>> else function_return (API_AttrValue_IDXSEG(attr#,file#,index#,segment#))
52834>>>>>>>>>>>end_function
52835>>>>>>>>>>>function FDX_AttrValue_SPECIAL1 global integer oFDX# integer attr# integer file# integer field1# integer field2# returns string
52837>>>>>>>>>>> if oFDX# function_return (AttrValue_SPECIAL1(oFDX#,attr#,file#,field1#,field2#))
52840>>>>>>>>>>> else function_return (API_AttrValue_SPECIAL1(attr#,file#,field1#,field2#))
52842>>>>>>>>>>>end_function
52843>>>>>>>>>>>function FDX_AttrValue_FLSTNAV global integer oFDX# integer attr# integer file# returns string
52845>>>>>>>>>>> if oFDX# function_return (AttrValue_FLSTNAV(oFDX#,attr#,file#))
52848>>>>>>>>>>> else function_return (API_AttrValue_FLSTNAV(attr#,file#))
52850>>>>>>>>>>>end_function
52851>>>>>>>>>>>function FDX_AttrValue_DRIVER global integer oFDX# integer attr# integer driver# returns string
52853>>>>>>>>>>> if oFDX# function_return (AttrValue_DRIVER(oFDX#,attr#,driver#))
52856>>>>>>>>>>> else function_return (API_AttrValue_DRIVER(attr#,driver#))
52858>>>>>>>>>>>end_function
52859>>>>>>>>>>>function FDX_AttrValue_DRVSRV global integer oFDX# integer attr# integer driver# integer server# returns string
52861>>>>>>>>>>> if oFDX# function_return (AttrValue_DRVSRV(oFDX#,attr#,driver#,server#))
52864>>>>>>>>>>> else function_return (API_AttrValue_DRVSRV(attr#,driver#,server#))
52866>>>>>>>>>>>end_function
52867>>>>>>>>>>>function FDX_OtherAttr_Value global integer oFDX# integer attr# returns string
52869>>>>>>>>>>> if oFDX# function_return (OtherAttr_Value(oFDX#,attr#))
52872>>>>>>>>>>> else function_return (API_OtherAttr_Value(attr#))
52874>>>>>>>>>>>end_function
52875>>>>>>>>>>>function FDX_CanOpenFile global integer oFDX# integer file# returns integer
52877>>>>>>>>>>> if oFDX# function_return (piFileDefObject.i(oFdx#,file#))
52880>>>>>>>>>>> else function_return (DBMS_CanOpenFile(file#))
52882>>>>>>>>>>>end_function
52883>>>>>>>>>>>function FDX_NextFileThatCanOpen global integer oFDX# integer file# returns integer
52885>>>>>>>>>>> if oFDX# function_return (iNextFileThatCanOpen(oFdx#,file#))
52888>>>>>>>>>>> else function_return (API_NextFileThatCanOpen(file#))
52890>>>>>>>>>>>end_function
52891>>>>>>>>>>>function FDX_FindRootName global integer lhFDX string lsFindRootName integer liFile returns integer
52893>>>>>>>>>>> string lsRootStripped
52893>>>>>>>>>>> get DBMS_StripPathAndDriver lsFindRootName to lsFindRootName
52894>>>>>>>>>>> repeat
52894>>>>>>>>>>>>
52894>>>>>>>>>>> move (FDX_AttrValue_FLSTNAV(lhFDX,DF_FILE_NEXT_USED,liFile)) to liFile
52895>>>>>>>>>>> if liFile begin
52897>>>>>>>>>>> get FDX_AttrValue_FILELIST lhFDX DF_FILE_ROOT_NAME liFile to lsRootStripped
52898>>>>>>>>>>> get DBMS_StripPathAndDriver lsRootStripped to lsRootStripped
52899>>>>>>>>>>> if (lowercase(lsFindRootName)=lowercase(lsRootStripped)) function_return liFile
52902>>>>>>>>>>> end
52902>>>>>>>>>>>>
52902>>>>>>>>>>> until liFile eq 0
52904>>>>>>>>>>> function_return 0
52905>>>>>>>>>>>end_function
52906>>>>>>>>>>>function FDX_FindLogicalName global integer lhFDX string lsFindLogName integer liFile returns integer
52908>>>>>>>>>>> string lsLogName
52908>>>>>>>>>>> repeat
52908>>>>>>>>>>>>
52908>>>>>>>>>>> move (FDX_AttrValue_FLSTNAV(lhFDX,DF_FILE_NEXT_USED,liFile)) to liFile
52909>>>>>>>>>>> if liFile begin
52911>>>>>>>>>>> get FDX_AttrValue_FILELIST lhFDX DF_FILE_LOGICAL_NAME liFile to lsLogName
52912>>>>>>>>>>> if (lowercase(lsFindLogName)=lowercase(lsLogName)) function_return liFile
52915>>>>>>>>>>> end
52915>>>>>>>>>>>>
52915>>>>>>>>>>> until liFile eq 0
52917>>>>>>>>>>> function_return 0
52918>>>>>>>>>>>end_function
52919>>>>>>>>>>>
52919>>>>>>>>>>>// ******** Samples ********************************************
52919>>>>>>>>>>>//
52919>>>>>>>>>>>// A loop through all files/all fields:
52919>>>>>>>>>>>//
52919>>>>>>>>>>>// procedure GoThoughAllFields
52919>>>>>>>>>>>// integer oFDX# file# field# max#
52919>>>>>>>>>>>// get piFDX_Server to oFDX#
52919>>>>>>>>>>>// move 0 to file#
52919>>>>>>>>>>>// repeat
52919>>>>>>>>>>>// move (FDX_AttrValue_FLSTNAV(oFDX#,DF_FILE_NEXT_USED,file#)) to file#
52919>>>>>>>>>>>// if file# begin
52919>>>>>>>>>>>// move (FDX_AttrValue_FILE(oFDX#,DF_FILE_NUMBER_FIELDS,file#)) to max#
52919>>>>>>>>>>>// for field# from 1 to max#
52919>>>>>>>>>>>// (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_NAME,file#,field#))
52919>>>>>>>>>>>// loop
52919>>>>>>>>>>>// end
52919>>>>>>>>>>>// until file# eq 0
52919>>>>>>>>>>>// end_procedure
52919>>>>>>>>>>>//
52919>>>>>>>>>>>// A loop through all indices/segments of a file:
52919>>>>>>>>>>>//
52919>>>>>>>>>>>// procedure GoThoughAllIndices integer file#
52919>>>>>>>>>>>// integer oFDX# index# seg_max# segment# field#
52919>>>>>>>>>>>// get piFDX_Server to oFDX#
52919>>>>>>>>>>>//
52919>>>>>>>>>>>// for index# from 1 to 16
52919>>>>>>>>>>>// get FDX_AttrValue_INDEX oFDX# DF_INDEX_NUMBER_SEGMENTS file# index# to seg_max#
52919>>>>>>>>>>>// if max_seg# begin // If there's an index at all
52919>>>>>>>>>>>// for segment# from 1 to seg_max#
52919>>>>>>>>>>>// get FDX_AttrValue_IDXSEG oFDX# DF_INDEX_SEGMENT_FIELD file# index# segment# to field#
52919>>>>>>>>>>>// loop
52919>>>>>>>>>>>// end
52919>>>>>>>>>>>// loop
52919>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
52919>>>>>>>>>Use Strings.nui // String manipulation for VDF
52919>>>>>>>>>Use Dates.nui // Date manipulation for VDF
52919>>>>>>>>>
52919>>>>>>>>>//> Translates an overlap field into the sequence of fields that makes up
52919>>>>>>>>>//> the overlap field. The field sequence is returned in a string where each
52919>>>>>>>>>//> field in the sequence takes up four characters. The sequence of fields
52919>>>>>>>>>//> 2, 3 and 4 would return as "2 3 4 ".
52919>>>>>>>>>function FDX_FieldsInOverlap global integer lhFDX integer liFile integer lbOverlap returns string
52921>>>>>>>>> integer liField liMax
52921>>>>>>>>> string lsValue
52921>>>>>>>>> move "" to lsValue
52922>>>>>>>>> // Only go through this if lbOverlap is indeed an overlap field:
52922>>>>>>>>> if (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile,lbOverlap))) eq DF_OVERLAP begin
52924>>>>>>>>> move (FDX_AttrValue_FILE(lhFDX,DF_FILE_NUMBER_FIELDS,liFile)) to liMax
52925>>>>>>>>> for liField from 1 to liMax
52931>>>>>>>>>>
52931>>>>>>>>> // Only check to see if field is part of the overlap if it is not itself an overlap field:
52931>>>>>>>>> if (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile,liField))) ne DF_OVERLAP begin
52933>>>>>>>>> if (integer(FDX_AttrValue_SPECIAL1(lhFDX,DF_FIELD_OVERLAP,liFile,lbOverlap,liField))) move (lsValue+pad(liField,4)) to lsValue
52936>>>>>>>>> end
52936>>>>>>>>>>
52936>>>>>>>>> loop
52937>>>>>>>>>>
52937>>>>>>>>> end
52937>>>>>>>>>>
52937>>>>>>>>> else move (pad(lbOverlap,4)) to lsValue
52939>>>>>>>>> function_return lsValue
52940>>>>>>>>>end_function // FDX_FieldsInOverlap
52941>>>>>>>>>
52941>>>>>>>>>//> The function returns a set of (overlap-) fields all overlapping
52941>>>>>>>>>//> the field passed as an arguments
52941>>>>>>>>>function FDX_FieldsOverlappingField global integer lhFDX integer liFile integer liField returns string
52943>>>>>>>>> integer liMaxField liTestField
52943>>>>>>>>> string lsRval
52943>>>>>>>>> move "" to lsRval
52944>>>>>>>>> move (FDX_AttrValue_FILE(lhFDX,DF_FILE_NUMBER_FIELDS,liFile)) to liMaxField
52945>>>>>>>>> for liTestField from 1 to liMaxField
52951>>>>>>>>>>
52951>>>>>>>>> if (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile,liTestField))) eq DF_OVERLAP begin
52953>>>>>>>>> if (integer(FDX_AttrValue_SPECIAL1(lhFDX,DF_FIELD_OVERLAP,liFile,liTestField,liField))) move (lsRval+pad(liTestField,4)) to lsRval
52956>>>>>>>>> end
52956>>>>>>>>>>
52956>>>>>>>>> loop
52957>>>>>>>>>>
52957>>>>>>>>> function_return lsRval
52958>>>>>>>>>end_function // FDX_FieldsInOverlap
52959>>>>>>>>>
52959>>>>>>>>>//> Remove dublettes from a sequence of fields
52959>>>>>>>>>function FDX_FieldsRemoveDublettes global string lsFields returns string
52961>>>>>>>>> integer liMaxPos liSegment
52961>>>>>>>>> string lsValue liField
52961>>>>>>>>> move "" to lsValue
52962>>>>>>>>> move (length(lsFields)+3/4) to liMaxPos
52963>>>>>>>>> for liSegment from 1 to liMaxPos
52969>>>>>>>>>>
52969>>>>>>>>> move (mid(lsFields,4,liSegment-1*4+1)) to liField
52970>>>>>>>>> ifnot liField in lsValue move (lsValue+liField) to lsValue
52973>>>>>>>>> loop
52974>>>>>>>>>>
52974>>>>>>>>> function_return lsValue
52975>>>>>>>>>end_function
52976>>>>>>>>>
52976>>>>>>>>>//> This function takes a sequence of fields translating each overlap field
52976>>>>>>>>>//> in the sequence to its underlying real fields and returns the translated
52976>>>>>>>>>//> sequence.
52976>>>>>>>>>function FDX_FieldsTranslateOverlaps global integer lhFDX integer liFile string lsFields returns string
52978>>>>>>>>> integer liMaxPos liField liPos
52978>>>>>>>>> string lsValue
52978>>>>>>>>> move "" to lsValue
52979>>>>>>>>> move (length(lsFields)+3/4) to liMaxPos
52980>>>>>>>>> for liPos from 0 to (liMaxPos-1)
52986>>>>>>>>>>
52986>>>>>>>>> move (mid(lsFields,4,liPos*4+1)) to liField
52987>>>>>>>>> if (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile,liField))) eq DF_OVERLAP move (lsValue+FDX_FieldsInOverlap(lhFDX,liFile,liField)) to lsValue
52990>>>>>>>>> else move (lsValue+pad(liField,4)) to lsValue
52992>>>>>>>>> loop
52993>>>>>>>>>>
52993>>>>>>>>> function_return lsValue
52994>>>>>>>>>end_function // FDX_FieldsTranslateOverlaps
52995>>>>>>>>>
52995>>>>>>>>>//> Use to check if two fields are identically defined
52995>>>>>>>>>function FDX_FieldIdenticalFieldDefinition global integer lhFDX integer liFile1 integer liField1 integer liFile2 integer liField2 returns integer
52997>>>>>>>>> if (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile1,liField1))<>integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile2,liField2))) function_return 0
53000>>>>>>>>> if (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_LENGTH,liFile1,liField1))<>integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_LENGTH,liFile2,liField2))) function_return 0
53003>>>>>>>>> if (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_PRECISION,liFile1,liField1))<>integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_PRECISION,liFile2,liField2))) function_return 0
53006>>>>>>>>> function_return 1 // Yes, they are identical
53007>>>>>>>>>end_function
53008>>>>>>>>>
53008>>>>>>>>>//> Use to check if two sequences of fields are identically defined. Returns TRUE if identical
53008>>>>>>>>>function FDX_FieldIdenticalFieldSequenceDefinition global integer lhFDX integer liFile1 string lsFields1 integer liFile2 string lsFields2 returns integer
53010>>>>>>>>> integer liMaxPos liField liPos liField1 liField2
53010>>>>>>>>> if (length(lsFields1)<>length(lsFields2)) function_return 0
53013>>>>>>>>> move (length(lsFields1)+3/4) to liMaxPos
53014>>>>>>>>> for liPos from 0 to (liMaxPos-1)
53020>>>>>>>>>>
53020>>>>>>>>> move (mid(lsFields1,4,liPos*4+1)) to liField1
53021>>>>>>>>> move (mid(lsFields2,4,liPos*4+1)) to liField2
53022>>>>>>>>> ifnot (FDX_FieldIdenticalFieldDefinition(lhFDX,liFile1,liField1,liFile2,liField2)) function_return 0
53025>>>>>>>>> loop
53026>>>>>>>>>>
53026>>>>>>>>> function_return 1 // Yes, they are identical
53027>>>>>>>>>end_function
53028>>>>>>>>>
53028>>>>>>>>>//> Use this to compare two overlap fields. Returns TRUE if identical.
53028>>>>>>>>>function FDX_FieldIdenticalOverlapStructures global integer lhFDX integer liFile1 integer liField1 integer liFile2 integer liField2 returns integer
53030>>>>>>>>> string lsFields1 lsFields2
53030>>>>>>>>> get FDX_FieldsInOverlap lhFDX liFile1 liField1 to lsFields1
53031>>>>>>>>> get FDX_FieldsInOverlap lhFDX liFile2 liField2 to lsFields2
53032>>>>>>>>> function_return (FDX_FieldIdenticalFieldSequenceDefinition(lhFDX,liFile1,lsFields1,liFile2,lsFields2))
53033>>>>>>>>>end_function
53034>>>>>>>>>
53034>>>>>>>>>function FDX_FieldName global integer lhFDX integer liFile integer liField integer lbIncludeTable returns string
53036>>>>>>>>> string lsLogName lsFieldName
53036>>>>>>>>> ifnot liFile function_return ""
53039>>>>>>>>> move (FDX_AttrValue_FILELIST(lhFDX,DF_FILE_LOGICAL_NAME,liFile)) to lsLogName
53040>>>>>>>>> if liField move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_NAME,liFile,liField)) to lsFieldName
53043>>>>>>>>> else move "RECNUM" to lsFieldName
53045>>>>>>>>> if lbIncludeTable function_return (lsLogName+"."+lsFieldName)
53048>>>>>>>>> function_return lsFieldName
53049>>>>>>>>>end_function
53050>>>>>>>>>
53050>>>>>>>>>function FDX_FieldNames global integer lhFDX integer liFile string lsFields returns string
53052>>>>>>>>> integer liMaxPos liSegment
53052>>>>>>>>> string lsRval lsField
53052>>>>>>>>> move "" to lsRval
53053>>>>>>>>> move (length(lsFields)+3/4) to liMaxPos
53054>>>>>>>>> for liSegment from 1 to liMaxPos
53060>>>>>>>>>>
53060>>>>>>>>> move (mid(lsFields,4,liSegment-1*4+1)) to lsField
53061>>>>>>>>> move (lsRval+FDX_FieldName(lhFDX,liFile,lsField,0)) to lsRval
53062>>>>>>>>> if liSegment ne liMaxPos move (lsRval+",") to lsRval
53065>>>>>>>>> loop
53066>>>>>>>>>>
53066>>>>>>>>> function_return lsRval
53067>>>>>>>>>end_function
53068>>>>>>>>>
53068>>>>>>>>>function FDX_FieldTypeName global integer lhFDX integer liFile integer liField returns string
53070>>>>>>>>> integer liType
53070>>>>>>>>> move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile,liField)) to liType
53071>>>>>>>>> function_return (StringFieldType(liType))
53072>>>>>>>>>end_function
53073>>>>>>>>>
53073>>>>>>>>>function FDX_FieldLength global integer lhFDX integer liFile integer liField returns string
53075>>>>>>>>> integer liType liLen liDec lhObj
53075>>>>>>>>> string lsRval
53075>>>>>>>>> move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile,liField)) to liType
53076>>>>>>>>> move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_LENGTH,liFile,liField)) to liLen
53077>>>>>>>>> move liLen to lsRval
53078>>>>>>>>> if liType eq DF_BCD begin
53080>>>>>>>>> move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_PRECISION,liFile,liField)) to liDec
53081>>>>>>>>> move "#.#" to lsRval
53082>>>>>>>>> replace "#" in lsRval with (string(liLen-liDec))
53084>>>>>>>>> replace "#" in lsRval with (string(liDec))
53086>>>>>>>>> end
53086>>>>>>>>>>
53086>>>>>>>>> function_return lsRval
53087>>>>>>>>>end_function
53088>>>>>>>>>
53088>>>>>>>>>function FDX_FieldTypeAndLengthName global integer lhFDX integer liFile integer liField returns string
53090>>>>>>>>> string lsRval
53090>>>>>>>>> get FDX_FieldTypeName lhFDX liFile liField to lsRval
53091>>>>>>>>> move (uppercase(left(lsRval,3))) to lsRval
53092>>>>>>>>> function_return (lsRval+" "+FDX_FieldLength(lhFDX,liFile,liField))
53093>>>>>>>>>end_function
53094>>>>>>>>>
53094>>>>>>>>>function FDX_FieldTypeAndLengthName2 global integer lhFDX integer liFile integer liField returns string
53096>>>>>>>>> string lsRval
53096>>>>>>>>> get FDX_FieldTypeName lhFDX liFile liField to lsRval
53097>>>>>>>>> function_return (lsRval+" "+FDX_FieldLength(lhFDX,liFile,liField))
53098>>>>>>>>>end_function
53099>>>>>>>>>
53099>>>>>>>>>//> Returns "Field Name (NUM 2.2)"
53099>>>>>>>>>function FDX_FieldNameAndType global integer lhFDX integer liFile integer liField returns string
53101>>>>>>>>> string lsRval
53101>>>>>>>>> get FDX_AttrValue_FIELD lhFDX DF_FIELD_NAME liFile liField to lsRval
53102>>>>>>>>> move (StringUppercaseFirstLetters(replaces("_",lsRval," "))) to lsRval
53103>>>>>>>>> function_return (lsRval+" ("+FDX_FieldTypeAndLengthName(lhFDX,liFile,liField)+")")
53104>>>>>>>>>end_function
53105>>>>>>>>>
53105>>>>>>>>>//> Returns the concatenated values of the fields in sFields parameter
53105>>>>>>>>>//> separated by space characters. Overlap fields are ignored. (and so
53105>>>>>>>>>//> are Text and Binary fields)
53105>>>>>>>>>function FDX_FieldValues global integer lhFDX integer iFile string sFields returns string
53107>>>>>>>>> integer iMaxPos iField iPos iType iLen iDec
53107>>>>>>>>> string sRval sFieldVal
53107>>>>>>>>> move "" to sRval
53108>>>>>>>>> ifnot lhFDX begin
53110>>>>>>>>> move (length(sFields)+3/4) to iMaxPos
53111>>>>>>>>> for iPos from 1 to iMaxPos
53117>>>>>>>>>>
53117>>>>>>>>> move (mid(sFields,4,iPos-1*4+1)) to iField
53118>>>>>>>>> move (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,iFile,iField))) to iType
53119>>>>>>>>> get_field_value iFile iField to sFieldVal
53122>>>>>>>>> if iType eq DF_ASCII move (sRval+rtrim(sFieldVal)) to sRval
53125>>>>>>>>> if iType eq DF_BCD begin
53127>>>>>>>>> get_attribute DF_FIELD_LENGTH of iFile iField to iLen
53130>>>>>>>>> get_attribute DF_FIELD_PRECISION of iFile iField to iDec
53133>>>>>>>>> if iDec increment iLen // Make room for comma
53136>>>>>>>>> move (sRval+NumToStrR(sFieldVal,iDec,iLen)) to sRval
53137>>>>>>>>> end
53137>>>>>>>>>>
53137>>>>>>>>> if iType eq DF_DATE move (sRval+string(DateToInteger(sFieldVal))) to sRval
53140>>>>>>>>> if iPos ne iMaxPos move (sRval+" ") to sRval
53143>>>>>>>>> loop
53144>>>>>>>>>>
53144>>>>>>>>> end
53144>>>>>>>>>>
53144>>>>>>>>> else function_return "Function FDX_FieldValues may only be called with lhFDX=0"
53146>>>>>>>>> function_return sRval
53147>>>>>>>>>end_function
53148>>>>>>>>>
53148>>>>>>>>>//> Returns the concatenated values of the fields in sFields parameter
53148>>>>>>>>>//> separated by "-" characters. Overlap fields are ignored. (and so
53148>>>>>>>>>//> are Text and Binary fields). The returns value of this function is
53148>>>>>>>>>//> meant to be used as the a file name.
53148>>>>>>>>>function FDX_FieldValuesFileName_Help global string lsSource returns string
53150>>>>>>>>> integer liPos liLen liByte
53150>>>>>>>>> string lsChar lsRval
53150>>>>>>>>> move "" to lsRval
53151>>>>>>>>> move (length(lsSource)) to liLen
53152>>>>>>>>> for liPos from 1 to liLen
53158>>>>>>>>>>
53158>>>>>>>>> move (mid(lsSource,1,liPos)) to lsChar
53159>>>>>>>>> move (lsRval+ByteToHex(ascii(lsChar))) to lsRval
53160>>>>>>>>> loop
53161>>>>>>>>>>
53161>>>>>>>>> function_return lsRval
53162>>>>>>>>>end_function
53163>>>>>>>>>function FDX_FieldValuesFileName global integer lhFDX integer liFile string lsFields returns string
53165>>>>>>>>> integer liMaxPos liField liPos liType liLen liDec
53165>>>>>>>>> string lsRval lsFieldValue
53165>>>>>>>>> move "" to lsRval
53166>>>>>>>>> ifnot lhFDX begin
53168>>>>>>>>> move (length(lsFields)+3/4) to liMaxPos
53169>>>>>>>>> for liPos from 1 to liMaxPos
53175>>>>>>>>>>
53175>>>>>>>>> move (mid(lsFields,4,liPos-1*4+1)) to liField
53176>>>>>>>>> move (integer(FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile,liField))) to liType
53177>>>>>>>>> get_field_value liFile liField to lsFieldValue
53180>>>>>>>>> if liType eq DF_ASCII move (lsRval+FDX_FieldValuesFileName_Help(lsFieldValue)) to lsRval
53183>>>>>>>>> if liType eq DF_BCD begin
53185>>>>>>>>> get_attribute DF_FIELD_LENGTH of liFile liField to liLen
53188>>>>>>>>> get_attribute DF_FIELD_PRECISION of liFile liField to liDec
53191>>>>>>>>> if liDec increment liLen // Make room for comma
53194>>>>>>>>> move (lsRval+NumToStrRzf(lsFieldValue,liDec,liLen)) to lsRval
53195>>>>>>>>> end
53195>>>>>>>>>>
53195>>>>>>>>> if liType eq DF_DATE move (lsRval+string(DateToInteger(lsFieldValue))) to lsRval
53198>>>>>>>>> if liPos ne liMaxPos move (lsRval+"-") to lsRval
53201>>>>>>>>> loop
53202>>>>>>>>>>
53202>>>>>>>>> end
53202>>>>>>>>>>
53202>>>>>>>>> else function_return "Function FDX_FieldValues may only be called with lhFDX=0"
53204>>>>>>>>> move (replaces(".",lsRval,"")) to lsRval
53205>>>>>>>>> move (replaces(",",lsRval,"")) to lsRval
53206>>>>>>>>> move (replaces(" ",lsRval,"")) to lsRval
53207>>>>>>>>> function_return lsRval
53208>>>>>>>>>end_function
53209>>>>>>>>>
53209>>>>>>>>>//
53209>>>>>>>>>// Recieving procedure should be defined like this:
53209>>>>>>>>>//
53209>>>>>>>>>// Procedure HandleField integer liFile integer liField string lsName integer liType integer liLen integer liPrec integer liRelFile integer liRelField integer liIndex integer liOffSet
53209>>>>>>>>>//
53209>>>>>>>>>//
53209>>>>>>>>>procedure FDX_FieldCallBack global integer lhFDX integer liFile integer liMsg integer lhObj
53211>>>>>>>>> integer liMaxField liField
53211>>>>>>>>> integer liType liLen liPrec liRelFile liRelField liIndex liOffSet
53211>>>>>>>>> string lsName
53211>>>>>>>>> move (FDX_AttrValue_FILE(lhFDX,DF_FILE_NUMBER_FIELDS,liFile)) to liMaxField
53212>>>>>>>>> for liField from 1 to liMaxField
53218>>>>>>>>>>
53218>>>>>>>>>
53218>>>>>>>>> get FDX_AttrValue_FIELD lhFDX DF_FIELD_NAME liFile liField to lsName
53219>>>>>>>>> get FDX_AttrValue_FIELD lhFDX DF_FIELD_TYPE liFile liField to liType
53220>>>>>>>>> get FDX_AttrValue_FIELD lhFDX DF_FIELD_LENGTH liFile liField to liLen
53221>>>>>>>>> get FDX_AttrValue_FIELD lhFDX DF_FIELD_PRECISION liFile liField to liPrec
53222>>>>>>>>> get FDX_AttrValue_FIELD lhFDX DF_FIELD_RELATED_FILE liFile liField to liRelFile
53223>>>>>>>>> get FDX_AttrValue_FIELD lhFDX DF_FIELD_RELATED_FIELD liFile liField to liRelField
53224>>>>>>>>> get FDX_AttrValue_FIELD lhFDX DF_FIELD_INDEX liFile liField to liIndex
53225>>>>>>>>> get FDX_AttrValue_FIELD lhFDX DF_FIELD_OFFSET liFile liField to liOffSet
53226>>>>>>>>> // procedure handle_field integer liFile integer liField string lsName integer liType integer liLen integer liPrec integer liRelFile integer liRelField integer liIndex integer liOffSet
53226>>>>>>>>> send liMsg to lhObj liFile liField lsName liType liLen liPrec liRelFile liRelField liIndex liOffSet
53227>>>>>>>>> loop
53228>>>>>>>>>>
53228>>>>>>>>>end_procedure
53229>>>>>>>>>
53229>>>>>>>>>function FDX_FindField global integer lhFDX integer liFile string lsFieldName returns integer
53231>>>>>>>>> integer liMax liField
53231>>>>>>>>> string lsValue
53231>>>>>>>>> move (uppercase(lsFieldName)) to lsFieldName
53232>>>>>>>>> if (lsFieldName="RECNUM") function_return 0
53235>>>>>>>>> move (FDX_AttrValue_FILE(lhFDX,DF_FILE_NUMBER_FIELDS,liFile)) to liMax
53236>>>>>>>>> for liField from 1 to liMax
53242>>>>>>>>>>
53242>>>>>>>>> get FDX_AttrValue_FIELD lhFDX DF_FIELD_NAME liFile liField to lsValue
53243>>>>>>>>> if (uppercase(lsValue)=lsFieldName) function_return liField
53246>>>>>>>>> loop
53247>>>>>>>>>>
53247>>>>>>>>> function_return -1
53248>>>>>>>>>end_function
53249>>>>>>>>>
53249>>>>>>>>>//> Reads a record like the SEQ_ReadRecordBuffer_LD procedure but places the
53249>>>>>>>>>//> result in the array passed in the lhArray instead of directly in the
53249>>>>>>>>>//> record buffer.
53249>>>>>>>>>procedure FDX_ReadRecordBufferToArray_LD global integer lhFDX integer liChannel integer liFile integer lhArray
53251>>>>>>>>> integer liMax liField liLen liType
53251>>>>>>>>> string lsValue
53251>>>>>>>>> send delete_data to lhArray
53252>>>>>>>>> get FDX_AttrValue_FILE lhFDX DF_FILE_NUMBER_FIELDS liFile to liMax
53253>>>>>>>>> read channel liChannel // Set channel
53254>>>>>>>>> for liField from 1 to liMax
53260>>>>>>>>>>
53260>>>>>>>>> get FDX_AttrValue_FIELD lhFDX DF_FIELD_TYPE liFile liField to liType
53261>>>>>>>>> if liType ne DF_OVERLAP begin
53263>>>>>>>>> if (liType=DF_BINARY or liType=DF_TEXT) begin
53265>>>>>>>>> readln liLen
53266>>>>>>>>> read_block lsValue liLen
53267>>>>>>>>> end
53267>>>>>>>>>>
53267>>>>>>>>> else readln lsValue
53269>>>>>>>>> end
53269>>>>>>>>>>
53269>>>>>>>>> set value of lhArray item liField to lsValue
53270>>>>>>>>> loop
53271>>>>>>>>>>
53271>>>>>>>>>end_procedure
53272>>>>>>>>>
53272>>>>>>>>>//> Returns set of (child table) fields that relates to parent table.
53272>>>>>>>>>function FDX_FieldsRelatingToParent global integer lhFDX integer liChild integer liParent returns string
53274>>>>>>>>> integer liMax liField liTest
53274>>>>>>>>> string lsValue
53274>>>>>>>>> get FDX_AttrValue_FILE lhFDX DF_FILE_NUMBER_FIELDS liChild to liMax
53275>>>>>>>>> move "" to lsValue
53276>>>>>>>>>
53276>>>>>>>>> for liField from 1 to liMax
53282>>>>>>>>>>
53282>>>>>>>>> get FDX_AttrValue_FIELD lhFDX DF_FIELD_RELATED_FILE liChild liField to liTest
53283>>>>>>>>> if (liTest=liParent) move (lsValue+pad(liField,4)) to lsValue
53286>>>>>>>>> loop
53287>>>>>>>>>>
53287>>>>>>>>>
53287>>>>>>>>> function_return lsValue
53288>>>>>>>>>end_function
53289>>>>>Use FdxIndex.utl // Index analysing functions
Including file: fdxindex.utl (C:\Apps\VDFQuery\AppSrc\fdxindex.utl)
53289>>>>>>>Use FdxIndex.nui // Index analysing functions
Including file: fdxindex.nui (C:\Apps\VDFQuery\AppSrc\fdxindex.nui)
53289>>>>>>>>>// Use FdxIndex.nui // Index analysing functions
53289>>>>>>>>>
53289>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
53289>>>>>>>>>Use Fdx_Attr.nui // FDX compatible attribute functions
53289>>>>>>>>>Use FdxField.nui // FDX Field things
53289>>>>>>>>>
53289>>>>>>>>>//> This function returns an index as a sequence of fields. The field
53289>>>>>>>>>//> sequence is returned in a string where each field in the sequence
53289>>>>>>>>>//> takes up four characters. The sequence of fields 2, 3 and 4 would
53289>>>>>>>>>//> return as "2 3 4 ".
53289>>>>>>>>>function FDX_IndexAsFields global integer oFDX# integer file# integer index# returns string
53291>>>>>>>>> integer segment# max_seg# field#
53291>>>>>>>>> string rval#
53291>>>>>>>>> move "" to rval#
53292>>>>>>>>> get FDX_AttrValue_INDEX oFDX# DF_INDEX_NUMBER_SEGMENTS file# index# to max_seg#
53293>>>>>>>>> if max_seg# begin // If there's an index at all
53295>>>>>>>>> for segment# from 1 to max_seg#
53301>>>>>>>>>>
53301>>>>>>>>> get FDX_AttrValue_IDXSEG oFDX# DF_INDEX_SEGMENT_FIELD file# index# segment# to field#
53302>>>>>>>>> move (rval#+pad(field#,4)) to rval#
53303>>>>>>>>> loop
53304>>>>>>>>>>
53304>>>>>>>>> end
53304>>>>>>>>>>
53304>>>>>>>>> function_return rval#
53305>>>>>>>>>end_function // FDX_IndexAsFields
53306>>>>>>>>>
53306>>>>>>>>>//> Returns DFTRUE if index# if last segment of index# is not RECNUM. If the
53306>>>>>>>>>//> index does not exist DFFALSE is returned.
53306>>>>>>>>>function FDX_IndexUnique global integer oFDX# integer file# integer index# returns integer
53308>>>>>>>>> string str#
53308>>>>>>>>> if index# eq 0 function_return 1
53311>>>>>>>>> get FDX_IndexAsFields oFDX# file# index# to str#
53312>>>>>>>>> function_return (integer(right(str#,4)))
53313>>>>>>>>>end_function
53314>>>>>>>>>
53314>>>>>>>>>//> Function FDX_IndexAsFieldNames returns the specified index as field names
53314>>>>>>>>>//> separated by commas. A descending segment will be marked by a minus
53314>>>>>>>>>//> sign while uppercased segments will appear with an uppercased field
53314>>>>>>>>>//> name. The width# parameter will (if not 0) break up the return value
53314>>>>>>>>>//> in strings none of which is longer than indicated by its value. In this
53314>>>>>>>>>//> case the sub-strings will be separated by a character 10.
53314>>>>>>>>>function FDX_IndexAsFieldNames global integer oFDX# integer file# integer index# integer width# returns string
53316>>>>>>>>> integer max_seg# segment# field# dir# case# liType
53316>>>>>>>>> string rval# lf# fname# substring# test#
53316>>>>>>>>>
53316>>>>>>>>> get FDX_AttrValue_INDEX oFDX# DF_INDEX_TYPE file# index# to liType
53317>>>>>>>>> ifnot width# move 1000 to width#
53320>>>>>>>>> move (character(10)) to lf#
53321>>>>>>>>> get FDX_AttrValue_INDEX oFDX# DF_INDEX_NUMBER_SEGMENTS file# index# to max_seg#
53322>>>>>>>>>
53322>>>>>>>>> if (liType=DF_INDEX_TYPE_ONLINE) move "" to substring#
53325>>>>>>>>> else move "(Batch) " to substring#
53327>>>>>>>>>
53327>>>>>>>>> for segment# from 1 to max_seg#
53333>>>>>>>>>>
53333>>>>>>>>> get FDX_AttrValue_IDXSEG oFDX# DF_INDEX_SEGMENT_FIELD file# index# segment# to field#
53334>>>>>>>>> if field# get FDX_AttrValue_FIELD oFDX# DF_FIELD_NAME file# field# to fname#
53337>>>>>>>>> else move "recnum" to fname#
53339>>>>>>>>> get FDX_AttrValue_IDXSEG oFDX# DF_INDEX_SEGMENT_DIRECTION file# index# segment# to dir#
53340>>>>>>>>> get FDX_AttrValue_IDXSEG oFDX# DF_INDEX_SEGMENT_CASE file# index# segment# to case#
53341>>>>>>>>>
53341>>>>>>>>> if dir# eq DF_DESCENDING move ("-"+fname#) to fname#
53344>>>>>>>>> if case# eq DF_CASE_IGNORED move (uppercase(fname#)) to fname#
53347>>>>>>>>> else move (lowercase(fname#)) to fname#
53349>>>>>>>>>
53349>>>>>>>>> if segment# ne max_seg# move (fname#+",") to fname# // If not the last segment append a comma to the name
53352>>>>>>>>> move (substring#+fname#) to test#
53353>>>>>>>>>
53353>>>>>>>>> if (length(test#)>width# and substring#<>"") begin
53355>>>>>>>>> // If we go in here the length of the substring is too long and
53355>>>>>>>>> // we will have to insert a lf character.
53355>>>>>>>>> if rval# eq "" move substring# to rval#
53358>>>>>>>>> else move (rval#+lf#+substring#) to rval#
53360>>>>>>>>> move fname# to substring#
53361>>>>>>>>> end
53361>>>>>>>>>>
53361>>>>>>>>> else begin // It's not too wide
53362>>>>>>>>> if substring# eq "" move fname# to substring#
53365>>>>>>>>> else move (substring#+fname#) to substring#
53367>>>>>>>>> end
53367>>>>>>>>>>
53367>>>>>>>>> loop
53368>>>>>>>>>>
53368>>>>>>>>>
53368>>>>>>>>> if rval# eq "" move substring# to rval#
53371>>>>>>>>> else move (rval#+lf#+substring#) to rval#
53373>>>>>>>>> function_return rval#
53374>>>>>>>>>end_function // FDX_IndexAsFieldNames
53375>>>>>>>>>
53375>>>>>>>>>//> This function will return the number of the first unique index
53375>>>>>>>>>//> defined for the file passed. If no such index is found, 0 will
53375>>>>>>>>>//> be returned.
53375>>>>>>>>>function FDX_IndexFindPrimary global integer oFDX# integer file# returns integer
53377>>>>>>>>> integer index# fin# rval# max_seg# segment# field#
53377>>>>>>>>> move 1 to index#
53378>>>>>>>>> move 0 to fin#
53379>>>>>>>>> move 0 to rval#
53380>>>>>>>>> repeat
53380>>>>>>>>>>
53380>>>>>>>>> if index# gt 15 move 1 to fin#
53383>>>>>>>>> ifnot fin# begin
53385>>>>>>>>> get FDX_AttrValue_INDEX oFDX# DF_INDEX_NUMBER_SEGMENTS file# index# to max_seg#
53386>>>>>>>>> for segment# from 1 to max_seg#
53392>>>>>>>>>>
53392>>>>>>>>> get FDX_AttrValue_IDXSEG oFDX# DF_INDEX_SEGMENT_FIELD file# index# segment# to field#
53393>>>>>>>>> if (segment#=max_seg# and field#<>0) begin
53395>>>>>>>>> move 1 to fin#
53396>>>>>>>>> move index# to rval#
53397>>>>>>>>> end
53397>>>>>>>>>>
53397>>>>>>>>> loop
53398>>>>>>>>>>
53398>>>>>>>>> increment index#
53399>>>>>>>>> end
53399>>>>>>>>>>
53399>>>>>>>>> until fin#
53401>>>>>>>>> function_return rval#
53402>>>>>>>>>end_function // FDX_IndexFindPrimary
53403>>>>>>>>>
53403>>>>>>>>>function FDX_IndexFindAny global integer lhFDX integer liFile integer liIndex integer lbMustBeUnique integer lbMustBeOnLine returns integer
53405>>>>>>>>> integer lbFin liRval liSegments lbOk liType
53405>>>>>>>>> move 0 to lbFin
53406>>>>>>>>> move 0 to liRval
53407>>>>>>>>> increment liIndex
53408>>>>>>>>> repeat
53408>>>>>>>>>>
53408>>>>>>>>> if liIndex gt 15 move 1 to lbFin
53411>>>>>>>>> ifnot lbFin begin
53413>>>>>>>>> get FDX_AttrValue_INDEX lhFDX DF_INDEX_NUMBER_SEGMENTS liFile liIndex to liSegments
53414>>>>>>>>>
53414>>>>>>>>> if liSegments begin // If index exists
53416>>>>>>>>> move DFTRUE to lbOk
53417>>>>>>>>> if lbMustBeUnique get FDX_IndexUnique lhFDX liFile liIndex to lbOk
53420>>>>>>>>> if lbMustBeOnLine begin
53422>>>>>>>>> get FDX_AttrValue_INDEX lhFDX DF_INDEX_TYPE liFile liIndex to liType
53423>>>>>>>>> move (liType=DF_INDEX_TYPE_ONLINE) to lbOk
53424>>>>>>>>> end
53424>>>>>>>>>>
53424>>>>>>>>> if lbOk begin
53426>>>>>>>>> move 1 to lbFin
53427>>>>>>>>> move liIndex to liRval
53428>>>>>>>>> end
53428>>>>>>>>>>
53428>>>>>>>>> end
53428>>>>>>>>>>
53428>>>>>>>>> increment liIndex
53429>>>>>>>>> end
53429>>>>>>>>>>
53429>>>>>>>>> until lbFin
53431>>>>>>>>> function_return liRval
53432>>>>>>>>>end_function
53433>>>>>>>>>
53433>>>>>>>>>//> This tries to find an index uniquely composed of the fields passed in
53433>>>>>>>>>//> fields parameter. If such an index can be found its number will be
53433>>>>>>>>>//> returned (otherwise 0 is returned). The search will begin at index
53433>>>>>>>>>//> start_idx#+1.
53433>>>>>>>>>function FDX_IndexFindUnique global integer oFDX# integer file# string fields# integer start_idx# returns integer
53435>>>>>>>>> integer index# pos# segment# max#
53435>>>>>>>>> string idx_fields# check_fields# field#
53435>>>>>>>>> get FDX_FieldsTranslateOverlaps oFDX# file# fields# to fields#
53436>>>>>>>>> get FDX_FieldsRemoveDublettes fields# to fields#
53437>>>>>>>>> for index# from (start_idx#+1) to 15
53443>>>>>>>>>>
53443>>>>>>>>> get FDX_IndexAsFields oFDX# file# index# to idx_fields#
53444>>>>>>>>> if idx_fields# ne "" begin
53446>>>>>>>>> move fields# to check_fields#
53447>>>>>>>>> get FDX_FieldsTranslateOverlaps oFDX# file# idx_fields# to idx_fields#
53448>>>>>>>>> get FDX_FieldsRemoveDublettes idx_fields# to idx_fields#
53449>>>>>>>>> move (length(idx_fields#)/4) to max#
53450>>>>>>>>> for segment# from 1 to max#
53456>>>>>>>>>>
53456>>>>>>>>> move (mid(fields#,4,segment#-1*4+1)) to field#
53457>>>>>>>>> move (replace(field#,check_fields#,"")) to check_fields#
53458>>>>>>>>> loop
53459>>>>>>>>>>
53459>>>>>>>>> if check_fields# eq "" function_return index#
53462>>>>>>>>> end
53462>>>>>>>>>>
53462>>>>>>>>> loop
53463>>>>>>>>>>
53463>>>>>>>>> function_return 0
53464>>>>>>>>>end_function // FDX_IndexFindUnique
53465>>>>>>>>>
53465>>>>>>>>>//> Find an index that has fields as its most significant segments (in that
53465>>>>>>>>>//> order)
53465>>>>>>>>>function FDX_IndexFindMatching global integer oFDX# integer file# string fields# integer start_idx# returns integer
53467>>>>>>>>> integer index# pos# segment# max# field1# field2# good#
53467>>>>>>>>> string idx_fields# field#
53467>>>>>>>>> get FDX_FieldsTranslateOverlaps oFDX# file# fields# to fields#
53468>>>>>>>>> move (length(fields#)/4) to max#
53469>>>>>>>>> for index# from (start_idx#+1) to 15
53475>>>>>>>>>>
53475>>>>>>>>> get FDX_IndexAsFields oFDX# file# index# to idx_fields#
53476>>>>>>>>> if idx_fields# ne "" begin
53478>>>>>>>>> get FDX_FieldsTranslateOverlaps oFDX# file# idx_fields# to idx_fields#
53479>>>>>>>>> move 1 to good#
53480>>>>>>>>> for segment# from 1 to max#
53486>>>>>>>>>>
53486>>>>>>>>> if good# begin
53488>>>>>>>>> move (mid(fields#,4,segment#-1*4+1)) to field1#
53489>>>>>>>>> move (mid(idx_fields#,4,segment#-1*4+1)) to field2#
53490>>>>>>>>> if field1# ne field2# move 0 to good#
53493>>>>>>>>> end
53493>>>>>>>>>>
53493>>>>>>>>> loop
53494>>>>>>>>>>
53494>>>>>>>>> if good# function_return index#
53497>>>>>>>>> end
53497>>>>>>>>>>
53497>>>>>>>>> loop
53498>>>>>>>>>>
53498>>>>>>>>> function_return 0
53499>>>>>>>>>end_function // FDX_IndexFindMatching
53500>>>>>>>>>
53500>>>>>>>>>//> Find a field that is not part of liIndex. The field returned will not be a
53500>>>>>>>>>//> overlap field. If no such field can be found, 0 is returned.
53500>>>>>>>>>function FDX_FieldNotInIndex global integer oFDX# integer liFile integer liIndex returns integer
53502>>>>>>>>> integer liField liMax
53502>>>>>>>>> string lsFields
53502>>>>>>>>> if liIndex begin // If not recnum
53504>>>>>>>>> get FDX_IndexAsFields oFDX# liFile liIndex to lsFields
53505>>>>>>>>> get FDX_FieldsTranslateOverlaps oFDX# liFile lsFields to lsFields
53506>>>>>>>>> end
53506>>>>>>>>>>
53506>>>>>>>>> else move "" to lsFields
53508>>>>>>>>> move (FDX_AttrValue_FILE(oFDX#,DF_FILE_NUMBER_FIELDS,liFile)) to liMax
53509>>>>>>>>> for liField from 1 to liMax
53515>>>>>>>>>>
53515>>>>>>>>> // Only check to see if field is part of the overlap if it is not itself an overlap field:
53515>>>>>>>>> if (integer(FDX_AttrValue_FIELD(oFDX#,DF_FIELD_TYPE,liFile,liField))) ne DF_OVERLAP begin
53517>>>>>>>>> ifnot (IsIntegerPresent(lsFields,liField)) function_return liField
53520>>>>>>>>> end
53520>>>>>>>>>>
53520>>>>>>>>> loop
53521>>>>>>>>>>
53521>>>>>>>>> function_return 0
53522>>>>>>>>>end_function
53523>>>>>>>>>
53523>>>>>>>>>//> This function returns all
53523>>>>>>>>>function FDX_MostSignificantFieldsInIndexNotRelating global integer oFDX# integer liFile integer liIndex returns string
53525>>>>>>>>> integer liPos liMaxPos liField liStillRelating liOverlapField
53525>>>>>>>>> integer liMaxOverlap liOverlapPos liAnyRelatingOverlaps
53525>>>>>>>>> string lsFields lsRval lsOverlaps
53525>>>>>>>>> get FDX_IndexAsFields oFDX# liFile liIndex to lsFields
53526>>>>>>>>> get FDX_FieldsTranslateOverlaps oFDX# liFile lsFields to lsFields
53527>>>>>>>>> move "" to lsRval
53528>>>>>>>>> move 1 to liStillRelating
53529>>>>>>>>> move (length(lsFields)+3/4) to liMaxPos
53530>>>>>>>>> for liPos from 0 to (liMaxPos-1)
53536>>>>>>>>>>
53536>>>>>>>>> move (mid(lsFields,4,liPos*4+1)) to liField
53537>>>>>>>>>
53537>>>>>>>>> if liStillRelating begin
53539>>>>>>>>> ifnot (integer(FDX_AttrValue_FIELD(oFDX#,DF_FIELD_RELATED_FILE,liFile,liField))) begin
53541>>>>>>>>> get FDX_FieldsOverlappingField oFDX# liFile liField to lsOverlaps
53542>>>>>>>>> move (length(lsFields)+3/4) to liMaxOverlap
53543>>>>>>>>> move 0 to liAnyRelatingOverlaps
53544>>>>>>>>> for liOverlapPos from 0 to (liMaxOverlap-1)
53550>>>>>>>>>>
53550>>>>>>>>> move (mid(lsOverlaps,4,liOverlapPos*4+1)) to liOverlapField
53551>>>>>>>>> if (integer(FDX_AttrValue_FIELD(oFDX#,DF_FIELD_RELATED_FILE,liFile,liOverlapField))) move 1 to liAnyRelatingOverlaps
53554>>>>>>>>> loop
53555>>>>>>>>>>
53555>>>>>>>>> ifnot liAnyRelatingOverlaps move 0 to liStillRelating
53558>>>>>>>>> end
53558>>>>>>>>>>
53558>>>>>>>>> end
53558>>>>>>>>>>
53558>>>>>>>>> ifnot liStillRelating move (lsRval+pad(liField,4)) to lsRval
53561>>>>>>>>> loop
53562>>>>>>>>>>
53562>>>>>>>>> function_return lsRval
53563>>>>>>>>>end_function
53564>>>>>>>>>
53564>>>>>>>>>// Parameter liIndexType must be DF_INDEX_TYPE_ONLINE or DF_INDEX_TYPE_BATCH
53564>>>>>>>>>// Define call back like this:
53564>>>>>>>>>// procedure HandleIndex integer liFile integer liIndex string lsFields integer liType
53564>>>>>>>>>procedure FDX_IndexCallback global integer lhFDX integer liFile integer liIndexType integer liMsg integer lhObj
53566>>>>>>>>> integer liIndex liType
53566>>>>>>>>> string lsIndexDef
53566>>>>>>>>> for liIndex from 1 to 15
53572>>>>>>>>>>
53572>>>>>>>>> get FDX_IndexAsFields lhFDX liFile liIndex to lsIndexDef
53573>>>>>>>>> if (lsIndexDef<>"") begin
53575>>>>>>>>> get FDX_AttrValue_INDEX lhFDX DF_INDEX_TYPE liFile liIndex to liType
53576>>>>>>>>> if (liType=liIndexType) send liMsg to lhObj liFile liIndex lsIndexDef liType
53579>>>>>>>>> end
53579>>>>>>>>>>
53579>>>>>>>>> loop
53580>>>>>>>>>>
53580>>>>>>>>>end_procedure
53581>>>>>>>>>
53581>>>>>>>>>desktop_section
53586>>>>>>>>> object oFdxIndexTempArray is a cArray
53588>>>>>>>>> property string psRval public ""
53590>>>>>>>>> procedure AddToRval integer liFile integer liIndex string lsIndexDef integer liIndexType
53593>>>>>>>>> string lsRval
53593>>>>>>>>> get psRval to lsRval
53594>>>>>>>>> if (lsRval="") set psRval to (string(liIndex))
53597>>>>>>>>> set psRval to (lsRval+" "+string(liIndex))
53598>>>>>>>>> end_procedure
53599>>>>>>>>> function sSetOfIndices integer lhFDX integer liFile integer liIndexType returns string
53602>>>>>>>>> set psRval to ""
53603>>>>>>>>> send FDX_IndexCallback lhFDX liFile liIndexType msg_AddToRval self
53604>>>>>>>>> function_return (psRval(self))
53605>>>>>>>>> end_function
53606>>>>>>>>> end_object
53607>>>>>>>>>end_desktop_section
53612>>>>>>>>>
53612>>>>>>>>>//> Returns all indices of type liIndexType (DF_INDEX_TYPE_ONLINE or DF_INDEX_TYPE_BATCH)
53612>>>>>>>>>function FDX_SetOfIndices global integer lhFDX integer liFile integer liIndexType returns string
53614>>>>>>>>> string lsRval
53614>>>>>>>>> get sSetOfIndices of (oFdxIndexTempArray(self)) lhFDX liFile liIndexType to lsRval
53615>>>>>>>>> function_return lsRval
53616>>>>>>>>>end_function
53617>>>>>>>>>
53617>>>>>>>>>//> Returns all indices that may be used efficiently for finding records in liFile by specifying
53617>>>>>>>>>//> fields in lsFields
53617>>>>>>>>>function FDX_SetOfIndicesFieldConstrained global integer lhFDX integer liFile string lsFields returns string
53619>>>>>>>>> integer liIndex liField liMaxPos liPos
53619>>>>>>>>> string lsTakeThemOut lsValue lsIndex lsField
53619>>>>>>>>> move "" to lsValue
53620>>>>>>>>> get FDX_FieldsRemoveDublettes lsFields to lsFields
53621>>>>>>>>> for liIndex from 1 to 15
53627>>>>>>>>>>
53627>>>>>>>>> move lsFields to lsTakeThemOut
53628>>>>>>>>>
53628>>>>>>>>> get FDX_IndexAsFields lhFDX liFile liIndex to lsIndex
53629>>>>>>>>> get FDX_FieldsTranslateOverlaps lhFDX liFile lsIndex to lsIndex
53630>>>>>>>>> get FDX_FieldsRemoveDublettes lsIndex to lsIndex
53631>>>>>>>>>
53631>>>>>>>>> // Note that we calculate liMaxPos based on lsFields and NOT lsIndex. The
53631>>>>>>>>> // reason is that we want lsFields (=lsTakeThemOut) to appear as the most
53631>>>>>>>>> // significant segments of the index (in no particular order) and not
53631>>>>>>>>> // scattered all over the index.
53631>>>>>>>>> move (length(lsFields)+3/4) to liMaxPos
53632>>>>>>>>> for liPos from 1 to liMaxPos
53638>>>>>>>>>>
53638>>>>>>>>> move (mid(lsIndex,4,liPos-1*4+1)) to liField
53639>>>>>>>>> move (pad(liField,4)) to lsField
53640>>>>>>>>> move (replace(lsField,lsTakeThemOut,"")) to lsTakeThemOut
53641>>>>>>>>> loop
53642>>>>>>>>>>
53642>>>>>>>>>
53642>>>>>>>>> if (lsTakeThemOut="") move (lsValue+pad(liIndex,4)) to lsValue
53645>>>>>>>>> loop
53646>>>>>>>>>>
53646>>>>>>>>>
53646>>>>>>>>> function_return lsValue
53647>>>>>>>>>end_function
53648>>>>>>>>>
53648>>>>>>>>>//> Returns all indices that may be used efficiently for finding records in liChildTable
53648>>>>>>>>>function FDX_SetOfIndicesTableConstrained global integer lhFDX integer liChildTable integer liParentTable returns string
53650>>>>>>>>> string lsRelatingFields lsValue
53650>>>>>>>>> get FDX_FieldsRelatingToParent lhFDX liChildTable liParentTable to lsRelatingFields
53651>>>>>>>>> get FDX_FieldsTranslateOverlaps lhFDX liChildTable lsRelatingFields to lsRelatingFields
53652>>>>>>>>> get FDX_SetOfIndicesFieldConstrained lhFDX liChildTable to lsRelatingFields
53653>>>>>>>>> function_return lsValue
53654>>>>>>>>>end_function
53655>>>>>>>>>
53655>>>>>>>>>
53655>>>>>>>>>
53655>>>>>Use DataScan.utl // Data scan classes
Including file: datascan.utl (C:\Apps\VDFQuery\AppSrc\datascan.utl)
53655>>>>>>>// **********************************************************************
53655>>>>>>>// Use DataScan.utl // Data scan classes
53655>>>>>>>//
53655>>>>>>>// By Sture Andersen
53655>>>>>>>//
53655>>>>>>>// Create: Sun 28-12-1997 -
53655>>>>>>>// Update: Fri 02-04-1998 - Descending segments are not seeded anymore.
53655>>>>>>>// Sat 20-06-1998 - cReport_info class moved to here from VDFQUERY.UTL.
53655>>>>>>>// Sat 29-08-1998 - Breaking ability added to cReport_info class.
53655>>>>>>>// Sat 13-02-1999 - cReportTotals class added
53655>>>>>>>// Wed 27-04-1999 - Fixed jump out error on numeric segments
53655>>>>>>>// - Fix for descending segments
53655>>>>>>>// - Objects oJumpInValues and oJumpOutValues needs
53655>>>>>>>// recoding. Currently it is next to un-readable
53655>>>>>>>// Mon 10-05-1999 - Fixes for VDF 6 (Vincent Oorsprong)
53655>>>>>>>// Tue 31-07-2001 - Made good for file numbers up to 4095
53655>>>>>>>// Wed 08-08-2001 - Fixed jump out error
53655>>>>>>>// Wed 07-05-2003 - Fixed SC_COMP_CBETWEEN criteria
53655>>>>>>>//
53655>>>>>>>//
53655>>>>>>>// "Or" criteria in conventional selection criteria
53655>>>>>>>//
53655>>>>>>>// 1. No index optimization: 20 hours
53655>>>>>>>// 2. Total rewrite: 120 hours
53655>>>>>>>//
53655>>>>>>>//
53655>>>>>>>//
53655>>>>>>>// ***********************************************************************
53655>>>>>>>
53655>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
53655>>>>>>>Use DataView.utl // Classes for analyzing db structures
Including file: dataview.utl (C:\Apps\VDFQuery\AppSrc\dataview.utl)
53655>>>>>>>>>// NOTE!! THIS PACKAGE IS - ALTHOUGH WELL FUNCTIONING - OUT OF FASHION!
53655>>>>>>>>>//
53655>>>>>>>>>// THE INTENTIONS OF IT HAS NOW BEEN SUPER IMPLEMENTED IN FDX.NUI
53655>>>>>>>>>//
53655>>>>>>>>>//
53655>>>>>>>>>// **********************************************************************
53655>>>>>>>>>// Use DataView.utl // Classes for analyzing index definitions
53655>>>>>>>>>//
53655>>>>>>>>>// by Sture Andersen
53655>>>>>>>>>//
53655>>>>>>>>>// Create: Sat 10-05-1997 - Extracted from AutoPrmt.pkg and re-organized.
53655>>>>>>>>>// Update: Sun 18-05-1997 - Function idx_next_index_ms_segments added
53655>>>>>>>>>// Sat 20-12-1997 - Functions idx_is_field_present_index,
53655>>>>>>>>>// idx_segment and idx_max_segment added.
53655>>>>>>>>>// Thu 05-02-1998 - Object oMoreInfo added to cIndexAnalyzer class.
53655>>>>>>>>>// Wed 10-11-1999 - Error fixed in idx_Segment_Directions and
53655>>>>>>>>>// idx_Segment_Cases
53655>>>>>>>>>//
53655>>>>>>>>>// The purpose of this package is to loosen the connection between the tools
53655>>>>>>>>>// and the "physical" table definition. Instead of using the get_attribute
53655>>>>>>>>>// command for retrieving structure information, you query this class, in
53655>>>>>>>>>// order to be able to change the view of the database.
53655>>>>>>>>>//
53655>>>>>>>>>// ***********************************************************************
53655>>>>>>>>>//
53655>>>>>>>>>// Contents: (1) db_structure_layer_mixin class.
53655>>>>>>>>>// (2) cIndexAnalyzer class.
53655>>>>>>>>>
53655>>>>>>>>>// (1)
53655>>>>>>>>>// The class db_structure_layer_mixin is a mixin that supports changing
53655>>>>>>>>>// the way that the get_attribute command sees the world.
53655>>>>>>>>>//
53655>>>>>>>>>// The idea is that every time the target class would normally use the
53655>>>>>>>>>// get_attribute command, it instead uses the functions in this class,
53655>>>>>>>>>// which will allow for delegation of the question.
53655>>>>>>>>>//
53655>>>>>>>>>// If property delegate_object is 0 the get_attribute command is used.
53655>>>>>>>>>
53655>>>>>>>>>
53655>>>>>>>>>// The format of the commands below is the following:
53655>>>>>>>>>// command <attr_name> <df_attrname> <type>
53655>>>>>>>>>
53655>>>>>>>>>class db_structure_layer_mixin is a message
53656>>>>>>>>> procedure define_db_structure_layer_mixin
53658>>>>>>>>> property integer DBMS_Server public 0 // If false get_attribute will be used
53659>>>>>>>>> end_procedure
53660>>>>>>>>>
53660>>>>>>>>> DBSTRUCT.INDEX_ATTR attr_index_number_segments DF_INDEX_NUMBER_SEGMENTS integer
53671>>>>>>>>> DBSTRUCT.IDXSEG_ATTR attr_index_segment_field DF_INDEX_SEGMENT_FIELD integer
53682>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_number_fields DF_FILE_NUMBER_FIELDS integer
53693>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_max_records DF_FILE_MAX_RECORDS integer
53704>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_records_used DF_FILE_RECORDS_USED integer
53715>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_type DF_FILE_TYPE integer
53726>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_multiuser DF_FILE_MULTIUSER integer
53737>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_reuse_deleted DF_FILE_REUSE_DELETED integer
53748>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_compression DF_FILE_COMPRESSION integer
53759>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_number_fields DF_FILE_NUMBER_FIELDS integer
53770>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_transaction DF_FILE_TRANSACTION integer
53781>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_record_length DF_FILE_RECORD_LENGTH integer
53792>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_integrity_check DF_FILE_INTEGRITY_CHECK integer
53803>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_is_system_file DF_FILE_IS_SYSTEM_FILE integer
53814>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_lock_type DF_FILE_LOCK_TYPE integer
53825>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_record_length_used DF_FILE_RECORD_LENGTH_USED integer
53836>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_record_identity DF_FILE_RECORD_IDENTITY integer
53847>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_revision DF_FILE_REVISION string
53858>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_logical_name DF_FILE_LOGICAL_NAME string
53869>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_root_name DF_FILE_ROOT_NAME string
53880>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_display_name DF_FILE_DISPLAY_NAME string
53891>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_physical_name DF_FILE_PHYSICAL_NAME string
53902>>>>>>>>> DBSTRUCT.FILE_ATTR attr_file_next_used DF_FILE_NEXT_USED integer
53913>>>>>>>>> DBSTRUCT.FIELD_ATTR attr_field_type DF_FIELD_TYPE integer
53924>>>>>>>>> DBSTRUCT.FIELD_ATTR attr_field_length DF_FIELD_LENGTH integer
53935>>>>>>>>> DBSTRUCT.FIELD_ATTR attr_field_native_length DF_FIELD_NATIVE_LENGTH integer
53946>>>>>>>>> function attr_field_overlap integer file# integer fld1# integer fld2# returns integer
53948>>>>>>>>> integer rval#
53948>>>>>>>>> if (DBMS_Server(self)) get attr_field_overlap of (DBMS_Server(self)) file# fld1# fld2# to rval#
53951>>>>>>>>> else get_attribute DF_FIELD_OVERLAP of file# fld1# fld2# to rval#
53955>>>>>>>>> function_return rval#
53956>>>>>>>>> end_function
53957>>>>>>>>>
53957>>>>>>>>> DBSTRUCT.FIELD_ATTR attr_field_index DF_FIELD_INDEX integer
53968>>>>>>>>> DBSTRUCT.FIELD_ATTR attr_field_name DF_FIELD_NAME string
53979>>>>>>>>> function attr_field_name integer file# integer field# returns string
53981>>>>>>>>> string rval#
53981>>>>>>>>>// send obs (string(file#)+","+string(field#)+","+string(!a))
53981>>>>>>>>> if (DBMS_Server(self)) get attr_field_name of (DBMS_Server(self)) file# field# to rval#
53984>>>>>>>>> else get_attribute DF_FIELD_NAME of file# field# to rval#
53988>>>>>>>>> if (rval#="" and field#=0) move "RECNUM" to rval#
53991>>>>>>>>> function_return rval#
53992>>>>>>>>> end_function
53993>>>>>>>>> DBSTRUCT.FIELD_ATTR attr_field_precision DF_FIELD_PRECISION integer
54004>>>>>>>>> DBSTRUCT.FIELD_ATTR attr_field_related_file DF_FIELD_RELATED_FILE integer
54015>>>>>>>>> DBSTRUCT.FIELD_ATTR attr_field_related_field DF_FIELD_RELATED_FIELD integer
54026>>>>>>>>> DBSTRUCT.FIELD_ATTR attr_field_offset DF_FIELD_OFFSET integer
54037>>>>>>>>>end_class
54038>>>>>>>>>
54038>>>>>>>>>class cIndexAnalyzerMoreInfo is an array
54039>>>>>>>>> // pIndex_Key_Length
54039>>>>>>>>> // pIndex_Levels
54039>>>>>>>>> // pIndex_Segment_Case
54039>>>>>>>>> // pIndex_Segment_Direction
54039>>>>>>>>> procedure set pIndex_Key_Length integer index# integer value#
54041>>>>>>>>> set value item (index#*40+37) to value#
54042>>>>>>>>> end_procedure
54043>>>>>>>>> function pIndex_Key_Length integer index# returns integer
54045>>>>>>>>> function_return (value(self,index#*40+37))
54046>>>>>>>>> end_function
54047>>>>>>>>> procedure set pIndex_Levels integer index# integer value#
54049>>>>>>>>> set value item (index#*40+38) to value#
54050>>>>>>>>> end_procedure
54051>>>>>>>>> function pIndex_Levels integer index# returns integer
54053>>>>>>>>> function_return (value(self,index#*40+38))
54054>>>>>>>>> end_function
54055>>>>>>>>> procedure set pIndex_Type integer index# integer value#
54057>>>>>>>>> set value item (index#*40+39) to value#
54058>>>>>>>>> end_procedure
54059>>>>>>>>> function pIndex_Type integer index# returns integer
54061>>>>>>>>> function_return (value(self,index#*40+39))
54062>>>>>>>>> end_function
54063>>>>>>>>> procedure set pIndex_Segment_Case integer index# integer seg# integer value#
54065>>>>>>>>> set value item (index#*40+seg#) to value#
54066>>>>>>>>> end_procedure
54067>>>>>>>>> function pIndex_Segment_Case integer index# integer segment# returns integer
54069>>>>>>>>> function_return (value(self,index#*40+segment#))
54070>>>>>>>>> end_function
54071>>>>>>>>> procedure set pIndex_Segment_Direction integer index# integer seg# integer value#
54073>>>>>>>>> set value item (index#*40+20+seg#) to value#
54074>>>>>>>>> end_procedure
54075>>>>>>>>> function pIndex_Segment_Direction integer index# integer segment# returns integer
54077>>>>>>>>> function_return (value(self,index#*40+20+segment#))
54078>>>>>>>>> end_function
54079>>>>>>>>>end_class
54080>>>>>>>>>
54080>>>>>>>>>// (2)
54080>>>>>>>>>// The index_analyzer class was made to put all stuff, that specifically
54080>>>>>>>>>// analyses indices in one place:
54080>>>>>>>>>class cIndexAnalyzer is an array
54081>>>>>>>>> procedure construct_object
54083>>>>>>>>> forward send construct_object
54085>>>>>>>>> property integer pMainFile public 0
54086>>>>>>>>> property integer p_min_len_descr_field public 15
54087>>>>>>>>> send define_db_structure_layer_mixin
54088>>>>>>>>> object oMoreInfo is an cIndexAnalyzerMoreInfo
54090>>>>>>>>> end_object
54091>>>>>>>>> end_procedure
54092>>>>>>>>> import_class_protocol db_structure_layer_mixin
54093>>>>>>>>>
54093>>>>>>>>> procedure seq_write integer ch# // Dump contents through sequential channel
54095>>>>>>>>> integer itm# max# obj#
54095>>>>>>>>> writeln channel ch# (pMainFile(self))
54098>>>>>>>>> writeln (p_min_len_descr_field(self))
54100>>>>>>>>> get item_count to max#
54101>>>>>>>>> writeln max#
54103>>>>>>>>> for itm# from 0 to (max#-1)
54109>>>>>>>>>>
54109>>>>>>>>> writeln (value(self,itm#))
54111>>>>>>>>> loop
54112>>>>>>>>>>
54112>>>>>>>>> move (oMoreInfo(self)) to obj#
54113>>>>>>>>> get item_count of obj# to max#
54114>>>>>>>>> writeln max#
54116>>>>>>>>> for itm# from 0 to (max#-1)
54122>>>>>>>>>>
54122>>>>>>>>> writeln (value(obj#,itm#))
54124>>>>>>>>> loop
54125>>>>>>>>>>
54125>>>>>>>>> end_procedure
54126>>>>>>>>>
54126>>>>>>>>> procedure seq_read integer ch# // Read contents from sequential channel
54128>>>>>>>>> integer itm# max# obj#
54128>>>>>>>>> string tmp#
54128>>>>>>>>> send reset
54129>>>>>>>>> readln channel ch# tmp#
54131>>>>>>>>> set pMainFile to tmp#
54132>>>>>>>>> readln channel ch# tmp#
54134>>>>>>>>> set p_min_len_descr_field to tmp#
54135>>>>>>>>> readln max#
54136>>>>>>>>> for itm# from 0 to (max#-1)
54142>>>>>>>>>>
54142>>>>>>>>> readln tmp#
54143>>>>>>>>> set value item itm# to tmp#
54144>>>>>>>>> loop
54145>>>>>>>>>>
54145>>>>>>>>> move (oMoreInfo(self)) to obj#
54146>>>>>>>>> readln max#
54147>>>>>>>>> for itm# from 0 to (max#-1)
54153>>>>>>>>>>
54153>>>>>>>>> readln tmp#
54154>>>>>>>>> set value of obj# item itm# to tmp#
54155>>>>>>>>> loop
54156>>>>>>>>>>
54156>>>>>>>>> end_procedure
54157>>>>>>>>>
54157>>>>>>>>> procedure reset
54159>>>>>>>>> send delete_data
54160>>>>>>>>> send delete_data to (oMoreInfo(self))
54161>>>>>>>>> end_procedure
54162>>>>>>>>>
54162>>>>>>>>> // The procedure reads the index definitions into the array
54162>>>>>>>>> procedure read_file_definition integer file# // This one reads the index
54164>>>>>>>>> integer idx# segment# max# fld# // definitions into the
54164>>>>>>>>> integer oMoreInfo# attr# // array.
54164>>>>>>>>> string str#
54164>>>>>>>>> if (file#<>pMainFile(self)) begin
54166>>>>>>>>> send reset
54167>>>>>>>>> move (oMoreInfo(self)) to oMoreInfo#
54168>>>>>>>>> for idx# from 1 to 15
54174>>>>>>>>>>
54174>>>>>>>>> move "" to str#
54175>>>>>>>>> get_attribute DF_INDEX_NUMBER_SEGMENTS of file# idx# to max#
54178>>>>>>>>> if max# begin
54180>>>>>>>>> get_attribute DF_INDEX_KEY_LENGTH of file# idx# to attr#
54183>>>>>>>>> set pIndex_Key_Length of oMoreInfo# idx# to attr#
54184>>>>>>>>> get_attribute DF_INDEX_LEVELS of file# idx# to attr#
54187>>>>>>>>> set pIndex_Levels of oMoreInfo# idx# to attr#
54188>>>>>>>>> get_attribute DF_INDEX_TYPE of file# idx# to attr#
54191>>>>>>>>> set pIndex_Type of oMoreInfo# idx# to attr#
54192>>>>>>>>>
54192>>>>>>>>> for segment# from 1 to max#
54198>>>>>>>>>>
54198>>>>>>>>> get_attribute DF_INDEX_SEGMENT_FIELD of file# idx# segment# to fld#
54201>>>>>>>>> move (str#+pad(string(fld#),4)) to str#
54202>>>>>>>>> get_attribute DF_INDEX_SEGMENT_CASE of file# idx# segment# to attr#
54205>>>>>>>>> set pIndex_Segment_Case of oMoreInfo# idx# segment# to attr#
54206>>>>>>>>> get_attribute DF_INDEX_SEGMENT_DIRECTION of file# idx# segment# to attr#
54209>>>>>>>>> set pIndex_Segment_Direction of oMoreInfo# idx# segment# to attr#
54210>>>>>>>>> loop
54211>>>>>>>>>>
54211>>>>>>>>> end
54211>>>>>>>>>>
54211>>>>>>>>> set value item idx# to str#
54212>>>>>>>>> loop
54213>>>>>>>>>>
54213>>>>>>>>> set pMainFile to file#
54214>>>>>>>>> end
54214>>>>>>>>>>
54214>>>>>>>>> end_procedure
54215>>>>>>>>>
54215>>>>>>>>> function idx_Key_Length integer idx# returns integer
54217>>>>>>>>> function_return (pIndex_Key_Length(oMoreInfo(self),idx#))
54218>>>>>>>>> end_function
54219>>>>>>>>> function idx_Levels integer idx# returns integer
54221>>>>>>>>> function_return (pIndex_Levels(oMoreInfo(self),idx#))
54222>>>>>>>>> end_function
54223>>>>>>>>> function idx_Type integer idx# returns integer
54225>>>>>>>>> function_return (pIndex_Type(oMoreInfo(self),idx#))
54226>>>>>>>>> end_function
54227>>>>>>>>> function idx_Segment_Case integer idx# integer seg# returns integer
54229>>>>>>>>> function_return (pIndex_Segment_Case(oMoreInfo(self),idx#,seg#))
54230>>>>>>>>> end_function
54231>>>>>>>>> function idx_Segment_Direction integer idx# integer seg# returns integer
54233>>>>>>>>> function_return (pIndex_Segment_Direction(oMoreInfo(self),idx#,seg#))
54234>>>>>>>>> end_function
54235>>>>>>>>>
54235>>>>>>>>> function idx_Segment_Cases integer idx# returns string
54237>>>>>>>>> integer seg# max#
54237>>>>>>>>> string rval#
54237>>>>>>>>> get idx_max_segment idx# to max#
54238>>>>>>>>> move "" to rval#
54239>>>>>>>>> for seg# from 1 to max#
54245>>>>>>>>>>
54245>>>>>>>>> move (rval#+pad(string(idx_Segment_Case(self,idx#,seg#)),4)) to rval#
54246>>>>>>>>> loop
54247>>>>>>>>>>
54247>>>>>>>>> function_return rval#
54248>>>>>>>>> end_function
54249>>>>>>>>> function idx_Segment_Directions integer idx# returns string
54251>>>>>>>>> integer seg# max#
54251>>>>>>>>> string rval#
54251>>>>>>>>> get idx_max_segment idx# to max#
54252>>>>>>>>> move "" to rval#
54253>>>>>>>>> for seg# from 1 to max#
54259>>>>>>>>>>
54259>>>>>>>>> move (rval#+pad(string(idx_Segment_Direction(self,idx#,seg#)),4)) to rval#
54260>>>>>>>>> loop
54261>>>>>>>>>>
54261>>>>>>>>> function_return rval#
54262>>>>>>>>> end_function
54263>>>>>>>>>
54263>>>>>>>>> function idx_exists integer idx# returns integer
54265>>>>>>>>> function_return (length(value(self,idx#)))
54266>>>>>>>>> end_function
54267>>>>>>>>>
54267>>>>>>>>> function idx_segment integer idx# integer segment# returns integer
54269>>>>>>>>> function_return (integer(mid(value(self,idx#),4,segment#-1*4+1)))
54270>>>>>>>>> end_function
54271>>>>>>>>>
54271>>>>>>>>> function idx_max_segment integer idx# returns integer
54273>>>>>>>>> function_return (length(value(self,idx#))/4)
54274>>>>>>>>> end_function
54275>>>>>>>>>
54275>>>>>>>>> function field_translate_overlap integer fld# returns string
54277>>>>>>>>> integer type# max# field# overlaps# file#
54277>>>>>>>>> string rval#
54277>>>>>>>>> get pMainFile to file#
54278>>>>>>>>> get attr_field_type file# fld# to type#
54279>>>>>>>>> if type# eq DF_OVERLAP begin
54281>>>>>>>>> move "" to rval#
54282>>>>>>>>> get attr_file_number_fields file# to max#
54283>>>>>>>>> for field# from 1 to max#
54289>>>>>>>>>>
54289>>>>>>>>> if field# ne fld# begin
54291>>>>>>>>> get attr_field_type file# field# to type#
54292>>>>>>>>> if type# ne DF_OVERLAP begin
54294>>>>>>>>> get attr_field_overlap file# fld# field# to overlaps#
54295>>>>>>>>> if overlaps# move (rval#+pad(string(field#),4)) to rval#
54298>>>>>>>>> end
54298>>>>>>>>>>
54298>>>>>>>>> end
54298>>>>>>>>>>
54298>>>>>>>>> loop
54299>>>>>>>>>>
54299>>>>>>>>> end
54299>>>>>>>>>>
54299>>>>>>>>> else move (pad(string(fld#),4)) to rval#
54301>>>>>>>>> function_return rval#
54302>>>>>>>>> end_function
54303>>>>>>>>>
54303>>>>>>>>> function field_translate_overlaps string str# returns string
54305>>>>>>>>> integer fld# max# segment#
54305>>>>>>>>> string rval#
54305>>>>>>>>> move "" to rval#
54306>>>>>>>>> move (length(str#)/4) to max#
54307>>>>>>>>> for segment# from 0 to (max#-1)
54313>>>>>>>>>>
54313>>>>>>>>> move (mid(str#,4,segment#*4+1)) to fld#
54314>>>>>>>>> move (rval#+field_translate_overlap(self,fld#)) to rval#
54315>>>>>>>>> loop
54316>>>>>>>>>>
54316>>>>>>>>> function_return rval#
54317>>>>>>>>> end_function
54318>>>>>>>>>
54318>>>>>>>>> procedure idx_translate_overlaps_all
54320>>>>>>>>> integer idx#
54320>>>>>>>>> for idx# from idx# to 15
54326>>>>>>>>>>
54326>>>>>>>>> if (idx_exists(self,idx#)) ; set value item idx# to (field_translate_overlaps(self,value(self,idx#)))
54329>>>>>>>>> loop
54330>>>>>>>>>>
54330>>>>>>>>> end_procedure
54331>>>>>>>>>
54331>>>>>>>>> function idx_is_unique integer idx# returns integer // Is index unique?
54333>>>>>>>>> string str#
54333>>>>>>>>> get value item idx# to str#
54334>>>>>>>>> function_return (length(str#) and integer(right(str#,4)))
54335>>>>>>>>> end_function
54336>>>>>>>>>
54336>>>>>>>>> function idx_next_index integer idx# returns integer
54338>>>>>>>>> for idx# from (idx#+1) to 15
54344>>>>>>>>>>
54344>>>>>>>>> if (idx_exists(self,idx#)) function_return idx#
54347>>>>>>>>> loop
54348>>>>>>>>>>
54348>>>>>>>>> end_function
54349>>>>>>>>>
54349>>>>>>>>> function idx_next_unique_index integer idx# returns integer
54351>>>>>>>>> for idx# from (idx#+1) to 15
54357>>>>>>>>>>
54357>>>>>>>>> if (idx_exists(self,idx#) and idx_is_unique(self,idx#)) function_return idx#
54360>>>>>>>>> loop
54361>>>>>>>>>>
54361>>>>>>>>> end_function
54362>>>>>>>>>
54362>>>>>>>>> function idx_next_nonunique_index integer idx# returns integer
54364>>>>>>>>> for idx# from (idx#+1) to 15
54370>>>>>>>>>>
54370>>>>>>>>> if (idx_exists(self,idx#) and not(idx_is_unique(self,idx#))) function_return idx#
54373>>>>>>>>> loop
54374>>>>>>>>>>
54374>>>>>>>>> end_function
54375>>>>>>>>>
54375>>>>>>>>> function idx_is_field_present_index integer idx# integer fld# returns integer
54377>>>>>>>>> integer segment# max#
54377>>>>>>>>> string str#
54377>>>>>>>>> get value item idx# to str#
54378>>>>>>>>> move (length(str#)/4) to max#
54379>>>>>>>>> for segment# from 0 to (max#-1)
54385>>>>>>>>>>
54385>>>>>>>>> if fld# eq (integer(mid(str#,4,segment#*4+1))) function_return (segment#+1)
54388>>>>>>>>> loop
54389>>>>>>>>>>
54389>>>>>>>>> end_function
54390>>>>>>>>>
54390>>>>>>>>> function idx_best_index returns integer
54392>>>>>>>>> integer idx#
54392>>>>>>>>> get idx_next_unique_index 0 to idx#
54393>>>>>>>>> ifnot idx# get idx_next_nonunique_index 0 to idx#
54396>>>>>>>>> function_return idx#
54397>>>>>>>>> end_function
54398>>>>>>>>>
54398>>>>>>>>> function idx_next_description_index integer idx# returns integer
54400>>>>>>>>> integer type# len# fld# file#
54400>>>>>>>>> string str#
54400>>>>>>>>> get pMainFile to file#
54401>>>>>>>>> for idx# from (idx#+1) to 15
54407>>>>>>>>>>
54407>>>>>>>>> get value item idx# to str#
54408>>>>>>>>> if (length(str#)) begin
54410>>>>>>>>> move (left(str#,4)) to fld#
54411>>>>>>>>> get attr_field_type file# fld# to type#
54412>>>>>>>>> if type# eq df_overlap begin // Translate if overlap
54414>>>>>>>>> get field_translate_overlap fld# to str#
54415>>>>>>>>> move (left(str#,4)) to fld#
54416>>>>>>>>> get attr_field_type file# fld# to type#
54417>>>>>>>>> end
54417>>>>>>>>>>
54417>>>>>>>>> if type# eq df_ascii begin // Examine the first segment
54419>>>>>>>>> get attr_field_length file# fld# to len#
54420>>>>>>>>> if len# ge (p_min_len_descr_field(self)) function_return idx#
54423>>>>>>>>> end
54423>>>>>>>>>>
54423>>>>>>>>> end
54423>>>>>>>>>>
54423>>>>>>>>> loop
54424>>>>>>>>>>
54424>>>>>>>>> end_function
54425>>>>>>>>>
54425>>>>>>>>> function idx_next_field_not_index integer fld# returns integer
54427>>>>>>>>> integer max# idx# file# type#
54427>>>>>>>>> get pMainFile to file#
54428>>>>>>>>> get attr_file_number_fields file# to max#
54429>>>>>>>>> for fld# from (fld#+1) to max#
54435>>>>>>>>>>
54435>>>>>>>>> get attr_field_index file# fld# to idx#
54436>>>>>>>>> ifnot idx# begin
54438>>>>>>>>> get attr_field_type file# fld# to type#
54439>>>>>>>>> if (type#<>df_overlap and type#<>df_text and type#<>df_binary) function_return fld#
54442>>>>>>>>> end
54442>>>>>>>>>>
54442>>>>>>>>> loop
54443>>>>>>>>>>
54443>>>>>>>>> end_function
54444>>>>>>>>>
54444>>>>>>>>> function idx_next_description_field_not_index integer fld# returns integer
54446>>>>>>>>> integer max# idx# type# len# min_len# file#
54446>>>>>>>>> get pMainFile to file#
54447>>>>>>>>> get attr_file_number_fields file# to max#
54448>>>>>>>>> get p_min_len_descr_field to min_len#
54449>>>>>>>>> for fld# from (fld#+1) to max#
54455>>>>>>>>>>
54455>>>>>>>>> get attr_field_type file# fld# to type#
54456>>>>>>>>> if type# eq df_ascii begin
54458>>>>>>>>> get attr_field_length file# fld# to len#
54459>>>>>>>>> if (len#>=min_len#) begin
54461>>>>>>>>> get attr_field_index file# fld# to idx#
54462>>>>>>>>> ifnot idx# function_return fld#
54465>>>>>>>>> end
54465>>>>>>>>>>
54465>>>>>>>>> end
54465>>>>>>>>>>
54465>>>>>>>>> loop
54466>>>>>>>>>>
54466>>>>>>>>> function_return 0
54467>>>>>>>>> end_function
54468>>>>>>>>>
54468>>>>>>>>> function idx_raw_definition integer idx# returns string
54470>>>>>>>>> function_return (value(self,idx#))
54471>>>>>>>>> end_function
54472>>>>>>>>>
54472>>>>>>>>> function idx_definition integer idx# returns string
54474>>>>>>>>> string rval#
54474>>>>>>>>> if idx# begin
54476>>>>>>>>> get idx_raw_definition idx# to rval#
54477>>>>>>>>> get field_translate_overlaps rval# to rval#
54478>>>>>>>>> end
54478>>>>>>>>>>
54478>>>>>>>>> else move "0 " to rval#
54480>>>>>>>>> function_return rval#
54481>>>>>>>>> end_function
54482>>>>>>>>>
54482>>>>>>>>> // This function returns the next index that has the fields listed in
54482>>>>>>>>> // parameter fields# as its most significant segments regardless the
54482>>>>>>>>> // order:
54482>>>>>>>>> function idx_next_index_ms_segments integer idx# string fields# returns integer
54484>>>>>>>>> integer segment# max# len# ok#
54484>>>>>>>>> string ms_fields#
54484>>>>>>>>> get field_translate_overlaps fields# to fields#
54485>>>>>>>>> move (length(fields#)) to len#
54486>>>>>>>>> move (len#/4) to max#
54487>>>>>>>>> for idx# from (idx#+1) to 15
54493>>>>>>>>>>
54493>>>>>>>>> if (idx_exists(self,idx#)) begin
54495>>>>>>>>> move (left(idx_definition(self,idx#),len#)) to ms_fields#
54496>>>>>>>>> move 1 to ok#
54497>>>>>>>>> for segment# from 0 to (max#-1)
54503>>>>>>>>>>
54503>>>>>>>>> ifnot (mid(fields#,4,segment#*4+1)) in ms_fields# move 0 to ok#
54506>>>>>>>>> loop
54507>>>>>>>>>>
54507>>>>>>>>> if ok# function_return idx#
54510>>>>>>>>> end
54510>>>>>>>>>>
54510>>>>>>>>> loop
54511>>>>>>>>>>
54511>>>>>>>>> end_function
54512>>>>>>>>>
54512>>>>>>>>> // This function returns the next index that has the fields listed in
54512>>>>>>>>> // parameter fields# as its most significant segments in the same order
54512>>>>>>>>> // (fixed order):
54512>>>>>>>>> function idx_next_index_ms_segments_fo integer idx# string fields# returns integer
54514>>>>>>>>> integer len#
54514>>>>>>>>> string ms_fields#
54514>>>>>>>>> get field_translate_overlaps fields# to fields#
54515>>>>>>>>> move (length(fields#)) to len#
54516>>>>>>>>> move (fields#+"*") to fields#
54517>>>>>>>>> for idx# from (idx#+1) to 15
54523>>>>>>>>>>
54523>>>>>>>>> if (idx_exists(self,idx#)) begin
54525>>>>>>>>> move (left(idx_definition(self,idx#),len#)) to ms_fields#
54526>>>>>>>>> if fields# match ms_fields# function_return idx#
54529>>>>>>>>> end
54529>>>>>>>>>>
54529>>>>>>>>> loop
54530>>>>>>>>>>
54530>>>>>>>>> end_function
54531>>>>>>>>>
54531>>>>>>>>> function field_remove_doubles string str# returns string
54533>>>>>>>>> integer max# segment#
54533>>>>>>>>> string rval# fld#
54533>>>>>>>>> move "" to rval#
54534>>>>>>>>> move (length(str#)/4) to max#
54535>>>>>>>>> for segment# from 0 to (max#-1)
54541>>>>>>>>>>
54541>>>>>>>>> move (mid(str#,4,segment#*4+1)) to fld#
54542>>>>>>>>> ifnot fld# in rval# move (rval#+fld#) to rval#
54545>>>>>>>>> loop
54546>>>>>>>>>>
54546>>>>>>>>> function_return rval#
54547>>>>>>>>> end_function
54548>>>>>>>>>
54548>>>>>>>>> function field_remove_recnum string str# returns string
54550>>>>>>>>> integer max# segment# file# fld#
54550>>>>>>>>> string rval#
54550>>>>>>>>> get pMainFile to file#
54551>>>>>>>>> move "" to rval#
54552>>>>>>>>> move (length(str#)/4) to max#
54553>>>>>>>>> for segment# from 0 to (max#-1)
54559>>>>>>>>>>
54559>>>>>>>>> move (mid(str#,4,segment#*4+1)) to fld#
54560>>>>>>>>> if fld# move (rval#+pad(string(fld#),4)) to rval#
54563>>>>>>>>> loop
54564>>>>>>>>>>
54564>>>>>>>>> function_return rval#
54565>>>>>>>>> end_function
54566>>>>>>>>>
54566>>>>>>>>> function insert_file_reference string str# returns string
54568>>>>>>>>> integer fld# max# segment# file#
54568>>>>>>>>> string rval#
54568>>>>>>>>> get pMainFile to file#
54569>>>>>>>>> move "" to rval#
54570>>>>>>>>> move (length(str#)/4) to max#
54571>>>>>>>>> for segment# from 0 to (max#-1)
54577>>>>>>>>>>
54577>>>>>>>>> move (mid(str#,4,segment#*4+1)) to fld#
54578>>>>>>>>> move (rval#+pad(string(file#),4)+pad(string(fld#),4)) to rval#
54579>>>>>>>>> loop
54580>>>>>>>>>>
54580>>>>>>>>> function_return rval#
54581>>>>>>>>> end_function
54582>>>>>>>>>
54582>>>>>>>>> function idx_field_names integer idx# integer ovl# integer remove_rec# returns string
54584>>>>>>>>> string str# rval# fname#
54584>>>>>>>>> integer file# fld# segment# max#
54584>>>>>>>>> get pMainFile to file#
54585>>>>>>>>> get value item idx# to str#
54586>>>>>>>>> if str# ne "" begin
54588>>>>>>>>> if remove_rec# get field_remove_recnum str# to str#
54591>>>>>>>>> if ovl# get field_translate_overlaps str# to str#
54594>>>>>>>>> move (length(str#)/4) to max#
54595>>>>>>>>> for segment# from 0 to (max#-1)
54601>>>>>>>>>>
54601>>>>>>>>> if segment# ne 0 move (rval#+", ") to rval#
54604>>>>>>>>> move (mid(str#,4,segment#*4+1)) to fld#
54605>>>>>>>>> //get_attribute DF_FIELD_NAME of file# fld# to fname#
54605>>>>>>>>> get attr_field_name file# fld# to fname#
54606>>>>>>>>> move (lowercase(fname#)) to fname#
54607>>>>>>>>> move (overstrike(uppercase(left(fname#,1)),fname#,1)) to fname#
54608>>>>>>>>> move (rval#+fname#) to rval#
54609>>>>>>>>> loop
54610>>>>>>>>>>
54610>>>>>>>>> end
54610>>>>>>>>>>
54610>>>>>>>>> else move "" to rval#
54612>>>>>>>>> function_return rval#
54613>>>>>>>>> end_function
54614>>>>>>>>>
54614>>>>>>>>> function idx_field_value integer idx# integer ovl# integer remove_rec# returns string
54616>>>>>>>>> string str# rval# fval#
54616>>>>>>>>> integer file# fld# segment# max#
54616>>>>>>>>> get pMainFile to file#
54617>>>>>>>>> if idx# get value item idx# to str#
54620>>>>>>>>> else begin // If idx# is 0 we un-conditionally return the recnum
54621>>>>>>>>> get_field_value file# fld# to fval#
54624>>>>>>>>> function_return fval#
54625>>>>>>>>> end
54625>>>>>>>>>>
54625>>>>>>>>> if str# ne "" begin
54627>>>>>>>>> if remove_rec# get field_remove_recnum str# to str#
54630>>>>>>>>> if ovl# get field_translate_overlaps str# to str#
54633>>>>>>>>> move (length(str#)/4) to max#
54634>>>>>>>>> for segment# from 0 to (max#-1)
54640>>>>>>>>>>
54640>>>>>>>>> if segment# ne 0 move (rval#+", ") to rval#
54643>>>>>>>>> move (mid(str#,4,segment#*4+1)) to fld#
54644>>>>>>>>> get_field_value file# fld# to fval#
54647>>>>>>>>> trim fval# to fval#
54648>>>>>>>>>>
54648>>>>>>>>> move (rval#+fval#) to rval#
54649>>>>>>>>> loop
54650>>>>>>>>>>
54650>>>>>>>>> end
54650>>>>>>>>>>
54650>>>>>>>>> else move "" to rval#
54652>>>>>>>>> function_return rval#
54653>>>>>>>>> end_function
54654>>>>>>>>>
54654>>>>>>>>> // -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
54654>>>>>>>>>
54654>>>>>>>>> // The function prompt_list_fields returns a bid for which fields
54654>>>>>>>>> // a prompt list should include.
54654>>>>>>>>> function prompt_list_fields integer file# returns string
54656>>>>>>>>> integer best_idx# descr_idx# descr_fld# second_best_idx#
54656>>>>>>>>> string rval#
54656>>>>>>>>>
54656>>>>>>>>> send read_file_definition file#
54657>>>>>>>>>
54657>>>>>>>>> get idx_best_index to best_idx# //
54658>>>>>>>>>
54658>>>>>>>>> get idx_next_description_index 0 to descr_idx#
54659>>>>>>>>> if descr_idx# begin
54661>>>>>>>>> if descr_idx# eq best_idx# ; get idx_next_description_index descr_idx# to descr_idx#
54664>>>>>>>>> end
54664>>>>>>>>>>
54664>>>>>>>>>
54664>>>>>>>>> ifnot descr_idx# begin
54666>>>>>>>>> get idx_next_description_field_not_index 0 to descr_fld#
54667>>>>>>>>> ifnot descr_idx# get idx_next_field_not_index 0 to descr_fld#
54670>>>>>>>>> end
54670>>>>>>>>>>
54670>>>>>>>>>
54670>>>>>>>>> get idx_next_index 0 to second_best_idx#
54671>>>>>>>>> if second_best_idx# begin
54673>>>>>>>>> repeat
54673>>>>>>>>>>
54673>>>>>>>>> if (second_best_idx#=best_idx# or second_best_idx#=descr_idx#) begin
54675>>>>>>>>> get idx_next_index second_best_idx# to second_best_idx#
54676>>>>>>>>> end
54676>>>>>>>>>>
54676>>>>>>>>> until (not(second_best_idx#) or (second_best_idx#<>best_idx# and second_best_idx#<>descr_idx#))
54678>>>>>>>>> end
54678>>>>>>>>>>
54678>>>>>>>>>
54678>>>>>>>>> if best_idx# move (idx_definition(self,best_idx#)) to rval#
54681>>>>>>>>> else move "0 " to rval#
54683>>>>>>>>>
54683>>>>>>>>> if descr_idx# move (rval#+idx_definition(self,descr_idx#)) to rval#
54686>>>>>>>>> if descr_fld# move (rval#+pad(string(descr_fld#),4)) to rval#
54689>>>>>>>>>
54689>>>>>>>>> if second_best_idx# move (rval#+idx_definition(self,second_best_idx#)) to rval#
54692>>>>>>>>>
54692>>>>>>>>> get field_remove_doubles rval# to rval#
54693>>>>>>>>> if best_idx# get field_remove_recnum rval# to rval#
54696>>>>>>>>> get insert_file_reference rval# to rval#
54697>>>>>>>>> function_return rval#
54698>>>>>>>>> end_function
54699>>>>>>>>>end_class // cIndexAnalyzer
54700>>>>>>>>>
54700>>>>>>>>>integer oIndexAnalyzer#
54700>>>>>>>>>object oIndexAnalyzer is a cIndexAnalyzer
54702>>>>>>>>> move self to oIndexAnalyzer#
54703>>>>>>>>>end_object
54704>>>>>>>//Use FdxField.nui // FDX Field things
54704>>>>>>>//Use FdxIndex.utl // Index analysing functions
54704>>>>>>>Use FieldInf.pkg // Global field info objects
54704>>>>>>>Use Strings.nui // String manipulation for VDF
54704>>>>>>>Use Dates.nui // Date manipulation for VDF and DF3.2
54704>>>>>>>Use QryExpr.utl // Expression handling for queries
Including file: qryexpr.utl (C:\Apps\VDFQuery\AppSrc\qryexpr.utl)
54704>>>>>>>>>// Use QryExpr.utl // Expression handling for queries
54704>>>>>>>>>Use DFScript.utl // DF-Script interpreter
Including file: dfscript.utl (C:\Apps\VDFQuery\AppSrc\dfscript.utl)
54704>>>>>>>>>>>//**********************************************************************
54704>>>>>>>>>>>// Use DFScript.utl // DF-Script interpreter
54704>>>>>>>>>>>//
54704>>>>>>>>>>>// by Sture Andersen
54704>>>>>>>>>>>//
54704>>>>>>>>>>>// Create: Fri 15-10-1999
54704>>>>>>>>>>>// Update:
54704>>>>>>>>>>>//
54704>>>>>>>>>>>//
54704>>>>>>>>>>>//
54704>>>>>>>>>>>// ========================= SCRIPT SYNTAX: ===========================
54704>>>>>>>>>>>//
54704>>>>>>>>>>>//
54704>>>>>>>>>>>// INTEGER {symbol}+ Global variable declaration(s)
54704>>>>>>>>>>>// STRING {symbol}+ Global variable declaration(s)
54704>>>>>>>>>>>// NUMBER {symbol}+ Global variable declaration(s)
54704>>>>>>>>>>>// DATE {symbol}+ Global variable declaration(s)
54704>>>>>>>>>>>// MOVE {value} to {varname} Assign value to variable
54704>>>>>>>>>>>// #REPLACE {symbol} {value} Create compiler symbol
54704>>>>>>>>>>>// #NOISY {0|1} Toggles interpreter debug state
54704>>>>>>>>>>>// PAUSE Pause program execution
54704>>>>>>>>>>>// GOTO {label} Jump to specified label
54704>>>>>>>>>>>// GOSUB {label} Execute subrutine
54704>>>>>>>>>>>// RETURN Return from subroutine
54704>>>>>>>>>>>// ABORT Halts program execution
54704>>>>>>>>>>>// INPUT {prompt} {varname} Lets the operator enter a value
54704>>>>>>>>>>>// DEBUG {ON|OFF|SINGLE_STEP|DISPLAY_VAR} Control debug status
54704>>>>>>>>>>>// GOTOXY {line} {column} Positions the cursor (character mode)
54704>>>>>>>>>>>// CLEARSCREEN Blanks the screen
54704>>>>>>>>>>>//
54704>>>>>>>>>>>// DELETE_FIELD {field}
54704>>>>>>>>>>>// CREATE_FIELD {field} {name} {type}
54704>>>>>>>>>>>// SET_ATTRIBUTE {}
54704>>>>>>>>>>>// DELETE_INDEX {index}
54704>>>>>>>>>>>//
54704>>>>>>>>>>>//**********************************************************************
54704>>>>>>>>>>>
54704>>>>>>>>>>>
54704>>>>>>>>>>>Use APS // Auto Positioning and Sizing classes for VDF
54704>>>>>>>>>>>Use vMachine.utl // Virtual machine class
Including file: vmachine.utl (C:\Apps\VDFQuery\AppSrc\vmachine.utl)
54704>>>>>>>>>>>>>//**********************************************************************
54704>>>>>>>>>>>>>// Use vMachine.utl // Virtual machine class (heart of DFScript)
54704>>>>>>>>>>>>>//
54704>>>>>>>>>>>>>// By Sture Andersen
54704>>>>>>>>>>>>>//
54704>>>>>>>>>>>>>// Create: Fri 01-10-1999
54704>>>>>>>>>>>>>// Update: Fri 15-10-1999 - Now handles DBMS field
54704>>>>>>>>>>>>>// - Repeat/Until macro added
54704>>>>>>>>>>>>>//
54704>>>>>>>>>>>>>//
54704>>>>>>>>>>>>>// Functions for dbQuery:
54704>>>>>>>>>>>>>//
54704>>>>>>>>>>>>>// Strings
54704>>>>>>>>>>>>>//
54704>>>>>>>>>>>>>// Simple Left
54704>>>>>>>>>>>>>// Right
54704>>>>>>>>>>>>>// Mid
54704>>>>>>>>>>>>>// Pos
54704>>>>>>>>>>>>>// Uppercase
54704>>>>>>>>>>>>>// Lowercase
54704>>>>>>>>>>>>>//
54704>>>>>>>>>>>>>// Advanced
54704>>>>>>>>>>>>>//
54704>>>>>>>>>>>>>//
54704>>>>>>>>>>>>>// Dates
54704>>>>>>>>>>>>>//
54704>>>>>>>>>>>>>// Simple DateCompose integer liDay integer liMonth integer liYear returns date
54704>>>>>>>>>>>>>// StringToDate string lsDate integer liFormat integer lbLong string lsSep returns date
54704>>>>>>>>>>>>>// DateToString date ldDate integer liFormat integer lbLong string lsSep returns string
54704>>>>>>>>>>>>>// DateIncrement date ldDate integer liSegment integer liAmount returns date
54704>>>>>>>>>>>>>// DateSegment date ldDate integer liSegment returns integer
54704>>>>>>>>>>>>>// FirstDayInMonth date ldDate returns date
54704>>>>>>>>>>>>>// LastDayInMonth date ldDate returns date
54704>>>>>>>>>>>>>// FirstDayInYear date ldDate returns date
54704>>>>>>>>>>>>>// LastDayInYear date ldDate returns date
54704>>>>>>>>>>>>>// DateWeekNumber date ldDate returns integer
54704>>>>>>>>>>>>>// DayName integer liWeekDay returns string
54704>>>>>>>>>>>>>// DateDayNumber date ldDate returns integer
54704>>>>>>>>>>>>>// DateDayName date ldDate returns string
54704>>>>>>>>>>>>>// WeekToDate integer liYear integer liWeek returns date
54704>>>>>>>>>>>>>// MonthName integer liMonth returns string
54704>>>>>>>>>>>>>// DateMonthName date ldDate returns string
54704>>>>>>>>>>>>>// DateAsText date ldDate string lsFormat returns string
54704>>>>>>>>>>>>>// SysDate returns date
54704>>>>>>>>>>>>>//
54704>>>>>>>>>>>>>//**********************************************************************
54704>>>>>>>>>>>>>
54704>>>>>>>>>>>>>Use Base.nui
54704>>>>>>>>>>>>>Use MsgBox.utl // obs procedure
54704>>>>>>>>>>>>>Use Strings.nui // String manipulation for VDF
54704>>>>>>>>>>>>>Use DBMS.utl // Basic DBMS functions
Including file: dbms.utl (C:\Apps\VDFQuery\AppSrc\dbms.utl)
54704>>>>>>>>>>>>>>>Use DBMS.nui // Basic DBMS functions
54704>>>>>>>>>>>>>>>Use MsgBox.utl // obs procedure
54704>>>>>>>>>>>>>>>
54704>>>>>>>>>>>>>>>Use Windows
54704>>>>>>>>>>>>>>>Use file_dlg // OpenDialog class (DAC)
54704>>>>>>>>>>>>>>>object oDBMS_FlDlg is a OpenDialog
54706>>>>>>>>>>>>>>> set NoChangeDir_State to true
54707>>>>>>>>>>>>>>>end_object
54708>>>>>>>>>>>>>>>
54708>>>>>>>>>>>>>>>function DBMS_OpenFileBrowse global string fn# integer file# integer mode# integer buf_index# returns integer
54710>>>>>>>>>>>>>>> integer obj# rval#
54710>>>>>>>>>>>>>>> move 0 to rval#
54711>>>>>>>>>>>>>>> move (oDBMS_FlDlg(self)) to obj#
54712>>>>>>>>>>>>>>> set Dialog_Caption of obj# to ("Locate "+fn#)
54713>>>>>>>>>>>>>>> set Filter_String of obj# to ("Standard ("+fn#+")|"+fn#+"|DAT files|*.dat|All files|*.*")
54714>>>>>>>>>>>>>>> if (Show_Dialog(obj#)) begin
54716>>>>>>>>>>>>>>> move (File_Name(obj#)) to fn#
54717>>>>>>>>>>>>>>> if fn# ne "" move (DBMS_OpenFileAs(fn#,file#,mode#,buf_index#)) to rval#
54720>>>>>>>>>>>>>>> end
54720>>>>>>>>>>>>>>>>
54720>>>>>>>>>>>>>>> function_return rval#
54721>>>>>>>>>>>>>>>end_function
54722>>>>>>>>>>>>>>>
54722>>>>>>>>>>>>>>>// Procedure private.DBMS_OpenFile is used by the DBMS_OPEN command.
54722>>>>>>>>>>>>>>>// It takes the following parameters:
54722>>>>>>>>>>>>>>>//
54722>>>>>>>>>>>>>>>// line_no# integer Number of the calling command line
54722>>>>>>>>>>>>>>>// file# integer Number of the file to open
54722>>>>>>>>>>>>>>>// as# boolean Is this an 'OPEN AS' thing?
54722>>>>>>>>>>>>>>>// as_string# string Name of the file to open if opened as
54722>>>>>>>>>>>>>>>// mode# integer DF_SHARE or DF_EXCLUSIVE
54722>>>>>>>>>>>>>>>// index# integer If non zero this specifies which index should be buffered
54722>>>>>>>>>>>>>>>// dfname# string Logical name of the file#
54722>>>>>>>>>>>>>>>
54722>>>>>>>>>>>>>>>procedure private.DBMS_OpenFile global integer line_no# integer file# integer as# string as_str# integer mode# integer index# string dffile#
54724>>>>>>>>>>>>>>> integer ok#
54724>>>>>>>>>>>>>>> string msg#
54724>>>>>>>>>>>>>>> if as# move (DBMS_OpenFileAs(as_str#,file#,mode#,index#)) to ok#
54727>>>>>>>>>>>>>>> else move (DBMS_OpenFile(file#,mode#,index#)) to ok#
54729>>>>>>>>>>>>>>> ifnot ok# begin
54731>>>>>>>>>>>>>>> move ("Datafile could not be opened."+character(10)) to msg#
54732>>>>>>>>>>>>>>> move (msg#+"File number "+string(file#)+" was attempted opened in line "+string(line_no#)+"."+character(10)) to msg#
54733>>>>>>>>>>>>>>> if as# move (msg#+"Physical file name is: "+as_str#+character(10)) to msg#
54736>>>>>>>>>>>>>>> else move (msg#+"Physical file name is: "+DBMS_Rootname(file#)+character(10)) to msg#
54738>>>>>>>>>>>>>>> if dffile# eq "DFFILE_NAME_NOT_FOUND" move (msg#+"No logical file name was specified.") to msg#
54741>>>>>>>>>>>>>>> else move (msg#+"Logical file name is: "+dffile#) to msg#
54743>>>>>>>>>>>>>>> send obs msg#
54744>>>>>>>>>>>>>>> end
54744>>>>>>>>>>>>>>>>
54744>>>>>>>>>>>>>>>end_procedure
54745>>>>>>>>>>>>>>>
54745>>>>>>>>>>>>>Use Focus.utl // Retrieve basic information about object
Including file: focus.utl (C:\Apps\VDFQuery\AppSrc\focus.utl)
54745>>>>>>>>>>>>>>>// **********************************************************************
54745>>>>>>>>>>>>>>>// Use Focus.utl // Retrieve basic information about object
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// by Sture Andersen
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// Create: Can't remember
54745>>>>>>>>>>>>>>>// Update: Fri 30-06-2000 - Changed and doc'ed
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// This package is able to perform a runtime analysis of the object that
54745>>>>>>>>>>>>>>>// currently holds the focus. The following information may be retrieved:
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// Info-ID Type Description
54745>>>>>>>>>>>>>>>// -----------------------------------------------------------
54745>>>>>>>>>>>>>>>// FOCUS_OK (Bool) Did this work at all?
54745>>>>>>>>>>>>>>>// FOCUS_DEO_ID (Integer) Who did we ask?
54745>>>>>>>>>>>>>>>// FOCUS_ITEM_FILE (Integer) What's the data file of the current
54745>>>>>>>>>>>>>>>// item.
54745>>>>>>>>>>>>>>>// FOCUS_ITEM_FIELD (Integer) What's the data field of the
54745>>>>>>>>>>>>>>>// current item.
54745>>>>>>>>>>>>>>>// FOCUS_MAIN_INDEX (Integer) What's the main index (if any)
54745>>>>>>>>>>>>>>>// FOCUS_DD (Integer) Who's the server
54745>>>>>>>>>>>>>>>// FOCUS_INDIRECT_DD (Integer) Which DDO is taking care of
54745>>>>>>>>>>>>>>>// FOCUS_ITEM_FILE
54745>>>>>>>>>>>>>>>// FOCUS_DEO_MODAL (Bool) Is that panel modal?
54745>>>>>>>>>>>>>>>// FOCUS_CLIENT_ID (Integer) What (if any) is the ID
54745>>>>>>>>>>>>>>>// of the client area?
54745>>>>>>>>>>>>>>>// FOCUS_DEO_ITEM (Integer) What's current item in
54745>>>>>>>>>>>>>>>// that objects
54745>>>>>>>>>>>>>>>// FOCUS_SCOPED_PARENT (Integer) Object ID of scoped parent
54745>>>>>>>>>>>>>>>// FOCUS_ITEM_VALUE (String) Value of current item
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// To retrieve all this wonderful information send message Focus_Analyse_Focus.
54745>>>>>>>>>>>>>>>// After that you must use the Focus_Info function to actually get hold of if:
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// procedure OnlyIfCustomer
54745>>>>>>>>>>>>>>>// integer iFile
54745>>>>>>>>>>>>>>>// send Focus_Analyse_Focus
54745>>>>>>>>>>>>>>>// get Focus_Info FOCUS_ITEM_FILE to iFile
54745>>>>>>>>>>>>>>>// if iFile eq Customer.File_Number begin
54745>>>>>>>>>>>>>>>// // Something fantastic
54745>>>>>>>>>>>>>>>// end
54745>>>>>>>>>>>>>>>// else send stop_box "Only do this from a Customer field!"
54745>>>>>>>>>>>>>>>// end_procedure
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// Public interface:
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// * function Focus_Find_Scoped_Parent global integer iObj returns integer
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// This function returns the innermost scoped parent (Scope_State = True)
54745>>>>>>>>>>>>>>>// of the object passed in parameter iObj. If no such object is found
54745>>>>>>>>>>>>>>>// DESKTOP is returned. If 0 is passed as iObj, 0 will be returned.
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// * procedure Focus_Analyze_DEO global integer iDEO integer iItem
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// Analyse object passed in the iDEO. The iItem parameter should indicate
54745>>>>>>>>>>>>>>>// which item in iDeo should be used for retrieving item based info.
54745>>>>>>>>>>>>>>>// Subsequently use the Focus_Info function to retrieve the information.
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// * procedure Focus_Analyze_Focus global
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// Analyse object that currently holds the focus. Subsequently use the
54745>>>>>>>>>>>>>>>// Focus_Info function to retrieve the information.
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// * function Focus_Info global integer iItem returns string
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// Use this function to get hold of information previously recorded
54745>>>>>>>>>>>>>>>// by the Focus_Analyze_Focus (or Focus_Analyze_DEO) function.
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// Parameter iItem may be any of the following values:
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// FOCUS_OK (Boolean)
54745>>>>>>>>>>>>>>>// FOCUS_DEO_ID (Integer)
54745>>>>>>>>>>>>>>>// FOCUS_ITEM_FILE (Integer)
54745>>>>>>>>>>>>>>>// FOCUS_ITEM_FIELD (Integer)
54745>>>>>>>>>>>>>>>// FOCUS_MAIN_INDEX (Integer)
54745>>>>>>>>>>>>>>>// FOCUS_DD (Integer)
54745>>>>>>>>>>>>>>>// FOCUS_INDIRECT_DD (Integer)
54745>>>>>>>>>>>>>>>// FOCUS_DEO_MODAL (Boolean)
54745>>>>>>>>>>>>>>>// FOCUS_CLIENT_ID (Integer)
54745>>>>>>>>>>>>>>>// FOCUS_DEO_ITEM (Integer)
54745>>>>>>>>>>>>>>>// FOCUS_SCOPED_PARENT (Integer)
54745>>>>>>>>>>>>>>>// FOCUS_ITEM_VALUE (String)
54745>>>>>>>>>>>>>>>//
54745>>>>>>>>>>>>>>>// The return type of this function is String but the return value
54745>>>>>>>>>>>>>>>// may be converted to the type indicated in parenthesis.
54745>>>>>>>>>>>>>>>
54745>>>>>>>>>>>>>>>
54745>>>>>>>>>>>>>>>use ui
54745>>>>>>>>>>>>>>>
54745>>>>>>>>>>>>>>>enumeration_list
54745>>>>>>>>>>>>>>> define FOCUS_OK // Bool Did this work at all?
54745>>>>>>>>>>>>>>> define FOCUS_DEO_ID // Integer Who did we ask?
54745>>>>>>>>>>>>>>> define FOCUS_DEO_ITEM // Integer What's current item in that objects
54745>>>>>>>>>>>>>>> define FOCUS_ITEM_FILE // Integer What's the data file
54745>>>>>>>>>>>>>>> define FOCUS_ITEM_FIELD // Integer What's the data field
54745>>>>>>>>>>>>>>> define FOCUS_MAIN_INDEX // Integer What's the main index (if any)
54745>>>>>>>>>>>>>>> define FOCUS_DD // Integer Who's the server
54745>>>>>>>>>>>>>>> define FOCUS_INDIRECT_DD // Integer Who's taking care of FOCUS_ITEM_FILE
54745>>>>>>>>>>>>>>> define FOCUS_DEO_MODAL // Bool Is that panel modal?
54745>>>>>>>>>>>>>>> define FOCUS_CLIENT_ID // Integer What (if any) is the ID of the client area?
54745>>>>>>>>>>>>>>> define FOCUS_SCOPED_PARENT // Integer Object ID of scoped parent
54745>>>>>>>>>>>>>>> define FOCUS_ITEM_VALUE // The current value of the focused field
54745>>>>>>>>>>>>>>>end_enumeration_list
54745>>>>>>>>>>>>>>>
54745>>>>>>>>>>>>>>>integer FocusInf_Array#
54745>>>>>>>>>>>>>>>object FocusInf_Array is an array
54747>>>>>>>>>>>>>>> move self to FocusInf_Array#
54748>>>>>>>>>>>>>>>end_object
54749>>>>>>>>>>>>>>>
54749>>>>>>>>>>>>>>>function Focus_Find_Scoped_Parent global integer obj# returns integer
54751>>>>>>>>>>>>>>> integer st#
54751>>>>>>>>>>>>>>> repeat
54751>>>>>>>>>>>>>>>>
54751>>>>>>>>>>>>>>> get scope_state of obj# to st#
54752>>>>>>>>>>>>>>> ifnot st# get parent of obj# to obj#
54755>>>>>>>>>>>>>>> until (st# or obj#=desktop)
54757>>>>>>>>>>>>>>> function_return obj#
54758>>>>>>>>>>>>>>>end_function
54759>>>>>>>>>>>>>>>
54759>>>>>>>>>>>>>>>procedure Focus_Analyze_DEO global integer deo# integer itm#
54761>>>>>>>>>>>>>>> integer st# file# fld# dd# tmp# scoped_parent#
54761>>>>>>>>>>>>>>> send delete_data to FocusInf_Array#
54762>>>>>>>>>>>>>>> if deo# gt desktop begin
54764>>>>>>>>>>>>>>> set value of FocusInf_Array# item FOCUS_OK to dfTrue
54765>>>>>>>>>>>>>>> set value of FocusInf_Array# item FOCUS_DEO_ID to deo#
54766>>>>>>>>>>>>>>> move (Focus_Find_Scoped_Parent(deo#)) to scoped_parent#
54767>>>>>>>>>>>>>>> set value of FocusInf_Array# item FOCUS_SCOPED_PARENT to scoped_parent#
54768>>>>>>>>>>>>>>> if scoped_parent# begin
54770>>>>>>>>>>>>>>> set value of FocusInf_Array# item FOCUS_DEO_MODAL to (modal_state(scoped_parent#))
54771>>>>>>>>>>>>>>> end
54771>>>>>>>>>>>>>>>>
54771>>>>>>>>>>>>>>> else set value of FocusInf_Array# item FOCUS_DEO_MODAL to dfFalse
54773>>>>>>>>>>>>>>> get delegation_mode of deo# to st#
54774>>>>>>>>>>>>>>> set delegation_mode of deo# to NO_DELEGATE_OR_ERROR
54775>>>>>>>>>>>>>>> get server of deo# to dd#
54776>>>>>>>>>>>>>>> get data_file of deo# item itm# to file#
54777>>>>>>>>>>>>>>> get data_field of deo# item itm# to fld#
54778>>>>>>>>>>>>>>> if (file# and fld#) begin
54780>>>>>>>>>>>>>>> get_attribute DF_FIELD_INDEX of file# fld# to tmp#
54783>>>>>>>>>>>>>>> set value of FocusInf_Array# item FOCUS_MAIN_INDEX to tmp#
54784>>>>>>>>>>>>>>> end
54784>>>>>>>>>>>>>>>>
54784>>>>>>>>>>>>>>>
54784>>>>>>>>>>>>>>> set delegation_mode of deo# to st#
54785>>>>>>>>>>>>>>> set value of FocusInf_Array# item FOCUS_DEO_ITEM to itm#
54786>>>>>>>>>>>>>>> set value of FocusInf_Array# item FOCUS_ITEM_FILE to file#
54787>>>>>>>>>>>>>>> set value of FocusInf_Array# item FOCUS_ITEM_FIELD to fld#
54788>>>>>>>>>>>>>>> set value of FocusInf_Array# item FOCUS_ITEM_VALUE to (value(deo#,itm#))
54789>>>>>>>>>>>>>>> if dd# begin
54791>>>>>>>>>>>>>>> set value of FocusInf_Array# item FOCUS_DD to dd#
54792>>>>>>>>>>>>>>> get which_data_set of dd# file# to dd#
54793>>>>>>>>>>>>>>> set value of FocusInf_Array# item FOCUS_INDIRECT_DD to dd#
54794>>>>>>>>>>>>>>> end
54794>>>>>>>>>>>>>>>>
54794>>>>>>>>>>>>>>> end
54794>>>>>>>>>>>>>>>>
54794>>>>>>>>>>>>>>>end_procedure
54795>>>>>>>>>>>>>>>
54795>>>>>>>>>>>>>>>procedure Focus_Analyze_Focus global
54797>>>>>>>>>>>>>>> integer focus# itm# st#
54797>>>>>>>>>>>>>>> get focus of desktop to focus#
54798>>>>>>>>>>>>>>> if focus# gt desktop begin
54800>>>>>>>>>>>>>>> get delegation_mode of focus# to st#
54801>>>>>>>>>>>>>>> set delegation_mode of focus# to NO_DELEGATE_OR_ERROR
54802>>>>>>>>>>>>>>> get current_item of focus# to itm#
54803>>>>>>>>>>>>>>> set delegation_mode of focus# to st#
54804>>>>>>>>>>>>>>> end
54804>>>>>>>>>>>>>>>>
54804>>>>>>>>>>>>>>> else move -1 to itm#
54806>>>>>>>>>>>>>>> send Focus_Analyze_DEO focus# itm#
54807>>>>>>>>>>>>>>>end_procedure
54808>>>>>>>>>>>>>>>
54808>>>>>>>>>>>>>>>function Focus_Info global integer itm# returns string
54810>>>>>>>>>>>>>>> function_return (value(FocusInf_Array#,itm#))
54811>>>>>>>>>>>>>>>end_function
54812>>>>>>>>>>>>>Use Structur.utl // Object for restructuring table definitions
Including file: structur.utl (C:\Apps\VDFQuery\AppSrc\structur.utl)
54812>>>>>>>>>>>>>>>//**********************************************************************
54812>>>>>>>>>>>>>>>// Use Structur.utl // Object for restructuring table definitions
54812>>>>>>>>>>>>>>>//
54812>>>>>>>>>>>>>>>// By Sture Andersen
54812>>>>>>>>>>>>>>>//
54812>>>>>>>>>>>>>>>// Create: Sun 24-10-1999
54812>>>>>>>>>>>>>>>// Update: Tue 25-01-2000 - Windows interface added to the waiter...
54812>>>>>>>>>>>>>>>// Fri 03-03-2000 - RS_RestructureGroup class added
54812>>>>>>>>>>>>>>>// Sat 22-04-2000 - RS_TableOpenName function added
54812>>>>>>>>>>>>>>>//**********************************************************************
54812>>>>>>>>>>>>>>>//
54812>>>>>>>>>>>>>>>// This package defines a global object for restructuring tables. This global
54812>>>>>>>>>>>>>>>// object is manipulated via a bunch of global messages all prefixed with
54812>>>>>>>>>>>>>>>// the letters "RS_".
54812>>>>>>>>>>>>>>>//
54812>>>>>>>>>>>>>>>// The advantage of using this object instead of using the SET_ATTRIBUTE and
54812>>>>>>>>>>>>>>>// GET_ATTRIBUTE commands directly is that the global object makes up for a
54812>>>>>>>>>>>>>>>// few shortcomings that these commands exhibits.
54812>>>>>>>>>>>>>>>//
54812>>>>>>>>>>>>>>>
54812>>>>>>>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
54812>>>>>>>>>>>>>>>Use Structur.nui
Including file: structur.nui (C:\Apps\VDFQuery\AppSrc\structur.nui)
54812>>>>>>>>>>>>>>>>>Use DBMS.nui // Basic DBMS functions (No User Interface)
54812>>>>>>>>>>>>>>>>>Use Files.nui // Utilities for handling file related stuff (No User Interface)
54812>>>>>>>>>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
54812>>>>>>>>>>>>>>>>>Use Strings.nui // String manipulation for VDF (No User Interface)
54812>>>>>>>>>>>>>>>>>Use API_Attr.nui // Functions for querying API attributes (No User Interface)
54812>>>>>>>>>>>>>>>>>Use OpenStat.nui // cTablesOpenStatus class (formely cFileAllFiles) (No User Interface)
54812>>>>>>>>>>>>>>>>>
54812>>>>>>>>>>>>>>>>> define t.STRUCT.Restart for "The program will now attempt to re-start"
54812>>>>>>>>>>>>>>>>>
54812>>>>>>>>>>>>>>>>> string Struc$ErrDescr
54812>>>>>>>>>>>>>>>>>
54812>>>>>>>>>>>>>>>>>integer cRestructurer#
54812>>>>>>>>>>>>>>>>>if dfFalse begin
54814>>>>>>>>>>>>>>>>> cRestructurer_Error:
54814>>>>>>>>>>>>>>>>> send structure_error to cRestructurer#
54815>>>>>>>>>>>>>>>>> return
54816>>>>>>>>>>>>>>>>>end
54816>>>>>>>>>>>>>>>>>>
54816>>>>>>>>>>>>>>>>>
54816>>>>>>>>>>>>>>>>>enumeration_list
54816>>>>>>>>>>>>>>>>> define RSOP_BEGIN
54816>>>>>>>>>>>>>>>>> define RSOP_CREATEFIELD
54816>>>>>>>>>>>>>>>>> define RSOP_DELETEFIELD
54816>>>>>>>>>>>>>>>>> define RSOP_DELETEINDEX
54816>>>>>>>>>>>>>>>>> define RSOP_SETFILEATTR
54816>>>>>>>>>>>>>>>>> define RSOP_SETFIELDATTR
54816>>>>>>>>>>>>>>>>> define RSOP_SETINDEXATTR
54816>>>>>>>>>>>>>>>>> define RSOP_SETINDEXSEGATTR
54816>>>>>>>>>>>>>>>>> define RSOP_TRUNCATED
54816>>>>>>>>>>>>>>>>> define RSOP_ERROR_OCCURRED
54816>>>>>>>>>>>>>>>>> define RSOP_END
54816>>>>>>>>>>>>>>>>>end_enumeration_list
54816>>>>>>>>>>>>>>>>>
54816>>>>>>>>>>>>>>>>>enumeration_list
54816>>>>>>>>>>>>>>>>> define ERRORTRAP_ATTRCHANGE
54816>>>>>>>>>>>>>>>>> define ERRORTRAP_FIELDCREATE
54816>>>>>>>>>>>>>>>>> define ERRORTRAP_FIELDDELETE
54816>>>>>>>>>>>>>>>>> define ERRORTRAP_INDEXCREATE
54816>>>>>>>>>>>>>>>>> define ERRORTRAP_INDEXDELETE
54816>>>>>>>>>>>>>>>>>end_enumeration_list
54816>>>>>>>>>>>>>>>>>
54816>>>>>>>>>>>>>>>>>object oStructureErrorInfo is a cArray no_image
54818>>>>>>>>>>>>>>>>> property string psLine1 public ""
54820>>>>>>>>>>>>>>>>> property string psLine2 public ""
54822>>>>>>>>>>>>>>>>> procedure DoPrepare
54825>>>>>>>>>>>>>>>>> integer attr# attr_type# field# index# segment# ErrTrapType#
54825>>>>>>>>>>>>>>>>> string line1# line2# value#
54825>>>>>>>>>>>>>>>>> get value item 0 to ErrTrapType#
54826>>>>>>>>>>>>>>>>> move "" to line1#
54827>>>>>>>>>>>>>>>>> move "" to line2#
54828>>>>>>>>>>>>>>>>> if ErrTrapType# eq ERRORTRAP_ATTRCHANGE begin
54830>>>>>>>>>>>>>>>>> get value item 1 to attr#
54831>>>>>>>>>>>>>>>>> get API_AttrType attr# to attr_type#
54832>>>>>>>>>>>>>>>>> if attr_type# eq ATTRTYPE_FILELIST begin
54834>>>>>>>>>>>>>>>>> get value item 3 to value#
54835>>>>>>>>>>>>>>>>> move "Set_Attribute # to #" to line1#
54836>>>>>>>>>>>>>>>>> replace "#" in line1# with (API_Attr_Name(attr#))
54838>>>>>>>>>>>>>>>>> replace "#" in line1# with (API_Attr_ValueName(attr#,value#))
54840>>>>>>>>>>>>>>>>> end
54840>>>>>>>>>>>>>>>>>>
54840>>>>>>>>>>>>>>>>> if attr_type# eq ATTRTYPE_FILE begin
54842>>>>>>>>>>>>>>>>> get value item 3 to value#
54843>>>>>>>>>>>>>>>>> move "Set_Attribute # to #" to line1#
54844>>>>>>>>>>>>>>>>> replace "#" in line1# with (API_Attr_Name(attr#))
54846>>>>>>>>>>>>>>>>> replace "#" in line1# with (API_Attr_ValueName(attr#,value#))
54848>>>>>>>>>>>>>>>>> end
54848>>>>>>>>>>>>>>>>>>
54848>>>>>>>>>>>>>>>>> if attr_type# eq ATTRTYPE_FIELD begin
54850>>>>>>>>>>>>>>>>> get value item 3 to field#
54851>>>>>>>>>>>>>>>>> get value item 4 to value#
54852>>>>>>>>>>>>>>>>> move "Set_Attribute # field #" to line1#
54853>>>>>>>>>>>>>>>>> move "to #" to line2#
54854>>>>>>>>>>>>>>>>> replace "#" in line1# with (API_Attr_Name(attr#))
54856>>>>>>>>>>>>>>>>> replace "#" in line1# with (string(field#))
54858>>>>>>>>>>>>>>>>> replace "#" in line2# with (API_Attr_ValueName(attr#,value#))
54860>>>>>>>>>>>>>>>>> end
54860>>>>>>>>>>>>>>>>>>
54860>>>>>>>>>>>>>>>>> if attr_type# eq ATTRTYPE_INDEX begin
54862>>>>>>>>>>>>>>>>> get value item 3 to index#
54863>>>>>>>>>>>>>>>>> get value item 4 to value#
54864>>>>>>>>>>>>>>>>> move "Set_Attribute # index #" to line1#
54865>>>>>>>>>>>>>>>>> move "to #" to line2#
54866>>>>>>>>>>>>>>>>> replace "#" in line1# with (API_Attr_Name(attr#))
54868>>>>>>>>>>>>>>>>> replace "#" in line1# with (string(index#))
54870>>>>>>>>>>>>>>>>> replace "#" in line2# with (API_Attr_ValueName(attr#,value#))
54872>>>>>>>>>>>>>>>>> end
54872>>>>>>>>>>>>>>>>>>
54872>>>>>>>>>>>>>>>>> if attr_type# eq ATTRTYPE_IDXSEG begin
54874>>>>>>>>>>>>>>>>> get value item 3 to index#
54875>>>>>>>>>>>>>>>>> get value item 4 to segment#
54876>>>>>>>>>>>>>>>>> get value item 5 to value#
54877>>>>>>>>>>>>>>>>> move "Set_Attribute # index # segment #" to line1#
54878>>>>>>>>>>>>>>>>> move "to #" to line2#
54879>>>>>>>>>>>>>>>>> replace "#" in line1# with (API_Attr_Name(attr#))
54881>>>>>>>>>>>>>>>>> replace "#" in line1# with (string(index#))
54883>>>>>>>>>>>>>>>>> replace "#" in line1# with (string(segment#))
54885>>>>>>>>>>>>>>>>> replace "#" in line2# with (API_Attr_ValueName(attr#,value#))
54887>>>>>>>>>>>>>>>>> end
54887>>>>>>>>>>>>>>>>>>
54887>>>>>>>>>>>>>>>>> end
54887>>>>>>>>>>>>>>>>>>
54887>>>>>>>>>>>>>>>>> if ErrTrapType# eq ERRORTRAP_FIELDCREATE begin
54889>>>>>>>>>>>>>>>>> move "Create_Field # at #" to line1#
54890>>>>>>>>>>>>>>>>> move (replace("#",line1#,string(value(self,1)))) to line1#
54891>>>>>>>>>>>>>>>>> move (replace("#",line1#,string(value(self,2)))) to line1#
54892>>>>>>>>>>>>>>>>> end
54892>>>>>>>>>>>>>>>>>>
54892>>>>>>>>>>>>>>>>> if ErrTrapType# eq ERRORTRAP_FIELDDELETE begin
54894>>>>>>>>>>>>>>>>> move "Delete_Field #" to line1#
54895>>>>>>>>>>>>>>>>> move (replace("#",line1#,string(value(self,1)))) to line1#
54896>>>>>>>>>>>>>>>>> end
54896>>>>>>>>>>>>>>>>>>
54896>>>>>>>>>>>>>>>>> if ErrTrapType# eq ERRORTRAP_INDEXCREATE begin
54898>>>>>>>>>>>>>>>>> move "Create_Index # at #" to line1#
54899>>>>>>>>>>>>>>>>> move (replace("#",line1#,string(value(self,1)))) to line1#
54900>>>>>>>>>>>>>>>>> move (replace("#",line1#,string(value(self,2)))) to line1#
54901>>>>>>>>>>>>>>>>> end
54901>>>>>>>>>>>>>>>>>>
54901>>>>>>>>>>>>>>>>> if ErrTrapType# eq ERRORTRAP_INDEXDELETE begin
54903>>>>>>>>>>>>>>>>> move "Delete_Index #" to line1#
54904>>>>>>>>>>>>>>>>> move (replace("#",line1#,string(value(self,1)))) to line1#
54905>>>>>>>>>>>>>>>>> end
54905>>>>>>>>>>>>>>>>>>
54905>>>>>>>>>>>>>>>>> set psLine1 to line1#
54906>>>>>>>>>>>>>>>>> set psLine2 to line2#
54907>>>>>>>>>>>>>>>>> send NotifyTracer to cRestructurer# RSOP_ERROR_OCCURRED 0 0 0 0 (line1#*line2#)
54908>>>>>>>>>>>>>>>>> end_procedure
54909>>>>>>>>>>>>>>>>>end_object // oStructureErrorInfo
54910>>>>>>>>>>>>>>>>>
54910>>>>>>>>>>>>>>>>>procedure set StructureErrorInfo global integer type# string value#
54912>>>>>>>>>>>>>>>>> set value of (oStructureErrorInfo(self)) item type# to value#
54913>>>>>>>>>>>>>>>>>end_procedure
54914>>>>>>>>>>>>>>>>>function StructureErrorInfo global integer type# returns string
54916>>>>>>>>>>>>>>>>> function_return (value(oStructureErrorInfo(self),type#))
54917>>>>>>>>>>>>>>>>>end_function
54918>>>>>>>>>>>>>>>>>procedure DoClearStructureErrorInfo global
54920>>>>>>>>>>>>>>>>> send delete_data to (oStructureErrorInfo(self))
54921>>>>>>>>>>>>>>>>>end_procedure
54922>>>>>>>>>>>>>>>>>
54922>>>>>>>>>>>>>>>>>//#IFDEF Is$WebApp
54922>>>>>>>>>>>>>>>>>// define Structur$ErrorTrapping for 0
54922>>>>>>>>>>>>>>>>>//#ELSE
54922>>>>>>>>>>>>>>>>> define Structur$ErrorTrapping for 1
54922>>>>>>>>>>>>>>>>>//#ENDIF
54922>>>>>>>>>>>>>>>>>
54922>>>>>>>>>>>>>>>>>
54922>>>>>>>>>>>>>>>>>
54922>>>>>>>>>>>>>>>>>
54922>>>>>>>>>>>>>>>
54922>>>>>>>>>>>>>>>Use LogFile.nui // Class for handling a log file (No User Interface)
54922>>>>>>>>>>>>>>>Use FdxIndex.nui // Index analysing functions
54922>>>>>>>>>>>>>>>
54922>>>>>>>>>>>>>>> define Structur$UI for 1
54922>>>>>>>>>>>>>>>
54922>>>>>>>>>>>>>>> Use Fdx2.utl // FDX aware object for displaying a table definiton
Including file: fdx2.utl (C:\Apps\VDFQuery\AppSrc\fdx2.utl)
54922>>>>>>>>>>>>>>>>>//**********************************************************************
54922>>>>>>>>>>>>>>>>>// Use Fdx2.utl // FDX aware object for displaying a table definition
54922>>>>>>>>>>>>>>>>>//
54922>>>>>>>>>>>>>>>>>// By Sture Andersen
54922>>>>>>>>>>>>>>>>>//
54922>>>>>>>>>>>>>>>>>// Create: Tue 09-02-2000
54922>>>>>>>>>>>>>>>>>// Update:
54922>>>>>>>>>>>>>>>>>//
54922>>>>>>>>>>>>>>>>>//**********************************************************************
54922>>>>>>>>>>>>>>>>>Use Fdx_Attr.nui // FDX compatible attribute functions
54922>>>>>>>>>>>>>>>>>Use DBMS.utl // Basic DBMS functions
54922>>>>>>>>>>>>>>>>>Use GridUtil.utl // Grid and List utilities
Including file: gridutil.utl (C:\Apps\VDFQuery\AppSrc\gridutil.utl)
54922>>>>>>>>>>>>>>>>>>>// Use GridUtil.utl // Grid and List utilities (not for dbGrid's or Table's)
54922>>>>>>>>>>>>>>>>>>>
54922>>>>>>>>>>>>>>>>>>>//> This package provides a number of functions working on objects of
54922>>>>>>>>>>>>>>>>>>>//> these classes
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> Grid (VDF)
54922>>>>>>>>>>>>>>>>>>>//> List (DF)
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> And not: dbGrid (VDF), List (VDF), dbList (VDF) or Table (DF)
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> The Grid of VDF and the List of DF are so much alike that it makes
54922>>>>>>>>>>>>>>>>>>>//> sence to give them a common interface via this package.
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> For the rest of this package (except the first sentence of the next
54922>>>>>>>>>>>>>>>>>>>//> paragraph) VDF Grid's and DF List's will be referred to as grids.
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> Rather than having these functions implemented in a subclass of the
54922>>>>>>>>>>>>>>>>>>>//> Grid- or List classes I have made global functions and procedures
54922>>>>>>>>>>>>>>>>>>>//> that all takes the object ID of the Grid as the first parameter.
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> You may therefore use the functions of this package regardless of
54922>>>>>>>>>>>>>>>>>>>//> the class hierarchy you are using.
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> To sort the contents of a grid by the contents of column liColumn use:
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> procedure Grid_SortByColumn global integer lhGrid integer liColumn
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> The set the entry_state of all items in a grid in one go use:
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> procedure Grid_SetEntryState global integer lhObj integer liState
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> To figure out the number of the first item in the current row use:
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> function Grid_BaseItem global integer lhObj returns integer
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> To figure out the current column use:
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> function Grid_CurrentColumn global integer lhObj returns integer
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> And finally, to figure out the number of columns used:
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> function Grid_Columns global integer lhObj returns integer
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> Added much later:
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> Use this to switch the contents of two rows (including aux_value, color
54922>>>>>>>>>>>>>>>>>>>//> entry_state and what have you):
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> procedure Grid_SwapRows global integer lhObj integer liRow1 ;
54922>>>>>>>>>>>>>>>>>>>//> integer liRow2
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> Most often, when swapping rows you'd really like to swap the current row
54922>>>>>>>>>>>>>>>>>>>//> up or down:
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> procedure Grid_SwapCurrentRowUp global integer lhGrid
54922>>>>>>>>>>>>>>>>>>>//> procedure Grid_SwapCurrentRowDown global integer lhGrid
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> Use like this (from within a Grid object):
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> procedure MoveItemUp
54922>>>>>>>>>>>>>>>>>>>//> send Grid_SwapCurrentRowUp self
54922>>>>>>>>>>>>>>>>>>>//> end_procedure
54922>>>>>>>>>>>>>>>>>>>//> procedure MoveItemDown
54922>>>>>>>>>>>>>>>>>>>//> send Grid_SwapCurrentRowDown self
54922>>>>>>>>>>>>>>>>>>>//> end_procedure
54922>>>>>>>>>>>>>>>>>>>//> on_key KEY_CTRL+KEY_UP_ARROW send MoveItemUp
54922>>>>>>>>>>>>>>>>>>>//> on_key KEY_CTRL+KEY_DOWN_ARROW send MoveItemDown
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> In some cases you may want to swap the current row to the top or to the
54922>>>>>>>>>>>>>>>>>>>//> bottom of the grid. Use:
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> procedure Grid_SwapCurrentRowTop global integer lhGrid
54922>>>>>>>>>>>>>>>>>>>//> procedure Grid_SwapCurrentRowBottom global integer lhGrid
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> Delete a row:
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> procedure Grid_DeleteRow global integer lhObj integer liRow
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> Delete current row:
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> procedure Grid_DeleteCurrentRow global integer lhObj
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> If the first column of the grid is a checkbox column you may use these
54922>>>>>>>>>>>>>>>>>>>//> methods:
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> Select all rows:
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> procedure Grid_RowSelectAll global integer lhGrid
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> Deselect all rows:
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> procedure Grid_RowDeselectAll global integer lhGrid
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> Invert row selection:
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> procedure Grid_RowSelectInvert global integer lhGrid
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> Call function liGet for each row in lhGrid to set the select
54922>>>>>>>>>>>>>>>>>>>//> or deselect each row. The liGet function ID will receive two
54922>>>>>>>>>>>>>>>>>>>//> parameter (Row number and number of the base item of that row)
54922>>>>>>>>>>>>>>>>>>>//> and should return an integer value:
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> procedure Grid_RowSelectCostum global integer lhGrid ;
54922>>>>>>>>>>>>>>>>>>>//> integer liGet
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> Use this to call procedure liMsg in lhGrid for each selected
54922>>>>>>>>>>>>>>>>>>>//> row. The procedure will receive two parameters (row number and
54922>>>>>>>>>>>>>>>>>>>//> number of the base item of that row):
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> procedure Grid_RowCallBackSelected global integer lhGrid ;
54922>>>>>>>>>>>>>>>>>>>//> integer liMsg
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> To write the contents of the Grid to a sequential channel use
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> procedure Grid_WriteToFile global integer lhGrid integer liChannel ;
54922>>>>>>>>>>>>>>>>>>>//> integer liFormat
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> where liFormat may be GD_FORMAT (Nicely formatted into colums), GD_COMMA
54922>>>>>>>>>>>>>>>>>>>//> (each line containing a row with comma separated items) or GD_TAB (same
54922>>>>>>>>>>>>>>>>>>>//> as the former, but separated by a TAB character).
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> In order to dump the grid data into an editor use
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> procedure Grid_DoWriteToFile global integer lhGrid
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> This will create a file called 'temp.txt' and launch an editor on it
54922>>>>>>>>>>>>>>>>>>>//> (NotePad, Edit or vi).
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> This is one of my best packages!
54922>>>>>>>>>>>>>>>>>>>//>
54922>>>>>>>>>>>>>>>>>>>//> =========================================================================
54922>>>>>>>>>>>>>>>>>>>//
54922>>>>>>>>>>>>>>>>>>>// Update: Wed 07-11-2001 - Changed procedures Grid_RowSelectAll,
54922>>>>>>>>>>>>>>>>>>>// Grid_RowDeselectAll and Grid_RowSelectInvert
54922>>>>>>>>>>>>>>>>>>>// to avoid changing the select_state of a
54922>>>>>>>>>>>>>>>>>>>// shadowed item.
54922>>>>>>>>>>>>>>>>>>>// Tue 25-12-2001 - Now also applies form_datatype it compiled
54922>>>>>>>>>>>>>>>>>>>// with VDF
54922>>>>>>>>>>>>>>>>>>>// Wed 18-04-2002 - desktop_section problem corrected
54922>>>>>>>>>>>>>>>>>>>// Mon 12-08-2002 - Function Grid_ItemRow added
54922>>>>>>>>>>>>>>>>>>>// Thu 16-06-2003 - Added optional parameter to Grid_RowCallBackSelected
54922>>>>>>>>>>>>>>>>>>>// Thu 01-07-2003 - Added functions Grid_AppendRow, Grid_InsertRow
54922>>>>>>>>>>>>>>>>>>>// and Grid_InsertCurrentRow
54922>>>>>>>>>>>>>>>>>>>// Fri 21-10-2005 - Added procedure Grid_SetRowColor and Grid_AddRowToGrid
54922>>>>>>>>>>>>>>>>>>>//
54922>>>>>>>>>>>>>>>>>>>// set Header_Visible_State to DFTRUE|DFFALSE
54922>>>>>>>>>>>>>>>>>>>//
54922>>>>>>>>>>>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
54922>>>>>>>>>>>>>>>>>>>Use Strings.nui // String manipulation for VDF
54922>>>>>>>>>>>>>>>>>>>Use Files.nui // Utilities for handling file related stuff (No User Interface)
54922>>>>>>>>>>>>>>>>>>>
54922>>>>>>>>>>>>>>>>>>>desktop_section // This makes sure the object is located on the desktop
54927>>>>>>>>>>>>>>>>>>> object oGridMoveSelectedListItems is an cArray NO_IMAGE
54929>>>>>>>>>>>>>>>>>>> end_object
54930>>>>>>>>>>>>>>>>>>>end_desktop_section
54935>>>>>>>>>>>>>>>>>>>
54935>>>>>>>>>>>>>>>>>>>//> Procedure Grid_CopySelectedListItems is meant for List objects (AHA! This
54935>>>>>>>>>>>>>>>>>>>//> is the only procedure that deals with the VDF list class)
54935>>>>>>>>>>>>>>>>>>>procedure Grid_CopySelectedListItems global integer lhSourceGrid integer lhTargetGrid integer lbAllItems integer lbDeleteFromSource
54937>>>>>>>>>>>>>>>>>>> integer liMax liItem liSelect lhObj liDeleteItem
54937>>>>>>>>>>>>>>>>>>> string lsValue
54937>>>>>>>>>>>>>>>>>>> move (oGridMoveSelectedListItems(self)) to lhObj
54938>>>>>>>>>>>>>>>>>>> get item_count of lhSourceGrid to liMax
54939>>>>>>>>>>>>>>>>>>> for liItem from 0 to (liMax-1) // Copy selected items
54945>>>>>>>>>>>>>>>>>>>>
54945>>>>>>>>>>>>>>>>>>> ifnot lbAllItems get select_state of lhSourceGrid item liItem to liSelect
54948>>>>>>>>>>>>>>>>>>> if (liSelect or lbAllItems) begin
54950>>>>>>>>>>>>>>>>>>> get value of lhSourceGrid item liItem to lsValue
54951>>>>>>>>>>>>>>>>>>> send add_item to lhTargetGrid msg_none lsValue
54952>>>>>>>>>>>>>>>>>>> set value of lhObj item (item_count(lhObj)) to liItem
54953>>>>>>>>>>>>>>>>>>> end
54953>>>>>>>>>>>>>>>>>>>>
54953>>>>>>>>>>>>>>>>>>> loop
54954>>>>>>>>>>>>>>>>>>>>
54954>>>>>>>>>>>>>>>>>>> if lbAllItems send delete_data to lhSourceGrid
54957>>>>>>>>>>>>>>>>>>> else begin
54958>>>>>>>>>>>>>>>>>>> get item_count of lhObj to liMax
54959>>>>>>>>>>>>>>>>>>> for_ex liItem from (liMax-1) down_to 0 // Remove selected items
54966>>>>>>>>>>>>>>>>>>> get value of lhObj item liItem to liDeleteItem
54967>>>>>>>>>>>>>>>>>>> send delete_item to lhSourceGrid liDeleteItem
54968>>>>>>>>>>>>>>>>>>> loop
54969>>>>>>>>>>>>>>>>>>>>
54969>>>>>>>>>>>>>>>>>>> end
54969>>>>>>>>>>>>>>>>>>>>
54969>>>>>>>>>>>>>>>>>>> send delete_data to lhObj
54970>>>>>>>>>>>>>>>>>>> send sort_items to lhSourceGrid
54971>>>>>>>>>>>>>>>>>>> send sort_items to lhTargetGrid
54972>>>>>>>>>>>>>>>>>>> set dynamic_update_state of lhSourceGrid to DFTRUE
54973>>>>>>>>>>>>>>>>>>> set dynamic_update_state of lhTargetGrid to DFTRUE
54974>>>>>>>>>>>>>>>>>>>end_procedure
54975>>>>>>>>>>>>>>>>>>>
54975>>>>>>>>>>>>>>>>>>>//> Set Entry_State for all items in a Grid (that are not checkboxes)
54975>>>>>>>>>>>>>>>>>>>procedure Grid_SetEntryState global integer lhObj integer liState
54977>>>>>>>>>>>>>>>>>>> integer liItem liMax
54977>>>>>>>>>>>>>>>>>>> get item_count of lhObj to liMax
54978>>>>>>>>>>>>>>>>>>> for liItem from 0 to (liMax-1)
54984>>>>>>>>>>>>>>>>>>>>
54984>>>>>>>>>>>>>>>>>>> ifnot (checkbox_item_state(lhObj,liItem)) set entry_state of lhObj item liItem to liState
54987>>>>>>>>>>>>>>>>>>> loop
54988>>>>>>>>>>>>>>>>>>>>
54988>>>>>>>>>>>>>>>>>>>end_procedure
54989>>>>>>>>>>>>>>>>>>>
54989>>>>>>>>>>>>>>>>>>>//> Function Grid_Columns takes the object ID of a Grid or List
54989>>>>>>>>>>>>>>>>>>>//> object and returns the number of columns in that object.
54989>>>>>>>>>>>>>>>>>>>function Grid_Columns global integer lhObj returns integer
54991>>>>>>>>>>>>>>>>>>> integer liMs
54991>>>>>>>>>>>>>>>>>>> get line_size of lhObj to liMs
54992>>>>>>>>>>>>>>>>>>> function_return liMs
54993>>>>>>>>>>>>>>>>>>>end_function
54994>>>>>>>>>>>>>>>>>>>
54994>>>>>>>>>>>>>>>>>>>function Grid_CurrentColumn global integer lhObj returns integer
54996>>>>>>>>>>>>>>>>>>> integer liColumns liCurrentItem liBase
54996>>>>>>>>>>>>>>>>>>> get Grid_Columns lhObj to liColumns
54997>>>>>>>>>>>>>>>>>>> get current_item of lhObj to liCurrentItem
54998>>>>>>>>>>>>>>>>>>> move ((liCurrentItem/liColumns)*liColumns) to liBase
54999>>>>>>>>>>>>>>>>>>> function_return (liCurrentItem-liBase)
55000>>>>>>>>>>>>>>>>>>>end_function
55001>>>>>>>>>>>>>>>>>>>
55001>>>>>>>>>>>>>>>>>>>function Grid_BaseItem global integer lhObj returns integer
55003>>>>>>>>>>>>>>>>>>> integer liColumns liCurrentItem
55003>>>>>>>>>>>>>>>>>>> get Grid_Columns lhObj to liColumns
55004>>>>>>>>>>>>>>>>>>> get current_item of lhObj to liCurrentItem
55005>>>>>>>>>>>>>>>>>>> function_return ((liCurrentItem/liColumns)*liColumns)
55006>>>>>>>>>>>>>>>>>>>end_function
55007>>>>>>>>>>>>>>>>>>>
55007>>>>>>>>>>>>>>>>>>>function Grid_ItemColumn global integer lhObj integer liItem returns integer
55009>>>>>>>>>>>>>>>>>>> integer liColumns
55009>>>>>>>>>>>>>>>>>>> get Grid_Columns lhObj to liColumns
55010>>>>>>>>>>>>>>>>>>> if liItem eq -99 get current_item of lhObj to liItem
55013>>>>>>>>>>>>>>>>>>> function_return (mod(liItem,liColumns))
55014>>>>>>>>>>>>>>>>>>>end_function
55015>>>>>>>>>>>>>>>>>>>
55015>>>>>>>>>>>>>>>>>>>function Grid_ItemRow global integer lhObj integer liItem returns integer
55017>>>>>>>>>>>>>>>>>>> integer liColumns
55017>>>>>>>>>>>>>>>>>>> get Grid_Columns lhObj to liColumns
55018>>>>>>>>>>>>>>>>>>> if liItem eq -99 get current_item of lhObj to liItem
55021>>>>>>>>>>>>>>>>>>> function_return (liItem/liColumns)
55022>>>>>>>>>>>>>>>>>>>end_function
55023>>>>>>>>>>>>>>>>>>>
55023>>>>>>>>>>>>>>>>>>>function Grid_ItemBaseItem global integer lhObj integer liItem returns integer
55025>>>>>>>>>>>>>>>>>>> integer liColumns
55025>>>>>>>>>>>>>>>>>>> if liItem eq -99 get current_item of lhObj to liItem
55028>>>>>>>>>>>>>>>>>>> get Grid_Columns lhObj to liColumns
55029>>>>>>>>>>>>>>>>>>> function_return ((liItem/liColumns)*liColumns)
55030>>>>>>>>>>>>>>>>>>>end_function
55031>>>>>>>>>>>>>>>>>>>
55031>>>>>>>>>>>>>>>>>>>//> What is the number of the base item of row liRow
55031>>>>>>>>>>>>>>>>>>>function Grid_RowBaseItem global integer lhObj integer liRow returns integer
55033>>>>>>>>>>>>>>>>>>> integer liColumns
55033>>>>>>>>>>>>>>>>>>> get Grid_Columns lhObj to liColumns
55034>>>>>>>>>>>>>>>>>>> function_return (liRow*liColumns)
55035>>>>>>>>>>>>>>>>>>>end_function
55036>>>>>>>>>>>>>>>>>>>
55036>>>>>>>>>>>>>>>>>>>//> Return the number of the row that includes the current_item
55036>>>>>>>>>>>>>>>>>>>function Grid_CurrentRow global integer lhObj returns integer
55038>>>>>>>>>>>>>>>>>>> integer liCurrentItem
55038>>>>>>>>>>>>>>>>>>> get current_item of lhObj to liCurrentItem
55039>>>>>>>>>>>>>>>>>>> function_return (liCurrentItem/Grid_Columns(lhObj))
55040>>>>>>>>>>>>>>>>>>>end_function
55041>>>>>>>>>>>>>>>>>>>
55041>>>>>>>>>>>>>>>>>>>//> Return the number of rows currently in the Grid
55041>>>>>>>>>>>>>>>>>>>function Grid_RowCount global integer lhObj returns integer
55043>>>>>>>>>>>>>>>>>>> integer liColumns
55043>>>>>>>>>>>>>>>>>>> get Grid_Columns lhObj to liColumns
55044>>>>>>>>>>>>>>>>>>> function_return (item_count(lhObj)/liColumns)
55045>>>>>>>>>>>>>>>>>>>end_function
55046>>>>>>>>>>>>>>>>>>>
55046>>>>>>>>>>>>>>>>>>>procedure Grid_SwapRows global integer lhObj integer liRow1 integer liRow2
55048>>>>>>>>>>>>>>>>>>> integer liBase1 liBase2 liItem liMax
55048>>>>>>>>>>>>>>>>>>> string lsValue
55048>>>>>>>>>>>>>>>>>>> get Grid_RowBaseItem lhObj liRow1 to liBase1
55049>>>>>>>>>>>>>>>>>>> get Grid_RowBaseItem lhObj liRow2 to liBase2
55050>>>>>>>>>>>>>>>>>>> get Grid_Columns lhObj to liMax
55051>>>>>>>>>>>>>>>>>>> for liItem from 0 to (liMax-1)
55057>>>>>>>>>>>>>>>>>>>>
55057>>>>>>>>>>>>>>>>>>> // value
55057>>>>>>>>>>>>>>>>>>> get value of lhObj item (liBase1+liItem) to lsValue
55058>>>>>>>>>>>>>>>>>>> set value of lhObj item (liBase1+liItem) to (value(lhObj,liBase2+liItem))
55059>>>>>>>>>>>>>>>>>>> set value of lhObj item (liBase2+liItem) to lsValue
55060>>>>>>>>>>>>>>>>>>> // entry_state
55060>>>>>>>>>>>>>>>>>>> get entry_state of lhObj item (liBase1+liItem) to lsValue
55061>>>>>>>>>>>>>>>>>>> set entry_state of lhObj item (liBase1+liItem) to (entry_state(lhObj,liBase2+liItem))
55062>>>>>>>>>>>>>>>>>>> set entry_state of lhObj item (liBase2+liItem) to lsValue
55063>>>>>>>>>>>>>>>>>>> // color
55063>>>>>>>>>>>>>>>>>>> get itemcolor of lhObj item (liBase1+liItem) to lsValue
55064>>>>>>>>>>>>>>>>>>> set itemcolor of lhObj item (liBase1+liItem) to (itemcolor(lhObj,liBase2+liItem))
55065>>>>>>>>>>>>>>>>>>> set itemcolor of lhObj item (liBase2+liItem) to lsValue
55066>>>>>>>>>>>>>>>>>>> // checkbox_item_state
55066>>>>>>>>>>>>>>>>>>> get checkbox_item_state of lhObj item (liBase1+liItem) to lsValue
55067>>>>>>>>>>>>>>>>>>> set checkbox_item_state of lhObj item (liBase1+liItem) to (checkbox_item_state(lhObj,liBase2+liItem))
55068>>>>>>>>>>>>>>>>>>> set checkbox_item_state of lhObj item (liBase2+liItem) to lsValue
55069>>>>>>>>>>>>>>>>>>> // aux_value
55069>>>>>>>>>>>>>>>>>>> get aux_value of lhObj item (liBase1+liItem) to lsValue
55070>>>>>>>>>>>>>>>>>>> set aux_value of lhObj item (liBase1+liItem) to (aux_value(lhObj,liBase2+liItem))
55071>>>>>>>>>>>>>>>>>>> set aux_value of lhObj item (liBase2+liItem) to lsValue
55072>>>>>>>>>>>>>>>>>>> // select_state
55072>>>>>>>>>>>>>>>>>>> get select_state of lhObj item (liBase1+liItem) to lsValue
55073>>>>>>>>>>>>>>>>>>> set select_state of lhObj item (liBase1+liItem) to (select_state(lhObj,liBase2+liItem))
55074>>>>>>>>>>>>>>>>>>> set select_state of lhObj item (liBase2+liItem) to lsValue
55075>>>>>>>>>>>>>>>>>>> // What about shadow_state (and item_shadow_state)?
55075>>>>>>>>>>>>>>>>>>> loop
55076>>>>>>>>>>>>>>>>>>>>
55076>>>>>>>>>>>>>>>>>>>end_procedure
55077>>>>>>>>>>>>>>>>>>>
55077>>>>>>>>>>>>>>>>>>>function Grid_AppendRow global integer lhObj returns integer
55079>>>>>>>>>>>>>>>>>>> integer liCount liMax liRow
55079>>>>>>>>>>>>>>>>>>> set dynamic_update_state of lhObj to DFFALSE
55080>>>>>>>>>>>>>>>>>>> get Grid_RowCount lhObj to liRow
55081>>>>>>>>>>>>>>>>>>> get Grid_Columns lhObj to liMax
55082>>>>>>>>>>>>>>>>>>> decrement liMax
55083>>>>>>>>>>>>>>>>>>> for liCount from 0 to liMax
55089>>>>>>>>>>>>>>>>>>>>
55089>>>>>>>>>>>>>>>>>>> send add_item to lhObj MSG_NONE ""
55090>>>>>>>>>>>>>>>>>>> loop
55091>>>>>>>>>>>>>>>>>>>>
55091>>>>>>>>>>>>>>>>>>> set dynamic_update_state of lhObj to DFTRUE
55092>>>>>>>>>>>>>>>>>>> function_return liRow
55093>>>>>>>>>>>>>>>>>>>end_function
55094>>>>>>>>>>>>>>>>>>>
55094>>>>>>>>>>>>>>>>>>>function Grid_InsertRow global integer lhObj integer liRow returns integer
55096>>>>>>>>>>>>>>>>>>> integer liCount liMax liItem
55096>>>>>>>>>>>>>>>>>>> get Grid_RowBaseItem lhObj liRow to liItem
55097>>>>>>>>>>>>>>>>>>> set dynamic_update_state of lhObj to DFFALSE
55098>>>>>>>>>>>>>>>>>>> get Grid_Columns lhObj to liMax
55099>>>>>>>>>>>>>>>>>>> decrement liMax
55100>>>>>>>>>>>>>>>>>>> for liCount from 0 to liMax
55106>>>>>>>>>>>>>>>>>>>>
55106>>>>>>>>>>>>>>>>>>> send insert_item to lhObj MSG_NONE "" liItem
55107>>>>>>>>>>>>>>>>>>> loop
55108>>>>>>>>>>>>>>>>>>>>
55108>>>>>>>>>>>>>>>>>>> set dynamic_update_state of lhObj to DFTRUE
55109>>>>>>>>>>>>>>>>>>> function_return liRow
55110>>>>>>>>>>>>>>>>>>>end_function
55111>>>>>>>>>>>>>>>>>>>
55111>>>>>>>>>>>>>>>>>>>function Grid_InsertCurrentRow global integer lhObj returns integer
55113>>>>>>>>>>>>>>>>>>> integer liRow
55113>>>>>>>>>>>>>>>>>>> get Grid_InsertRow lhObj (Grid_CurrentRow(lhObj)) to liRow
55114>>>>>>>>>>>>>>>>>>> function_return liRow
55115>>>>>>>>>>>>>>>>>>>end_function
55116>>>>>>>>>>>>>>>>>>>
55116>>>>>>>>>>>>>>>>>>>procedure Grid_DeleteRow global integer lhObj integer liRow
55118>>>>>>>>>>>>>>>>>>> integer liBase liCount liMax
55118>>>>>>>>>>>>>>>>>>> if (item_count(lhObj)) begin
55120>>>>>>>>>>>>>>>>>>> set dynamic_update_state of lhObj to DFFALSE
55121>>>>>>>>>>>>>>>>>>> get Grid_RowBaseItem lhObj liRow to liBase
55122>>>>>>>>>>>>>>>>>>> get Grid_Columns lhObj to liMax
55123>>>>>>>>>>>>>>>>>>> decrement liMax
55124>>>>>>>>>>>>>>>>>>> for liCount from 0 to liMax
55130>>>>>>>>>>>>>>>>>>>>
55130>>>>>>>>>>>>>>>>>>> send delete_item to lhObj liBase
55131>>>>>>>>>>>>>>>>>>> loop
55132>>>>>>>>>>>>>>>>>>>>
55132>>>>>>>>>>>>>>>>>>> set dynamic_update_state of lhObj to DFTRUE
55133>>>>>>>>>>>>>>>>>>> end
55133>>>>>>>>>>>>>>>>>>>>
55133>>>>>>>>>>>>>>>>>>>end_procedure
55134>>>>>>>>>>>>>>>>>>>procedure Grid_DeleteCurrentRow global integer lhObj
55136>>>>>>>>>>>>>>>>>>> send Grid_DeleteRow lhObj (Grid_CurrentRow(lhObj))
55137>>>>>>>>>>>>>>>>>>>end_procedure
55138>>>>>>>>>>>>>>>>>>>
55138>>>>>>>>>>>>>>>>>>>procedure Grid_SwapCurrentRowUp global integer lhObj
55140>>>>>>>>>>>>>>>>>>> integer liCurrentRow liCurrentItem
55140>>>>>>>>>>>>>>>>>>> get Grid_CurrentRow lhObj to liCurrentRow
55141>>>>>>>>>>>>>>>>>>> if liCurrentRow gt 0 begin
55143>>>>>>>>>>>>>>>>>>> get Current_Item of lhObj to liCurrentItem
55144>>>>>>>>>>>>>>>>>>> send Grid_SwapRows lhObj liCurrentRow (liCurrentRow-1)
55145>>>>>>>>>>>>>>>>>>> set Current_Item of lhObj to (liCurrentItem-Grid_Columns(lhObj))
55146>>>>>>>>>>>>>>>>>>> end
55146>>>>>>>>>>>>>>>>>>>>
55146>>>>>>>>>>>>>>>>>>>end_procedure
55147>>>>>>>>>>>>>>>>>>>procedure Grid_SwapCurrentRowTop global integer lhObj
55149>>>>>>>>>>>>>>>>>>> integer liCurrentRow liCurrentItem
55149>>>>>>>>>>>>>>>>>>> repeat
55149>>>>>>>>>>>>>>>>>>>>
55149>>>>>>>>>>>>>>>>>>> get Grid_CurrentRow lhObj to liCurrentRow
55150>>>>>>>>>>>>>>>>>>> if liCurrentRow gt 0 send Grid_SwapCurrentRowUp lhObj
55153>>>>>>>>>>>>>>>>>>> until (liCurrentRow=0)
55155>>>>>>>>>>>>>>>>>>>end_procedure
55156>>>>>>>>>>>>>>>>>>>procedure Grid_SwapCurrentRowDown global integer lhObj
55158>>>>>>>>>>>>>>>>>>> integer liCurrentRow liCurrentItem
55158>>>>>>>>>>>>>>>>>>> get Grid_CurrentRow lhObj to liCurrentRow
55159>>>>>>>>>>>>>>>>>>> if liCurrentRow lt (Grid_RowCount(lhObj)-1) begin
55161>>>>>>>>>>>>>>>>>>> get Current_Item of lhObj to liCurrentItem
55162>>>>>>>>>>>>>>>>>>> send Grid_SwapRows lhObj liCurrentRow (liCurrentRow+1)
55163>>>>>>>>>>>>>>>>>>> set Current_Item of lhObj to (liCurrentItem+Grid_Columns(lhObj))
55164>>>>>>>>>>>>>>>>>>> end
55164>>>>>>>>>>>>>>>>>>>>
55164>>>>>>>>>>>>>>>>>>>end_procedure
55165>>>>>>>>>>>>>>>>>>>procedure Grid_SwapCurrentRowBottom global integer lhObj
55167>>>>>>>>>>>>>>>>>>> integer liCurrentRow liCurrentItem
55167>>>>>>>>>>>>>>>>>>> repeat
55167>>>>>>>>>>>>>>>>>>>>
55167>>>>>>>>>>>>>>>>>>> get Grid_CurrentRow lhObj to liCurrentRow
55168>>>>>>>>>>>>>>>>>>> if liCurrentRow lt (Grid_RowCount(lhObj)-1) send Grid_SwapCurrentRowDown lhObj
55171>>>>>>>>>>>>>>>>>>> until (liCurrentRow=(Grid_RowCount(lhObj)-1))
55173>>>>>>>>>>>>>>>>>>>end_procedure
55174>>>>>>>>>>>>>>>>>>>
55174>>>>>>>>>>>>>>>>>>>Use FieldInf // Global field info objects and abstract field types
55174>>>>>>>>>>>>>>>>>>>desktop_section
55179>>>>>>>>>>>>>>>>>>> object oGridPrepare is a cArray
55181>>>>>>>>>>>>>>>>>>> property integer piNextPrevious public 1
55183>>>>>>>>>>>>>>>>>>> item_property_list
55183>>>>>>>>>>>>>>>>>>> item_property string psHeaderLabel.i
55183>>>>>>>>>>>>>>>>>>> item_property integer piAbstractOrFile.i
55183>>>>>>>>>>>>>>>>>>> item_property integer piField.i
55183>>>>>>>>>>>>>>>>>>> end_item_property_list
#REM 55223 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 55228 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 55233 DEFINE FUNCTION PIABSTRACTORFILE.I INTEGER LIROW RETURNS INTEGER
#REM 55238 DEFINE PROCEDURE SET PIABSTRACTORFILE.I INTEGER LIROW INTEGER VALUE
#REM 55243 DEFINE FUNCTION PSHEADERLABEL.I INTEGER LIROW RETURNS STRING
#REM 55248 DEFINE PROCEDURE SET PSHEADERLABEL.I INTEGER LIROW STRING VALUE
55254>>>>>>>>>>>>>>>>>>> procedure add_column string lsLabel integer liAbstract integer liField
55257>>>>>>>>>>>>>>>>>>> integer liRow
55257>>>>>>>>>>>>>>>>>>> get row_count to liRow
55258>>>>>>>>>>>>>>>>>>> set psHeaderLabel.i liRow to lsLabel
55259>>>>>>>>>>>>>>>>>>> set piAbstractOrFile.i liRow to liAbstract
55260>>>>>>>>>>>>>>>>>>> set piField.i liRow to liField
55261>>>>>>>>>>>>>>>>>>> end_procedure
55262>>>>>>>>>>>>>>>>>>> procedure reset
55265>>>>>>>>>>>>>>>>>>> send delete_data
55266>>>>>>>>>>>>>>>>>>> set piNextPrevious to 1
55267>>>>>>>>>>>>>>>>>>> end_procedure
55268>>>>>>>>>>>>>>>>>>> procedure apply_settings integer lhObj integer lbDoColor
55271>>>>>>>>>>>>>>>>>>> integer liRow liMax
55271>>>>>>>>>>>>>>>>>>> get row_count to liMax
55272>>>>>>>>>>>>>>>>>>> set line_width of lhObj to liMax 0
55273>>>>>>>>>>>>>>>>>>> decrement liMax
55274>>>>>>>>>>>>>>>>>>> for liRow from 0 to liMax
55280>>>>>>>>>>>>>>>>>>>>
55280>>>>>>>>>>>>>>>>>>> set header_label of lhObj liRow to (psHeaderLabel.i(self,liRow))
55281>>>>>>>>>>>>>>>>>>> if (piField.i(self,liRow)) eq -1 begin // Then it's an Abstract
55283>>>>>>>>>>>>>>>>>>> set form_margin of lhObj liRow to (integer_value.ii(form_margin_array#,0,piAbstractOrFile.i(self,liRow)))
55284>>>>>>>>>>>>>>>>>>> set form_datatype of lhObj liRow to (integer_value.ii(form_datatype_array#,0,piAbstractOrFile.i(self,liRow)))
55285>>>>>>>>>>>>>>>>>>> end
55285>>>>>>>>>>>>>>>>>>>>
55285>>>>>>>>>>>>>>>>>>> else begin // It's a file.field
55286>>>>>>>>>>>>>>>>>>> set form_margin of lhObj liRow to (gl_effective_form_margin(piAbstractOrFile.i(self,liRow),piField.i(self,liRow)))
55287>>>>>>>>>>>>>>>>>>> set form_datatype of lhObj liRow to (gl_effective_form_datatype(piAbstractOrFile.i(self,liRow),piField.i(self,liRow)))
55288>>>>>>>>>>>>>>>>>>> end
55288>>>>>>>>>>>>>>>>>>>>
55288>>>>>>>>>>>>>>>>>>> loop
55289>>>>>>>>>>>>>>>>>>>>
55289>>>>>>>>>>>>>>>>>>> set select_mode of lhObj to no_select
55290>>>>>>>>>>>>>>>>>>> if lbDoColor begin
55292>>>>>>>>>>>>>>>>>>> set highlight_row_state of lhObj to DFTRUE
55293>>>>>>>>>>>>>>>>>>> set CurrentCellColor of lhObj to clHighlight
55294>>>>>>>>>>>>>>>>>>> set CurrentCellTextColor of lhObj to clHighlightText
55295>>>>>>>>>>>>>>>>>>> set CurrentRowColor of lhObj to clHighlight
55296>>>>>>>>>>>>>>>>>>> set CurrentRowTextColor of lhObj to clHighlightText
55297>>>>>>>>>>>>>>>>>>> end
55297>>>>>>>>>>>>>>>>>>>>
55297>>>>>>>>>>>>>>>>>>> if (piNextPrevious(self)) begin
55299>>>>>>>>>>>>>>>>>>> move self to liMax // Overload
55300>>>>>>>>>>>>>>>>>>> move lhObj to self
55301>>>>>>>>>>>>>>>>>>> on_key knext_item send switch
55302>>>>>>>>>>>>>>>>>>> on_key kprevious_item send switch_back
55303>>>>>>>>>>>>>>>>>>> move liMax to self
55304>>>>>>>>>>>>>>>>>>> end
55304>>>>>>>>>>>>>>>>>>>>
55304>>>>>>>>>>>>>>>>>>> end_procedure
55305>>>>>>>>>>>>>>>>>>> end_object // oGridPrepare
55306>>>>>>>>>>>>>>>>>>> procedure GridPrepare_Reset global
55308>>>>>>>>>>>>>>>>>>> send reset to (oGridPrepare(self))
55309>>>>>>>>>>>>>>>>>>> end_procedure
55310>>>>>>>>>>>>>>>>>>> procedure GridPrepare_AddCheckBoxColumn global string lsHeader
55312>>>>>>>>>>>>>>>>>>> string lsTmp
55312>>>>>>>>>>>>>>>>>>> if num_arguments gt 0 move lsHeader to lsTmp
55315>>>>>>>>>>>>>>>>>>> else move "" to lsTmp
55317>>>>>>>>>>>>>>>>>>> send add_column to (oGridPrepare(self)) lsTmp AFT_ASCII3 -1
55318>>>>>>>>>>>>>>>>>>> end_procedure
55319>>>>>>>>>>>>>>>>>>> procedure GridPrepare_AddColumn global string lsLabel integer liAbstract
55321>>>>>>>>>>>>>>>>>>> send add_column to (oGridPrepare(self)) lsLabel liAbstract -1
55322>>>>>>>>>>>>>>>>>>> end_procedure
55323>>>>>>>>>>>>>>>>>>> procedure GridPrepare_AddColumnFileField global string lsLabel integer liFile integer liField
55325>>>>>>>>>>>>>>>>>>> send add_column to (oGridPrepare(self)) lsLabel liFile liField
55326>>>>>>>>>>>>>>>>>>> end_procedure
55327>>>>>>>>>>>>>>>>>>> procedure GridPrepare_Apply global integer lhObj integer lbDoColor
55329>>>>>>>>>>>>>>>>>>> integer liTemp
55329>>>>>>>>>>>>>>>>>>> if num_arguments gt 1 move lbDoColor to liTemp
55332>>>>>>>>>>>>>>>>>>> else move 1 to liTemp
55334>>>>>>>>>>>>>>>>>>> send apply_settings to (oGridPrepare(self)) lhObj liTemp
55335>>>>>>>>>>>>>>>>>>> send GridPrepare_Reset
55336>>>>>>>>>>>>>>>>>>> end_procedure
55337>>>>>>>>>>>>>>>>>>>end_desktop_section
55342>>>>>>>>>>>>>>>>>>>
55342>>>>>>>>>>>>>>>>>>>desktop_section
55347>>>>>>>>>>>>>>>>>>> // Here is a temporary array used for storing different values while
55347>>>>>>>>>>>>>>>>>>> // a grid is being sorted.
55347>>>>>>>>>>>>>>>>>>> object oSortGrid_Data is a cArray NO_IMAGE
55349>>>>>>>>>>>>>>>>>>> property integer piCurrentGridID public 0 // Not used
55351>>>>>>>>>>>>>>>>>>> property integer piCurrentRow public 0
55353>>>>>>>>>>>>>>>>>>> property integer piCurrentColumn public 0
55355>>>>>>>>>>>>>>>>>>> object oSortedData is a cArray NO_IMAGE
55357>>>>>>>>>>>>>>>>>>> end_object
55358>>>>>>>>>>>>>>>>>>> object oAuxValues is a cArray NO_IMAGE
55360>>>>>>>>>>>>>>>>>>> end_object
55361>>>>>>>>>>>>>>>>>>> object oEntryStates is a cArray NO_IMAGE
55363>>>>>>>>>>>>>>>>>>> end_object
55364>>>>>>>>>>>>>>>>>>> object oSelectStates is a cArray NO_IMAGE
55366>>>>>>>>>>>>>>>>>>> end_object
55367>>>>>>>>>>>>>>>>>>> object oItemColors is a cArray NO_IMAGE
55369>>>>>>>>>>>>>>>>>>> end_object
55370>>>>>>>>>>>>>>>>>>> object oCheckboxItemStates is a cArray NO_IMAGE
55372>>>>>>>>>>>>>>>>>>> end_object
55373>>>>>>>>>>>>>>>>>>> // Get data out of the grid to this structure
55373>>>>>>>>>>>>>>>>>>> procedure reset
55376>>>>>>>>>>>>>>>>>>> send delete_data
55377>>>>>>>>>>>>>>>>>>> send delete_data to (oAuxValues(self))
55378>>>>>>>>>>>>>>>>>>> send delete_data to (oSortedData(self))
55379>>>>>>>>>>>>>>>>>>> send delete_data to (oEntryStates(self))
55380>>>>>>>>>>>>>>>>>>> send delete_data to (oSelectStates(self))
55381>>>>>>>>>>>>>>>>>>> send delete_data to (oCheckboxItemStates(self))
55382>>>>>>>>>>>>>>>>>>> //send delete_data to (oMessages(self))
55382>>>>>>>>>>>>>>>>>>> send delete_data to (oItemColors(self))
55383>>>>>>>>>>>>>>>>>>> set piCurrentGridID to 0
55384>>>>>>>>>>>>>>>>>>> set piCurrentRow to 0
55385>>>>>>>>>>>>>>>>>>> set piCurrentColumn to 0
55386>>>>>>>>>>>>>>>>>>> end_procedure
55387>>>>>>>>>>>>>>>>>>> // Get data from grid
55387>>>>>>>>>>>>>>>>>>> procedure load_grid_data integer lhGrid
55390>>>>>>>>>>>>>>>>>>> integer liMax liItem lhAuxValues lhEntryStates liCurrentItem liColumns
55390>>>>>>>>>>>>>>>>>>> integer lhSelectStates lhCheckboxItemStates lhItemColors
55390>>>>>>>>>>>>>>>>>>> move (oAuxValues(self)) to lhAuxValues
55391>>>>>>>>>>>>>>>>>>> move (oEntryStates(self)) to lhEntryStates
55392>>>>>>>>>>>>>>>>>>> move (oSelectStates(self)) to lhSelectStates
55393>>>>>>>>>>>>>>>>>>> move (oCheckboxItemStates(self)) to lhCheckboxItemStates
55394>>>>>>>>>>>>>>>>>>> move (oItemColors(self)) to lhItemColors
55395>>>>>>>>>>>>>>>>>>> send delete_data
55396>>>>>>>>>>>>>>>>>>> send delete_data to lhAuxValues
55397>>>>>>>>>>>>>>>>>>> send delete_data to lhEntryStates
55398>>>>>>>>>>>>>>>>>>> send delete_data to lhSelectStates
55399>>>>>>>>>>>>>>>>>>> send delete_data to lhCheckboxItemStates
55400>>>>>>>>>>>>>>>>>>> send delete_data to lhItemColors
55401>>>>>>>>>>>>>>>>>>> set piCurrentGridID to lhGrid
55402>>>>>>>>>>>>>>>>>>> get item_count of lhGrid to liMax
55403>>>>>>>>>>>>>>>>>>> for liItem from 0 to (liMax-1)
55409>>>>>>>>>>>>>>>>>>>>
55409>>>>>>>>>>>>>>>>>>> set value item liItem to (value(lhGrid,liItem))
55410>>>>>>>>>>>>>>>>>>> set value of lhAuxValues item liItem to (aux_value(lhGrid,liItem))
55411>>>>>>>>>>>>>>>>>>> set value of lhEntryStates item liItem to (entry_state(lhGrid,liItem))
55412>>>>>>>>>>>>>>>>>>> set value of lhSelectStates item liItem to (select_state(lhGrid,liItem))
55413>>>>>>>>>>>>>>>>>>> set value of lhCheckboxItemStates item liItem to (checkbox_item_state(lhGrid,liItem))
55414>>>>>>>>>>>>>>>>>>> set value of lhItemColors item liItem to (ItemColor(lhGrid,liItem))
55415>>>>>>>>>>>>>>>>>>> loop
55416>>>>>>>>>>>>>>>>>>>>
55416>>>>>>>>>>>>>>>>>>> get current_item of lhGrid to liCurrentItem
55417>>>>>>>>>>>>>>>>>>> get Grid_Columns lhGrid to liColumns
55418>>>>>>>>>>>>>>>>>>> set piCurrentRow to (liCurrentItem/liColumns)
55419>>>>>>>>>>>>>>>>>>> set piCurrentColumn to (liCurrentItem-(liColumns*piCurrentRow(self)))
55420>>>>>>>>>>>>>>>>>>> end_procedure
55421>>>>>>>>>>>>>>>>>>>
55421>>>>>>>>>>>>>>>>>>> register_function iSpecialSortValueOnColumn.i integer liColumn returns integer
55421>>>>>>>>>>>>>>>>>>> register_function sSortValue.ii integer liColumn integer liItem returns string
55421>>>>>>>>>>>>>>>>>>> procedure sort_data integer lhGrid integer liColumn integer liDir
55424>>>>>>>>>>>>>>>>>>> integer lhSortArr liRow liMax liColumns liItem liState lbCustom
55424>>>>>>>>>>>>>>>>>>> string lsValue
55424>>>>>>>>>>>>>>>>>>> move (oSortedData(self)) to lhSortArr
55425>>>>>>>>>>>>>>>>>>> send delete_data to lhSortArr
55426>>>>>>>>>>>>>>>>>>> get Grid_Columns lhGrid to liColumns
55427>>>>>>>>>>>>>>>>>>> get item_count of lhGrid to liMax
55428>>>>>>>>>>>>>>>>>>> get delegation_mode of lhGrid to liState
55429>>>>>>>>>>>>>>>>>>> set delegation_mode of lhGrid to NO_DELEGATE_OR_ERROR
55430>>>>>>>>>>>>>>>>>>> get iSpecialSortValueOnColumn.i of lhGrid liColumn to lbCustom
55431>>>>>>>>>>>>>>>>>>> set delegation_mode of lhGrid to liState
55432>>>>>>>>>>>>>>>>>>> move (liMax/liColumns) to liMax // Number of rows
55433>>>>>>>>>>>>>>>>>>> for liRow from 0 to (liMax-1)
55439>>>>>>>>>>>>>>>>>>>>
55439>>>>>>>>>>>>>>>>>>> move (liRow*liColumns+liColumn) to liItem
55440>>>>>>>>>>>>>>>>>>> if lbCustom get sSortValue.ii of lhGrid liColumn liItem to lsValue
55443>>>>>>>>>>>>>>>>>>> else get value of lhGrid item liItem to lsValue
55445>>>>>>>>>>>>>>>>>>> move (lsValue+IntToStrR(liRow,6)) to lsValue
55446>>>>>>>>>>>>>>>>>>> set value of lhSortArr item liRow to lsValue
55447>>>>>>>>>>>>>>>>>>> loop
55448>>>>>>>>>>>>>>>>>>>>
55448>>>>>>>>>>>>>>>>>>> send sort_items to lhSortArr liDir //ASCENDING
55449>>>>>>>>>>>>>>>>>>> end_procedure
55450>>>>>>>>>>>>>>>>>>> procedure fill_grid integer lhGrid
55453>>>>>>>>>>>>>>>>>>> integer lhSortArr liRow liMax liItem liColumns liItmMin liItmMax liCurrentRow
55453>>>>>>>>>>>>>>>>>>> integer grid_liRow
55453>>>>>>>>>>>>>>>>>>> integer lhEntryStates lhAuxValues grid_liItem
55453>>>>>>>>>>>>>>>>>>> integer lhSelectStates lhCheckboxItemStates lhItemColors
55453>>>>>>>>>>>>>>>>>>> move (oSortedData(self)) to lhSortArr
55454>>>>>>>>>>>>>>>>>>> move (oAuxValues(self)) to lhAuxValues
55455>>>>>>>>>>>>>>>>>>> move (oEntryStates(self)) to lhEntryStates
55456>>>>>>>>>>>>>>>>>>> move (oSelectStates(self)) to lhSelectStates
55457>>>>>>>>>>>>>>>>>>> move (oCheckboxItemStates(self)) to lhCheckboxItemStates
55458>>>>>>>>>>>>>>>>>>> move (oItemColors(self)) to lhItemColors
55459>>>>>>>>>>>>>>>>>>> send delete_data to lhGrid
55460>>>>>>>>>>>>>>>>>>> get Grid_Columns lhGrid to liColumns
55461>>>>>>>>>>>>>>>>>>> get item_count of lhSortArr to liMax
55462>>>>>>>>>>>>>>>>>>> get piCurrentRow to liCurrentRow
55463>>>>>>>>>>>>>>>>>>> move 0 to grid_liItem
55464>>>>>>>>>>>>>>>>>>> for liRow from 0 to (liMax-1)
55470>>>>>>>>>>>>>>>>>>>>
55470>>>>>>>>>>>>>>>>>>> move (right(value(lhSortArr,liRow),6)) to grid_liRow
55471>>>>>>>>>>>>>>>>>>> if grid_liRow eq liCurrentRow set piCurrentRow to liRow
55474>>>>>>>>>>>>>>>>>>> move (grid_liRow*liColumns) to liItmMin
55475>>>>>>>>>>>>>>>>>>> move (liItmMin+liColumns-1) to liItmMax
55476>>>>>>>>>>>>>>>>>>> for liItem from liItmMin to liItmMax
55482>>>>>>>>>>>>>>>>>>>>
55482>>>>>>>>>>>>>>>>>>> send add_item to lhGrid msg_none (value(self,liItem))
55483>>>>>>>>>>>>>>>>>>> set checkbox_item_state of lhGrid item grid_liItem to (value(lhCheckboxItemStates,liItem))
55484>>>>>>>>>>>>>>>>>>> set select_state of lhGrid item grid_liItem to (value(lhSelectStates,liItem))
55485>>>>>>>>>>>>>>>>>>> set aux_value of lhGrid item grid_liItem to (value(lhAuxValues,liItem))
55486>>>>>>>>>>>>>>>>>>> set entry_state of lhGrid item grid_liItem to (value(lhEntryStates,liItem))
55487>>>>>>>>>>>>>>>>>>> set itemcolor of lhGrid item grid_liItem to (value(lhItemColors,liItem))
55488>>>>>>>>>>>>>>>>>>> increment grid_liItem
55489>>>>>>>>>>>>>>>>>>> loop
55490>>>>>>>>>>>>>>>>>>>>
55490>>>>>>>>>>>>>>>>>>> loop
55491>>>>>>>>>>>>>>>>>>>>
55491>>>>>>>>>>>>>>>>>>> end_procedure
55492>>>>>>>>>>>>>>>>>>> procedure Sort_Grid integer lhGrid integer liColumn integer liDir
55495>>>>>>>>>>>>>>>>>>> integer liCurrentRow liCurrentColumn liColumns
55495>>>>>>>>>>>>>>>>>>> send cursor_wait to (cursor_control(self))
55496>>>>>>>>>>>>>>>>>>> set dynamic_update_state of lhGrid to DFFALSE
55497>>>>>>>>>>>>>>>>>>> send reset
55498>>>>>>>>>>>>>>>>>>> send load_grid_data lhGrid
55499>>>>>>>>>>>>>>>>>>> send sort_data lhGrid liColumn liDir
55500>>>>>>>>>>>>>>>>>>> send fill_grid lhGrid
55501>>>>>>>>>>>>>>>>>>> set dynamic_update_state of lhGrid to DFTRUE
55502>>>>>>>>>>>>>>>>>>> get piCurrentRow to liCurrentRow
55503>>>>>>>>>>>>>>>>>>> get piCurrentColumn to liCurrentColumn
55504>>>>>>>>>>>>>>>>>>> get Grid_Columns lhGrid to liColumns
55505>>>>>>>>>>>>>>>>>>> set current_item of lhGrid to (liColumns*liCurrentRow+liCurrentColumn)
55506>>>>>>>>>>>>>>>>>>> send reset // Clean it up
55507>>>>>>>>>>>>>>>>>>> send cursor_ready to (cursor_control(self))
55508>>>>>>>>>>>>>>>>>>> end_procedure
55509>>>>>>>>>>>>>>>>>>> end_object // oSortGrid_Data
55510>>>>>>>>>>>>>>>>>>>end_desktop_section
55515>>>>>>>>>>>>>>>>>>>
55515>>>>>>>>>>>>>>>>>>>//> Sort grid ascending by column liColumn. Note that unless special
55515>>>>>>>>>>>>>>>>>>>//> sort value functions are set up all columns are sorted by their
55515>>>>>>>>>>>>>>>>>>>//> ASCII value (not what the user expects if the column contains numeric
55515>>>>>>>>>>>>>>>>>>>//> or date data).
55515>>>>>>>>>>>>>>>>>>>procedure Grid_SortByColumn global integer lhGrid integer liColumn
55517>>>>>>>>>>>>>>>>>>> send Sort_Grid to (oSortGrid_Data(self)) lhGrid liColumn ASCENDING
55518>>>>>>>>>>>>>>>>>>>end_procedure
55519>>>>>>>>>>>>>>>>>>>
55519>>>>>>>>>>>>>>>>>>>//> Sort grid descending by column liColumn. Note that unless special
55519>>>>>>>>>>>>>>>>>>>//> sort value functions are set up all columns are sorted by their
55519>>>>>>>>>>>>>>>>>>>//> ASCII value (not what the user expects if the column contains numeric
55519>>>>>>>>>>>>>>>>>>>//> or date data).
55519>>>>>>>>>>>>>>>>>>>procedure Grid_SortByColumn_Descending global integer lhGrid integer liColumn
55521>>>>>>>>>>>>>>>>>>> send Sort_Grid to (oSortGrid_Data(self)) lhGrid liColumn DESCENDING
55522>>>>>>>>>>>>>>>>>>>end_procedure
55523>>>>>>>>>>>>>>>>>>>
55523>>>>>>>>>>>>>>>>>>>procedure Grid_AddCheckBoxItem global integer lhGrid integer liState
55525>>>>>>>>>>>>>>>>>>> integer liItm
55525>>>>>>>>>>>>>>>>>>> get item_count of lhGrid to liItm
55526>>>>>>>>>>>>>>>>>>> send add_item to lhGrid msg_none ""
55527>>>>>>>>>>>>>>>>>>> set checkbox_item_state of lhGrid item liItm to DFTRUE
55528>>>>>>>>>>>>>>>>>>> set select_state of lhGrid item liItm to liState
55529>>>>>>>>>>>>>>>>>>>end_procedure
55530>>>>>>>>>>>>>>>>>>>procedure Grid_RowMakeSelectable global integer lhGrid
55532>>>>>>>>>>>>>>>>>>>end_procedure
55533>>>>>>>>>>>>>>>>>>>procedure Grid_RowSelectAll global integer lhGrid
55535>>>>>>>>>>>>>>>>>>> integer liRow liMax liBase
55535>>>>>>>>>>>>>>>>>>> get Grid_RowCount lhGrid to liMax
55536>>>>>>>>>>>>>>>>>>> decrement liMax
55537>>>>>>>>>>>>>>>>>>> for liRow from 0 to liMax
55543>>>>>>>>>>>>>>>>>>>>
55543>>>>>>>>>>>>>>>>>>> get Grid_RowBaseItem lhGrid liRow to liBase
55544>>>>>>>>>>>>>>>>>>> ifnot (item_shadow_state(lhGrid,liBase)) set select_state of lhGrid item liBase to DFTRUE
55547>>>>>>>>>>>>>>>>>>> loop
55548>>>>>>>>>>>>>>>>>>>>
55548>>>>>>>>>>>>>>>>>>>end_procedure
55549>>>>>>>>>>>>>>>>>>>procedure Grid_RowDeselectAll global integer lhGrid
55551>>>>>>>>>>>>>>>>>>> integer liRow liMax liBase
55551>>>>>>>>>>>>>>>>>>> get Grid_RowCount lhGrid to liMax
55552>>>>>>>>>>>>>>>>>>> decrement liMax
55553>>>>>>>>>>>>>>>>>>> for liRow from 0 to liMax
55559>>>>>>>>>>>>>>>>>>>>
55559>>>>>>>>>>>>>>>>>>> get Grid_RowBaseItem lhGrid liRow to liBase
55560>>>>>>>>>>>>>>>>>>> ifnot (item_shadow_state(lhGrid,liBase)) set select_state of lhGrid item liBase to DFFALSE
55563>>>>>>>>>>>>>>>>>>> loop
55564>>>>>>>>>>>>>>>>>>>>
55564>>>>>>>>>>>>>>>>>>>end_procedure
55565>>>>>>>>>>>>>>>>>>>procedure Grid_RowSelectInvert global integer lhGrid
55567>>>>>>>>>>>>>>>>>>> integer liRow liMax liSelect liBase
55567>>>>>>>>>>>>>>>>>>> get Grid_RowCount lhGrid to liMax
55568>>>>>>>>>>>>>>>>>>> decrement liMax
55569>>>>>>>>>>>>>>>>>>> for liRow from 0 to liMax
55575>>>>>>>>>>>>>>>>>>>>
55575>>>>>>>>>>>>>>>>>>> get Grid_RowBaseItem lhGrid liRow to liBase
55576>>>>>>>>>>>>>>>>>>> get select_state of lhGrid item liBase to liSelect
55577>>>>>>>>>>>>>>>>>>> ifnot (item_shadow_state(lhGrid,liBase)) set select_state of lhGrid item liBase to (not(liSelect))
55580>>>>>>>>>>>>>>>>>>> loop
55581>>>>>>>>>>>>>>>>>>>>
55581>>>>>>>>>>>>>>>>>>>end_procedure
55582>>>>>>>>>>>>>>>>>>>procedure Grid_RowSelectCostum global integer lhGrid integer liGet
55584>>>>>>>>>>>>>>>>>>> integer liRow liMax liSelect liBase
55584>>>>>>>>>>>>>>>>>>> get Grid_RowCount lhGrid to liMax
55585>>>>>>>>>>>>>>>>>>> decrement liMax
55586>>>>>>>>>>>>>>>>>>> for liRow from 0 to liMax
55592>>>>>>>>>>>>>>>>>>>>
55592>>>>>>>>>>>>>>>>>>> move (Grid_RowBaseItem(lhGrid,liRow)) to liBase
55593>>>>>>>>>>>>>>>>>>> get liGet of lhGrid liRow liBase to liSelect
55594>>>>>>>>>>>>>>>>>>> set select_state of lhGrid item liBase to liSelect
55595>>>>>>>>>>>>>>>>>>> loop
55596>>>>>>>>>>>>>>>>>>>>
55596>>>>>>>>>>>>>>>>>>>end_procedure
55597>>>>>>>>>>>>>>>>>>>procedure Grid_RowCallBackSelected global integer lhGrid integer liMsg integer lhObj
55599>>>>>>>>>>>>>>>>>>> integer liRow liMax liBase liSelect lhTmpObj
55599>>>>>>>>>>>>>>>>>>> if (num_arguments>2) move lhObj to lhTmpObj
55602>>>>>>>>>>>>>>>>>>> else move lhGrid to lhTmpObj
55604>>>>>>>>>>>>>>>>>>> get Grid_RowCount lhGrid to liMax
55605>>>>>>>>>>>>>>>>>>> decrement liMax
55606>>>>>>>>>>>>>>>>>>> for liRow from 0 to liMax
55612>>>>>>>>>>>>>>>>>>>>
55612>>>>>>>>>>>>>>>>>>> move (Grid_RowBaseItem(lhGrid,liRow)) to liBase
55613>>>>>>>>>>>>>>>>>>> get select_state of lhGrid item liBase to liSelect
55614>>>>>>>>>>>>>>>>>>> if liSelect send liMsg to lhTmpObj liRow liBase
55617>>>>>>>>>>>>>>>>>>> loop
55618>>>>>>>>>>>>>>>>>>>>
55618>>>>>>>>>>>>>>>>>>>end_procedure
55619>>>>>>>>>>>>>>>>>>>
55619>>>>>>>>>>>>>>>>>>>procedure Grid_RowCallBackAll global integer lhGrid integer liMsg integer lhObj
55621>>>>>>>>>>>>>>>>>>> integer liRow liMax liBase lhTmpObj
55621>>>>>>>>>>>>>>>>>>> if (num_arguments>2) move lhObj to lhTmpObj
55624>>>>>>>>>>>>>>>>>>> else move lhGrid to lhTmpObj
55626>>>>>>>>>>>>>>>>>>> get Grid_RowCount lhGrid to liMax
55627>>>>>>>>>>>>>>>>>>> decrement liMax
55628>>>>>>>>>>>>>>>>>>> for liRow from 0 to liMax
55634>>>>>>>>>>>>>>>>>>>>
55634>>>>>>>>>>>>>>>>>>> move (Grid_RowBaseItem(lhGrid,liRow)) to liBase
55635>>>>>>>>>>>>>>>>>>> send liMsg to lhTmpObj liRow liBase
55636>>>>>>>>>>>>>>>>>>> loop
55637>>>>>>>>>>>>>>>>>>>>
55637>>>>>>>>>>>>>>>>>>>end_procedure
55638>>>>>>>>>>>>>>>>>>>
55638>>>>>>>>>>>>>>>>>>>//> Returns number of selected rows
55638>>>>>>>>>>>>>>>>>>>function Grid_SelectedRows global integer lhGrid returns integer
55640>>>>>>>>>>>>>>>>>>> integer liRow liMax liBase liSelect liRval
55640>>>>>>>>>>>>>>>>>>> move 0 to liRval
55641>>>>>>>>>>>>>>>>>>> get Grid_RowCount lhGrid to liMax
55642>>>>>>>>>>>>>>>>>>> decrement liMax
55643>>>>>>>>>>>>>>>>>>> for liRow from 0 to liMax
55649>>>>>>>>>>>>>>>>>>>>
55649>>>>>>>>>>>>>>>>>>> move (Grid_RowBaseItem(lhGrid,liRow)) to liBase
55650>>>>>>>>>>>>>>>>>>> get select_state of lhGrid item liBase to liSelect
55651>>>>>>>>>>>>>>>>>>> if liSelect increment liRval
55654>>>>>>>>>>>>>>>>>>> loop
55655>>>>>>>>>>>>>>>>>>>>
55655>>>>>>>>>>>>>>>>>>> function_return liRval
55656>>>>>>>>>>>>>>>>>>>end_function
55657>>>>>>>>>>>>>>>>>>>
55657>>>>>>>>>>>>>>>>>>>procedure Set Grid_CurrentRow global integer lhGrid integer liRow
55659>>>>>>>>>>>>>>>>>>> integer liBase
55659>>>>>>>>>>>>>>>>>>> get Grid_RowBaseItem lhGrid liRow to liBase
55660>>>>>>>>>>>>>>>>>>> set current_item to liBase
55661>>>>>>>>>>>>>>>>>>>end_procedure
55662>>>>>>>>>>>>>>>>>>>
55662>>>>>>>>>>>>>>>>>>>enumeration_list
55662>>>>>>>>>>>>>>>>>>> define GD_FORMAT
55662>>>>>>>>>>>>>>>>>>> define GD_COMMA
55662>>>>>>>>>>>>>>>>>>> define GD_TAB
55662>>>>>>>>>>>>>>>>>>>end_enumeration_list
55662>>>>>>>>>>>>>>>>>>>
55662>>>>>>>>>>>>>>>>>>>desktop_section
55667>>>>>>>>>>>>>>>>>>> object Grid_WriteToFileColumnWidthArray is a cArray
55669>>>>>>>>>>>>>>>>>>> property integer phCurrentGrid public ""
55671>>>>>>>>>>>>>>>>>>> item_property_list
55671>>>>>>>>>>>>>>>>>>> item_property integer piWidth.i
55671>>>>>>>>>>>>>>>>>>> item_property integer piRightAlign.i
55671>>>>>>>>>>>>>>>>>>> end_item_property_list
#REM 55708 DEFINE FUNCTION PIRIGHTALIGN.I INTEGER LIROW RETURNS INTEGER
#REM 55713 DEFINE PROCEDURE SET PIRIGHTALIGN.I INTEGER LIROW INTEGER VALUE
#REM 55718 DEFINE FUNCTION PIWIDTH.I INTEGER LIROW RETURNS INTEGER
#REM 55723 DEFINE PROCEDURE SET PIWIDTH.I INTEGER LIROW INTEGER VALUE
55729>>>>>>>>>>>>>>>>>>> procedure DoReadGrid integer lhGrid
55732>>>>>>>>>>>>>>>>>>> integer liRows liColumns liRow liColumn liWidth liDecSep
55732>>>>>>>>>>>>>>>>>>> string lsValue
55732>>>>>>>>>>>>>>>>>>> get_attribute DF_DECIMAL_SEPARATOR to liDecSep
55735>>>>>>>>>>>>>>>>>>> send delete_data
55736>>>>>>>>>>>>>>>>>>> get Grid_Columns lhGrid to liColumns
55737>>>>>>>>>>>>>>>>>>> get Grid_RowCount lhGrid to liRows
55738>>>>>>>>>>>>>>>>>>> for liColumn from 0 to (liColumns-1)
55744>>>>>>>>>>>>>>>>>>>>
55744>>>>>>>>>>>>>>>>>>> set piRightAlign.i liColumn to DFTRUE
55745>>>>>>>>>>>>>>>>>>> loop
55746>>>>>>>>>>>>>>>>>>>>
55746>>>>>>>>>>>>>>>>>>> for liRow from 0 to (liRows-1)
55752>>>>>>>>>>>>>>>>>>>>
55752>>>>>>>>>>>>>>>>>>> for liColumn from 0 to (liColumns-1)
55758>>>>>>>>>>>>>>>>>>>>
55758>>>>>>>>>>>>>>>>>>> if (checkbox_item_state(lhGrid,liRow*liColumns+liColumn)) move "XXX" to lsValue
55761>>>>>>>>>>>>>>>>>>> else get value of lhGrid item (liRow*liColumns+liColumn) to lsValue
55763>>>>>>>>>>>>>>>>>>> move (rtrim(lsValue)) to lsValue
55764>>>>>>>>>>>>>>>>>>> move (length(lsValue)) to liWidth
55765>>>>>>>>>>>>>>>>>>> if (liWidth>integer(piWidth.i(self,liColumn))) set piWidth.i liColumn to liWidth
55768>>>>>>>>>>>>>>>>>>> ifnot (StringIsNumber(lsValue,liDecSep)) set piRightAlign.i liColumn to DFFALSE
55771>>>>>>>>>>>>>>>>>>> loop
55772>>>>>>>>>>>>>>>>>>>>
55772>>>>>>>>>>>>>>>>>>> loop
55773>>>>>>>>>>>>>>>>>>>>
55773>>>>>>>>>>>>>>>>>>> set phCurrentGrid to liWidth
55774>>>>>>>>>>>>>>>>>>> end_procedure
55775>>>>>>>>>>>>>>>>>>> end_object
55776>>>>>>>>>>>>>>>>>>>end_desktop_section
55781>>>>>>>>>>>>>>>>>>>
55781>>>>>>>>>>>>>>>>>>>function Grid_DataWidth global integer lhGrid integer liColumn returns integer
55783>>>>>>>>>>>>>>>>>>> function_return (piWidth.i(Grid_WriteToFileColumnWidthArray(self),liColumn))
55784>>>>>>>>>>>>>>>>>>>end_function
55785>>>>>>>>>>>>>>>>>>>
55785>>>>>>>>>>>>>>>>>>>procedure Grid_DoReadDataWidth global integer lhGrid
55787>>>>>>>>>>>>>>>>>>> send DoReadGrid to (Grid_WriteToFileColumnWidthArray(self)) lhGrid
55788>>>>>>>>>>>>>>>>>>>end_procedure
55789>>>>>>>>>>>>>>>>>>>
55789>>>>>>>>>>>>>>>>>>>function Grid_WriteToFile_Help global integer liFormat string lsValue integer liWidth integer liRightAlign returns string
55791>>>>>>>>>>>>>>>>>>> if (liFormat=GD_FORMAT) begin
55793>>>>>>>>>>>>>>>>>>> if (length(lsValue)>liWidth) move (left(lsValue,liWidth)) to lsValue
55796>>>>>>>>>>>>>>>>>>> if liRightAlign move (RightShift(lsValue,liWidth)) to lsValue
55799>>>>>>>>>>>>>>>>>>> else move (pad(lsValue,liWidth)) to lsValue
55801>>>>>>>>>>>>>>>>>>> end
55801>>>>>>>>>>>>>>>>>>>>
55801>>>>>>>>>>>>>>>>>>> if (liFormat=GD_COMMA) begin
55803>>>>>>>>>>>>>>>>>>> if "," in lsValue begin
55805>>>>>>>>>>>>>>>>>>> move (replaces('"',lsValue,"'")) to lsValue
55806>>>>>>>>>>>>>>>>>>> move ('"'+lsValue+'"') to lsValue
55807>>>>>>>>>>>>>>>>>>> end
55807>>>>>>>>>>>>>>>>>>>>
55807>>>>>>>>>>>>>>>>>>> end
55807>>>>>>>>>>>>>>>>>>>>
55807>>>>>>>>>>>>>>>>>>> function_return lsValue
55808>>>>>>>>>>>>>>>>>>>end_function
55809>>>>>>>>>>>>>>>>>>>
55809>>>>>>>>>>>>>>>>>>>// This procedure will write the entire contents of the Grid passed as
55809>>>>>>>>>>>>>>>>>>>// object handle object to a
55809>>>>>>>>>>>>>>>>>>>// sequential
55809>>>>>>>>>>>>>>>>>>>procedure Grid_WriteToFile global integer lhGrid integer liChannel integer liFormat
55811>>>>>>>>>>>>>>>>>>> integer liRows liColumns liRow liColumn liWidth liRightAlign
55811>>>>>>>>>>>>>>>>>>> string lsValue
55811>>>>>>>>>>>>>>>>>>> get Grid_Columns lhGrid to liColumns
55812>>>>>>>>>>>>>>>>>>> get Grid_RowCount lhGrid to liRows
55813>>>>>>>>>>>>>>>>>>> send Grid_DoReadDataWidth lhGrid
55814>>>>>>>>>>>>>>>>>>> for liColumn from 0 to (liColumns-1)
55820>>>>>>>>>>>>>>>>>>>>
55820>>>>>>>>>>>>>>>>>>> get header_label of lhGrid liColumn to lsValue
55821>>>>>>>>>>>>>>>>>>> get Grid_DataWidth lhGrid liColumn to liWidth
55822>>>>>>>>>>>>>>>>>>> get piRightAlign.i of (Grid_WriteToFileColumnWidthArray(self)) liColumn to liRightAlign
55823>>>>>>>>>>>>>>>>>>> get Grid_WriteToFile_Help liFormat lsValue liWidth liRightAlign to lsValue
55824>>>>>>>>>>>>>>>>>>> write channel liChannel (ToAnsi(lsValue))
55826>>>>>>>>>>>>>>>>>>> if liColumn ne (liColumns-1) begin
55828>>>>>>>>>>>>>>>>>>> if (liFormat=GD_FORMAT) write " "
55831>>>>>>>>>>>>>>>>>>> if (liFormat=GD_COMMA ) write ","
55834>>>>>>>>>>>>>>>>>>> if (liFormat=GD_TAB ) write (character(8))
55837>>>>>>>>>>>>>>>>>>> end
55837>>>>>>>>>>>>>>>>>>>>
55837>>>>>>>>>>>>>>>>>>> loop
55838>>>>>>>>>>>>>>>>>>>>
55838>>>>>>>>>>>>>>>>>>> writeln channel liChannel ""
55841>>>>>>>>>>>>>>>>>>> for liRow from 0 to (liRows-1)
55847>>>>>>>>>>>>>>>>>>>>
55847>>>>>>>>>>>>>>>>>>> for liColumn from 0 to (liColumns-1)
55853>>>>>>>>>>>>>>>>>>>>
55853>>>>>>>>>>>>>>>>>>> if (checkbox_item_state(lhGrid,liRow*liColumns+liColumn)) get select_state of lhGrid item (liRow*liColumns+liColumn) to lsValue
55856>>>>>>>>>>>>>>>>>>> else get value of lhGrid item (liRow*liColumns+liColumn) to lsValue
55858>>>>>>>>>>>>>>>>>>> get Grid_DataWidth lhGrid liColumn to liWidth
55859>>>>>>>>>>>>>>>>>>> get piRightAlign.i of (Grid_WriteToFileColumnWidthArray(self)) liColumn to liRightAlign
55860>>>>>>>>>>>>>>>>>>> get Grid_WriteToFile_Help liFormat lsValue liWidth liRightAlign to lsValue
55861>>>>>>>>>>>>>>>>>>> write channel liChannel (ToAnsi(lsValue))
55863>>>>>>>>>>>>>>>>>>> if liColumn ne (liColumns-1) begin
55865>>>>>>>>>>>>>>>>>>> if (liFormat=GD_FORMAT) write " "
55868>>>>>>>>>>>>>>>>>>> if (liFormat=GD_COMMA ) write ","
55871>>>>>>>>>>>>>>>>>>> if (liFormat=GD_TAB ) write (character(8))
55874>>>>>>>>>>>>>>>>>>> end
55874>>>>>>>>>>>>>>>>>>>>
55874>>>>>>>>>>>>>>>>>>> loop
55875>>>>>>>>>>>>>>>>>>>>
55875>>>>>>>>>>>>>>>>>>> writeln channel liChannel ""
55878>>>>>>>>>>>>>>>>>>> loop
55879>>>>>>>>>>>>>>>>>>>>
55879>>>>>>>>>>>>>>>>>>>end_procedure
55880>>>>>>>>>>>>>>>>>>>
55880>>>>>>>>>>>>>>>>>>>// The Grid_StateValue was developed in order to be able to check if a Grid (not a dbGrid) had
55880>>>>>>>>>>>>>>>>>>>// been changed by the user (by comparing the Grid
55880>>>>>>>>>>>>>>>>>>>function Grid_StateValue global integer lhGrid returns string
55882>>>>>>>>>>>>>>>>>>> integer liColumns liRows liColumn liRow
55882>>>>>>>>>>>>>>>>>>> string lsState lsValue
55882>>>>>>>>>>>>>>>>>>> get Grid_Columns lhGrid to liColumns
55883>>>>>>>>>>>>>>>>>>> get Grid_RowCount lhGrid to liRows
55884>>>>>>>>>>>>>>>>>>> for liRow from 0 to (liRows-1)
55890>>>>>>>>>>>>>>>>>>>>
55890>>>>>>>>>>>>>>>>>>> for liColumn from 0 to (liColumns-1)
55896>>>>>>>>>>>>>>>>>>>>
55896>>>>>>>>>>>>>>>>>>>
55896>>>>>>>>>>>>>>>>>>> if (checkbox_item_state(lhGrid,liRow*liColumns+liColumn)) get select_state of lhGrid item (liRow*liColumns+liColumn) to lsValue
55899>>>>>>>>>>>>>>>>>>> else get value of lhGrid item (liRow*liColumns+liColumn) to lsValue
55901>>>>>>>>>>>>>>>>>>> move (lsState+"|"+lsValue) to lsValue
55902>>>>>>>>>>>>>>>>>>> loop
55903>>>>>>>>>>>>>>>>>>>>
55903>>>>>>>>>>>>>>>>>>> loop
55904>>>>>>>>>>>>>>>>>>>>
55904>>>>>>>>>>>>>>>>>>> function_return lsState
55905>>>>>>>>>>>>>>>>>>>end_function
55906>>>>>>>>>>>>>>>>>>>
55906>>>>>>>>>>>>>>>>>>>// procedure row_change integer liRowFrom integer liRowTo
55906>>>>>>>>>>>>>>>>>>>// end_procedure
55906>>>>>>>>>>>>>>>>>>>// procedure item_change integer liItm1 integer liItm2 returns integer
55906>>>>>>>>>>>>>>>>>>>// integer liRval liColumns
55906>>>>>>>>>>>>>>>>>>>// get Grid_Columns self to liColumns
55906>>>>>>>>>>>>>>>>>>>// forward get msg_item_change liItm1 liItm2 to liRval
55906>>>>>>>>>>>>>>>>>>>// if (liItm1/liColumns) ne (liItm2/liColumns) send row_change (liItm1/liColumns) (liItm2/liColumns)
55906>>>>>>>>>>>>>>>>>>>// procedure_return liRval
55906>>>>>>>>>>>>>>>>>>>// end_procedure
55906>>>>>>>>>>>>>>>>>>>
55906>>>>>>>>>>>>>>>>>>>// procedure select_toggling integer liItem integer lbState
55906>>>>>>>>>>>>>>>>>>>// integer liCurrentItem liColumns
55906>>>>>>>>>>>>>>>>>>>// get Grid_Columns self to liColumns
55906>>>>>>>>>>>>>>>>>>>// get current_item to liCurrentItem
55906>>>>>>>>>>>>>>>>>>>// move ((liCurrentItem/liColumns)*liColumns) to liCurrentItem // Redirect to first column
55906>>>>>>>>>>>>>>>>>>>// forward send select_toggling liCurrentItem lbState
55906>>>>>>>>>>>>>>>>>>>// end_procedure
55906>>>>>>>>>>>>>>>>>>>
55906>>>>>>>>>>>>>>>>>>>procedure Grid_DoWriteToFile global integer lhGrid
55908>>>>>>>>>>>>>>>>>>> integer liChannel
55908>>>>>>>>>>>>>>>>>>> string lsTempFileName
55908>>>>>>>>>>>>>>>>>>> get SEQ_FirstDirInDfPath to lsTempFileName
55909>>>>>>>>>>>>>>>>>>> get SEQ_ComposeAbsoluteFileName lsTempFileName "temp.txt" to lsTempFileName
55910>>>>>>>>>>>>>>>>>>>
55910>>>>>>>>>>>>>>>>>>> get SEQ_DirectOutput lsTempFileName to liChannel
55911>>>>>>>>>>>>>>>>>>> if liChannel ge 0 begin
55913>>>>>>>>>>>>>>>>>>> send Grid_WriteToFile lhGrid liChannel GD_FORMAT
55914>>>>>>>>>>>>>>>>>>> send SEQ_CloseOutput liChannel
55915>>>>>>>>>>>>>>>>>>> runprogram BACKGROUND ("notepad "+lsTempFileName)
55916>>>>>>>>>>>>>>>>>>> end
55916>>>>>>>>>>>>>>>>>>>>
55916>>>>>>>>>>>>>>>>>>>end_procedure
55917>>>>>>>>>>>>>>>>>>>
55917>>>>>>>>>>>>>>>>>>>procedure Grid_SetRowColor global integer lhGrid integer liRow integer liColor
55919>>>>>>>>>>>>>>>>>>> integer liBase liMax liItem
55919>>>>>>>>>>>>>>>>>>> get Grid_RowBaseItem lhGrid liRow to liBase
55920>>>>>>>>>>>>>>>>>>> get Grid_Columns lhGrid to liMax
55921>>>>>>>>>>>>>>>>>>> for liItem from 0 to (liMax-1)
55927>>>>>>>>>>>>>>>>>>>>
55927>>>>>>>>>>>>>>>>>>> set itemcolor of lhGrid item (liBase+liItem) to liColor
55928>>>>>>>>>>>>>>>>>>> loop
55929>>>>>>>>>>>>>>>>>>>>
55929>>>>>>>>>>>>>>>>>>>end_procedure
55930>>>>>>>>>>>>>>>>>>>
55930>>>>>>>>>>>>>>>>>>>procedure Grid_AddRowToGrid global integer lhGrid integer liRow integer lhTargetGrid
55932>>>>>>>>>>>>>>>>>>> integer liBase liMax liItem liTargetBase
55932>>>>>>>>>>>>>>>>>>> string lsValue
55932>>>>>>>>>>>>>>>>>>> get Grid_RowBaseItem lhGrid liRow to liBase
55933>>>>>>>>>>>>>>>>>>> get Grid_Columns lhGrid to liMax
55934>>>>>>>>>>>>>>>>>>> get item_count of lhTargetGrid to liTargetBase
55935>>>>>>>>>>>>>>>>>>> for liItem from 0 to (liMax-1)
55941>>>>>>>>>>>>>>>>>>>>
55941>>>>>>>>>>>>>>>>>>> get value of lhGrid item (liBase+liItem) to lsValue
55942>>>>>>>>>>>>>>>>>>> send add_item to lhTargetGrid MSG_NONE lsValue
55943>>>>>>>>>>>>>>>>>>> set entry_state of lhTargetGrid item (liTargetBase+liItem) to (entry_state(lhGrid,liBase+liItem))
55944>>>>>>>>>>>>>>>>>>> set checkbox_item_state of lhTargetGrid item (liTargetBase+liItem) to (checkbox_item_state(lhGrid,liBase+liItem))
55945>>>>>>>>>>>>>>>>>>> set aux_value of lhTargetGrid item (liTargetBase+liItem) to (aux_value(lhGrid,liBase+liItem))
55946>>>>>>>>>>>>>>>>>>> set select_state of lhTargetGrid item (liTargetBase+liItem) to (select_state(lhGrid,liBase+liItem))
55947>>>>>>>>>>>>>>>>>>> set itemcolor of lhTargetGrid item (liTargetBase+liItem) to (itemcolor(lhGrid,liBase+liItem))
55948>>>>>>>>>>>>>>>>>>> loop
55949>>>>>>>>>>>>>>>>>>>>
55949>>>>>>>>>>>>>>>>>>>end_procedure
55950>>>>>>>>>>>>>>>>>>>
55950>>>>>>>>>>>>>>>>>
55950>>>>>>>>>>>>>>>>>Use APS // Auto Positioning and Sizing classes for VDF
55950>>>>>>>>>>>>>>>>>class cFDX.Display.FieldList is a aps.Grid
55951>>>>>>>>>>>>>>>>> register_function piFDX_Server returns integer
55951>>>>>>>>>>>>>>>>> register_function piMain_File returns integer
55951>>>>>>>>>>>>>>>>> procedure construct_object integer img#
55953>>>>>>>>>>>>>>>>> forward send construct_object img#
55955>>>>>>>>>>>>>>>>> property integer piDisplayOldNumbers public 0
55956>>>>>>>>>>>>>>>>> on_key kuser send ToggleDisplayOldNumbers
55957>>>>>>>>>>>>>>>>> send GridPrepare_AddColumn "#" AFT_ASCII2
55958>>>>>>>>>>>>>>>>> send GridPrepare_AddColumn "Name" AFT_ASCII15
55959>>>>>>>>>>>>>>>>> send GridPrepare_AddColumn "Type" AFT_ASCII4
55960>>>>>>>>>>>>>>>>> send GridPrepare_AddColumn "Len" AFT_ASCII5
55961>>>>>>>>>>>>>>>>> send GridPrepare_AddColumn "Offset" AFT_ASCII5
55962>>>>>>>>>>>>>>>>> send GridPrepare_AddColumn "Idx" AFT_ASCII3
55963>>>>>>>>>>>>>>>>> send GridPrepare_AddColumn "Relation" AFT_ASCII30
55964>>>>>>>>>>>>>>>>> send GridPrepare_Apply self
55965>>>>>>>>>>>>>>>>> set select_mode to no_select
55966>>>>>>>>>>>>>>>>> on_key key_ctrl+key_w send DoWriteToFile
55967>>>>>>>>>>>>>>>>> end_procedure
55968>>>>>>>>>>>>>>>>> procedure DoWriteToFile
55970>>>>>>>>>>>>>>>>> send Grid_DoWriteToFile self
55971>>>>>>>>>>>>>>>>> end_procedure
55972>>>>>>>>>>>>>>>>> procedure add_item integer msg# string value#
55974>>>>>>>>>>>>>>>>> forward send add_item msg# value#
55976>>>>>>>>>>>>>>>>> set entry_state item (item_count(self)-1) to false
55977>>>>>>>>>>>>>>>>> end_procedure
55978>>>>>>>>>>>>>>>>> function sRelFieldName.ii integer file# integer field# returns string
55980>>>>>>>>>>>>>>>>> integer fdx#
55980>>>>>>>>>>>>>>>>> string file_name# field_name#
55980>>>>>>>>>>>>>>>>> ifnot file# function_return ""
55983>>>>>>>>>>>>>>>>> get piFDX_Server to fdx#
55984>>>>>>>>>>>>>>>>> if fdx# begin
55986>>>>>>>>>>>>>>>>> get FDX_AttrValue_FILELIST fdx# DF_FILE_LOGICAL_NAME file# to file_name#
55987>>>>>>>>>>>>>>>>> get FDX_AttrValue_FIELD fdx# DF_FIELD_NAME file# field# to field_name#
55988>>>>>>>>>>>>>>>>> end
55988>>>>>>>>>>>>>>>>>>
55988>>>>>>>>>>>>>>>>> else begin
55989>>>>>>>>>>>>>>>>> get API_AttrValue_FILELIST DF_FILE_LOGICAL_NAME file# to file_name#
55990>>>>>>>>>>>>>>>>> if file_name# eq "" move ("FILE"+string(file#)) to file_name#
55993>>>>>>>>>>>>>>>>> if (DBMS_IsOpenFile(file#)) get API_AttrValue_FIELD DF_FIELD_NAME file# field# to field_name#
55996>>>>>>>>>>>>>>>>> else move ("FIELD"+string(field#)) to field_name#
55998>>>>>>>>>>>>>>>>> end
55998>>>>>>>>>>>>>>>>>>
55998>>>>>>>>>>>>>>>>> function_return (file_name#+"."+field_name#)
55999>>>>>>>>>>>>>>>>> end_function
56000>>>>>>>>>>>>>>>>> procedure fill_list
56002>>>>>>>>>>>>>>>>> integer file# fdx# max# field# st# type# len# dec# idx# iDisplayOldNumbers#
56002>>>>>>>>>>>>>>>>> string str#
56002>>>>>>>>>>>>>>>>> get piMain_File to file#
56003>>>>>>>>>>>>>>>>> get piFDX_Server to fdx#
56004>>>>>>>>>>>>>>>>> get dynamic_update_state to st#
56005>>>>>>>>>>>>>>>>> set dynamic_update_state to false
56006>>>>>>>>>>>>>>>>> get FDX_AttrValue_FILE fdx# DF_FILE_NUMBER_FIELDS file# to max#
56007>>>>>>>>>>>>>>>>> get piDisplayOldNumbers to iDisplayOldNumbers#
56008>>>>>>>>>>>>>>>>> send delete_data
56009>>>>>>>>>>>>>>>>> for field# from 1 to max#
56015>>>>>>>>>>>>>>>>>>
56015>>>>>>>>>>>>>>>>> send add_item msg_none (string(field#))
56016>>>>>>>>>>>>>>>>> send add_item msg_none (FDX_AttrValue_FIELD(fdx#,DF_FIELD_NAME,file#,field#))
56017>>>>>>>>>>>>>>>>> move (FDX_AttrValue_FIELD(fdx#,DF_FIELD_TYPE,file#,field#)) to type#
56018>>>>>>>>>>>>>>>>> send add_item msg_none (API_ShortFieldTypeName(type#))
56019>>>>>>>>>>>>>>>>> move (FDX_AttrValue_FIELD(fdx#,DF_FIELD_LENGTH,file#,field#)) to len#
56020>>>>>>>>>>>>>>>>> if type# eq DF_BCD begin
56022>>>>>>>>>>>>>>>>> move (FDX_AttrValue_FIELD(fdx#,DF_FIELD_PRECISION,file#,field#)) to dec#
56023>>>>>>>>>>>>>>>>> send add_item msg_none (string(len#-dec#)+"."+string(dec#))
56024>>>>>>>>>>>>>>>>> end
56024>>>>>>>>>>>>>>>>>>
56024>>>>>>>>>>>>>>>>> else send add_item msg_none (string(len#))
56026>>>>>>>>>>>>>>>>> send add_item msg_none (FDX_AttrValue_FIELD(fdx#,DF_FIELD_OFFSET,file#,field#))
56027>>>>>>>>>>>>>>>>> move (FDX_AttrValue_FIELD(fdx#,DF_FIELD_INDEX,file#,field#)) to idx#
56028>>>>>>>>>>>>>>>>> if idx# send add_item msg_none (string(idx#))
56031>>>>>>>>>>>>>>>>> else send add_item msg_none ""
56033>>>>>>>>>>>>>>>>>
56033>>>>>>>>>>>>>>>>> if iDisplayOldNumbers# begin
56035>>>>>>>>>>>>>>>>> move "(Old #) PhysLen: #" to str#
56036>>>>>>>>>>>>>>>>> replace "#" in str# with (FDX_AttrValue_FIELD(fdx#,DF_FIELD_OLD_NUMBER,file#,field#))
56038>>>>>>>>>>>>>>>>> replace "#" in str# with (FDX_AttrValue_FIELD(fdx#,DF_FIELD_NATIVE_LENGTH,file#,field#))
56040>>>>>>>>>>>>>>>>> send add_item msg_none str#
56041>>>>>>>>>>>>>>>>> end
56041>>>>>>>>>>>>>>>>>>
56041>>>>>>>>>>>>>>>>> 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#)))
56043>>>>>>>>>>>>>>>>> loop
56044>>>>>>>>>>>>>>>>>>
56044>>>>>>>>>>>>>>>>> set dynamic_update_state to st#
56045>>>>>>>>>>>>>>>>> end_procedure
56046>>>>>>>>>>>>>>>>>
56046>>>>>>>>>>>>>>>>> procedure ToggleDisplayOldNumbers
56048>>>>>>>>>>>>>>>>> set piDisplayOldNumbers to (not(piDisplayOldNumbers(self)))
56049>>>>>>>>>>>>>>>>> send fill_list
56050>>>>>>>>>>>>>>>>> end_procedure
56051>>>>>>>>>>>>>>>>>end_class // cFDX.Display.FieldList
56052>>>>>>>>>>>>>>>>>
56052>>>>>>>>>>>>>>>>>class cFDX.Display.IndexList is a aps.Grid
56053>>>>>>>>>>>>>>>>> procedure construct_object integer img#
56055>>>>>>>>>>>>>>>>> forward send construct_object img#
56057>>>>>>>>>>>>>>>>> set select_mode to auto_select
56058>>>>>>>>>>>>>>>>> set Line_Width to 1 0
56059>>>>>>>>>>>>>>>>> set header_label item 0 to "#"
56060>>>>>>>>>>>>>>>>> set form_margin item 0 to 8
56061>>>>>>>>>>>>>>>>> set highlight_row_state to true
56062>>>>>>>>>>>>>>>>>// set highlight_row_color to (rgb(0,255,255))
56062>>>>>>>>>>>>>>>>>// set current_item_color to (rgb(0,255,255))
56062>>>>>>>>>>>>>>>>> set CurrentCellColor to clHighlight
56063>>>>>>>>>>>>>>>>> set CurrentCellTextColor to clHighlightText
56064>>>>>>>>>>>>>>>>> set CurrentRowColor to clHighlight
56065>>>>>>>>>>>>>>>>> set CurrentRowTextColor to clHighlightText
56066>>>>>>>>>>>>>>>>> set select_mode to no_select
56067>>>>>>>>>>>>>>>>> on_key knext_item send switch
56068>>>>>>>>>>>>>>>>> on_key kprevious_item send switch_back
56069>>>>>>>>>>>>>>>>> on_key key_ctrl+key_w send DoWriteToFile
56070>>>>>>>>>>>>>>>>> end_procedure
56071>>>>>>>>>>>>>>>>> procedure DoWriteToFile
56073>>>>>>>>>>>>>>>>> send Grid_DoWriteToFile self
56074>>>>>>>>>>>>>>>>> end_procedure
56075>>>>>>>>>>>>>>>>> procedure add_item integer msg# string value#
56077>>>>>>>>>>>>>>>>> forward send add_item msg# value#
56079>>>>>>>>>>>>>>>>> set entry_state item (item_count(self)-1) to false
56080>>>>>>>>>>>>>>>>> end_procedure
56081>>>>>>>>>>>>>>>>> procedure fill_list
56083>>>>>>>>>>>>>>>>> integer idx# file# fdx#
56083>>>>>>>>>>>>>>>>> send delete_data
56084>>>>>>>>>>>>>>>>> get piMain_File to file#
56085>>>>>>>>>>>>>>>>> get piFDX_Server to fdx#
56086>>>>>>>>>>>>>>>>> for idx# from 1 to 15
56092>>>>>>>>>>>>>>>>>>
56092>>>>>>>>>>>>>>>>> send add_item msg_none ("Index "+string(idx#))
56093>>>>>>>>>>>>>>>>> ifnot (integer(FDX_AttrValue_INDEX(fdx#,DF_INDEX_NUMBER_SEGMENTS,file#,idx#))) set shadow_state item (item_count(self)-1) to true
56096>>>>>>>>>>>>>>>>> loop
56097>>>>>>>>>>>>>>>>>>
56097>>>>>>>>>>>>>>>>> set dynamic_update_state to true
56098>>>>>>>>>>>>>>>>> end_procedure
56099>>>>>>>>>>>>>>>>>end_class // cFDX.Display.IndexList
56100>>>>>>>>>>>>>>>>>
56100>>>>>>>>>>>>>>>>>class cFDX.Display.IndexSegmentList is a aps.Grid
56101>>>>>>>>>>>>>>>>> procedure construct_object integer img#
56103>>>>>>>>>>>>>>>>> forward send construct_object img#
56105>>>>>>>>>>>>>>>>> set Line_Width to 3 0
56106>>>>>>>>>>>>>>>>> set header_label item 0 to "Field"
56107>>>>>>>>>>>>>>>>> set header_label item 1 to "U/C"
56108>>>>>>>>>>>>>>>>> set header_label item 2 to "Dsc"
56109>>>>>>>>>>>>>>>>> set form_margin item 0 to 15
56110>>>>>>>>>>>>>>>>> set form_margin item 1 to 3
56111>>>>>>>>>>>>>>>>> set form_margin item 2 to 3
56112>>>>>>>>>>>>>>>>> set highlight_row_state to true
56113>>>>>>>>>>>>>>>>> set CurrentCellColor to clHighlight
56114>>>>>>>>>>>>>>>>> set CurrentCellTextColor to clHighlightText
56115>>>>>>>>>>>>>>>>> set CurrentRowColor to clHighlight
56116>>>>>>>>>>>>>>>>> set CurrentRowTextColor to clHighlightText
56117>>>>>>>>>>>>>>>>>// set highlight_row_color to (rgb(0,255,255))
56117>>>>>>>>>>>>>>>>>// set current_item_color to (rgb(0,255,255))
56117>>>>>>>>>>>>>>>>> set select_mode to no_select
56118>>>>>>>>>>>>>>>>> on_key knext_item send switch
56119>>>>>>>>>>>>>>>>> on_key kprevious_item send switch_back
56120>>>>>>>>>>>>>>>>> on_key key_ctrl+key_w send DoWriteToFile
56121>>>>>>>>>>>>>>>>> end_procedure
56122>>>>>>>>>>>>>>>>> procedure DoWriteToFile
56124>>>>>>>>>>>>>>>>> send Grid_DoWriteToFile self
56125>>>>>>>>>>>>>>>>> end_procedure
56126>>>>>>>>>>>>>>>>> procedure add_item integer msg# string value#
56128>>>>>>>>>>>>>>>>> forward send add_item msg# value#
56130>>>>>>>>>>>>>>>>> set entry_state item (item_count(self)-1) to false
56131>>>>>>>>>>>>>>>>> end_procedure
56132>>>>>>>>>>>>>>>>> procedure fill_list
56134>>>>>>>>>>>>>>>>> integer max# seg# file# field# attr# fdx# value# idx#
56134>>>>>>>>>>>>>>>>> string fname#
56134>>>>>>>>>>>>>>>>> send delete_data
56135>>>>>>>>>>>>>>>>> get piMain_File to file#
56136>>>>>>>>>>>>>>>>> get piFDX_Server to fdx#
56137>>>>>>>>>>>>>>>>> get piIndex to idx#
56138>>>>>>>>>>>>>>>>> move (FDX_AttrValue_INDEX(fdx#,DF_INDEX_NUMBER_SEGMENTS,file#,idx#)) to max#
56139>>>>>>>>>>>>>>>>> for seg# from 1 to max#
56145>>>>>>>>>>>>>>>>>>
56145>>>>>>>>>>>>>>>>> move (FDX_AttrValue_IDXSEG(fdx#,DF_INDEX_SEGMENT_FIELD,file#,idx#,seg#)) to field#
56146>>>>>>>>>>>>>>>>> if field# move (FDX_AttrValue_FIELD(fdx#,DF_FIELD_NAME,file#,field#)) to fname#
56149>>>>>>>>>>>>>>>>> else move "RECNUM" to fname#
56151>>>>>>>>>>>>>>>>> send add_item msg_none fname#
56152>>>>>>>>>>>>>>>>> move (FDX_AttrValue_IDXSEG(fdx#,DF_INDEX_SEGMENT_CASE,file#,idx#,seg#)) to value#
56153>>>>>>>>>>>>>>>>> send add_item msg_none (if(value#=DF_CASE_IGNORED,"Yes","No"))
56154>>>>>>>>>>>>>>>>> move (FDX_AttrValue_IDXSEG(fdx#,DF_INDEX_SEGMENT_DIRECTION,file#,idx#,seg#)) to value#
56155>>>>>>>>>>>>>>>>> send add_item msg_none (if(value#=DF_DESCENDING,"Yes","No"))
56156>>>>>>>>>>>>>>>>> loop
56157>>>>>>>>>>>>>>>>>>
56157>>>>>>>>>>>>>>>>> set dynamic_update_state to true
56158>>>>>>>>>>>>>>>>> end_procedure
56159>>>>>>>>>>>>>>>>>end_class // cFDX.Display.IndexSegmentList
56160>>>>>>>>>>>>>>>>>class cFDX.Display.FileOtherList is a aps.Grid
56161>>>>>>>>>>>>>>>>> procedure construct_object integer img#
56163>>>>>>>>>>>>>>>>> forward send construct_object img#
56165>>>>>>>>>>>>>>>>> set Line_Width to 2 0
56166>>>>>>>>>>>>>>>>> set header_label item 0 to "Parameter"
56167>>>>>>>>>>>>>>>>> set header_label item 1 to "Value"
56168>>>>>>>>>>>>>>>>> set form_margin item 0 to 30
56169>>>>>>>>>>>>>>>>> set form_margin item 1 to 30
56170>>>>>>>>>>>>>>>>> set highlight_row_state to true
56171>>>>>>>>>>>>>>>>> set CurrentCellColor to clHighlight
56172>>>>>>>>>>>>>>>>> set CurrentCellTextColor to clHighlightText
56173>>>>>>>>>>>>>>>>> set CurrentRowColor to clHighlight
56174>>>>>>>>>>>>>>>>> set CurrentRowTextColor to clHighlightText
56175>>>>>>>>>>>>>>>>>// set highlight_row_color to (rgb(0,255,255))
56175>>>>>>>>>>>>>>>>>// set current_item_color to (rgb(0,255,255))
56175>>>>>>>>>>>>>>>>> set select_mode to no_select
56176>>>>>>>>>>>>>>>>> property integer piDisplayRuntimeOnlies public 0
56177>>>>>>>>>>>>>>>>> on_key key_ctrl+key_w send DoWriteToFile
56178>>>>>>>>>>>>>>>>> end_procedure
56179>>>>>>>>>>>>>>>>> procedure DoWriteToFile
56181>>>>>>>>>>>>>>>>> send Grid_DoWriteToFile self
56182>>>>>>>>>>>>>>>>> end_procedure
56183>>>>>>>>>>>>>>>>> procedure add_item integer msg# string value#
56185>>>>>>>>>>>>>>>>> forward send add_item msg# value#
56187>>>>>>>>>>>>>>>>> set entry_state item (item_count(self)-1) to false
56188>>>>>>>>>>>>>>>>> end_procedure
56189>>>>>>>>>>>>>>>>> procedure add_entry string param# string value#
56191>>>>>>>>>>>>>>>>> send add_item msg_none param#
56192>>>>>>>>>>>>>>>>> send add_item msg_none value#
56193>>>>>>>>>>>>>>>>> end_procedure
56194>>>>>>>>>>>>>>>>> procedure fill_list_help integer attr#
56196>>>>>>>>>>>>>>>>> integer file# fdx#
56196>>>>>>>>>>>>>>>>> string str#
56196>>>>>>>>>>>>>>>>> if (piDisplayRuntimeOnlies(self) or not(API_AttrRuntimeOnly(attr#))) begin
56198>>>>>>>>>>>>>>>>> get piMain_File to file#
56199>>>>>>>>>>>>>>>>> get piFDX_Server to fdx#
56200>>>>>>>>>>>>>>>>> move (FDX_AttrValue_FILE(fdx#,attr#,file#)) to str#
56201>>>>>>>>>>>>>>>>> send add_entry (API_Attr_DisplayName(attr#)) (API_Attr_DisplayValueName(attr#,str#))
56202>>>>>>>>>>>>>>>>> end
56202>>>>>>>>>>>>>>>>>>
56202>>>>>>>>>>>>>>>>> end_procedure
56203>>>>>>>>>>>>>>>>> procedure fill_list
56205>>>>>>>>>>>>>>>>> send delete_data
56206>>>>>>>>>>>>>>>>> send API_AttrType_Callback ATTRTYPE_FILE msg_fill_list_help self
56207>>>>>>>>>>>>>>>>> set dynamic_update_state to true
56208>>>>>>>>>>>>>>>>> end_procedure
56209>>>>>>>>>>>>>>>>>end_class // cFDX.Display.FileOtherList
56210>>>>>>>>>>>>>>>>>
56210>>>>>>>>>>>>>>>>>object oFdxModalDisplayFileAttributes is a aps.ModalPanel label "Display table definition"
56213>>>>>>>>>>>>>>>>> property integer piFDX_Server public 0
56215>>>>>>>>>>>>>>>>> property integer piMain_File public 0
56217>>>>>>>>>>>>>>>>> property integer piIndex public 1
56219>>>>>>>>>>>>>>>>> on_key kcancel send close_panel
56220>>>>>>>>>>>>>>>>> set Locate_Mode to CENTER_ON_SCREEN
56221>>>>>>>>>>>>>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
56222>>>>>>>>>>>>>>>>> object oTabs is a aps.TabDialog
56224>>>>>>>>>>>>>>>>> set peAnchors to (anTop+anLeft+anBottom+anRight)
56225>>>>>>>>>>>>>>>>> object oTab1 is a aps.TabPage label "Fields"
56228>>>>>>>>>>>>>>>>> set p_Auto_Column to false
56229>>>>>>>>>>>>>>>>> object oFields is a cFDX.Display.FieldList
56231>>>>>>>>>>>>>>>>> set size to 160 0
56232>>>>>>>>>>>>>>>>> set peAnchors to (anTop+anLeft+anBottom+anRight)
56233>>>>>>>>>>>>>>>>> set peResizeColumn to rcAll
56234>>>>>>>>>>>>>>>>> end_object
56235>>>>>>>>>>>>>>>>> end_object
56236>>>>>>>>>>>>>>>>> register_object oIndexFields
56236>>>>>>>>>>>>>>>>> object oTab2 is a aps.TabPage label "Indices"
56239>>>>>>>>>>>>>>>>> object oIndexNo is a cFDX.Display.IndexList
56241>>>>>>>>>>>>>>>>> set size to 160 0
56242>>>>>>>>>>>>>>>>> set peAnchors to (anTop+anBottom)
56243>>>>>>>>>>>>>>>>> set peResizeColumn to rcAll
56244>>>>>>>>>>>>>>>>> procedure item_change integer from# integer to# returns integer
56247>>>>>>>>>>>>>>>>> integer rval#
56247>>>>>>>>>>>>>>>>> forward get msg_item_change from# to# to rval#
56249>>>>>>>>>>>>>>>>> set piIndex to (rval#+1)
56250>>>>>>>>>>>>>>>>> send fill_list to (oIndexFields(self))
56251>>>>>>>>>>>>>>>>> send display_info
56252>>>>>>>>>>>>>>>>> procedure_return rval#
56253>>>>>>>>>>>>>>>>> end_procedure
56254>>>>>>>>>>>>>>>>> end_object
56255>>>>>>>>>>>>>>>>> set p_auto_column to false
56256>>>>>>>>>>>>>>>>> object oIndexFields is a cFDX.Display.IndexSegmentList
56258>>>>>>>>>>>>>>>>> set peAnchors to (anTop+anLeft+anBottom+anRight)
56259>>>>>>>>>>>>>>>>> set peResizeColumn to rcAll
56260>>>>>>>>>>>>>>>>> set size to 160 0
56261>>>>>>>>>>>>>>>>> end_object
56262>>>>>>>>>>>>>>>>> object oFrm1 is a aps.Form label "Key length:" abstract aft_numeric4.0 snap sl_right_space
56267>>>>>>>>>>>>>>>>> set peAnchors to (anTop+anRight)
56268>>>>>>>>>>>>>>>>> set object_shadow_state to true
56269>>>>>>>>>>>>>>>>> end_object
56270>>>>>>>>>>>>>>>>> object oFrm2 is a aps.Form label "Levels:" abstract aft_numeric4.0 snap sl_down
56275>>>>>>>>>>>>>>>>> set peAnchors to (anTop+anRight)
56276>>>>>>>>>>>>>>>>> set object_shadow_state to true
56277>>>>>>>>>>>>>>>>> set label_offset to 0 0
56278>>>>>>>>>>>>>>>>> set label_justification_mode to jmode_right
56279>>>>>>>>>>>>>>>>> end_object
56280>>>>>>>>>>>>>>>>> object oFrm3 is a aps.Form label "Batch:" abstract aft_ascii4 snap sl_down
56285>>>>>>>>>>>>>>>>> set peAnchors to (anTop+anRight)
56286>>>>>>>>>>>>>>>>> set object_shadow_state to true
56287>>>>>>>>>>>>>>>>> set label_offset to 0 0
56288>>>>>>>>>>>>>>>>> set label_justification_mode to jmode_right
56289>>>>>>>>>>>>>>>>> end_object
56290>>>>>>>>>>>>>>>>> procedure display_info
56293>>>>>>>>>>>>>>>>> integer idx# attr#
56293>>>>>>>>>>>>>>>>> integer file# fdx#
56293>>>>>>>>>>>>>>>>> get piMain_File to file#
56294>>>>>>>>>>>>>>>>> get piFDX_Server to fdx#
56295>>>>>>>>>>>>>>>>> get piIndex to idx#
56296>>>>>>>>>>>>>>>>> move (FDX_AttrValue_INDEX(fdx#,DF_INDEX_KEY_LENGTH,file#,idx#)) to attr#
56297>>>>>>>>>>>>>>>>> set value of (oFrm1(self)) item 0 to attr#
56298>>>>>>>>>>>>>>>>> move (FDX_AttrValue_INDEX(fdx#,DF_INDEX_LEVELS,file#,idx#)) to attr#
56299>>>>>>>>>>>>>>>>> set value of (oFrm2(self)) item 0 to attr#
56300>>>>>>>>>>>>>>>>> move (FDX_AttrValue_INDEX(fdx#,DF_INDEX_TYPE,file#,idx#)) to attr#
56301>>>>>>>>>>>>>>>>> if attr# eq DF_INDEX_TYPE_ONLINE set value of (oFrm3(self)) item 0 to "No"
56304>>>>>>>>>>>>>>>>> else set value of (oFrm3(self)) item 0 to "Yes"
56306>>>>>>>>>>>>>>>>> end_procedure
56307>>>>>>>>>>>>>>>>> end_object
56308>>>>>>>>>>>>>>>>> object oTab3 is a aps.TabPage label "Attributes"
56311>>>>>>>>>>>>>>>>> object oOther is a cFDX.Display.FileOtherList
56313>>>>>>>>>>>>>>>>> set size to 160 0
56314>>>>>>>>>>>>>>>>> set peAnchors to (anTop+anLeft+anBottom+anRight)
56315>>>>>>>>>>>>>>>>> set peResizeColumn to rcAll
56316>>>>>>>>>>>>>>>>> end_object
56317>>>>>>>>>>>>>>>>> end_object
56318>>>>>>>>>>>>>>>>> end_object
56319>>>>>>>>>>>>>>>>> object oBtn is a aps.Multi_Button
56321>>>>>>>>>>>>>>>>> on_item t.btn.close send close_panel
56322>>>>>>>>>>>>>>>>> set peAnchors to (anBottom+anRight)
56323>>>>>>>>>>>>>>>>> end_object
56324>>>>>>>>>>>>>>>>> send aps_locate_multi_buttons
56325>>>>>>>>>>>>>>>>> procedure run.ii integer obj# integer file#
56328>>>>>>>>>>>>>>>>> set piFDX_Server to obj#
56329>>>>>>>>>>>>>>>>> set piMain_File to file#
56330>>>>>>>>>>>>>>>>> send fill_list to (oFields(oTab1(oTabs(self))))
56331>>>>>>>>>>>>>>>>> set piIndex to 1
56332>>>>>>>>>>>>>>>>> send fill_list to (oIndexNo(oTab2(oTabs(self))))
56333>>>>>>>>>>>>>>>>> send fill_list to (oIndexFields(oTab2(oTabs(self))))
56334>>>>>>>>>>>>>>>>> send display_info to (oTab2(oTabs(self)))
56335>>>>>>>>>>>>>>>>> send fill_list to (oOther(oTab3(oTabs(self)))) obj#
56336>>>>>>>>>>>>>>>>> send popup
56337>>>>>>>>>>>>>>>>> end_procedure
56338>>>>>>>>>>>>>>>>>end_object
56339>>>>>>>>>>>>>>>>>send aps_SetMinimumDialogSize (oFdxModalDisplayFileAttributes(self))
56340>>>>>>>>>>>>>>>>>
56340>>>>>>>>>>>>>>>>>object oABCDEFG is a cArray NO_IMAGE
56342>>>>>>>>>>>>>>>>> register_function iFdxIsEncapsulated returns integer
56342>>>>>>>>>>>>>>>>>end_object
56343>>>>>>>>>>>>>>>>>
56343>>>>>>>>>>>>>>>>>register_function piMainFile returns integer
56343>>>>>>>>>>>>>>>>>procedure FDX_ModalDisplayFileAttributes global integer oFDX# integer file#
56345>>>>>>>>>>>>>>>>> integer open# was_open# lbIsEncapsulated
56345>>>>>>>>>>>>>>>>> ifnot oFDX# begin
56347>>>>>>>>>>>>>>>>> move (DBMS_IsOpenFile(file#)) to was_open#
56348>>>>>>>>>>>>>>>>> if was_open# move 1 to open#
56351>>>>>>>>>>>>>>>>> else move (DBMS_OpenFile(file#,DF_SHARE,0)) to open#
56353>>>>>>>>>>>>>>>>> end
56353>>>>>>>>>>>>>>>>>>
56353>>>>>>>>>>>>>>>>> else begin
56354>>>>>>>>>>>>>>>>> move 1 to open#
56355>>>>>>>>>>>>>>>>> if file# eq 0 begin
56357>>>>>>>>>>>>>>>>> // File not specified means the oFDX# holds only one file
56357>>>>>>>>>>>>>>>>> get iFdxIsEncapsulated of oFDX# to lbIsEncapsulated
56358>>>>>>>>>>>>>>>>> if lbIsEncapsulated begin
56360>>>>>>>>>>>>>>>>> send obs "Missing file number argument"
56361>>>>>>>>>>>>>>>>> move 0 to open#
56362>>>>>>>>>>>>>>>>> end
56362>>>>>>>>>>>>>>>>>>
56362>>>>>>>>>>>>>>>>> else get piMainFile of oFDX# to file#
56364>>>>>>>>>>>>>>>>> end
56364>>>>>>>>>>>>>>>>>>
56364>>>>>>>>>>>>>>>>> end
56364>>>>>>>>>>>>>>>>>>
56364>>>>>>>>>>>>>>>>> if open# send run.ii to (oFdxModalDisplayFileAttributes(self)) oFDX# file#
56367>>>>>>>>>>>>>>>>> else send obs "Table is not available"
56369>>>>>>>>>>>>>>>>> ifnot oFDX# if (open# and not(was_open#)) close file#
56374>>>>>>>>>>>>>>>>>end_procedure
56375>>>>>>>>>>>>>>>>>
56375>>>>>>>>>>>>>>>>>// Test code
56375>>>>>>>>>>>>>>>>>//
56375>>>>>>>>>>>>>>>>>// open prtcomm
56375>>>>>>>>>>>>>>>>>// send FDX_DisplayFileAttributes 0 PrtComm.File_Number
56375>>>>>>>>>>>>>>> Use Wait.utl // Something to put on screen while batching.
56375>>>>>>>>>>>>>>> Use MsgBox.utl // obs procedure
56375>>>>>>>>>>>>>>>
56375>>>>>>>>>>>>>>>desktop_section
56380>>>>>>>>>>>>>>> object oStructure_LogFile is a cLogFile
56382>>>>>>>>>>>>>>> set psFileName to "dfmatrix.log"
56383>>>>>>>>>>>>>>> set piCloseOnWrite to DFTRUE
56384>>>>>>>>>>>>>>> set psPurpose to "Events during table restructuring"
56385>>>>>>>>>>>>>>> property integer pbError public 0
56387>>>>>>>>>>>>>>> procedure OnLogFileOpen
56390>>>>>>>>>>>>>>> set pbError to DFFALSE
56391>>>>>>>>>>>>>>> end_procedure
56392>>>>>>>>>>>>>>>
56392>>>>>>>>>>>>>>> register_object oBatchModeLogFile
56392>>>>>>>>>>>>>>> procedure WriteLn string lsValue
56395>>>>>>>>>>>>>>> forward send WriteLn lsValue
56397>>>>>>>>>>>>>>> end_procedure
56398>>>>>>>>>>>>>>>
56398>>>>>>>>>>>>>>> procedure OnLogFileClose
56401>>>>>>>>>>>>>>> end_procedure
56402>>>>>>>>>>>>>>> procedure WriteLnError string lsValue
56405>>>>>>>>>>>>>>> send WriteLn ("Error: "+lsValue)
56406>>>>>>>>>>>>>>> set pbError to DFTRUE
56407>>>>>>>>>>>>>>> end_procedure
56408>>>>>>>>>>>>>>> end_object
56409>>>>>>>>>>>>>>>end_desktop_section
56414>>>>>>>>>>>>>>>
56414>>>>>>>>>>>>>>> Use APS // Auto Positioning and Sizing classes for VDF
56414>>>>>>>>>>>>>>> object oStructureError is a aps.ModalPanel label "Restructure error"
56417>>>>>>>>>>>>>>> set Locate_Mode to CENTER_ON_SCREEN
56418>>>>>>>>>>>>>>> on_key kcancel send close_panel
56419>>>>>>>>>>>>>>>
56419>>>>>>>>>>>>>>> // Must be provided if local error handler is to be created
56419>>>>>>>>>>>>>>>
56419>>>>>>>>>>>>>>> property integer error_processing_state public DFFALSE
56421>>>>>>>>>>>>>>> property integer piOriginalErrorObject public 0
56423>>>>>>>>>>>>>>>
56423>>>>>>>>>>>>>>> object oTb1 is a aps.TextBox label "DataFlex reported this error:"
56426>>>>>>>>>>>>>>> end_object
56427>>>>>>>>>>>>>>> object oFrm1 is a aps.Form abstract AFT_ASCII50 snap SL_DOWN
56431>>>>>>>>>>>>>>> set object_shadow_state to true
56432>>>>>>>>>>>>>>> end_object
56433>>>>>>>>>>>>>>> object oFrm2 is a aps.Form abstract AFT_ASCII50 snap SL_DOWN
56437>>>>>>>>>>>>>>> set object_shadow_state to true
56438>>>>>>>>>>>>>>> end_object
56439>>>>>>>>>>>>>>> object oTb2 is a aps.TextBox label "While executing this instruction:" snap SL_DOWN
56443>>>>>>>>>>>>>>> end_object
56444>>>>>>>>>>>>>>> object oFrm3 is a aps.Form abstract AFT_ASCII50 snap SL_DOWN
56448>>>>>>>>>>>>>>> set object_shadow_state to true
56449>>>>>>>>>>>>>>> end_object
56450>>>>>>>>>>>>>>> object oFrm4 is a aps.Form abstract AFT_ASCII50 snap SL_DOWN
56454>>>>>>>>>>>>>>> set object_shadow_state to true
56455>>>>>>>>>>>>>>> end_object
56456>>>>>>>>>>>>>>> object oFrm5 is a aps.Form abstract AFT_ASCII50 snap SL_DOWN
56460>>>>>>>>>>>>>>> set object_shadow_state to true
56461>>>>>>>>>>>>>>> end_object
56462>>>>>>>>>>>>>>> object oBtn1 is a aps.Multi_Button
56464>>>>>>>>>>>>>>> on_item "End script" send end_script
56465>>>>>>>>>>>>>>> end_object
56466>>>>>>>>>>>>>>> object oBtn2 is a aps.Multi_Button
56468>>>>>>>>>>>>>>> on_item "Display def" send display_definition
56469>>>>>>>>>>>>>>> end_object
56470>>>>>>>>>>>>>>> object oBtn3 is a aps.Multi_Button
56472>>>>>>>>>>>>>>> on_item "Continue" send close_panel
56473>>>>>>>>>>>>>>> end_object
56474>>>>>>>>>>>>>>> send aps_locate_multi_buttons
56475>>>>>>>>>>>>>>> procedure Error_Report integer liErrNum integer liErr_Line string lsValue
56478>>>>>>>>>>>>>>> integer lhObj lhStructure_LogFile
56478>>>>>>>>>>>>>>> string lsValue1 lsValue2 lsError1 lsError2
56478>>>>>>>>>>>>>>> If (error_processing_state(self)) procedure_return // this prevents recursion
56481>>>>>>>>>>>>>>> set error_processing_state to DFTRUE
56482>>>>>>>>>>>>>>> move (Error_Description(self,liErrNum,lsValue)) to lsError1
56483>>>>>>>>>>>>>>> move ("(Error "+string(liErrNum)+" on line "+string(liErr_Line)+")") to lsError2
56484>>>>>>>>>>>>>>> set value of (oFrm1(self)) item 0 to lsError1
56485>>>>>>>>>>>>>>> set value of (oFrm2(self)) item 0 to lsError2
56486>>>>>>>>>>>>>>> move (oStructureErrorInfo(self)) to lhObj
56487>>>>>>>>>>>>>>> send DoPrepare to lhObj
56488>>>>>>>>>>>>>>> get psLine1 of lhObj to lsValue1
56489>>>>>>>>>>>>>>> get psLine2 of lhObj to lsValue2
56490>>>>>>>>>>>>>>> set value of (oFrm3(self)) item 0 to lsValue1
56491>>>>>>>>>>>>>>> set value of (oFrm4(self)) item 0 to lsValue2
56492>>>>>>>>>>>>>>> set value of (oFrm5(self)) item 0 to Struc$ErrDescr
56493>>>>>>>>>>>>>>> move (oStructure_LogFile(self)) to lhStructure_LogFile
56494>>>>>>>>>>>>>>> send WriteLnError to lhStructure_LogFile " DataFlex reported this error:"
56495>>>>>>>>>>>>>>> send WriteLn to lhStructure_LogFile (" "+lsError1)
56496>>>>>>>>>>>>>>> send WriteLn to lhStructure_LogFile (" "+lsError2)
56497>>>>>>>>>>>>>>> if (lsValue1<>"" or lsValue2<>"") begin
56499>>>>>>>>>>>>>>> send WriteLn to lhStructure_LogFile " While executing this instruction:"
56500>>>>>>>>>>>>>>> if lsValue1 ne "" send WriteLn to lhStructure_LogFile (" "+lsValue1)
56503>>>>>>>>>>>>>>> if lsValue2 ne "" send WriteLn to lhStructure_LogFile (" "+lsValue2)
56506>>>>>>>>>>>>>>> if Struc$ErrDescr ne "" send WriteLn to lhStructure_LogFile (" "+Struc$ErrDescr)
56509>>>>>>>>>>>>>>> end
56509>>>>>>>>>>>>>>>>
56509>>>>>>>>>>>>>>> send popup
56510>>>>>>>>>>>>>>> set error_processing_state to DFFALSE
56511>>>>>>>>>>>>>>> end_procedure
56512>>>>>>>>>>>>>>>
56512>>>>>>>>>>>>>>> // Stolen right out of error.pkg:
56512>>>>>>>>>>>>>>> //*** Build complete error description from Flexerrs and user error message.
56512>>>>>>>>>>>>>>> function Error_Description integer liError string lsErrMsg returns string
56515>>>>>>>>>>>>>>> string lsFullErrorText
56515>>>>>>>>>>>>>>> trim lsErrMsg to lsErrMsg
56516>>>>>>>>>>>>>>>>
56516>>>>>>>>>>>>>>> move (trim(error_text(DESKTOP,liError))) to lsFullErrorText
56517>>>>>>>>>>>>>>> if lsErrMsg ne "" begin
56519>>>>>>>>>>>>>>> if ((lsFullErrorText ne "") AND error_text_available(DESKTOP,liError)) append lsFullErrorText " " lsErrMsg
56523>>>>>>>>>>>>>>> else move lsErrMsg to lsFullErrorText
56525>>>>>>>>>>>>>>> end
56525>>>>>>>>>>>>>>>>
56525>>>>>>>>>>>>>>> function_return lsFullErrorText
56526>>>>>>>>>>>>>>> end_function
56527>>>>>>>>>>>>>>>
56527>>>>>>>>>>>>>>> procedure end_script
56530>>>>>>>>>>>>>>> error 774 "No such thing as 'End script'"
56531>>>>>>>>>>>>>>>>
56531>>>>>>>>>>>>>>> end_procedure
56532>>>>>>>>>>>>>>>
56532>>>>>>>>>>>>>>> procedure display_definition
56535>>>>>>>>>>>>>>> send RS_DisplayDef
56536>>>>>>>>>>>>>>> end_procedure
56537>>>>>>>>>>>>>>> end_object // oStructureError
56538>>>>>>>>>>>>>>>
56538>>>>>>>>>>>>>>>procedure DFMatrixError_On global // Set error trapping mode to DFMatrix
56540>>>>>>>>>>>>>>> integer lhObj
56540>>>>>>>>>>>>>>> move (oStructureError(self)) to lhObj
56541>>>>>>>>>>>>>>> if Error_Object_Id ne lhObj begin
56543>>>>>>>>>>>>>>> set piOriginalErrorObject of lhObj to Error_Object_Id
56544>>>>>>>>>>>>>>> move lhObj to Error_Object_Id
56545>>>>>>>>>>>>>>> end
56545>>>>>>>>>>>>>>>>
56545>>>>>>>>>>>>>>>end_procedure
56546>>>>>>>>>>>>>>>procedure DFMatrixError_Off global // Set error trapping mode back to normal
56548>>>>>>>>>>>>>>> integer lhObj
56548>>>>>>>>>>>>>>> move (oStructureError(self)) to lhObj
56549>>>>>>>>>>>>>>> if Error_Object_Id eq lhObj get piOriginalErrorObject of lhObj to Error_Object_Id
56552>>>>>>>>>>>>>>>end_procedure
56553>>>>>>>>>>>>>>>
56553>>>>>>>>>>>>>>>
56553>>>>>>>>>>>>>>>enumeration_list // Progress modes
56553>>>>>>>>>>>>>>> define RS_PG_DEFAULT
56553>>>>>>>>>>>>>>> define RS_PG_NONE
56553>>>>>>>>>>>>>>> define RS_PG_LEAVE_ON
56553>>>>>>>>>>>>>>> define RS_PG_OFF
56553>>>>>>>>>>>>>>>end_enumeration_list
56553>>>>>>>>>>>>>>>
56553>>>>>>>>>>>>>>>
56553>>>>>>>>>>>>>>> object oStructureWait is a cBatchCompanion
56555>>>>>>>>>>>>>>> property string psMostRecentProgressTitle public ""
56557>>>>>>>>>>>>>>> set allow_cancel_state to false
56558>>>>>>>>>>>>>>> function callback string lsText integer liType returns integer
56561>>>>>>>>>>>>>>> if liType eq DF_MESSAGE_HEADING_1 send batch_update lsText
56564>>>>>>>>>>>>>>> else if liType eq DF_MESSAGE_PROGRESS_TITLE begin
56567>>>>>>>>>>>>>>> set psMostRecentProgressTitle to (lsText+": ")
56568>>>>>>>>>>>>>>> send batch_update2 lsText
56569>>>>>>>>>>>>>>> end
56569>>>>>>>>>>>>>>>>
56569>>>>>>>>>>>>>>> else if liType eq DF_MESSAGE_PROGRESS_VALUE send batch_update2 lsText (psMostRecentProgressTitle(self)+replace(",",lsText," of "))
56573>>>>>>>>>>>>>>> else begin
56574>>>>>>>>>>>>>>> if liType eq DF_MESSAGE_HEADING_2 send batch_update3 lsText ("HDR2: "+lsText)
56577>>>>>>>>>>>>>>> else if liType eq DF_MESSAGE_HEADING_3 send batch_update3 ("HDR3: "+lsText)
56581>>>>>>>>>>>>>>> else if liType eq DF_MESSAGE_HEADING_4 send batch_update3 ("HDR4: "+lsText)
56585>>>>>>>>>>>>>>> else if liType eq DF_MESSAGE_HEADING_5 send batch_update3 ("HDR5: "+lsText)
56589>>>>>>>>>>>>>>> else if liType eq DF_MESSAGE_WARNING begin
56592>>>>>>>>>>>>>>> send batch_update3 ("WARN: "+lsText)
56593>>>>>>>>>>>>>>> send WriteLnError to (oStructure_LogFile(self)) (" Warning: "+lsText)
56594>>>>>>>>>>>>>>> end
56594>>>>>>>>>>>>>>>>
56594>>>>>>>>>>>>>>> else if liType eq DF_MESSAGE_TEXT send batch_update3 (" "+lsText)
56598>>>>>>>>>>>>>>> else send batch_update3 ("????: "+lsText)
56600>>>>>>>>>>>>>>> end
56600>>>>>>>>>>>>>>>>
56600>>>>>>>>>>>>>>> function_return 0 // Continue please
56601>>>>>>>>>>>>>>> end_function
56602>>>>>>>>>>>>>>> procedure activate_title string lsTitle
56605>>>>>>>>>>>>>>> send batch_on lsTitle
56606>>>>>>>>>>>>>>> send batch_update "Doing something" // 1
56607>>>>>>>>>>>>>>> send batch_update2 "No idea..."
56608>>>>>>>>>>>>>>> send batch_update3 ""
56609>>>>>>>>>>>>>>> set psMostRecentProgressTitle to ""
56610>>>>>>>>>>>>>>> end_procedure
56611>>>>>>>>>>>>>>> procedure deactivate_display
56614>>>>>>>>>>>>>>> send batch_off
56615>>>>>>>>>>>>>>> end_procedure
56616>>>>>>>>>>>>>>> function batch_interrupt returns integer // Cancel (no interupting!)
56619>>>>>>>>>>>>>>> end_function
56620>>>>>>>>>>>>>>> end_object
56621>>>>>>>>>>>>>>>
56621>>>>>>>>>>>>>>>define FIX_31D_RESTRUCT_ERROR for 1
56621>>>>>>>>>>>>>>>
56621>>>>>>>>>>>>>>>define IMPLICIT_FIELD for -1
56621>>>>>>>>>>>>>>>
56621>>>>>>>>>>>>>>>
56621>>>>>>>>>>>>>>>function sRSErr_Text.i global integer op# returns string
56623>>>>>>>>>>>>>>> enumeration_list
56623>>>>>>>>>>>>>>> define_rserr RSERR.NO_ERROR "No error"
56626>>>>>>>>>>>>>>> define_rserr RSERR.NOTAVALIDFLENTRY "Not a valid FILELIST entry"
56629>>>>>>>>>>>>>>> define_rserr RSERR.NOEXCLACCESS "Exclusive access could not be obtained"
56632>>>>>>>>>>>>>>> define_rserr RSERR.NOT_A_DF_FILE "Cannot restructure files in foreign DB"
56635>>>>>>>>>>>>>>> end_enumeration_list
56635>>>>>>>>>>>>>>> function_return "Undefined error"
56636>>>>>>>>>>>>>>>end_function
56637>>>>>>>>>>>>>>>
56637>>>>>>>>>>>>>>>
56637>>>>>>>>>>>>>>>// This class is used for setting FILE attribute DF_FILE_RECORD_LENGTH. I would
56637>>>>>>>>>>>>>>>// agree if you argue that it seems gross overkill to handle this with an
56637>>>>>>>>>>>>>>>// array and procedures instead of simply a single property.
56637>>>>>>>>>>>>>>>register_function piTraceState returns integer
56637>>>>>>>>>>>>>>>class cPostponedFileSettings is a cArray
56638>>>>>>>>>>>>>>> item_property_list
56638>>>>>>>>>>>>>>> item_property integer piAttribute.i
56638>>>>>>>>>>>>>>> item_property string psValue.i
56638>>>>>>>>>>>>>>> end_item_property_list cPostponedFileSettings
#REM 56670 DEFINE FUNCTION PSVALUE.I INTEGER LIROW RETURNS STRING
#REM 56674 DEFINE PROCEDURE SET PSVALUE.I INTEGER LIROW STRING VALUE
#REM 56678 DEFINE FUNCTION PIATTRIBUTE.I INTEGER LIROW RETURNS INTEGER
#REM 56682 DEFINE PROCEDURE SET PIATTRIBUTE.I INTEGER LIROW INTEGER VALUE
56687>>>>>>>>>>>>>>> procedure postponed_setting integer attr# string value#
56689>>>>>>>>>>>>>>> integer row#
56689>>>>>>>>>>>>>>> get row_count to row#
56690>>>>>>>>>>>>>>> set piAttribute.i row# to attr#
56691>>>>>>>>>>>>>>> set psValue.i row# to value#
56692>>>>>>>>>>>>>>> end_procedure
56693>>>>>>>>>>>>>>> procedure execute string physname#
56695>>>>>>>>>>>>>>> integer row# max# liFile attr#
56695>>>>>>>>>>>>>>> string value#
56695>>>>>>>>>>>>>>> get piFileHandle to liFile
56696>>>>>>>>>>>>>>> get row_count to max#
56697>>>>>>>>>>>>>>> for row# from 0 to (max#-1)
56703>>>>>>>>>>>>>>>>
56703>>>>>>>>>>>>>>> get piAttribute.i row# to attr#
56704>>>>>>>>>>>>>>> get psValue.i row# to value#
56705>>>>>>>>>>>>>>> // If DF_FILE_RECORD_LENGTH and -1 we must trim the record size:
56705>>>>>>>>>>>>>>> if (attr#=DF_FILE_RECORD_LENGTH and integer(value#)=-1) get_attribute DF_FILE_RECORD_LENGTH_USED of liFile to value#
56710>>>>>>>>>>>>>>> ErrorTrapping.set_attribute attr# of liFile to value#
56718>>>>>>>>>>>>>>> send NotifyTracer RSOP_SETFILEATTR attr# 0 0 0 value#
56719>>>>>>>>>>>>>>> loop
56720>>>>>>>>>>>>>>>>
56720>>>>>>>>>>>>>>> end_procedure
56721>>>>>>>>>>>>>>>end_class
56722>>>>>>>>>>>>>>>// This is used simply for postponing setting the DF_FIELD_INDEX attribute.
56722>>>>>>>>>>>>>>>class cPostponedFieldSettings is a cArray
56723>>>>>>>>>>>>>>> item_property_list
56723>>>>>>>>>>>>>>> item_property integer piAttribute.i
56723>>>>>>>>>>>>>>> item_property integer piField.i
56723>>>>>>>>>>>>>>> item_property string psValue.i
56723>>>>>>>>>>>>>>> end_item_property_list cPostponedFieldSettings
#REM 56758 DEFINE FUNCTION PSVALUE.I INTEGER LIROW RETURNS STRING
#REM 56762 DEFINE PROCEDURE SET PSVALUE.I INTEGER LIROW STRING VALUE
#REM 56766 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 56770 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 56774 DEFINE FUNCTION PIATTRIBUTE.I INTEGER LIROW RETURNS INTEGER
#REM 56778 DEFINE PROCEDURE SET PIATTRIBUTE.I INTEGER LIROW INTEGER VALUE
56783>>>>>>>>>>>>>>> procedure postponed_setting integer attr# integer field# string value#
56785>>>>>>>>>>>>>>> integer row#
56785>>>>>>>>>>>>>>> get row_count to row#
56786>>>>>>>>>>>>>>> set piAttribute.i row# to attr#
56787>>>>>>>>>>>>>>> set piField.i row# to field#
56788>>>>>>>>>>>>>>> set psValue.i row# to value#
56789>>>>>>>>>>>>>>> end_procedure
56790>>>>>>>>>>>>>>>
56790>>>>>>>>>>>>>>> function iCheckMainIndexSetting integer liFile integer field# integer index# returns integer
56792>>>>>>>>>>>>>>> integer segment# max_seg# seg_field# liMaxField liTestField lbOverlaps
56792>>>>>>>>>>>>>>> if index# begin
56794>>>>>>>>>>>>>>> // Either index is non-zero in which case we need to check that the
56794>>>>>>>>>>>>>>> // field is actuially part of the index:
56794>>>>>>>>>>>>>>> get_attribute DF_INDEX_NUMBER_SEGMENTS of liFile index# to max_seg#
56797>>>>>>>>>>>>>>> for segment# from 1 to max_seg#
56803>>>>>>>>>>>>>>>>
56803>>>>>>>>>>>>>>> get_attribute DF_INDEX_SEGMENT_FIELD of liFile index# segment# to seg_field#
56806>>>>>>>>>>>>>>> if seg_field# eq field# function_return 1
56809>>>>>>>>>>>>>>> if (integer(FDX_AttrValue_SPECIAL1(0,DF_FIELD_OVERLAP,liFile,field#,seg_field#))) function_return 1
56812>>>>>>>>>>>>>>> loop
56813>>>>>>>>>>>>>>>>
56813>>>>>>>>>>>>>>> end
56813>>>>>>>>>>>>>>>>
56813>>>>>>>>>>>>>>> else begin
56814>>>>>>>>>>>>>>> // Or index is zero in which case field cannot be part of ANY index.
56814>>>>>>>>>>>>>>> // (Unfortunately I don't have time to code this so we just say it's
56814>>>>>>>>>>>>>>> // alright. The point is that if a field is not part of ANY index
56814>>>>>>>>>>>>>>> // its main_index is automatically set to zero - I think).
56814>>>>>>>>>>>>>>> function_return 1
56815>>>>>>>>>>>>>>> end
56815>>>>>>>>>>>>>>>>
56815>>>>>>>>>>>>>>> // function_return 0
56815>>>>>>>>>>>>>>> end_function
56816>>>>>>>>>>>>>>> procedure execute string physname#
56818>>>>>>>>>>>>>>> integer row# max# attr# liFile field# lhStructure_LogFile
56818>>>>>>>>>>>>>>> string value# test# lsValue
56818>>>>>>>>>>>>>>> get piFileHandle to liFile
56819>>>>>>>>>>>>>>> get row_count to max#
56820>>>>>>>>>>>>>>> for row# from 0 to (max#-1)
56826>>>>>>>>>>>>>>>>
56826>>>>>>>>>>>>>>> get piAttribute.i row# to attr#
56827>>>>>>>>>>>>>>> get piField.i row# to field#
56828>>>>>>>>>>>>>>> get psValue.i row# to value#
56829>>>>>>>>>>>>>>> move "#, Field: #, value: #" to Struc$ErrDescr
56830>>>>>>>>>>>>>>> replace "#" in Struc$ErrDescr with physname#
56832>>>>>>>>>>>>>>> replace "#" in Struc$ErrDescr with field#
56834>>>>>>>>>>>>>>> replace "#" in Struc$ErrDescr with value#
56836>>>>>>>>>>>>>>> get_attribute attr# of liFile field# to test#
56839>>>>>>>>>>>>>>> if (integer(value#)<>integer(test#)) begin
56841>>>>>>>>>>>>>>> if (iCheckMainIndexSetting(self,liFile,field#,value#)) begin
56843>>>>>>>>>>>>>>> ErrorTrapping.set_attribute attr# of liFile field# to value#
56852>>>>>>>>>>>>>>> send NotifyTracer RSOP_SETFIELDATTR attr# field# 0 0 value#
56853>>>>>>>>>>>>>>>// send obs Struc$ErrDescr (API_Attr_Name(ATTR#))
56853>>>>>>>>>>>>>>> end
56853>>>>>>>>>>>>>>>>
56853>>>>>>>>>>>>>>> else begin
56854>>>>>>>>>>>>>>> move (oStructure_LogFile(self)) to lhStructure_LogFile
56855>>>>>>>>>>>>>>> move "Can not set index.# as main index for field #." to lsValue
56856>>>>>>>>>>>>>>> move (replace("#",lsValue,value#)) to lsValue
56857>>>>>>>>>>>>>>> move (replace("#",lsValue,string(field#))) to lsValue
56858>>>>>>>>>>>>>>>// send obs lsValue "" "Field is not part of (or overlapped by a field that" "is path of) the index."
56858>>>>>>>>>>>>>>> send WriteLnError to lhStructure_LogFile (" "+lsValue+" "+"Field is not part of (or overlapped by a field that is path of) the index.")
56859>>>>>>>>>>>>>>> end
56859>>>>>>>>>>>>>>>>
56859>>>>>>>>>>>>>>> end
56859>>>>>>>>>>>>>>>>
56859>>>>>>>>>>>>>>> loop
56860>>>>>>>>>>>>>>>>
56860>>>>>>>>>>>>>>> move "" to Struc$ErrDescr
56861>>>>>>>>>>>>>>> end_procedure
56862>>>>>>>>>>>>>>>end_class // cPostponedFieldSettings
56863>>>>>>>>>>>>>>>
56863>>>>>>>>>>>>>>>//> The cRSIndexCreations class is used within an cBasicRestructurer object
56863>>>>>>>>>>>>>>>//> to keep track of indices that were created as part of a restructure
56863>>>>>>>>>>>>>>>//> operation. Why? Because we may need to manually move the corresponding
56863>>>>>>>>>>>>>>>//> index files next to the DAT files. Otherwise the index files will
56863>>>>>>>>>>>>>>>//> remain in the first directory in the current search path (DF_OPEN_PATH)
56863>>>>>>>>>>>>>>>class cRSIndexCreations is an cArray
56864>>>>>>>>>>>>>>>end_class
56865>>>>>>>>>>>>>>>
56865>>>>>>>>>>>>>>>//> This class is also used from within an cBasicRestructurer object for
56865>>>>>>>>>>>>>>>//> the following reason. The '@' is not allowed as part of a field name.
56865>>>>>>>>>>>>>>>//> However, in vintage DataFlex the '@' sign is perfectly valid and in fact
56865>>>>>>>>>>>>>>>//> was used as part of a field name as an indication that the field is an
56865>>>>>>>>>>>>>>>//> overlap field or otherwise should not be presented to the end user
56865>>>>>>>>>>>>>>>//> (DFQuery and VDFQuery automatically filters such fields out).
56865>>>>>>>>>>>>>>>//> The cFieldNameRepair class is used to temporarily substitute 'illegal'
56865>>>>>>>>>>>>>>>//> field names with something legal. After the restructure has ended
56865>>>>>>>>>>>>>>>//> this object will edit the resulting TAG file.
56865>>>>>>>>>>>>>>>class cFieldNameRepair is an cArray
56866>>>>>>>>>>>>>>> item_property_list
56866>>>>>>>>>>>>>>> item_property string psRealName.i // "@ROAD_ID"
56866>>>>>>>>>>>>>>> item_property string psTempName.i // "RSTMPFLDNAME001"
56866>>>>>>>>>>>>>>> end_item_property_list cFieldNameRepair
#REM 56898 DEFINE FUNCTION PSTEMPNAME.I INTEGER LIROW RETURNS STRING
#REM 56902 DEFINE PROCEDURE SET PSTEMPNAME.I INTEGER LIROW STRING VALUE
#REM 56906 DEFINE FUNCTION PSREALNAME.I INTEGER LIROW RETURNS STRING
#REM 56910 DEFINE PROCEDURE SET PSREALNAME.I INTEGER LIROW STRING VALUE
56915>>>>>>>>>>>>>>> procedure construct_object integer img#
56917>>>>>>>>>>>>>>> forward send construct_object img#
56919>>>>>>>>>>>>>>> property integer piTmpCounter private 0
56920>>>>>>>>>>>>>>> object oTagFileArray is an cArray no_image
56922>>>>>>>>>>>>>>> end_object
56923>>>>>>>>>>>>>>> end_procedure
56924>>>>>>>>>>>>>>> procedure reset
56926>>>>>>>>>>>>>>> send delete_data
56927>>>>>>>>>>>>>>> set !$.piTmpCounter to 1
56928>>>>>>>>>>>>>>> end_procedure
56929>>>>>>>>>>>>>>> function sRealName.s string tempname# returns string
56931>>>>>>>>>>>>>>> integer max# row#
56931>>>>>>>>>>>>>>> get row_count to max#
56932>>>>>>>>>>>>>>> for row# from 0 to (max#-1)
56938>>>>>>>>>>>>>>>>
56938>>>>>>>>>>>>>>> if (psTempName.i(self,row#)) eq tempname# function_return (psRealName.i(self,row#))
56941>>>>>>>>>>>>>>> loop
56942>>>>>>>>>>>>>>>>
56942>>>>>>>>>>>>>>> function_return ""
56943>>>>>>>>>>>>>>> end_function
56944>>>>>>>>>>>>>>> function sTempName.s string realname# returns string
56946>>>>>>>>>>>>>>> integer max# row#
56946>>>>>>>>>>>>>>> get row_count to max#
56947>>>>>>>>>>>>>>> for row# from 0 to (max#-1)
56953>>>>>>>>>>>>>>>>
56953>>>>>>>>>>>>>>> if (psRealName.i(self,row#)) eq realname# function_return (psTempName.i(self,row#))
56956>>>>>>>>>>>>>>> loop
56957>>>>>>>>>>>>>>>>
56957>>>>>>>>>>>>>>> function_return ""
56958>>>>>>>>>>>>>>> end_function
56959>>>>>>>>>>>>>>> function sAddField.s string realname# returns string
56961>>>>>>>>>>>>>>> integer counter# row#
56961>>>>>>>>>>>>>>> string rval#
56961>>>>>>>>>>>>>>> get !$.piTmpCounter to counter#
56962>>>>>>>>>>>>>>> move ("RSTMPFLDNAME"+IntToStrRzf(counter#,3)) to rval#
56963>>>>>>>>>>>>>>> get row_count to row#
56964>>>>>>>>>>>>>>> set psRealName.i row# to realname#
56965>>>>>>>>>>>>>>> set psTempName.i row# to rval#
56966>>>>>>>>>>>>>>> set !$.piTmpCounter to (counter#+1)
56967>>>>>>>>>>>>>>> function_return rval#
56968>>>>>>>>>>>>>>> end_function
56969>>>>>>>>>>>>>>> procedure fix_the_tag_file
56971>>>>>>>>>>>>>>> integer arr# ch# max# itm#
56971>>>>>>>>>>>>>>> string root# name# real_name#
56971>>>>>>>>>>>>>>> if (row_count(self)) begin // Only if necessary
56973>>>>>>>>>>>>>>> get sRootInclPath to root#
56974>>>>>>>>>>>>>>> move (root#+".tag") to root#
56975>>>>>>>>>>>>>>> //send obs "sRootInclPath" root#
56975>>>>>>>>>>>>>>> move (SEQ_DirectInput(root#)) to ch#
56976>>>>>>>>>>>>>>> if ch# ge 0 begin
56978>>>>>>>>>>>>>>> move (oTagFileArray(self)) to arr#
56979>>>>>>>>>>>>>>> send delete_data to arr#
56980>>>>>>>>>>>>>>> repeat
56980>>>>>>>>>>>>>>>>
56980>>>>>>>>>>>>>>> move (SEQ_ReadLn(ch#)) to name#
56981>>>>>>>>>>>>>>> if name# ne "" set value of arr# item (item_count(arr#)) to name#
56984>>>>>>>>>>>>>>> until name# eq ""
56986>>>>>>>>>>>>>>> send SEQ_CloseInput ch#
56987>>>>>>>>>>>>>>> move (SEQ_DirectOutput(root#)) to ch#
56988>>>>>>>>>>>>>>> get item_count of arr# to max#
56989>>>>>>>>>>>>>>> for itm# from 0 to (max#-1)
56995>>>>>>>>>>>>>>>>
56995>>>>>>>>>>>>>>> move (value(arr#,itm#)) to name#
56996>>>>>>>>>>>>>>> get sRealName.s name# to real_name#
56997>>>>>>>>>>>>>>> if real_name# ne "" writeln real_name#
57001>>>>>>>>>>>>>>> else writeln name#
57004>>>>>>>>>>>>>>> loop
57005>>>>>>>>>>>>>>>>
57005>>>>>>>>>>>>>>> send SEQ_CloseOutput ch#
57006>>>>>>>>>>>>>>> end
57006>>>>>>>>>>>>>>>>
57006>>>>>>>>>>>>>>> else error 672 ("TAG file not found ("+root#+")")
57008>>>>>>>>>>>>>>> end
57008>>>>>>>>>>>>>>>>
57008>>>>>>>>>>>>>>> end_procedure
57009>>>>>>>>>>>>>>>end_class // cFieldNameRepair
57010>>>>>>>>>>>>>>>
57010>>>>>>>>>>>>>>>//> Attribute DF_FILE_NUMBER_FIELDS does not work as stated by the
57010>>>>>>>>>>>>>>>//> documentation (it simply returns the current position of the
57010>>>>>>>>>>>>>>>//> field at any time). To overcome this a stunt based on this class
57010>>>>>>>>>>>>>>>//> is performed.
57010>>>>>>>>>>>>>>>class cBleedingOldFieldNumbers is a cArray // Godammit!
57011>>>>>>>>>>>>>>> procedure initialize
57013>>>>>>>>>>>>>>> integer liFile max# field#
57013>>>>>>>>>>>>>>> send delete_data
57014>>>>>>>>>>>>>>> get piFileHandle to liFile
57015>>>>>>>>>>>>>>> get_attribute DF_FILE_NUMBER_FIELDS of liFile to max#
57018>>>>>>>>>>>>>>> for field# from 1 to max#
57024>>>>>>>>>>>>>>>>
57024>>>>>>>>>>>>>>> set value item field# to field#
57025>>>>>>>>>>>>>>> loop
57026>>>>>>>>>>>>>>>>
57026>>>>>>>>>>>>>>> end_procedure
57027>>>>>>>>>>>>>>> procedure delete_field integer field#
57029>>>>>>>>>>>>>>> send delete_item field#
57030>>>>>>>>>>>>>>> end_procedure
57031>>>>>>>>>>>>>>> procedure insert_item integer itm#
57033>>>>>>>>>>>>>>> integer xitm# max#
57033>>>>>>>>>>>>>>> get item_count to max#
57034>>>>>>>>>>>>>>> for_ex xitm# from max# down_to (itm#+1)
57041>>>>>>>>>>>>>>> set value item xitm# to (value(self,xitm#-1))
57042>>>>>>>>>>>>>>> loop
57043>>>>>>>>>>>>>>>>
57043>>>>>>>>>>>>>>> set value item itm# to 0
57044>>>>>>>>>>>>>>> end_procedure
57045>>>>>>>>>>>>>>> procedure create_field integer field#
57047>>>>>>>>>>>>>>> integer append#
57047>>>>>>>>>>>>>>> move 0 to append#
57048>>>>>>>>>>>>>>> ifnot field# move 1 to append#
57051>>>>>>>>>>>>>>> if field# gt (item_count(self)) move 1 to append#
57054>>>>>>>>>>>>>>> if append# set value item (item_count(self)) to 0
57057>>>>>>>>>>>>>>> else begin
57058>>>>>>>>>>>>>>> send insert_item field#
57059>>>>>>>>>>>>>>> set value item field# to 0
57060>>>>>>>>>>>>>>> end
57060>>>>>>>>>>>>>>>>
57060>>>>>>>>>>>>>>> end_procedure
57061>>>>>>>>>>>>>>> function iFindFieldOldNumber.i integer old_field# returns integer
57063>>>>>>>>>>>>>>> integer itm# max# field#
57063>>>>>>>>>>>>>>> get item_count to max#
57064>>>>>>>>>>>>>>> for itm# from 1 to (max#-1)
57070>>>>>>>>>>>>>>>>
57070>>>>>>>>>>>>>>> get value item itm# to field#
57071>>>>>>>>>>>>>>> if old_field# eq field# function_return itm#
57074>>>>>>>>>>>>>>> loop
57075>>>>>>>>>>>>>>>>
57075>>>>>>>>>>>>>>> function_return -1
57076>>>>>>>>>>>>>>> end_function
57077>>>>>>>>>>>>>>>end_class // cBleedingOldFieldNumbers
57078>>>>>>>>>>>>>>>
57078>>>>>>>>>>>>>>>register_procedure RegisterUpdate integer op# integer attr# integer field# integer index# integer seg# string value#
57078>>>>>>>>>>>>>>>class cBasicRestructurer is a cArray
57079>>>>>>>>>>>>>>> procedure construct_object integer img#
57081>>>>>>>>>>>>>>> forward send construct_object img#
57083>>>>>>>>>>>>>>> property integer piRS_State public 0 // Are preconditions ok for RS?
57084>>>>>>>>>>>>>>> property integer piFileHandle public 0 // File handle during restructure, File number during probe
57085>>>>>>>>>>>>>>> property integer piMainFile public 0 // File number during restructure and probe
57086>>>>>>>>>>>>>>> property string psDriver public "DATAFLEX"
57087>>>>>>>>>>>>>>> // Used for tracking field insertion error in DF31D:
57087>>>>>>>>>>>>>>> property integer piInitialNumberOfFields public 0
57088>>>>>>>>>>>>>>> property integer piIgnoreTheRestState public 0
57089>>>>>>>>>>>>>>>
57089>>>>>>>>>>>>>>> property integer piErrorHandling public 0 // Catch DF errors?
57090>>>>>>>>>>>>>>> property integer piProbeState public 0 //
57091>>>>>>>>>>>>>>> property integer private.piOrigOnError public 0
57092>>>>>>>>>>>>>>> property integer private.piDropCounter public 0
57093>>>>>>>>>>>>>>> property integer private.piCurrentField public 0
57094>>>>>>>>>>>>>>> property integer piFieldTrackState public 1
57095>>>>>>>>>>>>>>> // Name of DAT file being restructured
57095>>>>>>>>>>>>>>> property string psDatFilePath public ""
57096>>>>>>>>>>>>>>> property string psDatFileName public "" //
57097>>>>>>>>>>>>>>> property integer piTraceState public 0
57098>>>>>>>>>>>>>>> property integer piTraceObject public 0
57099>>>>>>>>>>>>>>> property integer piProgressMode public RS_PG_DEFAULT // Wait image behavior
57100>>>>>>>>>>>>>>>
57100>>>>>>>>>>>>>>> property integer private.piSortOnEndStructure public DFFALSE
57101>>>>>>>>>>>>>>>
57101>>>>>>>>>>>>>>> object oPostponedFileSettings is a cPostponedFileSettings no_image
57103>>>>>>>>>>>>>>> end_object
57104>>>>>>>>>>>>>>> object oPostponedFieldSettings is a cPostponedFieldSettings no_image
57106>>>>>>>>>>>>>>> end_object
57107>>>>>>>>>>>>>>> object oRSIndexCreations is a cRSIndexCreations no_image
57109>>>>>>>>>>>>>>> end_object
57110>>>>>>>>>>>>>>> object oTmpArray is a cArray no_image
57112>>>>>>>>>>>>>>> // Used when creating indices.
57112>>>>>>>>>>>>>>> end_object
57113>>>>>>>>>>>>>>> object oFieldNameRepair is a cFieldNameRepair no_image
57115>>>>>>>>>>>>>>> end_object
57116>>>>>>>>>>>>>>> object oOldFieldNumbersRepair is a cBleedingOldFieldNumbers no_image
57118>>>>>>>>>>>>>>> end_object
57119>>>>>>>>>>>>>>> end_procedure
57120>>>>>>>>>>>>>>>
57120>>>>>>>>>>>>>>>//procedure reset // I don't know who'd call this
57120>>>>>>>>>>>>>>>// set piRS_State to 0
57120>>>>>>>>>>>>>>>// set piProbeState to 0
57120>>>>>>>>>>>>>>>// set piFileHandle to 0
57120>>>>>>>>>>>>>>>// set piMainFile to 0
57120>>>>>>>>>>>>>>>// set private.piCurrentField to -1
57120>>>>>>>>>>>>>>>// send delete_data to (oRSIndexCreations(self))
57120>>>>>>>>>>>>>>>//end_procedure
57120>>>>>>>>>>>>>>>
57120>>>>>>>>>>>>>>> function field_count returns integer
57122>>>>>>>>>>>>>>> integer liFile rval#
57122>>>>>>>>>>>>>>> get piFileHandle to liFile
57123>>>>>>>>>>>>>>> get_attribute DF_FILE_NUMBER_FIELDS of liFile to rval#
57126>>>>>>>>>>>>>>> function_return rval#
57127>>>>>>>>>>>>>>> end_function
57128>>>>>>>>>>>>>>>
57128>>>>>>>>>>>>>>> procedure SetFieldNumber integer field#
57130>>>>>>>>>>>>>>> set private.piCurrentField to field#
57131>>>>>>>>>>>>>>> end_procedure
57132>>>>>>>>>>>>>>>
57132>>>>>>>>>>>>>>> procedure CreateField integer field# string name# integer type#
57134>>>>>>>>>>>>>>> integer liFile WasIRightOrWasIRight# InitialNumberOfFields#
57134>>>>>>>>>>>>>>> integer liFieldNameAlreadyExists
57134>>>>>>>>>>>>>>> ifnot (piIgnoreTheRestState(self)) begin
57136>>>>>>>>>>>>>>> get piFileHandle to liFile
57137>>>>>>>>>>>>>>> if field# gt (field_count(self)) move 0 to field# // Append
57140>>>>>>>>>>>>>>> get piInitialNumberOfFields to InitialNumberOfFields#
57141>>>>>>>>>>>>>>> ErrorTrapping.create_field liFile at field#
57146>>>>>>>>>>>>>>> send create_field to (oOldFieldNumbersRepair(self)) field#
57147>>>>>>>>>>>>>>> // If fieldname begins with "@" we have to cheat
57147>>>>>>>>>>>>>>> if "@" in name# move (sAddField.s(oFieldNameRepair(self),name#)) to name#
57150>>>>>>>>>>>>>>> // If fieldname begins with "FIELD" we have to cheat
57150>>>>>>>>>>>>>>> if (StringBeginsWith(name#,"FIELD")) move (sAddField.s(oFieldNameRepair(self),name#)) to name#
57153>>>>>>>>>>>>>>> // If fieldname already exists (but we intend to create the other field later) we have to cheat
57153>>>>>>>>>>>>>>> get iFindFieldName.s name# to liFieldNameAlreadyExists
57154>>>>>>>>>>>>>>> if (liFieldNameAlreadyExists<>-1) move (sAddField.s(oFieldNameRepair(self),name#)) to name#
57157>>>>>>>>>>>>>>> ErrorTrapping.set_attribute DF_FIELD_NAME of liFile field# to name#
57166>>>>>>>>>>>>>>> ErrorTrapping.set_attribute DF_FIELD_TYPE of liFile field# to type#
57175>>>>>>>>>>>>>>> if field# set private.piCurrentField to field#
57178>>>>>>>>>>>>>>> else set private.piCurrentField to (field_count(self))
57180>>>>>>>>>>>>>>> send NotifyTracer RSOP_CREATEFIELD 0 field# type# 0 name#
57181>>>>>>>>>>>>>>> end
57181>>>>>>>>>>>>>>>>
57181>>>>>>>>>>>>>>> end_procedure
57182>>>>>>>>>>>>>>> procedure CreateField_OldNumber integer old_number# string name# integer type#
57184>>>>>>>>>>>>>>> integer field#
57184>>>>>>>>>>>>>>> get iFindFieldOldNumber.i old_number# to field#
57185>>>>>>>>>>>>>>> if field# ne -1 send CreateField field# name# type#
57188>>>>>>>>>>>>>>> else error 667 ("Old number not found ("+string(old_number#)+")")
57190>>>>>>>>>>>>>>> end_procedure
57191>>>>>>>>>>>>>>>
57191>>>>>>>>>>>>>>> procedure AppendField string name# integer type#
57193>>>>>>>>>>>>>>> ifnot (piIgnoreTheRestState(self)) ; send CreateField 0 name# type#
57196>>>>>>>>>>>>>>> end_procedure
57197>>>>>>>>>>>>>>> procedure DeleteField integer field#
57199>>>>>>>>>>>>>>> integer liFile
57199>>>>>>>>>>>>>>> ifnot (piIgnoreTheRestState(self)) begin
57201>>>>>>>>>>>>>>> get piFileHandle to liFile
57202>>>>>>>>>>>>>>> ErrorTrapping.delete_field liFile field#
57207>>>>>>>>>>>>>>> send delete_field to (oOldFieldNumbersRepair(self)) field#
57208>>>>>>>>>>>>>>> send NotifyTracer RSOP_DELETEFIELD 0 field# 0 0 ""
57209>>>>>>>>>>>>>>> end
57209>>>>>>>>>>>>>>>>
57209>>>>>>>>>>>>>>> end_procedure
57210>>>>>>>>>>>>>>>
57210>>>>>>>>>>>>>>> procedure DeleteField_OldNumber integer old_number#
57212>>>>>>>>>>>>>>> integer field#
57212>>>>>>>>>>>>>>> get iFindFieldOldNumber.i old_number# to field#
57213>>>>>>>>>>>>>>> if field# ne -1 send DeleteField field#
57216>>>>>>>>>>>>>>> else error 668 ("Old number not found ("+string(old_number#)+")")
57218>>>>>>>>>>>>>>> end_procedure
57219>>>>>>>>>>>>>>>
57219>>>>>>>>>>>>>>> procedure DeleteIndex integer idx#
57221>>>>>>>>>>>>>>> integer liFile segments#
57221>>>>>>>>>>>>>>> ifnot (piIgnoreTheRestState(self)) begin
57223>>>>>>>>>>>>>>> get piFileHandle to liFile
57224>>>>>>>>>>>>>>> get_attribute DF_INDEX_NUMBER_SEGMENTS of liFile idx# to segments#
57227>>>>>>>>>>>>>>> // We have to check if there are any segments in the index before we
57227>>>>>>>>>>>>>>> // delete it. If there aren't we will get an error if we try to delete it.
57227>>>>>>>>>>>>>>> if segments# delete_index liFile idx#
57230>>>>>>>>>>>>>>> send NotifyTracer RSOP_DELETEINDEX 0 0 idx# 0 ""
57231>>>>>>>>>>>>>>> end
57231>>>>>>>>>>>>>>>>
57231>>>>>>>>>>>>>>> end_procedure
57232>>>>>>>>>>>>>>>
57232>>>>>>>>>>>>>>> procedure structure_abort
57234>>>>>>>>>>>>>>> integer liFile
57234>>>>>>>>>>>>>>> get piFileHandle to liFile
57235>>>>>>>>>>>>>>> structure_abort liFile
57236>>>>>>>>>>>>>>> set piFileHandle to liFile
57237>>>>>>>>>>>>>>> if (piErrorHandling(self)) get private.piOrigOnError to |VI31 // Restore normal error handling routine
57240>>>>>>>>>>>>>>> end_procedure
57241>>>>>>>>>>>>>>> procedure structure_error
57243>>>>>>>>>>>>>>> integer liFile
57243>>>>>>>>>>>>>>> get piFileHandle to liFile
57244>>>>>>>>>>>>>>> error 673 ("An error occured while re-structuring file number "+string(liFile)+". Program will abort.")
57245>>>>>>>>>>>>>>>>
57245>>>>>>>>>>>>>>> send structure_abort
57246>>>>>>>>>>>>>>> system
57247>>>>>>>>>>>>>>>>
57247>>>>>>>>>>>>>>> end_procedure
57248>>>>>>>>>>>>>>> procedure structure_start
57250>>>>>>>>>>>>>>> integer liFile
57250>>>>>>>>>>>>>>> string root#
57250>>>>>>>>>>>>>>> if (piErrorHandling(self)) begin
57252>>>>>>>>>>>>>>> move self to cRestructurer# // Make global integer cRestructurer# point to this object
57253>>>>>>>>>>>>>>> set private.piOrigOnError to |VI31 // If an error occurs while restructuring we must abort the
57254>>>>>>>>>>>>>>> on error gosub cRestructurer_Error // re-structuring AND the program
57255>>>>>>>>>>>>>>> indicate err false // This just needs to be done (can't remember why)
57256>>>>>>>>>>>>>>> end
57256>>>>>>>>>>>>>>>>
57256>>>>>>>>>>>>>>> send delete_data to (oPostponedFileSettings(self))
57257>>>>>>>>>>>>>>> send delete_data to (oPostponedFieldSettings(self))
57258>>>>>>>>>>>>>>> send reset to (oFieldNameRepair(self))
57259>>>>>>>>>>>>>>> get piMainFile to liFile
57260>>>>>>>>>>>>>>> structure_start liFile (psDriver(self))
57261>>>>>>>>>>>>>>> set piFileHandle to liFile
57262>>>>>>>>>>>>>>> send initialize to (oOldFieldNumbersRepair(self))
57263>>>>>>>>>>>>>>> if (piTraceState(self)) begin
57265>>>>>>>>>>>>>>> get sRootInclPath to root#
57266>>>>>>>>>>>>>>> send NotifyTracer RSOP_BEGIN 0 0 0 0 root#
57267>>>>>>>>>>>>>>> end
57267>>>>>>>>>>>>>>>>
57267>>>>>>>>>>>>>>> end_procedure
57268>>>>>>>>>>>>>>> procedure SetProgressMode integer mode#
57270>>>>>>>>>>>>>>> // Possible values for mode# are: RS_PG_DEFAULT RS_PG_NONE RS_PG_LEAVE_ON RS_PG_OFF
57270>>>>>>>>>>>>>>> if mode# eq RS_PG_OFF begin
57272>>>>>>>>>>>>>>> send deactivate_display to (oStructureWait(self))
57273>>>>>>>>>>>>>>> set piProgressMode to RS_PG_DEFAULT
57274>>>>>>>>>>>>>>> end
57274>>>>>>>>>>>>>>>>
57274>>>>>>>>>>>>>>> else set piProgressMode to mode#
57276>>>>>>>>>>>>>>> end_procedure
57277>>>>>>>>>>>>>>> procedure structure_end
57279>>>>>>>>>>>>>>> integer liFile callback_obj# wmode# lbOpen
57279>>>>>>>>>>>>>>> integer lhSortHandle
57279>>>>>>>>>>>>>>> string physical_name#
57279>>>>>>>>>>>>>>> if (piProbeState(self)) begin
57281>>>>>>>>>>>>>>> error 773 "No STRUCTURE_END while in probe mode"
57282>>>>>>>>>>>>>>>>
57282>>>>>>>>>>>>>>> procedure_return
57283>>>>>>>>>>>>>>> end
57283>>>>>>>>>>>>>>>>
57283>>>>>>>>>>>>>>> move (oStructureWait(self)) to callback_obj#
57284>>>>>>>>>>>>>>> get piProgressMode to wmode#
57285>>>>>>>>>>>>>>> get piFileHandle to liFile
57286>>>>>>>>>>>>>>> get_attribute DF_FILE_PHYSICAL_NAME of liFile to physical_name#
57289>>>>>>>>>>>>>>> send execute to (oPostponedFileSettings(self)) physical_name#
57290>>>>>>>>>>>>>>> send execute to (oPostponedFieldSettings(self)) physical_name#
57291>>>>>>>>>>>>>>> if wmode# ne RS_PG_NONE begin
57293>>>>>>>>>>>>>>> send activate_title to callback_obj# physical_name#
57294>>>>>>>>>>>>>>> structure_end liFile DF_STRUCTEND_OPT_NONE "." callback_obj# // (pRestuctOpt(self)) (pTempDir(self)) (pCallBackObj(self))
57296>>>>>>>>>>>>>>> end
57296>>>>>>>>>>>>>>>>
57296>>>>>>>>>>>>>>> else begin
57297>>>>>>>>>>>>>>> structure_end liFile DF_STRUCTEND_OPT_NONE "." // (pRestuctOpt(self)) (pTempDir(self))
57299>>>>>>>>>>>>>>> end
57299>>>>>>>>>>>>>>>>
57299>>>>>>>>>>>>>>>
57299>>>>>>>>>>>>>>> send fix_the_tag_file to (oFieldNameRepair(self))
57300>>>>>>>>>>>>>>> set piFileHandle to liFile
57301>>>>>>>>>>>>>>>// send DFMatrixError_Off
57301>>>>>>>>>>>>>>>// if (piErrorHandling(self)) get private.piOrigOnError to |VI31 // Restore normal error handling routine
57301>>>>>>>>>>>>>>> send NotifyTracer RSOP_END 0 0 0 0 ""
57302>>>>>>>>>>>>>>> send delete_data to (oOldFieldNumbersRepair(self))
57303>>>>>>>>>>>>>>>
57303>>>>>>>>>>>>>>> if (private.piSortOnEndStructure(self)) begin
57305>>>>>>>>>>>>>>> get piMainFile to lhSortHandle
57306>>>>>>>>>>>>>>> if lhSortHandle begin // We don't reindex files that were just created
57308>>>>>>>>>>>>>>> send WriteLn to (oStructure_LogFile(self)) " Forcing reindex..."
57309>>>>>>>>>>>>>>> close lhSortHandle
57310>>>>>>>>>>>>>>>// send WriteLn to (oStructure_LogFile(self)) (" And the sort handle is: "+string(lhSortHandle))
57310>>>>>>>>>>>>>>>// send WriteLn to (oStructure_LogFile(self)) (" And the rootname is: "+physical_name#)
57310>>>>>>>>>>>>>>>// if (lhSortHandle=1 or lhSortHandle=21 or lhSortHandle=95) begin
57310>>>>>>>>>>>>>>>// send obs "open physical_name# as" physical_name# lhSortHandle DF_EXCLUSIVE
57310>>>>>>>>>>>>>>>
57310>>>>>>>>>>>>>>>// send obs "Errors?" WINDOWINDEX
57310>>>>>>>>>>>>>>>// end
57310>>>>>>>>>>>>>>>// open physical_name# as lhSortHandle DF_EXCLUSIVE
57310>>>>>>>>>>>>>>>
57310>>>>>>>>>>>>>>> get DBMS_OpenFileAs physical_name# lhSortHandle DF_EXCLUSIVE 0 to lbOpen
57311>>>>>>>>>>>>>>> if lbOpen begin
57313>>>>>>>>>>>>>>> if wmode# ne RS_PG_NONE sort lhSortHandle '' (DF_SORT_OPTION_BAD_DATA_FILE ior DF_SORT_OPTION_DUP_DATA_FILE) callback_obj#
57317>>>>>>>>>>>>>>> else sort lhSortHandle '' (DF_SORT_OPTION_BAD_DATA_FILE ior DF_SORT_OPTION_DUP_DATA_FILE)
57320>>>>>>>>>>>>>>> end
57320>>>>>>>>>>>>>>>>
57320>>>>>>>>>>>>>>> else send WriteLnError to (oStructure_LogFile(self)) " Table could not be opened for reindexing!"
57322>>>>>>>>>>>>>>>// if (FDX_SetOfIndices(0,lhSortHandle,DF_INDEX_TYPE_ONLINE)+FDX_SetOfIndices(0,lhSortHandle,DF_INDEX_TYPE_BATCH)) ne "" begin
57322>>>>>>>>>>>>>>>// if wmode# ne RS_PG_NONE sort lhSortHandle '' (DF_SORT_OPTION_BAD_DATA_FILE ior DF_SORT_OPTION_DUP_DATA_FILE) callback_obj#
57322>>>>>>>>>>>>>>>// else sort lhSortHandle '' (DF_SORT_OPTION_BAD_DATA_FILE ior DF_SORT_OPTION_DUP_DATA_FILE)
57322>>>>>>>>>>>>>>>// end
57322>>>>>>>>>>>>>>>// else send WriteLn to (oStructure_LogFile(self)) " No indices on table, reindex abandoned!"
57322>>>>>>>>>>>>>>> close lhSortHandle
57323>>>>>>>>>>>>>>> end
57323>>>>>>>>>>>>>>>>
57323>>>>>>>>>>>>>>> end
57323>>>>>>>>>>>>>>>>
57323>>>>>>>>>>>>>>>
57323>>>>>>>>>>>>>>> send DFMatrixError_Off
57324>>>>>>>>>>>>>>> if (piErrorHandling(self)) get private.piOrigOnError to |VI31 // Restore normal error handling routine
57327>>>>>>>>>>>>>>>
57327>>>>>>>>>>>>>>> send CloseOutput to (oStructure_LogFile(self)) // Structure_End
57328>>>>>>>>>>>>>>>
57328>>>>>>>>>>>>>>> if wmode# eq RS_PG_DEFAULT send deactivate_display to callback_obj#
57331>>>>>>>>>>>>>>> end_procedure
57332>>>>>>>>>>>>>>>
57332>>>>>>>>>>>>>>> procedure SetFileAttr integer attr# string value#
57334>>>>>>>>>>>>>>> integer liFile
57334>>>>>>>>>>>>>>> if (piProbeState(self)) begin
57336>>>>>>>>>>>>>>> error 674 "Sorry, no SETFILEATTR while in probe mode"
57337>>>>>>>>>>>>>>>>
57337>>>>>>>>>>>>>>> procedure_return
57338>>>>>>>>>>>>>>> end
57338>>>>>>>>>>>>>>>>
57338>>>>>>>>>>>>>>> ifnot (piIgnoreTheRestState(self)) begin
57340>>>>>>>>>>>>>>> if attr# eq DF_FILE_RECORD_LENGTH send postponed_setting to (oPostponedFileSettings(self)) attr# value#
57343>>>>>>>>>>>>>>> else begin
57344>>>>>>>>>>>>>>> get piFileHandle to liFile
57345>>>>>>>>>>>>>>> //send obs "SET FileAttribute of" liFile (API_Attr_Name(attr#)) value#
57345>>>>>>>>>>>>>>> ErrorTrapping.set_attribute attr# of liFile to value#
57353>>>>>>>>>>>>>>> send NotifyTracer RSOP_SETFILEATTR attr# 0 0 0 value#
57354>>>>>>>>>>>>>>> end
57354>>>>>>>>>>>>>>>>
57354>>>>>>>>>>>>>>> end
57354>>>>>>>>>>>>>>>>
57354>>>>>>>>>>>>>>> end_procedure
57355>>>>>>>>>>>>>>> procedure SetFieldAttr integer attr# integer field# string value#
57357>>>>>>>>>>>>>>> integer liFile
57357>>>>>>>>>>>>>>> if (piProbeState(self)) begin
57359>>>>>>>>>>>>>>> error 675 "Sorry, no SETFIELDATTR while in probe mode"
57360>>>>>>>>>>>>>>>>
57360>>>>>>>>>>>>>>> procedure_return
57361>>>>>>>>>>>>>>> end
57361>>>>>>>>>>>>>>>>
57361>>>>>>>>>>>>>>> ifnot (piIgnoreTheRestState(self)) begin
57363>>>>>>>>>>>>>>> if attr# eq DF_FIELD_NAME begin
57365>>>>>>>>>>>>>>> if "@" in value# move (sAddField.s(oFieldNameRepair(self),value#)) to value#
57368>>>>>>>>>>>>>>> if (StringBeginsWith(value#,"FIELD")) move (sAddField.s(oFieldNameRepair(self),value#)) to value#
57371>>>>>>>>>>>>>>> end
57371>>>>>>>>>>>>>>>>
57371>>>>>>>>>>>>>>> if attr# eq DF_FIELD_INDEX begin
57373>>>>>>>>>>>>>>> // We postpone main index setting until the very end. Then we are
57373>>>>>>>>>>>>>>> // sure that the relevant index is present
57373>>>>>>>>>>>>>>> if field# eq IMPLICIT_FIELD get private.piCurrentField to field#
57376>>>>>>>>>>>>>>> send postponed_setting to (oPostponedFieldSettings(self)) attr# field# value#
57377>>>>>>>>>>>>>>> end
57377>>>>>>>>>>>>>>>>
57377>>>>>>>>>>>>>>> else begin
57378>>>>>>>>>>>>>>> if field# eq IMPLICIT_FIELD get private.piCurrentField to field#
57381>>>>>>>>>>>>>>> get piFileHandle to liFile
57382>>>>>>>>>>>>>>> ErrorTrapping.set_attribute attr# of liFile field# to value#
57391>>>>>>>>>>>>>>> send NotifyTracer RSOP_SETFIELDATTR attr# field# 0 0 value#
57392>>>>>>>>>>>>>>> end
57392>>>>>>>>>>>>>>>>
57392>>>>>>>>>>>>>>> end
57392>>>>>>>>>>>>>>>>
57392>>>>>>>>>>>>>>> end_procedure
57393>>>>>>>>>>>>>>> function iFindFieldOldNumber.i integer old_number# returns integer
57395>>>>>>>>>>>>>>> integer liFile max# field# test#
57395>>>>>>>>>>>>>>> // Very unfortunately, this function doesn't work! (DF_FIELD_OLD_NUMBER returns rubbish)
57395>>>>>>>>>>>>>>> // Therefore we call another procedure until DAW gets it fixed
57395>>>>>>>>>>>>>>> function_return (iFindFieldOldNumber.i(oOldFieldNumbersRepair(self),old_number#))
57396>>>>>>>>>>>>>>> get piFileHandle to liFile
57397>>>>>>>>>>>>>>> get_attribute DF_FILE_NUMBER_FIELDS of liFile to max#
57400>>>>>>>>>>>>>>> for field# from 1 to max#
57406>>>>>>>>>>>>>>>>
57406>>>>>>>>>>>>>>> get_attribute DF_FIELD_OLD_NUMBER of liFile field# to test#
57409>>>>>>>>>>>>>>> if test# eq old_number# function_return field#
57412>>>>>>>>>>>>>>> loop
57413>>>>>>>>>>>>>>>>
57413>>>>>>>>>>>>>>> function_return -1
57414>>>>>>>>>>>>>>> end_function
57415>>>>>>>>>>>>>>> function iFindFieldName.s string name# returns integer
57417>>>>>>>>>>>>>>> integer field# max# liFile
57417>>>>>>>>>>>>>>> string test_name#
57417>>>>>>>>>>>>>>> get piFileHandle to liFile
57418>>>>>>>>>>>>>>> get field_count to max#
57419>>>>>>>>>>>>>>> // First we look for the name passed:
57419>>>>>>>>>>>>>>> for field# from 1 to max#
57425>>>>>>>>>>>>>>>>
57425>>>>>>>>>>>>>>> get_attribute DF_FIELD_NAME of liFile field# to test_name#
57428>>>>>>>>>>>>>>> if test_name# eq name# function_return field#
57431>>>>>>>>>>>>>>> loop
57432>>>>>>>>>>>>>>>>
57432>>>>>>>>>>>>>>> // If not found we now see if it helps to translate it:
57432>>>>>>>>>>>>>>> get sTempName.s of (oFieldNameRepair(self)) name# to name#
57433>>>>>>>>>>>>>>> if name# ne "" begin
57435>>>>>>>>>>>>>>> for field# from 1 to max#
57441>>>>>>>>>>>>>>>>
57441>>>>>>>>>>>>>>> get_attribute DF_FIELD_NAME of liFile field# to test_name#
57444>>>>>>>>>>>>>>> if test_name# eq name# function_return field#
57447>>>>>>>>>>>>>>> loop
57448>>>>>>>>>>>>>>>>
57448>>>>>>>>>>>>>>> end
57448>>>>>>>>>>>>>>>>
57448>>>>>>>>>>>>>>> function_return -1
57449>>>>>>>>>>>>>>> end_function
57450>>>>>>>>>>>>>>> procedure SetFieldAttr_OldNumber integer attr# integer old_number# string value#
57452>>>>>>>>>>>>>>> integer field#
57452>>>>>>>>>>>>>>> error 678 "Procedure SetFieldAttr_OldNumber in STRUCTUR.UTL) was called"
57453>>>>>>>>>>>>>>>>
57453>>>>>>>>>>>>>>> get iFindFieldOldNumber.i old_number# to field#
57454>>>>>>>>>>>>>>> if field# ne -1 send SetFieldAttr attr# field# value#
57457>>>>>>>>>>>>>>> else error 669 ("Old number not found ("+string(old_number#)+")")
57459>>>>>>>>>>>>>>> end_procedure
57460>>>>>>>>>>>>>>> procedure SetFieldAttr_ByName integer attr# string name# string value#
57462>>>>>>>>>>>>>>> integer field#
57462>>>>>>>>>>>>>>> ifnot (piIgnoreTheRestState(self)) begin
57464>>>>>>>>>>>>>>> get iFindFieldName.s name# to field#
57465>>>>>>>>>>>>>>> if field# ne -1 send SetFieldAttr attr# field# value#
57468>>>>>>>>>>>>>>> else error 670 ("Field name not found ("+name#+")")
57470>>>>>>>>>>>>>>> end
57470>>>>>>>>>>>>>>>>
57470>>>>>>>>>>>>>>> end_procedure
57471>>>>>>>>>>>>>>> procedure SetIndexAttr_Help integer index#
57473>>>>>>>>>>>>>>> integer liFile index_handle# arr# max#
57473>>>>>>>>>>>>>>> if (index#<1 or index#>15) error 671 ("Index number out of bounds ("+string(index#)+")")
57476>>>>>>>>>>>>>>> move (oTmpArray(self)) to arr#
57477>>>>>>>>>>>>>>> send delete_data to arr#
57478>>>>>>>>>>>>>>> get piFileHandle to liFile
57479>>>>>>>>>>>>>>> move index# to index_handle#
57480>>>>>>>>>>>>>>> repeat
57480>>>>>>>>>>>>>>>>
57480>>>>>>>>>>>>>>> ErrorTrapping.create_index liFile at index_handle#
57485>>>>>>>>>>>>>>> if index_handle# ne index# set value of arr# item index_handle# to 1
57488>>>>>>>>>>>>>>> until index_handle# eq index#
57490>>>>>>>>>>>>>>> get item_count of arr# to max#
57491>>>>>>>>>>>>>>> for index# from 0 to (max#-1)
57497>>>>>>>>>>>>>>>>
57497>>>>>>>>>>>>>>> if (integer(value(arr#,index#))) ErrorTrapping.delete_index liFile index#
57504>>>>>>>>>>>>>>> loop
57505>>>>>>>>>>>>>>>>
57505>>>>>>>>>>>>>>> send delete_data to arr#
57506>>>>>>>>>>>>>>> end_procedure
57507>>>>>>>>>>>>>>> procedure SetIndexAttr integer attr# integer index# string value#
57509>>>>>>>>>>>>>>> integer liFile segments#
57509>>>>>>>>>>>>>>> if (piProbeState(self)) begin
57511>>>>>>>>>>>>>>> error 676 "Sorry, not while in probe mode"
57512>>>>>>>>>>>>>>>>
57512>>>>>>>>>>>>>>> procedure_return
57513>>>>>>>>>>>>>>> end
57513>>>>>>>>>>>>>>>>
57513>>>>>>>>>>>>>>> ifnot (piIgnoreTheRestState(self)) begin
57515>>>>>>>>>>>>>>> if (attr#=DF_INDEX_NUMBER_SEGMENTS and integer(value#)=0) send DeleteIndex index#
57518>>>>>>>>>>>>>>> else begin
57519>>>>>>>>>>>>>>> get piFileHandle to liFile
57520>>>>>>>>>>>>>>> get_attribute DF_INDEX_NUMBER_SEGMENTS of liFile index# to segments#
57523>>>>>>>>>>>>>>> ifnot segments# send SetIndexAttr_Help index# // create_index liFile at index#
57526>>>>>>>>>>>>>>> ErrorTrapping.set_attribute attr# of liFile index# to value#
57535>>>>>>>>>>>>>>> send NotifyTracer RSOP_SETINDEXATTR attr# 0 index# 0 value#
57536>>>>>>>>>>>>>>> end
57536>>>>>>>>>>>>>>>>
57536>>>>>>>>>>>>>>> end
57536>>>>>>>>>>>>>>>>
57536>>>>>>>>>>>>>>> end_procedure
57537>>>>>>>>>>>>>>> procedure SetIndexSegAttr integer attr# integer index# integer seg# string value#
57539>>>>>>>>>>>>>>> integer liFile field# type#
57539>>>>>>>>>>>>>>> if (piProbeState(self)) begin
57541>>>>>>>>>>>>>>> error 677 "Sorry, not while in probe mode"
57542>>>>>>>>>>>>>>>>
57542>>>>>>>>>>>>>>> procedure_return
57543>>>>>>>>>>>>>>> end
57543>>>>>>>>>>>>>>>>
57543>>>>>>>>>>>>>>> ifnot (piIgnoreTheRestState(self)) begin
57545>>>>>>>>>>>>>>> get piFileHandle to liFile
57546>>>>>>>>>>>>>>> if attr# eq DF_INDEX_SEGMENT_CASE begin
57548>>>>>>>>>>>>>>> get_attribute DF_INDEX_SEGMENT_FIELD of liFile index# seg# to field#
57551>>>>>>>>>>>>>>> get_attribute DF_FIELD_TYPE of liFile field# to type#
57554>>>>>>>>>>>>>>> if (type#<>DF_ASCII and integer(value#)=DF_CASE_IGNORED) procedure_return // We only do this for ASCII fields
57557>>>>>>>>>>>>>>> end
57557>>>>>>>>>>>>>>>>
57557>>>>>>>>>>>>>>> ErrorTrapping.set_attribute attr# of liFile index# seg# to value#
57567>>>>>>>>>>>>>>> send NotifyTracer RSOP_SETINDEXSEGATTR attr# 0 index# seg# value#
57568>>>>>>>>>>>>>>> end
57568>>>>>>>>>>>>>>>>
57568>>>>>>>>>>>>>>> end_procedure
57569>>>>>>>>>>>>>>>
57569>>>>>>>>>>>>>>> function GetFileAttr integer attr# returns string
57571>>>>>>>>>>>>>>> integer liFile
57571>>>>>>>>>>>>>>> string value#
57571>>>>>>>>>>>>>>> get piFileHandle to liFile
57572>>>>>>>>>>>>>>> get_attribute attr# of liFile to value#
57575>>>>>>>>>>>>>>> function_return value#
57576>>>>>>>>>>>>>>> end_function
57577>>>>>>>>>>>>>>> function GetFieldAttr integer attr# integer field# returns string
57579>>>>>>>>>>>>>>> integer liFile
57579>>>>>>>>>>>>>>> string value#
57579>>>>>>>>>>>>>>> if field# eq IMPLICIT_FIELD get private.piCurrentField to field#
57582>>>>>>>>>>>>>>> get piFileHandle to liFile
57583>>>>>>>>>>>>>>> get_attribute attr# of liFile field# to value#
57586>>>>>>>>>>>>>>> function_return value#
57587>>>>>>>>>>>>>>> end_function
57588>>>>>>>>>>>>>>> function GetIndexAttr integer attr# integer index# returns string
57590>>>>>>>>>>>>>>> integer liFile
57590>>>>>>>>>>>>>>> string value#
57590>>>>>>>>>>>>>>> get piFileHandle to liFile
57591>>>>>>>>>>>>>>> get_attribute attr# of liFile index# to value#
57594>>>>>>>>>>>>>>> function_return value#
57595>>>>>>>>>>>>>>> end_function
57596>>>>>>>>>>>>>>> function GetIndexSegAttr integer attr# integer index# integer seg# returns string
57598>>>>>>>>>>>>>>> integer liFile
57598>>>>>>>>>>>>>>> string value#
57598>>>>>>>>>>>>>>> get piFileHandle to liFile
57599>>>>>>>>>>>>>>> get_attribute attr# of liFile index# seg# to value#
57602>>>>>>>>>>>>>>> function_return value#
57603>>>>>>>>>>>>>>> end_function
57604>>>>>>>>>>>>>>> function GetFileListAttr integer attr# returns string
57606>>>>>>>>>>>>>>> integer liFile
57606>>>>>>>>>>>>>>> string value#
57606>>>>>>>>>>>>>>> get piFileHandle to liFile
57607>>>>>>>>>>>>>>> get_attribute attr# of liFile to value#
57610>>>>>>>>>>>>>>> function_return value#
57611>>>>>>>>>>>>>>> end_function
57612>>>>>>>>>>>>>>>
57612>>>>>>>>>>>>>>> procedure TableDropHelp string lsFile
57614>>>>>>>>>>>>>>> integer liError
57614>>>>>>>>>>>>>>> move (uppercase(lsFile)) to lsFile
57615>>>>>>>>>>>>>>> if (right(lsFile,3)="DAT") move 1 to liError
57618>>>>>>>>>>>>>>> if (right(lsFile,3)="TAG") move 1 to liError
57621>>>>>>>>>>>>>>> if (right(lsFile,3)="VLD") move 1 to liError
57624>>>>>>>>>>>>>>> if (right(lsFile,3)="HDR") move 1 to liError
57627>>>>>>>>>>>>>>>// if (right(lsFile,1)="K") move 1 to liError
57627>>>>>>>>>>>>>>> if (right(lsFile,3)="DEF") move 1 to liError
57630>>>>>>>>>>>>>>> if (right(lsFile,2)="FD") move 1 to liError
57633>>>>>>>>>>>>>>> if liError set private.piDropCounter to (private.piDropCounter(self)+1)
57636>>>>>>>>>>>>>>> end_procedure
57637>>>>>>>>>>>>>>> function iTableDrop.s string lsRoot returns integer
57639>>>>>>>>>>>>>>> string lsDatFile lsPath liGrb
57639>>>>>>>>>>>>>>> move (lowercase(lsRoot)) to lsRoot
57640>>>>>>>>>>>>>>> move (lsRoot+".dat") to lsDatFile
57641>>>>>>>>>>>>>>> move (SEQ_FindFileAlongDFPath(lsDatFile)) to lsPath
57642>>>>>>>>>>>>>>> move (SEQ_ComposeAbsoluteFileName(lsPath,lsRoot)) to lsRoot
57643>>>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".dat") to liGrb
57644>>>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".tag") to liGrb
57645>>>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".vld") to liGrb
57646>>>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".hdr") to liGrb
57647>>>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".k?") to liGrb
57648>>>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".def") to liGrb
57649>>>>>>>>>>>>>>> get SEQ_EraseFile (lsRoot+".fd") to liGrb
57650>>>>>>>>>>>>>>> send SEQ_Load_ItemsInDir (lsRoot+".*")
57651>>>>>>>>>>>>>>> set private.piDropCounter to 0
57652>>>>>>>>>>>>>>> send SEQ_CallBack_ItemsInDir SEQCB_FILES_ONLY msg_TableDropHelp self
57653>>>>>>>>>>>>>>> function_return (private.piDropCounter(self))
57654>>>>>>>>>>>>>>> end_function
57655>>>>>>>>>>>>>>> function iTableProbe.i integer liFile returns integer
57657>>>>>>>>>>>>>>> integer rval#
57657>>>>>>>>>>>>>>> move (DBMS_OpenFile(liFile,DF_SHARE,0)) to rval#
57658>>>>>>>>>>>>>>> set piProbeState to rval#
57659>>>>>>>>>>>>>>> if rval# begin
57661>>>>>>>>>>>>>>> set piMainFile to liFile
57662>>>>>>>>>>>>>>> set piFileHandle to liFile
57663>>>>>>>>>>>>>>> end
57663>>>>>>>>>>>>>>>>
57663>>>>>>>>>>>>>>> function_return (not(rval#)) // Returns 0 if success
57664>>>>>>>>>>>>>>> end_function
57665>>>>>>>>>>>>>>> procedure Probe_End
57667>>>>>>>>>>>>>>> if (piProbeState(self)) begin
57669>>>>>>>>>>>>>>> close (piMainFile(self))
57670>>>>>>>>>>>>>>> set piProbeState to false
57671>>>>>>>>>>>>>>> end
57671>>>>>>>>>>>>>>>>
57671>>>>>>>>>>>>>>> else error 679 "Probing not initialized"
57673>>>>>>>>>>>>>>> end_procedure
57674>>>>>>>>>>>>>>>
57674>>>>>>>>>>>>>>> procedure reset.is integer liFile string lsRootName
57676>>>>>>>>>>>>>>> send DFMatrixError_On
57677>>>>>>>>>>>>>>> if liFile send DoWriteTimeEntry to (oStructure_LogFile(self)) ("Restructuring table: "+lsRootName+" ("+string(liFile)+")")
57680>>>>>>>>>>>>>>> else send DoWriteTimeEntry to (oStructure_LogFile(self)) ("Creating table: "+lsRootName)
57682>>>>>>>>>>>>>>> set piMainFile to liFile
57683>>>>>>>>>>>>>>> if liFile set piInitialNumberOfFields to (API_AttrValue_FILE(DF_FILE_NUMBER_FIELDS,liFile))
57686>>>>>>>>>>>>>>> else set piInitialNumberOfFields to 0
57688>>>>>>>>>>>>>>> set piIgnoreTheRestState to 0
57689>>>>>>>>>>>>>>> end_procedure
57690>>>>>>>>>>>>>>>
57690>>>>>>>>>>>>>>> function iTableOpen.is integer liFile string fn# returns integer
57692>>>>>>>>>>>>>>> integer rval#
57692>>>>>>>>>>>>>>> string path#
57692>>>>>>>>>>>>>>> move (DBMS_OpenFileAs(fn#,liFile,DF_EXCLUSIVE,0)) to rval#
57693>>>>>>>>>>>>>>> if rval# begin
57695>>>>>>>>>>>>>>> //move (rval#=DBMS_DRIVER_DATAFLEX) to rval# // Only DataFlex files
57695>>>>>>>>>>>>>>> ifnot rval# close liFile
57698>>>>>>>>>>>>>>> end
57698>>>>>>>>>>>>>>>>
57698>>>>>>>>>>>>>>> if rval# begin
57700>>>>>>>>>>>>>>> send AppendOutput to (oStructure_LogFile(self))
57701>>>>>>>>>>>>>>> send reset.is liFile fn#
57702>>>>>>>>>>>>>>> move (fn#+".dat") to fn#
57703>>>>>>>>>>>>>>> move (SEQ_ExtractPathFromFileName(fn#)) to path#
57704>>>>>>>>>>>>>>> set psDatFileName to (SEQ_RemovePathFromFileName(fn#))
57705>>>>>>>>>>>>>>> if path# eq "" move (SEQ_FindFileAlongDFPath(fn#)) to path#
57708>>>>>>>>>>>>>>> set psDatFilePath to path#
57709>>>>>>>>>>>>>>> send structure_start
57710>>>>>>>>>>>>>>> end
57710>>>>>>>>>>>>>>>>
57710>>>>>>>>>>>>>>> else send CloseOutput to (oStructure_LogFile(self)) // Close log file if table could not open
57712>>>>>>>>>>>>>>> set piRS_State to rval#
57713>>>>>>>>>>>>>>> function_return (not(rval#)) // Returns 0 if success
57714>>>>>>>>>>>>>>> end_function
57715>>>>>>>>>>>>>>>
57715>>>>>>>>>>>>>>> function iTableOpen.i integer liFile returns integer
57717>>>>>>>>>>>>>>> integer rval#
57717>>>>>>>>>>>>>>> string fn# path#
57717>>>>>>>>>>>>>>> move (DBMS_IsOpenFile(liFile)) to rval#
57718>>>>>>>>>>>>>>> if rval# ifnot (integer(API_AttrValue_FILE(DF_FILE_OPEN_MODE,liFile))=DF_EXCLUSIVE) move 0 to rval#
57723>>>>>>>>>>>>>>> ifnot rval# move (DBMS_OpenFile(liFile,DF_EXCLUSIVE,0)) to rval#
57726>>>>>>>>>>>>>>> if rval# begin
57728>>>>>>>>>>>>>>> //move (rval#=DBMS_DRIVER_DATAFLEX) to rval# // Only DataFlex files
57728>>>>>>>>>>>>>>> ifnot rval# close liFile
57731>>>>>>>>>>>>>>> end
57731>>>>>>>>>>>>>>>>
57731>>>>>>>>>>>>>>> if rval# begin
57733>>>>>>>>>>>>>>> move (API_AttrValue_FILELIST(DF_FILE_ROOT_NAME,liFile)) to fn#
57734>>>>>>>>>>>>>>> send AppendOutput to (oStructure_LogFile(self))
57735>>>>>>>>>>>>>>> send reset.is liFile fn#
57736>>>>>>>>>>>>>>> move (fn#+".dat") to fn#
57737>>>>>>>>>>>>>>> move (SEQ_ExtractPathFromFileName(fn#)) to path#
57738>>>>>>>>>>>>>>> set psDatFileName to (SEQ_RemovePathFromFileName(fn#))
57739>>>>>>>>>>>>>>> if path# eq "" move (SEQ_FindFileAlongDFPath(fn#)) to path#
57742>>>>>>>>>>>>>>> set psDatFilePath to path#
57743>>>>>>>>>>>>>>> send structure_start
57744>>>>>>>>>>>>>>> end
57744>>>>>>>>>>>>>>>>
57744>>>>>>>>>>>>>>> else send CloseOutput to (oStructure_LogFile(self)) //
57746>>>>>>>>>>>>>>> set piRS_State to rval#
57747>>>>>>>>>>>>>>> function_return (not(rval#)) // Returns 0 if success
57748>>>>>>>>>>>>>>> end_function
57749>>>>>>>>>>>>>>>
57749>>>>>>>>>>>>>>> function iTableExists.s string root# returns integer
57751>>>>>>>>>>>>>>> integer rval#
57751>>>>>>>>>>>>>>> function_return 1
57752>>>>>>>>>>>>>>> end_function
57753>>>>>>>>>>>>>>>
57753>>>>>>>>>>>>>>> //> Specifying a root name that does already exist on
57753>>>>>>>>>>>>>>> //> disk will overwrite existing data.
57753>>>>>>>>>>>>>>> //> Omitting the path from the root name will place the
57753>>>>>>>>>>>>>>> //> table in the first directory of the current DFPATH.
57753>>>>>>>>>>>>>>> //> Returns 0 if all is well
57753>>>>>>>>>>>>>>> function iTableCreate.s string lsRoot returns integer
57755>>>>>>>>>>>>>>> send AppendOutput to (oStructure_LogFile(self))
57756>>>>>>>>>>>>>>> send reset.is 0 lsRoot
57757>>>>>>>>>>>>>>> set psDatFileName to (SEQ_RemovePathFromFileName(lsRoot)+".dat")
57758>>>>>>>>>>>>>>> set psDatFilePath to (SEQ_ExtractPathFromFileName(lsRoot))
57759>>>>>>>>>>>>>>> if (SEQ_FileExists(ToAnsi(lsRoot)+".dat")=SEQIT_NONE) begin
57761>>>>>>>>>>>>>>> //send obs "psDatFileName" (psDatFileName(self)) "psDatFilePath" (psDatFilePath(self))
57761>>>>>>>>>>>>>>> send structure_start
57762>>>>>>>>>>>>>>> send SetFileAttr DF_FILE_MAX_RECORDS 10000 // Set up a few default values
57763>>>>>>>>>>>>>>> send SetFileAttr DF_FILE_MULTIUSER DF_FILE_USER_MULTI
57764>>>>>>>>>>>>>>> send SetFileAttr DF_FILE_REUSE_DELETED DF_FILE_DELETED_REUSE
57765>>>>>>>>>>>>>>> send SetFileAttr DF_FILE_PHYSICAL_NAME (ToAnsi(lsRoot))
57766>>>>>>>>>>>>>>> function_return 0 // 0 means OK
57767>>>>>>>>>>>>>>> end
57767>>>>>>>>>>>>>>>>
57767>>>>>>>>>>>>>>> send WriteLnError to (oStructure_LogFile(self)) (" Cannot create existing file "+lsRoot+".dat")
57768>>>>>>>>>>>>>>> send DFMatrixError_Off
57769>>>>>>>>>>>>>>> send CloseOutput to (oStructure_LogFile(self)) // Closes log file if Table could not be created
57770>>>>>>>>>>>>>>> function_return 1
57771>>>>>>>>>>>>>>> end_function
57772>>>>>>>>>>>>>>> procedure display_definition
57774>>>>>>>>>>>>>>> integer liFile
57774>>>>>>>>>>>>>>> get piFileHandle to liFile
57775>>>>>>>>>>>>>>>
57775>>>>>>>>>>>>>>> send FDX_ModalDisplayFileAttributes 0 liFile
57776>>>>>>>>>>>>>>> end_procedure
57777>>>>>>>>>>>>>>> procedure NotifyTracer integer op# integer attr# integer field# integer index# integer seg# string value#
57779>>>>>>>>>>>>>>> integer liFile
57779>>>>>>>>>>>>>>> get piFileHandle to liFile
57780>>>>>>>>>>>>>>> if (piTraceObject(self)) send RegisterUpdate to (piTraceObject(self)) liFile op# attr# field# index# seg# value#
57783>>>>>>>>>>>>>>> end_procedure
57784>>>>>>>>>>>>>>>
57784>>>>>>>>>>>>>>> //> This function returns the root name of the file including path
57784>>>>>>>>>>>>>>> //> if a path was originally specified:
57784>>>>>>>>>>>>>>> function sRootInclPath returns string
57786>>>>>>>>>>>>>>> string root# path#
57786>>>>>>>>>>>>>>> get psDatFileName to root#
57787>>>>>>>>>>>>>>> move (replace(".dat",root#,"")) to root#
57788>>>>>>>>>>>>>>> move (replace(".DAT",root#,"")) to root#
57789>>>>>>>>>>>>>>> get psDatFilePath to path#
57790>>>>>>>>>>>>>>> if path# ne "" move (SEQ_ComposeAbsoluteFileName(path#,root#)) to root#
57793>>>>>>>>>>>>>>> function_return root#
57794>>>>>>>>>>>>>>> end_function
57795>>>>>>>>>>>>>>>end_class // cBasicRestructurer
57796>>>>>>>>>>>>>>>
57796>>>>>>>>>>>>>>>integer oRestructurer#
57796>>>>>>>>>>>>>>>object oRestructurer is a cBasicRestructurer
57798>>>>>>>>>>>>>>> move self to oRestructurer#
57799>>>>>>>>>>>>>>>end_object
57800>>>>>>>>>>>>>>>
57800>>>>>>>>>>>>>>>// This one is used to control whether the sentinel should be
57800>>>>>>>>>>>>>>>// removed from screen when a restructure has ended.
57800>>>>>>>>>>>>>>>procedure RS_Progress global integer mode#
57802>>>>>>>>>>>>>>> send SetProgressMode to oRestructurer# mode#
57803>>>>>>>>>>>>>>>end_procedure
57804>>>>>>>>>>>>>>>
57804>>>>>>>>>>>>>>>// ********************** GLOBAL INTERFACE ******************************
57804>>>>>>>>>>>>>>>//> Display the definition as it looks right now. May be sent during a
57804>>>>>>>>>>>>>>>//> restructure for debug purposes.
57804>>>>>>>>>>>>>>>procedure RS_DisplayDef global
57806>>>>>>>>>>>>>>> send Display_Definition to oRestructurer#
57807>>>>>>>>>>>>>>>end_procedure
57808>>>>>>>>>>>>>>>//> May be used to manually set the field pointed to by the symbol
57808>>>>>>>>>>>>>>>//> IMPLICIT_FIELD (which is in fact -1)
57808>>>>>>>>>>>>>>>procedure RS_SetFieldNumber global integer field#
57810>>>>>>>>>>>>>>> send SetFieldNumber to oRestructurer# field#
57811>>>>>>>>>>>>>>>end_procedure
57812>>>>>>>>>>>>>>>//> Inserts a new field before existing field number field#. When this
57812>>>>>>>>>>>>>>>//> is done you should take care manually to change the offsets and
57812>>>>>>>>>>>>>>>//> lengths of affected overlap fields.
57812>>>>>>>>>>>>>>>procedure RS_CreateField global integer field# string name# integer type#
57814>>>>>>>>>>>>>>> send CreateField to oRestructurer# field# name# type#
57815>>>>>>>>>>>>>>>end_procedure
57816>>>>>>>>>>>>>>>procedure RS_CreateField_OldNumber global integer field# string name# integer type#
57818>>>>>>>>>>>>>>> send CreateField_OldNumber to oRestructurer# field# name# type#
57819>>>>>>>>>>>>>>>end_procedure
57820>>>>>>>>>>>>>>>//> Appends a field to the existing ones. Following this there should
57820>>>>>>>>>>>>>>>//> always be messages to set the length of the field.
57820>>>>>>>>>>>>>>>procedure RS_AppendField global string name# integer type#
57822>>>>>>>>>>>>>>> send AppendField to oRestructurer# name# type#
57823>>>>>>>>>>>>>>>end_procedure
57824>>>>>>>>>>>>>>>//> Deletes a field.
57824>>>>>>>>>>>>>>>procedure RS_DeleteField global integer field#
57826>>>>>>>>>>>>>>> send DeleteField to oRestructurer# field#
57827>>>>>>>>>>>>>>>end_procedure
57828>>>>>>>>>>>>>>>//> Deletes a field.
57828>>>>>>>>>>>>>>>procedure RS_DeleteField_OldNumber global integer old_field#
57830>>>>>>>>>>>>>>> send DeleteField_OldNumber to oRestructurer# old_field#
57831>>>>>>>>>>>>>>>end_procedure
57832>>>>>>>>>>>>>>>//> Deletes an index.
57832>>>>>>>>>>>>>>>procedure RS_DeleteIndex global integer idx#
57834>>>>>>>>>>>>>>> send DeleteIndex to oRestructurer# idx#
57835>>>>>>>>>>>>>>>end_procedure
57836>>>>>>>>>>>>>>>//> Abort the restructure.
57836>>>>>>>>>>>>>>>procedure RS_Structure_Abort global
57838>>>>>>>>>>>>>>> send Structure_Abort to oRestructurer#
57839>>>>>>>>>>>>>>>end_procedure
57840>>>>>>>>>>>>>>>//> Lets the changes that you have made so far take effect.
57840>>>>>>>>>>>>>>>procedure RS_Structure_End global integer liForceExtraSort
57842>>>>>>>>>>>>>>> integer liDoSort
57842>>>>>>>>>>>>>>> if num_arguments gt 0 move liForceExtraSort to liDoSort
57845>>>>>>>>>>>>>>> else move DFFALSE to liDoSort
57847>>>>>>>>>>>>>>> set private.piSortOnEndStructure of oRestructurer# to liDoSort
57848>>>>>>>>>>>>>>> send Structure_End to oRestructurer#
57849>>>>>>>>>>>>>>> set private.piSortOnEndStructure of oRestructurer# to DFFALSE
57850>>>>>>>>>>>>>>>end_procedure
57851>>>>>>>>>>>>>>>//> Closes the file formerly opened for probing.
57851>>>>>>>>>>>>>>>procedure RS_Probe_End global
57853>>>>>>>>>>>>>>> send Probe_End to oRestructurer#
57854>>>>>>>>>>>>>>>end_procedure
57855>>>>>>>>>>>>>>>
57855>>>>>>>>>>>>>>>//> Returns the current number of fields.
57855>>>>>>>>>>>>>>>function RS_CurrentFieldCount global returns integer
57857>>>>>>>>>>>>>>> function_return (field_count(oRestructurer#))
57858>>>>>>>>>>>>>>>end_function
57859>>>>>>>>>>>>>>>
57859>>>>>>>>>>>>>>>//> RS_TableOpenNumber returns 1 if the file was successfully opened
57859>>>>>>>>>>>>>>>//> for restructuring. The restructuring presumably anout to take place
57859>>>>>>>>>>>>>>>//> should be terminated with a RS_Structure_End or RS_Structure_Abort
57859>>>>>>>>>>>>>>>//> message.
57859>>>>>>>>>>>>>>>function RS_TableOpenNumber global integer liFile returns integer
57861>>>>>>>>>>>>>>> function_return (not(iTableOpen.i(oRestructurer#,liFile)))
57862>>>>>>>>>>>>>>>end_function
57863>>>>>>>>>>>>>>>
57863>>>>>>>>>>>>>>>//> RS_TableOpenName returns 1 if the file was successfully opened
57863>>>>>>>>>>>>>>>//> for restrucuring. The restructuring presumably anout to take place
57863>>>>>>>>>>>>>>>//> should be terminated with a RS_Structure_End or RS_Structure_Abort
57863>>>>>>>>>>>>>>>//> message.
57863>>>>>>>>>>>>>>>function RS_TableOpenName global integer liFile string fn# returns integer
57865>>>>>>>>>>>>>>> function_return (not(iTableOpen.is(oRestructurer#,liFile,fn#)))
57866>>>>>>>>>>>>>>>end_function
57867>>>>>>>>>>>>>>>
57867>>>>>>>>>>>>>>>//> RS_TableProbeNumber returns 1 if the file was successfully opened
57867>>>>>>>>>>>>>>>//> for probing. Probing should be ended with a RS_Probe_End message.
57867>>>>>>>>>>>>>>>function RS_TableProbeNumber global integer liFile returns integer
57869>>>>>>>>>>>>>>> function_return (not(iTableProbe.i(oRestructurer#,liFile)))
57870>>>>>>>>>>>>>>>end_function
57871>>>>>>>>>>>>>>>function RS_TableCreateName global string root# returns integer
57873>>>>>>>>>>>>>>> function_return (not(iTableCreate.s(oRestructurer#,root#)))
57874>>>>>>>>>>>>>>>end_function
57875>>>>>>>>>>>>>>>
57875>>>>>>>>>>>>>>>function RS_TableDropName global string root# returns integer
57877>>>>>>>>>>>>>>> function_return (not(iTableDrop.s(oRestructurer#,root#)))
57878>>>>>>>>>>>>>>>end_function
57879>>>>>>>>>>>>>>>function RS_TableExistsName global string root# returns integer
57881>>>>>>>>>>>>>>> function_return (iTableExists.s(oRestructurer#,root#))
57882>>>>>>>>>>>>>>>end_function
57883>>>>>>>>>>>>>>>
57883>>>>>>>>>>>>>>>//> Set value of File type attribute during restructuring.
57883>>>>>>>>>>>>>>>procedure RS_SetFileAttr global integer attr# string value#
57885>>>>>>>>>>>>>>> send SetFileAttr to oRestructurer# attr# value#
57886>>>>>>>>>>>>>>>end_procedure
57887>>>>>>>>>>>>>>>//> Set value of Field type attribute during restructuring.
57887>>>>>>>>>>>>>>>procedure RS_SetFieldAttr global integer attr# integer field# string value#
57889>>>>>>>>>>>>>>> send SetFieldAttr to oRestructurer# attr# field# value#
57890>>>>>>>>>>>>>>>end_procedure
57891>>>>>>>>>>>>>>>//> Set value of Field type attribute during restructuring. Field referenced by OLD_NUMBER
57891>>>>>>>>>>>>>>>procedure RS_SetFieldAttr_OldNumber global integer attr# integer field# string value#
57893>>>>>>>>>>>>>>> send SetFieldAttr_OldNumber to oRestructurer# attr# field# value#
57894>>>>>>>>>>>>>>>end_procedure
57895>>>>>>>>>>>>>>>//> Set value of Field type attribute during restructuring. Field referenced by NAME
57895>>>>>>>>>>>>>>>procedure RS_SetFieldAttr_ByName global integer attr# string name# string value#
57897>>>>>>>>>>>>>>> send SetFieldAttr_ByName to oRestructurer# attr# name# value#
57898>>>>>>>>>>>>>>>end_procedure
57899>>>>>>>>>>>>>>>//> Set value of Index type attribute during restructuring.
57899>>>>>>>>>>>>>>>procedure RS_SetIndexAttr global integer attr# integer index# string value#
57901>>>>>>>>>>>>>>> send SetIndexAttr to oRestructurer# attr# index# value#
57902>>>>>>>>>>>>>>>end_procedure
57903>>>>>>>>>>>>>>>//> Set value of Index Segment type attribute during restructuring.
57903>>>>>>>>>>>>>>>procedure RS_SetIndexSegAttr global integer attr# integer index# integer seg# string value#
57905>>>>>>>>>>>>>>> send SetIndexSegAttr to oRestructurer# attr# index# seg# value#
57906>>>>>>>>>>>>>>>end_procedure
57907>>>>>>>>>>>>>>>//> Set value of FileList type attribute during restructuring.
57907>>>>>>>>>>>>>>>procedure RS_SetFileListAttr global integer attr# integer liFile string value#
57909>>>>>>>>>>>>>>> ErrorTrapping.set_attribute attr# of liFile to value#
57917>>>>>>>>>>>>>>>end_procedure
57918>>>>>>>>>>>>>>>
57918>>>>>>>>>>>>>>>//> Get value of File type attribute while restructuring or probing.
57918>>>>>>>>>>>>>>>function RS_GetFileAttr global integer attr# returns string
57920>>>>>>>>>>>>>>> function_return (GetFileAttr(oRestructurer#,attr#))
57921>>>>>>>>>>>>>>>end_function
57922>>>>>>>>>>>>>>>//> Get value of Field type attribute while restructuring or probing.
57922>>>>>>>>>>>>>>>function RS_GetFieldAttr global integer attr# integer field# returns string
57924>>>>>>>>>>>>>>> function_return (GetFieldAttr(oRestructurer#,attr#,field#))
57925>>>>>>>>>>>>>>>end_function
57926>>>>>>>>>>>>>>>//> Get value of Index type attribute while restructuring or probing.
57926>>>>>>>>>>>>>>>function RS_GetIndexAttr global integer attr# integer index# returns string
57928>>>>>>>>>>>>>>> function_return (GetIndexAttr(oRestructurer#,attr#,index#))
57929>>>>>>>>>>>>>>>end_function
57930>>>>>>>>>>>>>>>//> Get value of Index Segment type attribute while restructuring or probing.
57930>>>>>>>>>>>>>>>function RS_GetIndexSegAttr global integer attr# integer index# integer seg# returns string
57932>>>>>>>>>>>>>>> function_return (GetIndexSegAttr(oRestructurer#,attr#,index#,seg#))
57933>>>>>>>>>>>>>>>end_function
57934>>>>>>>>>>>>>>>//> Get value of FileList type attribute while restructuring or probing.
57934>>>>>>>>>>>>>>>function RS_GetFileListAttr global integer attr# returns string
57936>>>>>>>>>>>>>>> function_return (GetFileListAttr(oRestructurer#,attr#))
57937>>>>>>>>>>>>>>>end_function
57938>>>>>>>>>>>>>>>
57938>>>>>>>>>>>>>Use API_Attr.nui // Database API attributes characteristics
57938>>>>>>>>>>>>>Use Spec0006.utl // Function MakeStringConstant and MakeStringConstantMax255
Including file: spec0006.utl (C:\Apps\VDFQuery\AppSrc\spec0006.utl)
57938>>>>>>>>>>>>>>>// Use Spec0006.utl // Function MakeStringConstant
57938>>>>>>>>>>>>>>>
57938>>>>>>>>>>>>>>>Use Strings.nui // String manipulation for VDF
57938>>>>>>>>>>>>>>>
57938>>>>>>>>>>>>>>>//> If the length of the return value is two longer than the length of
57938>>>>>>>>>>>>>>>//> the passed argument, the function only put qoutes around it. Otherwise
57938>>>>>>>>>>>>>>>//> the argument has been converted to a concatenation of string constants.
57938>>>>>>>>>>>>>>>//>
57938>>>>>>>>>>>>>>>//> World tour '99 becomes "World tour '99"
57938>>>>>>>>>>>>>>>//> 7" nails becomes '7" nails'
57938>>>>>>>>>>>>>>>//> 10" reels for an '88 becomes "10"+'" reels for an '+"'88"
57938>>>>>>>>>>>>>>>//
57938>>>>>>>>>>>>>>>
57938>>>>>>>>>>>>>>>function MakeStringConstant global string str# returns string
57940>>>>>>>>>>>>>>> integer len# pos#
57940>>>>>>>>>>>>>>> string char# rval# current_quote#
57940>>>>>>>>>>>>>>> ifnot "'" in str# function_return ("'"+str#+"'")
57943>>>>>>>>>>>>>>> ifnot '"' in str# function_return ('"'+str#+'"')
57946>>>>>>>>>>>>>>> move "" to rval#
57947>>>>>>>>>>>>>>> move (length(str#)) to len#
57948>>>>>>>>>>>>>>> if (left(str#,1)) eq '"' move "'" to current_quote#
57951>>>>>>>>>>>>>>> else move '"' to current_quote#
57953>>>>>>>>>>>>>>> move current_quote# to rval#
57954>>>>>>>>>>>>>>> for pos# from 0 to len#
57960>>>>>>>>>>>>>>>>
57960>>>>>>>>>>>>>>> move (mid(str#,1,pos#)) to char#
57961>>>>>>>>>>>>>>> if char# eq current_quote# begin
57963>>>>>>>>>>>>>>> move (rval#+current_quote#+"+") to rval#
57964>>>>>>>>>>>>>>> if current_quote# eq "'" move '"' to current_quote#
57967>>>>>>>>>>>>>>> else move "'" to current_quote#
57969>>>>>>>>>>>>>>> move (rval#+current_quote#) to rval#
57970>>>>>>>>>>>>>>> end
57970>>>>>>>>>>>>>>>>
57970>>>>>>>>>>>>>>> move (rval#+char#) to rval#
57971>>>>>>>>>>>>>>> loop
57972>>>>>>>>>>>>>>>>
57972>>>>>>>>>>>>>>> move (rval#+current_quote#) to rval#
57973>>>>>>>>>>>>>>> function_return rval#
57974>>>>>>>>>>>>>>>end_function
57975>>>>>>>>>>>>>>>
57975>>>>>>>>>>>>>>>function MakeStringConstantMax255Help global string str# returns string
57977>>>>>>>>>>>>>>> integer len# pos#
57977>>>>>>>>>>>>>>> string char# rval# current_quote#
57977>>>>>>>>>>>>>>> ifnot "'" in str# function_return ("'"+str#+"'")
57980>>>>>>>>>>>>>>> ifnot '"' in str# function_return ('"'+str#+'"')
57983>>>>>>>>>>>>>>> move "" to rval#
57984>>>>>>>>>>>>>>> move (length(str#)) to len#
57985>>>>>>>>>>>>>>> if (left(str#,1)) eq '"' move "'" to current_quote#
57988>>>>>>>>>>>>>>> else move '"' to current_quote#
57990>>>>>>>>>>>>>>> move current_quote# to rval#
57991>>>>>>>>>>>>>>> for pos# from 0 to len#
57997>>>>>>>>>>>>>>>>
57997>>>>>>>>>>>>>>> move (mid(str#,1,pos#)) to char#
57998>>>>>>>>>>>>>>> if char# eq current_quote# begin
58000>>>>>>>>>>>>>>> move (rval#+current_quote#+"+") to rval#
58001>>>>>>>>>>>>>>> if current_quote# eq "'" move '"' to current_quote#
58004>>>>>>>>>>>>>>> else move "'" to current_quote#
58006>>>>>>>>>>>>>>> move (rval#+current_quote#) to rval#
58007>>>>>>>>>>>>>>> end
58007>>>>>>>>>>>>>>>>
58007>>>>>>>>>>>>>>> move (rval#+char#) to rval#
58008>>>>>>>>>>>>>>> loop
58009>>>>>>>>>>>>>>>>
58009>>>>>>>>>>>>>>> move (rval#+current_quote#) to rval#
58010>>>>>>>>>>>>>>> function_return rval#
58011>>>>>>>>>>>>>>>end_function
58012>>>>>>>>>>>>>>>
58012>>>>>>>>>>>>>>>function MakeStringConstantMax255 global string str# returns string
58014>>>>>>>>>>>>>>> integer liLen liPos
58014>>>>>>>>>>>>>>> string lsRval lsChunk
58014>>>>>>>>>>>>>>> move (length(str#)) to liLen
58015>>>>>>>>>>>>>>> move "" to lsRval
58016>>>>>>>>>>>>>>> for liPos from 0 to (liLen-1/250)
58022>>>>>>>>>>>>>>>>
58022>>>>>>>>>>>>>>> if liPos move (lsRval+"+") to lsRval
58025>>>>>>>>>>>>>>> move (mid(str#,250,liPos*250+1)) to lsChunk
58026>>>>>>>>>>>>>>> move (lsRval+MakeStringConstantMax255Help(lsChunk)) to lsRval
58027>>>>>>>>>>>>>>> loop
58028>>>>>>>>>>>>>>>>
58028>>>>>>>>>>>>>>> function_return lsRval
58029>>>>>>>>>>>>>>>end_function
58030>>>>>>>>>>>>>>>
58030>>>>>>>>>>>>>Use FdxField.utl // FDX Field things
58030>>>>>>>>>>>>>Use Dates.nui // Date routines (No User Interface)
58030>>>>>>>>>>>>>Use Output.utl // Sequential output to whatever
58030>>>>>>>>>>>>>Use ErrorHnd.nui // cErrorHandlerRedirector class and oErrorHandlerQuiet object (No User Interface)
58030>>>>>>>>>>>>>// Use LogFile.nui // Class for handling a log file (No User Interface)
58030>>>>>>>>>>>>>//
58030>>>>>>>>>>>>>// object oVMLogFile is a cLogFile
58030>>>>>>>>>>>>>// set psFileName to "vmachine.log"
58030>>>>>>>>>>>>>// set piCloseOnWrite to DFTRUE
58030>>>>>>>>>>>>>// set psPurpose to "Expression evaluation log"
58030>>>>>>>>>>>>>// send DirectOutput
58030>>>>>>>>>>>>>// end_object
58030>>>>>>>>>>>>>
58030>>>>>>>>>>>>>
58030>>>>>>>>>>>>>Enumeration_List // Operation codes for Virtual Machine
58030>>>>>>>>>>>>> define OP_NOP // Do nothing!
58030>>>>>>>>>>>>> define OP_ABORT // Stop program execution
58030>>>>>>>>>>>>> define OP_CLEARSCREEN // Clear the screen
58030>>>>>>>>>>>>> define OP_GOSUB // Call subrutine
58030>>>>>>>>>>>>> define OP_GOTO // Goto label
58030>>>>>>>>>>>>> define OP_RETURN // Return from subrutine
58030>>>>>>>>>>>>> define OP_PAUSE // Pauses program execution
58030>>>>>>>>>>>>> define OP_GOTOXY // Positions the cursor on a character mode screen
58030>>>>>>>>>>>>> define OP_INPUT // Input from the keyboard
58030>>>>>>>>>>>>> define OP_SHOW // Display on virtual console
58030>>>>>>>>>>>>> define OP_SHOWLN // Display on virtual console
58030>>>>>>>>>>>>> define OP_SEQFILE // Open/close/append sequential file
58030>>>>>>>>>>>>> define OP_WRITE // Write to currently open sequential out file
58030>>>>>>>>>>>>> define OP_WRITELN // Write to currently open sequential out file
58030>>>>>>>>>>>>> define OP_READ // Read from currently open sequential in file
58030>>>>>>>>>>>>> define OP_READLN // Read from currently open sequential in file
58030>>>>>>>>>>>>> define OP_MSGBOX // Display a message box
58030>>>>>>>>>>>>> define OP_ASSIGN // Assign value to variable or a field
58030>>>>>>>>>>>>> define OP_GVAR_INCR // Increment integer variable by amount
58030>>>>>>>>>>>>> define OP_GVAR_DISPLAY // Display global variable (debug purposes)
58030>>>>>>>>>>>>> define OP_IF_GOTO // Conditioned jump (x<>0)
58030>>>>>>>>>>>>> define OP_IF_GOSUB // Conditioned gosub (x<>0)
58030>>>>>>>>>>>>> define OP_IFTEST_GOTO // Conditioned jump (x comp y)
58030>>>>>>>>>>>>> define OP_IFTEST_GOSUB // Conditioned gosub (x comp y)
58030>>>>>>>>>>>>> define OP_DEBUG // Turn debug on and off
58030>>>>>>>>>>>>> define OP_LOG_OPEN // Open file for logging
58030>>>>>>>>>>>>> define OP_LOG_CLOSE // Close log file
58030>>>>>>>>>>>>> define OP_LOG_DISPLAY // Display log file
58030>>>>>>>>>>>>> define OP_LOG_FLUSH // Flush log file (momentarily close/open)
58030>>>>>>>>>>>>> define OP_LOG_WRITE // Write something to log file
58030>>>>>>>>>>>>> define OP_LOG_WRITELN // WriteLn something to log file
58030>>>>>>>>>>>>> define OP_API_FILELIST // Set_Attribute (filelist)
58030>>>>>>>>>>>>> define OP_API_FILE // Set_Attribute (file)
58030>>>>>>>>>>>>> define OP_API_FIELD // Set_Attribute (field)
58030>>>>>>>>>>>>> define OP_API_INDEX // Set_Attribute (index)
58030>>>>>>>>>>>>> define OP_API_IDXSEG // Set_Attribute (idxseg)
58030>>>>>>>>>>>>> define OP_API_STRUCTURE_ABORT // Structure abort
58030>>>>>>>>>>>>> define OP_API_STRUCTURE_END // Structure end
58030>>>>>>>>>>>>> define OP_API_PROBE_END // Probe end
58030>>>>>>>>>>>>> define OP_API_DELETEINDEX // Delete index
58030>>>>>>>>>>>>> define OP_API_DELETEFIELD // Delete field
58030>>>>>>>>>>>>> define OP_API_APPENDFIELD // Append field
58030>>>>>>>>>>>>> define OP_API_CREATEFIELD // Create field
58030>>>>>>>>>>>>> define OP_API_SETFIELDNUMBER // Set implicit field number
58030>>>>>>>>>>>>> define cBasicVirtualMachine.NEXT_OP // Augmentation codes starts here
58030>>>>>>>>>>>>>End_Enumeration_List
58030>>>>>>>>>>>>>
58030>>>>>>>>>>>>>Enumeration_List // Variable types
58030>>>>>>>>>>>>> define VARTYP_VOID // Return type for procedures
58030>>>>>>>>>>>>> define VARTYP_INTEGER
58030>>>>>>>>>>>>> define VARTYP_DATE
58030>>>>>>>>>>>>> define VARTYP_NUMBER
58030>>>>>>>>>>>>> define VARTYP_STRING
58030>>>>>>>>>>>>>End_Enumeration_List
58030>>>>>>>>>>>>>
58030>>>>>>>>>>>>>Enumeration_List // Field types
58030>>>>>>>>>>>>> define FLDTYP_DATE
58030>>>>>>>>>>>>> define FLDTYP_NUMBER
58030>>>>>>>>>>>>> define FLDTYP_STRING
58030>>>>>>>>>>>>> define FLDTYP_BINARY
58030>>>>>>>>>>>>> define FLDTYP_OVERLAP
58030>>>>>>>>>>>>> define FLDTYP_TEXT
58030>>>>>>>>>>>>>End_Enumeration_List
58030>>>>>>>>>>>>>
58030>>>>>>>>>>>>>Enumeration_List // Comparison modes
58030>>>>>>>>>>>>> define COMP_LT
58030>>>>>>>>>>>>> define COMP_LE
58030>>>>>>>>>>>>> define COMP_EQ
58030>>>>>>>>>>>>> define COMP_GE
58030>>>>>>>>>>>>> define COMP_GT
58030>>>>>>>>>>>>> define COMP_NE
58030>>>>>>>>>>>>>End_Enumeration_List
58030>>>>>>>>>>>>>
58030>>>>>>>>>>>>>Enumeration_List // Argument types
58030>>>>>>>>>>>>> define AT_NOT_VALID
58030>>>>>>>>>>>>> define AT_CINT
58030>>>>>>>>>>>>> define AT_CSTR
58030>>>>>>>>>>>>> define AT_CNUM
58030>>>>>>>>>>>>> define AT_CDAT
58030>>>>>>>>>>>>> define AT_VAR
58030>>>>>>>>>>>>> define AT_VARNO
58030>>>>>>>>>>>>> define AT_EXPR
58030>>>>>>>>>>>>> define AT_LBL
58030>>>>>>>>>>>>> define AT_FIELD
58030>>>>>>>>>>>>> define AT_FIELDNO
58030>>>>>>>>>>>>> define AT_ARRAY_ID
58030>>>>>>>>>>>>> define AT_ARRAY_ELEM
58030>>>>>>>>>>>>>End_Enumeration_List
58030>>>>>>>>>>>>>
58030>>>>>>>>>>>>>function iCompStringToInt.s global string lsComp returns integer
58032>>>>>>>>>>>>> move (uppercase(lsComp)) to lsComp
58033>>>>>>>>>>>>> if lsComp eq "LT" function_return COMP_LT
58036>>>>>>>>>>>>> if lsComp eq "LE" function_return COMP_LE
58039>>>>>>>>>>>>> if lsComp eq "EQ" function_return COMP_EQ
58042>>>>>>>>>>>>> if lsComp eq "GE" function_return COMP_GE
58045>>>>>>>>>>>>> if lsComp eq "GT" function_return COMP_GT
58048>>>>>>>>>>>>> if lsComp eq "NE" function_return COMP_NE
58051>>>>>>>>>>>>> function_return -1
58052>>>>>>>>>>>>>end_function
58053>>>>>>>>>>>>>
58053>>>>>>>>>>>>>function iArgType_Const.i global integer liType returns integer
58055>>>>>>>>>>>>> if liType eq AT_CINT function_return 1
58058>>>>>>>>>>>>> if liType eq AT_CSTR function_return 1
58061>>>>>>>>>>>>> if liType eq AT_CNUM function_return 1
58064>>>>>>>>>>>>> if liType eq AT_CDAT function_return 1
58067>>>>>>>>>>>>> function_return 0
58068>>>>>>>>>>>>>end_function
58069>>>>>>>>>>>>>
58069>>>>>>>>>>>>>function sArgtype_Name.i global integer liType returns string
58071>>>>>>>>>>>>> if liType eq AT_CINT function_return "CnstInt"
58074>>>>>>>>>>>>> if liType eq AT_CSTR function_return "CnstStr"
58077>>>>>>>>>>>>> if liType eq AT_CNUM function_return "CnstNum"
58080>>>>>>>>>>>>> if liType eq AT_CDAT function_return "CnstDat"
58083>>>>>>>>>>>>> if liType eq AT_VAR function_return "VarName"
58086>>>>>>>>>>>>> if liType eq AT_VARNO function_return "VarNo"
58089>>>>>>>>>>>>> if liType eq AT_EXPR function_return "Expr"
58092>>>>>>>>>>>>> if liType eq AT_LBL function_return "Lbl"
58095>>>>>>>>>>>>> if liType eq AT_FIELD function_return "Field"
58098>>>>>>>>>>>>> if liType eq AT_FIELDNO function_return "FieldNo"
58101>>>>>>>>>>>>> if liType eq AT_ARRAY_ID function_return "Array ID"
58104>>>>>>>>>>>>> if liType eq AT_ARRAY_ELEM function_return "Array Index"
58107>>>>>>>>>>>>> function_return "Unknown argtype"
58108>>>>>>>>>>>>>end_function
58109>>>>>>>>>>>>>
58109>>>>>>>>>>>>>class cOpCodes is a cArray
58110>>>>>>>>>>>>> item_property_list
58110>>>>>>>>>>>>> item_property string psName.i
58110>>>>>>>>>>>>> item_property integer piMessage.i
58110>>>>>>>>>>>>> item_property integer piParameters.i // Number of parameters
58110>>>>>>>>>>>>> item_property integer psFormat.i // Format of parameters
58110>>>>>>>>>>>>> item_property integer piSpecialAddMsg.i
58110>>>>>>>>>>>>> end_item_property_list cOpCodes
#REM 58151 DEFINE FUNCTION PISPECIALADDMSG.I INTEGER LIROW RETURNS INTEGER
#REM 58155 DEFINE PROCEDURE SET PISPECIALADDMSG.I INTEGER LIROW INTEGER VALUE
#REM 58159 DEFINE FUNCTION PSFORMAT.I INTEGER LIROW RETURNS INTEGER
#REM 58163 DEFINE PROCEDURE SET PSFORMAT.I INTEGER LIROW INTEGER VALUE
#REM 58167 DEFINE FUNCTION PIPARAMETERS.I INTEGER LIROW RETURNS INTEGER
#REM 58171 DEFINE PROCEDURE SET PIPARAMETERS.I INTEGER LIROW INTEGER VALUE
#REM 58175 DEFINE FUNCTION PIMESSAGE.I INTEGER LIROW RETURNS INTEGER
#REM 58179 DEFINE PROCEDURE SET PIMESSAGE.I INTEGER LIROW INTEGER VALUE
#REM 58183 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 58187 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
58192>>>>>>>>>>>>> procedure add_opcode integer liOpCode string lsName integer lhMsg integer liParams integer lhSpecial_add_msg
58194>>>>>>>>>>>>> set psName.i liOpCode to lsName
58195>>>>>>>>>>>>> set piMessage.i liOpCode to lhMsg
58196>>>>>>>>>>>>> set piParameters.i liOpCode to liParams
58197>>>>>>>>>>>>> set piSpecialAddMsg.i liOpCode to lhSpecial_add_msg
58198>>>>>>>>>>>>> end_procedure
58199>>>>>>>>>>>>>end_class // cOpCodes
58200>>>>>>>>>>>>>
58200>>>>>>>>>>>>>function VmIntIf global integer lbCondition integer liTrue integer liFalse returns integer
58202>>>>>>>>>>>>> if lbCondition function_return liTrue
58205>>>>>>>>>>>>> function_return liFalse
58206>>>>>>>>>>>>>end_function
58207>>>>>>>>>>>>>function VmNumIf global integer lbCondition number lnTrue number lnFalse returns number
58209>>>>>>>>>>>>> if lbCondition function_return lnTrue
58212>>>>>>>>>>>>> function_return lnFalse
58213>>>>>>>>>>>>>end_function
58214>>>>>>>>>>>>>function VmStrIf global integer lbCondition string lsTrue string lsFalse returns string
58216>>>>>>>>>>>>> if lbCondition function_return lsTrue
58219>>>>>>>>>>>>> function_return lsFalse
58220>>>>>>>>>>>>>end_function
58221>>>>>>>>>>>>>function VmDatIf global integer lbCondition date ldTrue date ldFalse returns date
58223>>>>>>>>>>>>> if lbCondition function_return ldTrue
58226>>>>>>>>>>>>> function_return ldFalse
58227>>>>>>>>>>>>>end_function
58228>>>>>>>>>>>>>
58228>>>>>>>>>>>>>class cDeclaredArrays is a cArray
58229>>>>>>>>>>>>> item_property_list
58229>>>>>>>>>>>>> item_property string psName.i
58229>>>>>>>>>>>>> item_property integer piObject.i
58229>>>>>>>>>>>>> item_property integer piType.i // VARTYP_INTEGER, VARTYP_NUMBER, VARTYP_DATE or VARTYP_STRING
58229>>>>>>>>>>>>> end_item_property_list cDeclaredArrays
#REM 58264 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 58268 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 58272 DEFINE FUNCTION PIOBJECT.I INTEGER LIROW RETURNS INTEGER
#REM 58276 DEFINE PROCEDURE SET PIOBJECT.I INTEGER LIROW INTEGER VALUE
#REM 58280 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 58284 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
58289>>>>>>>>>>>>> procedure reset
58291>>>>>>>>>>>>> integer liRow max# obj#
58291>>>>>>>>>>>>> get row_count to max#
58292>>>>>>>>>>>>> for liRow from 0 to (max#-1)
58298>>>>>>>>>>>>>>
58298>>>>>>>>>>>>> get piObject.i liRow to obj#
58299>>>>>>>>>>>>> if obj# send request_destroy_object to obj#
58302>>>>>>>>>>>>> loop
58303>>>>>>>>>>>>>>
58303>>>>>>>>>>>>> send delete_data
58304>>>>>>>>>>>>> end_procedure
58305>>>>>>>>>>>>> function iRowToObjectID.i integer liRow returns integer
58307>>>>>>>>>>>>> integer obj#
58307>>>>>>>>>>>>> get piObject.i liRow to obj#
58308>>>>>>>>>>>>> ifnot obj# begin
58310>>>>>>>>>>>>> object oArray is an cArray
58312>>>>>>>>>>>>> move self to obj#
58313>>>>>>>>>>>>> end_object
58314>>>>>>>>>>>>> end
58314>>>>>>>>>>>>>>
58314>>>>>>>>>>>>> function_return obj#
58315>>>>>>>>>>>>> end_function
58316>>>>>>>>>>>>> procedure Array_Reset integer liRow
58318>>>>>>>>>>>>> send delete_data to (iRowToObjectID.i(self,liRow))
58319>>>>>>>>>>>>> end_procedure
58320>>>>>>>>>>>>> function iNameToNumber.s string lsName returns integer
58322>>>>>>>>>>>>> integer liRow liMax
58322>>>>>>>>>>>>> move (uppercase(lsName)) to lsName
58323>>>>>>>>>>>>> get row_count to liMax
58324>>>>>>>>>>>>> for liRow from 0 to (liMax-1)
58330>>>>>>>>>>>>>>
58330>>>>>>>>>>>>> if lsName eq (psName.i(self,liRow)) function_return liRow
58333>>>>>>>>>>>>> loop
58334>>>>>>>>>>>>>>
58334>>>>>>>>>>>>> function_return -1
58335>>>>>>>>>>>>> end_function
58336>>>>>>>>>>>>> procedure declare_array string lsName integer liType
58338>>>>>>>>>>>>> integer liRow
58338>>>>>>>>>>>>> get row_count to liRow
58339>>>>>>>>>>>>> set psName.i liRow to (uppercase(lsName))
58340>>>>>>>>>>>>> set piObject.i liRow to 0
58341>>>>>>>>>>>>> set piType.i liRow to liType
58342>>>>>>>>>>>>> end_procedure
58343>>>>>>>>>>>>> procedure Assign_Value integer liRow integer liItem string lsValue
58345>>>>>>>>>>>>> integer liType lhObj
58345>>>>>>>>>>>>> get piObject.i liRow to lhObj
58346>>>>>>>>>>>>> get piType.i liRow to liType
58347>>>>>>>>>>>>> if liType eq VARTYP_INTEGER set value of lhObj item liItem to (integer(lsValue))
58350>>>>>>>>>>>>> if liType eq VARTYP_NUMBER set value of lhObj item liItem to (number(lsValue))
58353>>>>>>>>>>>>> if liType eq VARTYP_DATE set value of lhObj item liItem to (date(lsValue))
58356>>>>>>>>>>>>> if liType eq VARTYP_STRING set value of lhObj item liItem to (string(lsValue))
58359>>>>>>>>>>>>> end_procedure
58360>>>>>>>>>>>>> function sAssigned_Value.ii integer liRow integer liItem returns string
58362>>>>>>>>>>>>> function_return (value(piObject.i(self,liRow),liItem))
58363>>>>>>>>>>>>> end_function
58364>>>>>>>>>>>>> procedure sort_array integer liRow
58366>>>>>>>>>>>>> send sort_items to (piObject.i(self,liRow))
58367>>>>>>>>>>>>> end_procedure
58368>>>>>>>>>>>>> function iItem_Count.i integer liRow returns integer
58370>>>>>>>>>>>>> function_return (item_count(piObject.i(self,liRow)))
58371>>>>>>>>>>>>> end_function
58372>>>>>>>>>>>>>end_class // cDeclaredArrays
58373>>>>>>>>>>>>>
58373>>>>>>>>>>>>>// Move MyArray(2) to YourArray(4)
58373>>>>>>>>>>>>>// Move MyArray.Item_Count to WhatEver#
58373>>>>>>>>>>>>>//
58373>>>>>>>>>>>>>//
58373>>>>>>>>>>>>>enumeration_list // Function classes
58373>>>>>>>>>>>>> define FTYPE.SCRIPT // Functions declared in the script
58373>>>>>>>>>>>>> define FTYPE.GET // Globally declared functions
58373>>>>>>>>>>>>> define FTYPE.BUILTIN // Predefined DF functions that are called automatically by the eval function
58373>>>>>>>>>>>>>end_enumeration_list
58373>>>>>>>>>>>>>
58373>>>>>>>>>>>>>register_object oParameterStack
58373>>>>>>>>>>>>>class cDeclaredFunctions is a cArray
58374>>>>>>>>>>>>> procedure construct_object integer liImg
58376>>>>>>>>>>>>> forward send construct_object liImg
58378>>>>>>>>>>>>> object oParameterReverse is a cStack NO_IMAGE
58380>>>>>>>>>>>>> end_object
58381>>>>>>>>>>>>> object oParameterStack is a cStack NO_IMAGE
58383>>>>>>>>>>>>> end_object
58384>>>>>>>>>>>>> end_procedure
58385>>>>>>>>>>>>> item_property_list
58385>>>>>>>>>>>>> item_property string psName.i
58385>>>>>>>>>>>>> item_property string psDisplayName.i
58385>>>>>>>>>>>>> item_property integer piReturnType.i // VT_Something
58385>>>>>>>>>>>>> item_property string psParameterList.i //
58385>>>>>>>>>>>>> item_property string psDisplayParameterList.i //
58385>>>>>>>>>>>>> item_property integer piFuncClass.i // FTYPE.SCRIPT/FTYPE.GET/FTYPE.EXPR
58385>>>>>>>>>>>>> item_property integer piLineDeclared.i // when FTYPE.SCRIPT
58385>>>>>>>>>>>>> item_property integer piMessage.i // when FTYPE.GET or FTYPE.EXPR
58385>>>>>>>>>>>>> end_item_property_list cDeclaredFunctions
#REM 58435 DEFINE FUNCTION PIMESSAGE.I INTEGER LIROW RETURNS INTEGER
#REM 58439 DEFINE PROCEDURE SET PIMESSAGE.I INTEGER LIROW INTEGER VALUE
#REM 58443 DEFINE FUNCTION PILINEDECLARED.I INTEGER LIROW RETURNS INTEGER
#REM 58447 DEFINE PROCEDURE SET PILINEDECLARED.I INTEGER LIROW INTEGER VALUE
#REM 58451 DEFINE FUNCTION PIFUNCCLASS.I INTEGER LIROW RETURNS INTEGER
#REM 58455 DEFINE PROCEDURE SET PIFUNCCLASS.I INTEGER LIROW INTEGER VALUE
#REM 58459 DEFINE FUNCTION PSDISPLAYPARAMETERLIST.I INTEGER LIROW RETURNS STRING
#REM 58463 DEFINE PROCEDURE SET PSDISPLAYPARAMETERLIST.I INTEGER LIROW STRING VALUE
#REM 58467 DEFINE FUNCTION PSPARAMETERLIST.I INTEGER LIROW RETURNS STRING
#REM 58471 DEFINE PROCEDURE SET PSPARAMETERLIST.I INTEGER LIROW STRING VALUE
#REM 58475 DEFINE FUNCTION PIRETURNTYPE.I INTEGER LIROW RETURNS INTEGER
#REM 58479 DEFINE PROCEDURE SET PIRETURNTYPE.I INTEGER LIROW INTEGER VALUE
#REM 58483 DEFINE FUNCTION PSDISPLAYNAME.I INTEGER LIROW RETURNS STRING
#REM 58487 DEFINE PROCEDURE SET PSDISPLAYNAME.I INTEGER LIROW STRING VALUE
#REM 58491 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 58495 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
58500>>>>>>>>>>>>>
58500>>>>>>>>>>>>> procedure declare_function string lsName integer liRtnType string lsParamList integer liFuncClass integer liLine integer lhMsg
58502>>>>>>>>>>>>> integer liRow
58502>>>>>>>>>>>>> get row_count to liRow
58503>>>>>>>>>>>>> set psName.i liRow to (uppercase(lsName))
58504>>>>>>>>>>>>> set psDisplayName.i liRow to lsName
58505>>>>>>>>>>>>> set piReturnType.i liRow to liRtnType
58506>>>>>>>>>>>>> set psParameterList.i liRow to lsParamList
58507>>>>>>>>>>>>> set piFuncClass.i liRow to liFuncClass
58508>>>>>>>>>>>>> set piLineDeclared.i liRow to liLine
58509>>>>>>>>>>>>> set piMessage.i liRow to lhMsg
58510>>>>>>>>>>>>> end_function
58511>>>>>>>>>>>>>
58511>>>>>>>>>>>>> function MidFunction string lsValue integer liLen integer liPos returns string
58513>>>>>>>>>>>>> function_return (mid(lsValue,liLen,liPos))
58514>>>>>>>>>>>>> end_function
58515>>>>>>>>>>>>>
58515>>>>>>>>>>>>> // procedure Handle_Function string lsName integer liReturnType string lsParamList string lsLongParamList
58515>>>>>>>>>>>>> procedure CallBack_AllFunctions integer lhMsg integer lhObj
58517>>>>>>>>>>>>> integer liRow liMax lhSelf
58517>>>>>>>>>>>>> move self to lhSelf
58518>>>>>>>>>>>>> get row_count to liMax
58519>>>>>>>>>>>>> decrement liMax
58520>>>>>>>>>>>>> for liRow from 0 to liMax
58526>>>>>>>>>>>>>>
58526>>>>>>>>>>>>> send lhMsg to lhObj (psDisplayName.i(lhSelf,liRow)) (piReturnType.i(lhSelf,liRow)) (psParameterList.i(lhSelf,liRow)) (psDisplayParameterList.i(lhSelf,liRow))
58527>>>>>>>>>>>>> loop
58528>>>>>>>>>>>>>>
58528>>>>>>>>>>>>> end_procedure
58529>>>>>>>>>>>>>
58529>>>>>>>>>>>>> enumeration_list // Function groups
58529>>>>>>>>>>>>> define FG_BEYOND_DESCRIPTION
58529>>>>>>>>>>>>> define FG_STRING
58529>>>>>>>>>>>>> define FG_DATETIME
58529>>>>>>>>>>>>> define FG_LOGIC
58529>>>>>>>>>>>>> define FG_TYPECONV
58529>>>>>>>>>>>>> define FG_TRIG
58529>>>>>>>>>>>>> end_enumeration_list
58529>>>>>>>>>>>>>
58529>>>>>>>>>>>>> procedure reset
58531>>>>>>>>>>>>> send delete_data
58532>>>>>>>>>>>>> // STRINGS
58532>>>>>>>>>>>>> send declare_function "Mid" VARTYP_STRING "SII" FTYPE.GET 0 get_MidFunction FG_STRING
58533>>>>>>>>>>>>> send declare_function "Left" VARTYP_STRING "SI" FTYPE.BUILTIN 0 0 FG_STRING
58534>>>>>>>>>>>>> send declare_function "Right" VARTYP_STRING "SI" FTYPE.BUILTIN 0 0 FG_STRING
58535>>>>>>>>>>>>> send declare_function "Uppercase" VARTYP_STRING "S" FTYPE.BUILTIN 0 0 FG_STRING
58536>>>>>>>>>>>>> send declare_function "Lowercase" VARTYP_STRING "S" FTYPE.BUILTIN 0 0 FG_STRING
58537>>>>>>>>>>>>> send declare_function "Length" VARTYP_INTEGER "S" FTYPE.BUILTIN 0 0 FG_STRING
58538>>>>>>>>>>>>> send declare_function "Trim" VARTYP_STRING "S" FTYPE.BUILTIN 0 0 FG_STRING
58539>>>>>>>>>>>>> if DFFALSE begin
58541>>>>>>>>>>>>> send declare_function "Pad" VARTYP_STRING "SI" FTYPE.BUILTIN 0 0 FG_STRING
58542>>>>>>>>>>>>> send declare_function "NumToStr" VARTYP_STRING "NI" FTYPE.GET 0 get_NumToStr FG_STRING
58543>>>>>>>>>>>>> send declare_function "NumToStrR" VARTYP_STRING "NII" FTYPE.GET 0 get_NumToStrR FG_STRING
58544>>>>>>>>>>>>> send declare_function "IntToStrR" VARTYP_STRING "NI" FTYPE.GET 0 get_IntToStrR FG_STRING
58545>>>>>>>>>>>>> send declare_function "IntToStrRzf" VARTYP_STRING "NI" FTYPE.GET 0 get_IntToStrRzf FG_STRING
58546>>>>>>>>>>>>> end
58546>>>>>>>>>>>>>>
58546>>>>>>>>>>>>> // DATES
58546>>>>>>>>>>>>> send declare_function "SysDate" VARTYP_DATE "" FTYPE.GET 0 get_dSysDate FG_DATETIME
58547>>>>>>>>>>>>> send declare_function "DateIncrement" VARTYP_DATE "DII" FTYPE.GET 0 get_DateIncrement FG_DATETIME
58548>>>>>>>>>>>>> send declare_function "FirstDayInMonth" VARTYP_DATE "D" FTYPE.GET 0 get_FirstDayInMonth FG_DATETIME
58549>>>>>>>>>>>>> if DFFALSE begin
58551>>>>>>>>>>>>> send declare_function "SysYear" VARTYP_INTEGER "" FTYPE.GET 0 get_iSysYear FG_DATETIME
58552>>>>>>>>>>>>> send declare_function "SysTime" VARTYP_STRING "" FTYPE.GET 0 get_sSysTime FG_DATETIME
58553>>>>>>>>>>>>> send declare_function "DateCompose" VARTYP_DATE "III" FTYPE.GET 0 get_DateCompose FG_DATETIME
58554>>>>>>>>>>>>> send declare_function "StringToDate" VARTYP_DATE "SIIS" FTYPE.GET 0 get_StringToDate FG_DATETIME
58555>>>>>>>>>>>>> send declare_function "DateToString" VARTYP_STRING "DIIS" FTYPE.GET 0 get_DateToString FG_DATETIME
58556>>>>>>>>>>>>> send declare_function "DateSegment" VARTYP_INTEGER "DI" FTYPE.GET 0 get_DateSegment FG_DATETIME
58557>>>>>>>>>>>>> send declare_function "LastDayInMonth" VARTYP_DATE "D" FTYPE.GET 0 get_LastDayInMonth FG_DATETIME
58558>>>>>>>>>>>>> send declare_function "FirstDayInYear" VARTYP_DATE "D" FTYPE.GET 0 get_FirstDayInYear FG_DATETIME
58559>>>>>>>>>>>>> send declare_function "LastDayInYear" VARTYP_DATE "D" FTYPE.GET 0 get_LastDayInYear FG_DATETIME
58560>>>>>>>>>>>>> end
58560>>>>>>>>>>>>>>
58560>>>>>>>>>>>>> send declare_function "DateWeekNumber" VARTYP_INTEGER "D" FTYPE.GET 0 get_DateWeekNumber FG_DATETIME
58561>>>>>>>>>>>>> send declare_function "DateDayName" VARTYP_STRING "D" FTYPE.GET 0 get_DateDayName FG_DATETIME
58562>>>>>>>>>>>>> send declare_function "DateMonthName" VARTYP_STRING "D" FTYPE.GET 0 get_DateMonthName FG_DATETIME
58563>>>>>>>>>>>>> send declare_function "DateAsText" VARTYP_STRING "DS" FTYPE.GET 0 get_DateAsText FG_DATETIME
58564>>>>>>>>>>>>> if DFFALSE begin
58566>>>>>>>>>>>>> send declare_function "DayName" VARTYP_STRING "I" FTYPE.GET 0 get_DayName FG_DATETIME
58567>>>>>>>>>>>>> send declare_function "DateDayNumber" VARTYP_INTEGER "D" FTYPE.GET 0 get_DateDayNumber FG_DATETIME
58568>>>>>>>>>>>>> send declare_function "WeekToDate" VARTYP_DATE "II" FTYPE.GET 0 get_WeekToDate FG_DATETIME
58569>>>>>>>>>>>>> send declare_function "MonthName" VARTYP_STRING "I" FTYPE.GET 0 get_MonthName FG_DATETIME
58570>>>>>>>>>>>>> end
58570>>>>>>>>>>>>>>
58570>>>>>>>>>>>>>// if DFFALSE begin
58570>>>>>>>>>>>>> // If
58570>>>>>>>>>>>>> send declare_function "If_Int" VARTYP_INTEGER "III" FTYPE.GET 0 get_VmIntIf FG_LOGIC
58571>>>>>>>>>>>>> send declare_function "If_Num" VARTYP_NUMBER "INN" FTYPE.GET 0 get_VmNumIf FG_LOGIC
58572>>>>>>>>>>>>> send declare_function "If_Str" VARTYP_STRING "ISS" FTYPE.GET 0 get_VmStrIf FG_LOGIC
58573>>>>>>>>>>>>> send declare_function "If_Dat" VARTYP_DATE "IDD" FTYPE.GET 0 get_VmDatIf FG_LOGIC
58574>>>>>>>>>>>>>// end
58574>>>>>>>>>>>>> // TYPE CONVERSION
58574>>>>>>>>>>>>> send declare_function "Integer" VARTYP_INTEGER "I" FTYPE.BUILTIN 0 0 FG_TYPECONV
58575>>>>>>>>>>>>> send declare_function "String" VARTYP_STRING "S" FTYPE.BUILTIN 0 0 FG_TYPECONV
58576>>>>>>>>>>>>> send declare_function "Number" VARTYP_NUMBER "N" FTYPE.BUILTIN 0 0 FG_TYPECONV
58577>>>>>>>>>>>>> send declare_function "Date" VARTYP_DATE "D" FTYPE.BUILTIN 0 0 FG_TYPECONV
58578>>>>>>>>>>>>> // GEOMETRY (just for fun, shouldn't be here really)
58578>>>>>>>>>>>>> if DFFALSE begin
58580>>>>>>>>>>>>> send declare_function "sin" VARTYP_NUMBER "N" FTYPE.BUILTIN 0 0 FG_TRIG
58581>>>>>>>>>>>>> send declare_function "cos" VARTYP_NUMBER "N" FTYPE.BUILTIN 0 0 FG_TRIG
58582>>>>>>>>>>>>> send declare_function "tan" VARTYP_NUMBER "N" FTYPE.BUILTIN 0 0 FG_TRIG
58583>>>>>>>>>>>>> end
58583>>>>>>>>>>>>>>
58583>>>>>>>>>>>>> // LOGICAL
58583>>>>>>>>>>>>> send declare_function "not" VARTYP_INTEGER "I" FTYPE.BUILTIN 0 0 FG_LOGIC
58584>>>>>>>>>>>>>
58584>>>>>>>>>>>>> if DFFALSE begin
58586>>>>>>>>>>>>> // DBMS
58586>>>>>>>>>>>>> send declare_function "OpenFile" VARTYP_INTEGER "III" FTYPE.GET 0 get_DBMS_OpenFile FG_BEYOND_DESCRIPTION
58587>>>>>>>>>>>>> // Restructuring
58587>>>>>>>>>>>>> send declare_function "RS_TableOpenNumber" VARTYP_INTEGER "I" FTYPE.GET 0 get_RS_TableOpenNumber FG_BEYOND_DESCRIPTION
58588>>>>>>>>>>>>> send declare_function "RS_TableProbeNumber" VARTYP_INTEGER "I" FTYPE.GET 0 get_RS_TableProbeNumber FG_BEYOND_DESCRIPTION
58589>>>>>>>>>>>>> send declare_function "RS_TableCreateName" VARTYP_INTEGER "S" FTYPE.GET 0 get_RS_TableCreateName FG_BEYOND_DESCRIPTION
58590>>>>>>>>>>>>> send declare_function "RS_TableDropName" VARTYP_INTEGER "S" FTYPE.GET 0 get_RS_TableDropName FG_BEYOND_DESCRIPTION
58591>>>>>>>>>>>>> send declare_function "RS_TableExistsName" VARTYP_INTEGER "S" FTYPE.GET 0 get_RS_TableExistsName FG_BEYOND_DESCRIPTION
58592>>>>>>>>>>>>> send declare_function "RS_CurrentFieldCount" VARTYP_INTEGER "" FTYPE.GET 0 get_RS_CurrentFieldCount FG_BEYOND_DESCRIPTION
58593>>>>>>>>>>>>> send declare_function "RS_GetFileAttr" VARTYP_STRING "I" FTYPE.GET 0 get_RS_GetFileAttr FG_BEYOND_DESCRIPTION
58594>>>>>>>>>>>>> send declare_function "RS_GetFieldAttr" VARTYP_STRING "II" FTYPE.GET 0 get_RS_GetFieldAttr FG_BEYOND_DESCRIPTION
58595>>>>>>>>>>>>> send declare_function "RS_GetIndexAttr" VARTYP_STRING "II" FTYPE.GET 0 get_RS_GetIndexAttr FG_BEYOND_DESCRIPTION
58596>>>>>>>>>>>>> send declare_function "RS_GetIndexSegAttr" VARTYP_STRING "III" FTYPE.GET 0 get_RS_GetIndexSegAttr FG_BEYOND_DESCRIPTION
58597>>>>>>>>>>>>> send declare_function "RS_GetFileListAttr" VARTYP_STRING "I" FTYPE.GET 0 get_RS_GetFileListAttr FG_BEYOND_DESCRIPTION
58598>>>>>>>>>>>>>
58598>>>>>>>>>>>>> send declare_function "API_AttrValue_GLOBAL" VARTYP_STRING "I" FTYPE.GET 0 get_API_AttrValue_GLOBAL FG_BEYOND_DESCRIPTION
58599>>>>>>>>>>>>> send declare_function "API_AttrValue_FILELIST" VARTYP_STRING "II" FTYPE.GET 0 get_API_AttrValue_FILELIST FG_BEYOND_DESCRIPTION
58600>>>>>>>>>>>>> send declare_function "API_AttrValue_FILE" VARTYP_STRING "II" FTYPE.GET 0 get_API_AttrValue_FILE FG_BEYOND_DESCRIPTION
58601>>>>>>>>>>>>> send declare_function "API_AttrValue_FIELD" VARTYP_STRING "III" FTYPE.GET 0 get_API_AttrValue_FIELD FG_BEYOND_DESCRIPTION
58602>>>>>>>>>>>>> send declare_function "API_AttrValue_INDEX" VARTYP_STRING "III" FTYPE.GET 0 get_API_AttrValue_INDEX FG_BEYOND_DESCRIPTION
58603>>>>>>>>>>>>> send declare_function "API_AttrValue_IDXSEG" VARTYP_STRING "IIII" FTYPE.GET 0 get_API_AttrValue_IDXSEG FG_BEYOND_DESCRIPTION
58604>>>>>>>>>>>>> send declare_function "API_AttrValue_SPECIAL1" VARTYP_STRING "IIII" FTYPE.GET 0 get_API_AttrValue_SPECIAL1 FG_BEYOND_DESCRIPTION
58605>>>>>>>>>>>>> send declare_function "API_AttrValue_FLSTNAV" VARTYP_STRING "II" FTYPE.GET 0 get_API_AttrValue_FLSTNAV FG_BEYOND_DESCRIPTION
58606>>>>>>>>>>>>> send declare_function "API_AttrValue_DRIVER" VARTYP_STRING "II" FTYPE.GET 0 get_API_AttrValue_DRIVER FG_BEYOND_DESCRIPTION
58607>>>>>>>>>>>>> send declare_function "API_AttrValue_DRVSRV" VARTYP_STRING "III" FTYPE.GET 0 get_API_AttrValue_DRVSRV FG_BEYOND_DESCRIPTION
58608>>>>>>>>>>>>>
58608>>>>>>>>>>>>> send declare_function "API_Attr_ValueName" VARTYP_STRING "IS" FTYPE.GET 0 get_API_Attr_ValueName FG_BEYOND_DESCRIPTION
58609>>>>>>>>>>>>> end
58609>>>>>>>>>>>>>>
58609>>>>>>>>>>>>> send delete_data to (oParameterStack(self))
58610>>>>>>>>>>>>> end_procedure
58611>>>>>>>>>>>>> procedure reverse_stack integer how_many#
58613>>>>>>>>>>>>> integer obj1# obj2# itm#
58613>>>>>>>>>>>>> move (oParameterStack(self)) to obj1#
58614>>>>>>>>>>>>> move (oParameterReverse(self)) to obj2#
58615>>>>>>>>>>>>> for itm# from 1 to how_many#
58621>>>>>>>>>>>>>>
58621>>>>>>>>>>>>> send push.s to obj2# (sPop(obj1#))
58622>>>>>>>>>>>>> loop
58623>>>>>>>>>>>>>>
58623>>>>>>>>>>>>> end_procedure
58624>>>>>>>>>>>>> function sExec_Function.i integer liRow returns string
58626>>>>>>>>>>>>> integer msg# params# obj#
58626>>>>>>>>>>>>> string rval#
58626>>>>>>>>>>>>> get piMessage.i liRow to msg#
58627>>>>>>>>>>>>> // Apparently the parameters to the get command are evaluated
58627>>>>>>>>>>>>> // in reverse order, thus eliminating the need for me to reverse
58627>>>>>>>>>>>>> // the parameters. What luck.
58627>>>>>>>>>>>>> //move (oParameterReverse(self)) to obj#
58627>>>>>>>>>>>>> //move (length(psParameterList.i(self,liRow))) to params#
58627>>>>>>>>>>>>> //send reverse_stack params#
58627>>>>>>>>>>>>> move (oParameterStack(self)) to obj#
58628>>>>>>>>>>>>> move (length(psParameterList.i(self,liRow))) to params#
58629>>>>>>>>>>>>> //send reverse_stack params#
58629>>>>>>>>>>>>> if msg# begin //
58631>>>>>>>>>>>>> if params# eq 0 get msg# to rval#
58634>>>>>>>>>>>>> if params# eq 1 get msg# (sPop(obj#)) to rval#
58637>>>>>>>>>>>>> if params# eq 2 get msg# (sPop(obj#)) (sPop(obj#)) to rval#
58640>>>>>>>>>>>>> if params# eq 3 get msg# (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) to rval#
58643>>>>>>>>>>>>> if params# eq 4 get msg# (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) to rval#
58646>>>>>>>>>>>>> if params# eq 5 get msg# (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) to rval#
58649>>>>>>>>>>>>> if params# eq 6 get msg# (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) (sPop(obj#)) to rval#
58652>>>>>>>>>>>>> if (piReturnType.i(self,liRow)=VARTYP_DATE) begin
58654>>>>>>>>>>>>>// showln "XXX: " rval#
58654>>>>>>>>>>>>> function_return (date(rval#))
58655>>>>>>>>>>>>> end
58655>>>>>>>>>>>>>>
58655>>>>>>>>>>>>> end
58655>>>>>>>>>>>>>>
58655>>>>>>>>>>>>> else begin // Script defined function
58656>>>>>>>>>>>>> end
58656>>>>>>>>>>>>>>
58656>>>>>>>>>>>>> function_return rval#
58657>>>>>>>>>>>>> end_function
58658>>>>>>>>>>>>> function iNameToNumber.s string name# returns integer
58660>>>>>>>>>>>>> integer liRow max#
58660>>>>>>>>>>>>> move (uppercase(name#)) to name#
58661>>>>>>>>>>>>> get row_count to max#
58662>>>>>>>>>>>>> for liRow from 0 to (max#-1)
58668>>>>>>>>>>>>>>
58668>>>>>>>>>>>>> if name# eq (psName.i(self,liRow)) function_return liRow
58671>>>>>>>>>>>>> loop
58672>>>>>>>>>>>>>>
58672>>>>>>>>>>>>> function_return -1
58673>>>>>>>>>>>>> end_function
58674>>>>>>>>>>>>> procedure push_param string param#
58676>>>>>>>>>>>>> send Push.s to (oParameterStack(self)) param#
58677>>>>>>>>>>>>> end_procedure
58678>>>>>>>>>>>>>end_class // cDeclaredFunctions
58679>>>>>>>>>>>>>
58679>>>>>>>>>>>>>class cResolvedLabels is a cArray // Help class for cLabels class below
58680>>>>>>>>>>>>> item_property_list
58680>>>>>>>>>>>>> item_property string psLabelName.i
58680>>>>>>>>>>>>> item_property integer piLabelLine.i
58680>>>>>>>>>>>>> end_item_property_list cResolvedLabels
#REM 58712 DEFINE FUNCTION PILABELLINE.I INTEGER LIROW RETURNS INTEGER
#REM 58716 DEFINE PROCEDURE SET PILABELLINE.I INTEGER LIROW INTEGER VALUE
#REM 58720 DEFINE FUNCTION PSLABELNAME.I INTEGER LIROW RETURNS STRING
#REM 58724 DEFINE PROCEDURE SET PSLABELNAME.I INTEGER LIROW STRING VALUE
58729>>>>>>>>>>>>> function iFindLabel.s string labelid# returns integer // Has label already been defined?
58731>>>>>>>>>>>>> integer max# liRow
58731>>>>>>>>>>>>> get row_count to max#
58732>>>>>>>>>>>>> move 0 to liRow
58733>>>>>>>>>>>>> while liRow lt max#
58737>>>>>>>>>>>>> if labelid# eq (psLabelName.i(self,liRow)) function_return liRow
58740>>>>>>>>>>>>> increment liRow
58741>>>>>>>>>>>>> end
58742>>>>>>>>>>>>>>
58742>>>>>>>>>>>>> function_return -1 // Not found
58743>>>>>>>>>>>>> end_function
58744>>>>>>>>>>>>> function iLabelidToLine.s string labelid# returns integer
58746>>>>>>>>>>>>> integer liRow line#
58746>>>>>>>>>>>>> get iFindLabel.s labelid# to liRow
58747>>>>>>>>>>>>> move -1 to line#
58748>>>>>>>>>>>>> if liRow ne -1 get piLabelLine.i liRow to line#
58751>>>>>>>>>>>>> function_return line#
58752>>>>>>>>>>>>> end_function
58753>>>>>>>>>>>>> procedure add_resolved_label string labelid# integer line#
58755>>>>>>>>>>>>> integer liRow
58755>>>>>>>>>>>>> if (iFindLabel.s(self,labelid#)=-1) begin
58757>>>>>>>>>>>>> get row_count to liRow
58758>>>>>>>>>>>>> set psLabelName.i liRow to labelid#
58759>>>>>>>>>>>>> set piLabelLine.i liRow to line#
58760>>>>>>>>>>>>> end
58760>>>>>>>>>>>>>>
58760>>>>>>>>>>>>> else send add_ct_error line# ("ERROR! Label already defined: "+labelid#)
58762>>>>>>>>>>>>> end_procedure
58763>>>>>>>>>>>>> procedure add_resolved_label_no_error string labelid# integer line#
58765>>>>>>>>>>>>> integer liRow
58765>>>>>>>>>>>>> if (iFindLabel.s(self,labelid#)=-1) begin
58767>>>>>>>>>>>>> get row_count to liRow
58768>>>>>>>>>>>>> set psLabelName.i liRow to labelid#
58769>>>>>>>>>>>>> set piLabelLine.i liRow to line#
58770>>>>>>>>>>>>> end
58770>>>>>>>>>>>>>>
58770>>>>>>>>>>>>> end_procedure
58771>>>>>>>>>>>>>end_class // cResolvedLabels
58772>>>>>>>>>>>>>
58772>>>>>>>>>>>>>class cLabels is a cArray
58773>>>>>>>>>>>>> procedure construct_object integer img#
58775>>>>>>>>>>>>> forward send construct_object img#
58777>>>>>>>>>>>>> object oResolvedLabels is a cResolvedLabels
58779>>>>>>>>>>>>> end_object
58780>>>>>>>>>>>>> object oReferredLabels is a cSet
58782>>>>>>>>>>>>> end_object
58783>>>>>>>>>>>>> end_procedure
58784>>>>>>>>>>>>> procedure reset
58786>>>>>>>>>>>>> send delete_data
58787>>>>>>>>>>>>> send delete_data to (oResolvedLabels(self))
58788>>>>>>>>>>>>> send delete_data to (oReferredLabels(self))
58789>>>>>>>>>>>>> end_procedure
58790>>>>>>>>>>>>> procedure add_resolved_label string labelid# integer line#
58792>>>>>>>>>>>>> send add_resolved_label to (oResolvedLabels(self)) labelid# line#
58793>>>>>>>>>>>>> end_procedure
58794>>>>>>>>>>>>> procedure add_resolved_label_no_error string labelid# integer line#
58796>>>>>>>>>>>>> send add_resolved_label_no_error to (oResolvedLabels(self)) labelid# line#
58797>>>>>>>>>>>>> end_procedure
58798>>>>>>>>>>>>> procedure add_label_reference string labelid# integer obj# integer line#
58800>>>>>>>>>>>>> integer labelno#
58800>>>>>>>>>>>>> set value item (item_count(self)) to line#
58801>>>>>>>>>>>>> get iAddOrFind_Element of (oReferredLabels(self)) labelid# to labelno#
58802>>>>>>>>>>>>> set value of obj# item line# to labelno#
58803>>>>>>>>>>>>> end_procedure
58804>>>>>>>>>>>>> function sResolve_Labels.i integer obj# returns string // Obj# is the program array
58806>>>>>>>>>>>>> integer itm# max# line# labelno# reflabels# reslabels# labelline#
58806>>>>>>>>>>>>> string labelid# rval#
58806>>>>>>>>>>>>> move "" to rval# // All is OK!
58807>>>>>>>>>>>>> move (oResolvedLabels(self)) to reslabels#
58808>>>>>>>>>>>>> move (oReferredLabels(self)) to reflabels#
58809>>>>>>>>>>>>> get item_count to max#
58810>>>>>>>>>>>>> for itm# from 0 to (max#-1)
58816>>>>>>>>>>>>>>
58816>>>>>>>>>>>>> get value item itm# to line#
58817>>>>>>>>>>>>> get value of obj# item line# to labelno#
58818>>>>>>>>>>>>> get value of reflabels# item labelno# to labelid#
58819>>>>>>>>>>>>> get iLabelidToLine.s of reslabels# labelid# to labelline#
58820>>>>>>>>>>>>> set value of obj# item line# to labelline#
58821>>>>>>>>>>>>> if labelline# eq -1 move labelid# to rval#
58824>>>>>>>>>>>>> loop
58825>>>>>>>>>>>>>>
58825>>>>>>>>>>>>> function_return rval#
58826>>>>>>>>>>>>> end_function
58827>>>>>>>>>>>>> function iIsLabelNameUsed.s string label# returns integer
58829>>>>>>>>>>>>> integer rval#
58829>>>>>>>>>>>>> get element_find of (oReferredLabels(self)) label# to rval#
58830>>>>>>>>>>>>> if rval# eq -1 get iFindLabel.s of (oResolvedLabels(self)) label# to rval#
58833>>>>>>>>>>>>> if rval# eq -1 function_return 0
58836>>>>>>>>>>>>> function_return 1
58837>>>>>>>>>>>>> end_function
58838>>>>>>>>>>>>>end_class // cLabels
58839>>>>>>>>>>>>>
58839>>>>>>>>>>>>>class cVariables is a cArray
58840>>>>>>>>>>>>> item_property_list
58840>>>>>>>>>>>>> item_property string psName.i
58840>>>>>>>>>>>>> item_property string psValue.i
58840>>>>>>>>>>>>> item_property integer piType.i
58840>>>>>>>>>>>>> end_item_property_list cVariables
#REM 58875 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 58879 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 58883 DEFINE FUNCTION PSVALUE.I INTEGER LIROW RETURNS STRING
#REM 58887 DEFINE PROCEDURE SET PSVALUE.I INTEGER LIROW STRING VALUE
#REM 58891 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 58895 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
58900>>>>>>>>>>>>> function iVarNameToVarNo string name# returns integer
58902>>>>>>>>>>>>> integer liRow max# rval#
58902>>>>>>>>>>>>> move (uppercase(name#)) to name#
58903>>>>>>>>>>>>> get row_count to max#
58904>>>>>>>>>>>>> move -1 to rval#
58905>>>>>>>>>>>>> move 0 to liRow
58906>>>>>>>>>>>>> while (liRow<max# and rval#=-1)
58910>>>>>>>>>>>>> if name# eq (psName.i(self,liRow)) move liRow to rval#
58913>>>>>>>>>>>>> increment liRow
58914>>>>>>>>>>>>> end
58915>>>>>>>>>>>>>>
58915>>>>>>>>>>>>> function_return rval#
58916>>>>>>>>>>>>> end_function
58917>>>>>>>>>>>>> register_function piProgramCounter returns integer
58917>>>>>>>>>>>>> procedure VarNameDeclare string name# integer type#
58919>>>>>>>>>>>>> integer liRow
58919>>>>>>>>>>>>> move (uppercase(name#)) to name#
58920>>>>>>>>>>>>> get iVarNameToVarNo name# to liRow
58921>>>>>>>>>>>>> if liRow eq -1 begin
58923>>>>>>>>>>>>> get row_count to liRow
58924>>>>>>>>>>>>> set psName.i liRow to name#
58925>>>>>>>>>>>>> set psValue.i liRow to ""
58926>>>>>>>>>>>>> set piType.i liRow to type#
58927>>>>>>>>>>>>> end
58927>>>>>>>>>>>>>>
58927>>>>>>>>>>>>> else send add_ct_error (piProgramCounter(self)) ("Variable already defined ("+name#+")")
58929>>>>>>>>>>>>> end_procedure
58930>>>>>>>>>>>>> function sVarValue integer varno# returns string
58932>>>>>>>>>>>>> function_return (psValue.i(self,varno#))
58933>>>>>>>>>>>>> end_function
58934>>>>>>>>>>>>> procedure VarIncrement integer varno# integer amount#
58936>>>>>>>>>>>>> set psValue.i varno# to (psValue.i(self,varno#)+amount#)
58937>>>>>>>>>>>>> end_procedure
58938>>>>>>>>>>>>> procedure VarAssign integer varno# string value#
58940>>>>>>>>>>>>> integer type#
58940>>>>>>>>>>>>> get piType.i varno# to type#
58941>>>>>>>>>>>>> if type# eq VARTYP_INTEGER set psValue.i varno# to (integer(value#))
58944>>>>>>>>>>>>> if type# eq VARTYP_NUMBER set psValue.i varno# to (number(value#))
58947>>>>>>>>>>>>> if type# eq VARTYP_DATE set psValue.i varno# to (date(value#))
58950>>>>>>>>>>>>> if type# eq VARTYP_STRING set psValue.i varno# to (string(value#))
58953>>>>>>>>>>>>> end_procedure
58954>>>>>>>>>>>>> procedure VarDisplay
58956>>>>>>>>>>>>> integer liRow max#
58956>>>>>>>>>>>>> string str#
58956>>>>>>>>>>>>> move "" to str#
58957>>>>>>>>>>>>> get row_count to max#
58958>>>>>>>>>>>>> for liRow from 0 to (max#-1)
58964>>>>>>>>>>>>>>
58964>>>>>>>>>>>>> move (str#+psName.i(self,liRow)+": "+psValue.i(self,liRow)) to str#
58965>>>>>>>>>>>>> if liRow ne (max#-1) move (str#+character(10)) to str#
58968>>>>>>>>>>>>> loop
58969>>>>>>>>>>>>>>
58969>>>>>>>>>>>>> send obs str#
58970>>>>>>>>>>>>> end_procedure
58971>>>>>>>>>>>>>end_class // cVariables
58972>>>>>>>>>>>>>
58972>>>>>>>>>>>>>
58972>>>>>>>>>>>>>function sExprOp_Text.i global integer op# returns string
58974>>>>>>>>>>>>> enumeration_list
58974>>>>>>>>>>>>> define_exprop EXPROP.ERROR "Error" // 0
58977>>>>>>>>>>>>> define_exprop EXPROP.TYPE "TypeDef" // 1
58980>>>>>>>>>>>>> define_exprop EXPROP.APPEND "Append" // 2
58983>>>>>>>>>>>>> define_exprop EXPROP.PUSH_EXPRESSION "PushExpr" // 3
58986>>>>>>>>>>>>> define_exprop EXPROP.PUSH_PARAM "PushParam" // 4
58989>>>>>>>>>>>>> define_exprop EXPROP.EXEC_FUNCTION "Exec&Pop&Append" // 5
58992>>>>>>>>>>>>> define_exprop EXPROP.EXEC_SFUNCTION "Exec&sPop&Append" // 6
58995>>>>>>>>>>>>> define_exprop EXPROP.GET_IVAR "Get iVar" // 7
58998>>>>>>>>>>>>> define_exprop EXPROP.GET_DVAR "Get dVar" // 8
59001>>>>>>>>>>>>> define_exprop EXPROP.GET_NVAR "Get nVar" // 9
59004>>>>>>>>>>>>> define_exprop EXPROP.GET_SVAR "Get sVar" // 10
59007>>>>>>>>>>>>> define_exprop EXPROP.GET_IFIELD "Get iField" // 11
59010>>>>>>>>>>>>> define_exprop EXPROP.GET_DFIELD "Get dField" // 12
59013>>>>>>>>>>>>> define_exprop EXPROP.GET_NFIELD "Get nField" // 13
59016>>>>>>>>>>>>> define_exprop EXPROP.GET_SFIELD "Get sField" // 14
59019>>>>>>>>>>>>> define_exprop EXPROP.END "ExprEnd" // 15
59022>>>>>>>>>>>>> end_enumeration_list
59022>>>>>>>>>>>>> function_return "Error"
59023>>>>>>>>>>>>>end_function
59024>>>>>>>>>>>>>
59024>>>>>>>>>>>>>desktop_section
59029>>>>>>>>>>>>> integer ghExpressionErrorHandler
59029>>>>>>>>>>>>> object oExpressionErrorHandler is a cErrorHandlerRedirector NO_IMAGE
59031>>>>>>>>>>>>> item_property_list
59031>>>>>>>>>>>>> item_property integer piError.i
59031>>>>>>>>>>>>> item_property string psErrorText.i
59031>>>>>>>>>>>>> item_property integer piErrorLine.i
59031>>>>>>>>>>>>> end_item_property_list
#REM 59071 DEFINE FUNCTION PIERRORLINE.I INTEGER LIROW RETURNS INTEGER
#REM 59076 DEFINE PROCEDURE SET PIERRORLINE.I INTEGER LIROW INTEGER VALUE
#REM 59081 DEFINE FUNCTION PSERRORTEXT.I INTEGER LIROW RETURNS STRING
#REM 59086 DEFINE PROCEDURE SET PSERRORTEXT.I INTEGER LIROW STRING VALUE
#REM 59091 DEFINE FUNCTION PIERROR.I INTEGER LIROW RETURNS INTEGER
#REM 59096 DEFINE PROCEDURE SET PIERROR.I INTEGER LIROW INTEGER VALUE
59102>>>>>>>>>>>>> procedure OnError integer liError string lsErrorText integer liErrorLine
59105>>>>>>>>>>>>> integer liRow
59105>>>>>>>>>>>>>// showln "Error: " liError " " lsErrorText " " liErrorLine
59105>>>>>>>>>>>>> get row_count to liRow
59106>>>>>>>>>>>>> set piError.i liRow to liError
59107>>>>>>>>>>>>> set psErrorText.i liRow to lsErrorText
59108>>>>>>>>>>>>> set piErrorLine.i liRow to liErrorLine
59109>>>>>>>>>>>>> end_procedure
59110>>>>>>>>>>>>> move self to ghExpressionErrorHandler
59111>>>>>>>>>>>>> end_object
59112>>>>>>>>>>>>>end_desktop_section
59117>>>>>>>>>>>>>
59117>>>>>>>>>>>>>class cEvalSequence is a cArray
59118>>>>>>>>>>>>> procedure construct_object integer img#
59120>>>>>>>>>>>>> forward send construct_object img#
59122>>>>>>>>>>>>> object oStack is a cStack no_image
59124>>>>>>>>>>>>> end_object
59125>>>>>>>>>>>>> property integer piFunctionObject public 0
59126>>>>>>>>>>>>> end_procedure
59127>>>>>>>>>>>>> item_property_list
59127>>>>>>>>>>>>> item_property integer piOpCode.i
59127>>>>>>>>>>>>> item_property string psVar.i
59127>>>>>>>>>>>>> end_item_property_list cEvalSequence
#REM 59159 DEFINE FUNCTION PSVAR.I INTEGER LIROW RETURNS STRING
#REM 59163 DEFINE PROCEDURE SET PSVAR.I INTEGER LIROW STRING VALUE
#REM 59167 DEFINE FUNCTION PIOPCODE.I INTEGER LIROW RETURNS INTEGER
#REM 59171 DEFINE PROCEDURE SET PIOPCODE.I INTEGER LIROW INTEGER VALUE
59176>>>>>>>>>>>>> function insert_and_append_quotes string str# returns string
59178>>>>>>>>>>>>> function_return (MakeStringConstantMax255(str#))
59179>>>>>>>>>>>>> end_function
59180>>>>>>>>>>>>> register_function iVarValue integer varno# returns integer
59180>>>>>>>>>>>>> register_function dVarValue integer varno# returns integer // date
59180>>>>>>>>>>>>> register_function nVarValue integer varno# returns number
59180>>>>>>>>>>>>> register_function sVarValue integer varno# returns string
59180>>>>>>>>>>>>> function iFieldValue integer liFileField returns integer
59182>>>>>>>>>>>>> integer liRval
59182>>>>>>>>>>>>> get_field_value (liFileField/65536) (mod(liFileField,65536)) to liRval
59185>>>>>>>>>>>>> function_return liRval
59186>>>>>>>>>>>>> end_function
59187>>>>>>>>>>>>> function dFieldValue integer liFileField returns integer //date
59189>>>>>>>>>>>>> date ldRval
59189>>>>>>>>>>>>> get_field_value (liFileField/65536) (mod(liFileField,65536)) to ldRval
59192>>>>>>>>>>>>> function_return ldRval
59193>>>>>>>>>>>>> end_function
59194>>>>>>>>>>>>> function nFieldValue integer liFileField returns number
59196>>>>>>>>>>>>> number lnRval
59196>>>>>>>>>>>>> get_field_value (liFileField/65536) (mod(liFileField,65536)) to lnRval
59199>>>>>>>>>>>>> function_return lnRval
59200>>>>>>>>>>>>> end_function
59201>>>>>>>>>>>>> function sFieldValue integer liFileField returns string
59203>>>>>>>>>>>>> string lsRval
59203>>>>>>>>>>>>> get_field_value (liFileField/65536) (mod(liFileField,65536)) to lsRval
59206>>>>>>>>>>>>> function_return (rtrim(lsRval))
59207>>>>>>>>>>>>> end_function
59208>>>>>>>>>>>>> procedure Handle_ExprEvalError integer liExprId string lsExpr
59210>>>>>>>>>>>>> integer liMax liRow
59210>>>>>>>>>>>>> string lsValue
59210>>>>>>>>>>>>> get row_count of ghExpressionErrorHandler to liMax
59211>>>>>>>>>>>>> decrement liMax
59212>>>>>>>>>>>>> showln ""
59214>>>>>>>>>>>>> showln "DataFlex reported this error:"
59216>>>>>>>>>>>>> for liRow from 0 to liMax
59222>>>>>>>>>>>>>>
59222>>>>>>>>>>>>> show (piError.i(ghExpressionErrorHandler,liRow)) ", "
59224>>>>>>>>>>>>> get psErrorText.i of ghExpressionErrorHandler liRow to lsValue
59225>>>>>>>>>>>>> show lsValue " on line "
59227>>>>>>>>>>>>> showln (piErrorLine.i(ghExpressionErrorHandler,liRow))
59229>>>>>>>>>>>>> loop
59230>>>>>>>>>>>>>>
59230>>>>>>>>>>>>> showln "while executing this expression:"
59232>>>>>>>>>>>>> showln lsExpr
59234>>>>>>>>>>>>> end_procedure
59235>>>>>>>>>>>>> function sExec_Expression.i integer liExprId returns string
59237>>>>>>>>>>>>> integer op# stack# funcobj# liDec liType liRow
59237>>>>>>>>>>>>> string expression# lsRval
59237>>>>>>>>>>>>> send DoReset to ghExpressionErrorHandler
59238>>>>>>>>>>>>> send DoActivate to ghExpressionErrorHandler
59239>>>>>>>>>>>>> move liExprId to liRow
59240>>>>>>>>>>>>> get_attribute DF_DECIMAL_SEPARATOR to liDec
59243>>>>>>>>>>>>> set_attribute DF_DECIMAL_SEPARATOR to 46 // "."
59246>>>>>>>>>>>>> move (oStack(self)) to stack#
59247>>>>>>>>>>>>> move (piFunctionObject(self)) to funcobj#
59248>>>>>>>>>>>>> // showln "Hello " liRow " " (value(self,liRow-1))
59248>>>>>>>>>>>>> //
59248>>>>>>>>>>>>> // direct_output channel 1 "c:\cc.ccc"
59248>>>>>>>>>>>>> // for windowindex from 0 to (item_count(self)-1)
59248>>>>>>>>>>>>> // writeln channel 1 (value(self,windowindex))
59248>>>>>>>>>>>>> // loop
59248>>>>>>>>>>>>> // close_output channel 1
59248>>>>>>>>>>>>> // send obs "OK!"
59248>>>>>>>>>>>>>
59248>>>>>>>>>>>>> move "" to expression#
59249>>>>>>>>>>>>> get psVar.i (liRow-1) to liType
59250>>>>>>>>>>>>> repeat
59250>>>>>>>>>>>>>>
59250>>>>>>>>>>>>> get piOpCode.i liRow to op#
59251>>>>>>>>>>>>> //showln (sExprOp_Text.i(op#)) " " (psVar.i(self,liRow)) " Expr: " expression#
59251>>>>>>>>>>>>> if op# ne EXPROP.END begin
59253>>>>>>>>>>>>> if op# eq EXPROP.GET_IVAR move (expression#+string(iVarValue(self,psVar.i(self,liRow)))) to expression#
59256>>>>>>>>>>>>> if op# eq EXPROP.GET_DVAR move (expression#+string(dVarValue(self,psVar.i(self,liRow)))) to expression#
59259>>>>>>>>>>>>> if op# eq EXPROP.GET_NVAR move (expression#+string(nVarValue(self,psVar.i(self,liRow)))) to expression#
59262>>>>>>>>>>>>> if op# eq EXPROP.GET_SVAR move (expression#+MakeStringConstantMax255(sVarValue(self,psVar.i(self,liRow)))) to expression#
59265>>>>>>>>>>>>> if op# eq EXPROP.GET_IFIELD move (expression#+string(iFieldValue(self,psVar.i(self,liRow)))) to expression#
59268>>>>>>>>>>>>> if op# eq EXPROP.GET_DFIELD move (expression#+string(dFieldValue(self,psVar.i(self,liRow)))) to expression#
59271>>>>>>>>>>>>> if op# eq EXPROP.GET_NFIELD move (expression#+string(nFieldValue(self,psVar.i(self,liRow)))) to expression#
59274>>>>>>>>>>>>> if op# eq EXPROP.GET_SFIELD move (expression#+MakeStringConstantMax255(sFieldValue(self,psVar.i(self,liRow)))) to expression#
59277>>>>>>>>>>>>> if op# eq EXPROP.APPEND move (expression#+psVar.i(self,liRow)) to expression#
59280>>>>>>>>>>>>> if op# eq EXPROP.PUSH_EXPRESSION begin
59282>>>>>>>>>>>>> send push.s to stack# expression#
59283>>>>>>>>>>>>> move "" to expression#
59284>>>>>>>>>>>>> end
59284>>>>>>>>>>>>>>
59284>>>>>>>>>>>>> if op# eq EXPROP.PUSH_PARAM begin
59286>>>>>>>>>>>>> send push_param to funcobj# (eval(expression#))
59287>>>>>>>>>>>>> move "" to expression#
59288>>>>>>>>>>>>> end
59288>>>>>>>>>>>>>>
59288>>>>>>>>>>>>> if op# eq EXPROP.EXEC_FUNCTION begin // Exec, Pop Expr and Append
59290>>>>>>>>>>>>> get sExec_Function.i of funcobj# (integer(psVar.i(self,liRow))) to expression#
59291>>>>>>>>>>>>> move (sPop(stack#)+expression#) to expression#
59292>>>>>>>>>>>>> end
59292>>>>>>>>>>>>>>
59292>>>>>>>>>>>>> if op# eq EXPROP.EXEC_SFUNCTION begin // Exec, Pop Expr and Append
59294>>>>>>>>>>>>> // In this case we have to insert and append quotes
59294>>>>>>>>>>>>> get sExec_Function.i of funcobj# (integer(psVar.i(self,liRow))) to expression#
59295>>>>>>>>>>>>> get insert_and_append_quotes expression# to expression#
59296>>>>>>>>>>>>> move (sPop(stack#)+expression#) to expression#
59297>>>>>>>>>>>>> end
59297>>>>>>>>>>>>>>
59297>>>>>>>>>>>>> end
59297>>>>>>>>>>>>>>
59297>>>>>>>>>>>>> increment liRow
59298>>>>>>>>>>>>>// showln ": " expression#
59298>>>>>>>>>>>>> until op# eq EXPROP.END
59300>>>>>>>>>>>>> if (expression#="()") move "" to lsRval
59303>>>>>>>>>>>>> else move (eval(expression#)) to lsRval
59305>>>>>>>>>>>>>// showln expression#
59305>>>>>>>>>>>>> set_attribute DF_DECIMAL_SEPARATOR to liDec
59308>>>>>>>>>>>>>// showln "After expr1: " liDec " " liType " Value: " lsRval
59308>>>>>>>>>>>>>
59308>>>>>>>>>>>>> if (liType=VARTYP_DATE) begin
59310>>>>>>>>>>>>> move (date(lsRval)) to lsRval
59311>>>>>>>>>>>>> end
59311>>>>>>>>>>>>>>
59311>>>>>>>>>>>>> if (liType=VARTYP_NUMBER or liType=VARTYP_INTEGER) begin
59313>>>>>>>>>>>>>// showln "Was number or integer " lsRval
59313>>>>>>>>>>>>> if (liDec<>46) move (replace(".",lsRval,",")) to lsRval
59316>>>>>>>>>>>>> end
59316>>>>>>>>>>>>>>
59316>>>>>>>>>>>>>// showln "After expr2: " liDec " " liType " Value: " lsRval
59316>>>>>>>>>>>>> send DoDeactivate to ghExpressionErrorHandler
59317>>>>>>>>>>>>> if (row_count(ghExpressionErrorHandler)) begin
59319>>>>>>>>>>>>> // Af this point we know that there was an error while evaluating
59319>>>>>>>>>>>>> // the expression.
59319>>>>>>>>>>>>> send Handle_ExprEvalError liExprId expression#
59320>>>>>>>>>>>>> end
59320>>>>>>>>>>>>>>
59320>>>>>>>>>>>>> function_return lsRval
59321>>>>>>>>>>>>> end_function
59322>>>>>>>>>>>>> procedure add_expr_instruction integer op# string item#
59324>>>>>>>>>>>>> integer liRow
59324>>>>>>>>>>>>> get row_count to liRow
59325>>>>>>>>>>>>> set piOpCode.i liRow to op#
59326>>>>>>>>>>>>> set psVar.i liRow to item#
59327>>>>>>>>>>>>> end_procedure
59328>>>>>>>>>>>>> procedure RemoveSuperfluosPar
59330>>>>>>>>>>>>>// integer max#
59330>>>>>>>>>>>>>// get row_count to max#
59330>>>>>>>>>>>>>// decrement max#
59330>>>>>>>>>>>>>// decrement max#
59330>>>>>>>>>>>>>// 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
59330>>>>>>>>>>>>>// send delete_row max#
59330>>>>>>>>>>>>>// send delete_row 1
59330>>>>>>>>>>>>>// send RemoveSuperfluosPar
59330>>>>>>>>>>>>>// end
59330>>>>>>>>>>>>> end_procedure
59331>>>>>>>>>>>>> procedure Optimize
59333>>>>>>>>>>>>> integer liRow
59333>>>>>>>>>>>>> send RemoveSuperfluosPar
59334>>>>>>>>>>>>> move 0 to liRow
59335>>>>>>>>>>>>> while (liRow<row_count(self))
59339>>>>>>>>>>>>> if (piOpCode.i(self,liRow)=EXPROP.APPEND and piOpCode.i(self,liRow+1)=EXPROP.APPEND) begin
59341>>>>>>>>>>>>> set psVar.i liRow to (psVar.i(self,liRow)+psVar.i(self,liRow+1))
59342>>>>>>>>>>>>> send delete_row (liRow+1)
59343>>>>>>>>>>>>> end
59343>>>>>>>>>>>>>>
59343>>>>>>>>>>>>> else increment liRow
59345>>>>>>>>>>>>> end
59346>>>>>>>>>>>>>>
59346>>>>>>>>>>>>> end_procedure
59347>>>>>>>>>>>>> procedure reset
59349>>>>>>>>>>>>> send delete_data
59350>>>>>>>>>>>>> send delete_data to (oStack(self))
59351>>>>>>>>>>>>> end_procedure
59352>>>>>>>>>>>>> function iAppendToOtherSequence integer target_obj# returns integer
59354>>>>>>>>>>>>> integer liRow remote_row# max#
59354>>>>>>>>>>>>> get row_count of target_obj# to remote_row#
59355>>>>>>>>>>>>> get row_count to max#
59356>>>>>>>>>>>>> decrement max#
59357>>>>>>>>>>>>> for liRow from 0 to max#
59363>>>>>>>>>>>>>>
59363>>>>>>>>>>>>> send add_expr_instruction to target_obj# (piOpCode.i(self,liRow)) (psVar.i(self,liRow))
59364>>>>>>>>>>>>> loop
59365>>>>>>>>>>>>>>
59365>>>>>>>>>>>>> function_return remote_row#
59366>>>>>>>>>>>>> end_function
59367>>>>>>>>>>>>>end_class // cEvalSequence
59368>>>>>>>>>>>>>
59368>>>>>>>>>>>>>register_procedure mthd_Nop
59368>>>>>>>>>>>>>register_procedure mthd_ClearScreen
59368>>>>>>>>>>>>>register_procedure mthd_Abort
59368>>>>>>>>>>>>>register_procedure mthd_Gosub
59368>>>>>>>>>>>>>register_procedure mthd_Goto
59368>>>>>>>>>>>>>register_procedure mthd_Return
59368>>>>>>>>>>>>>register_procedure mthd_ShowLn
59368>>>>>>>>>>>>>register_procedure mthd_Show
59368>>>>>>>>>>>>>register_procedure mthd_SeqFile
59368>>>>>>>>>>>>>register_procedure mthd_WriteLn
59368>>>>>>>>>>>>>register_procedure mthd_MsgBox
59368>>>>>>>>>>>>>register_procedure mthd_GotoXY
59368>>>>>>>>>>>>>register_procedure mthd_Input
59368>>>>>>>>>>>>>register_procedure mthd_Pause
59368>>>>>>>>>>>>>register_procedure mthd_Assign
59368>>>>>>>>>>>>>register_procedure mthd_gVar_Incr
59368>>>>>>>>>>>>>register_procedure mthd_gVar_Display
59368>>>>>>>>>>>>>register_procedure mthd_if_goto
59368>>>>>>>>>>>>>register_procedure mthd_if_gosub
59368>>>>>>>>>>>>>register_procedure mthd_iftest_goto
59368>>>>>>>>>>>>>register_procedure mthd_iftest_gosub
59368>>>>>>>>>>>>>register_procedure mthd_debug
59368>>>>>>>>>>>>>register_procedure mthd_log_open
59368>>>>>>>>>>>>>register_procedure mthd_log_close
59368>>>>>>>>>>>>>register_procedure mthd_log_display
59368>>>>>>>>>>>>>register_procedure mthd_log_flush
59368>>>>>>>>>>>>>register_procedure mthd_log_write
59368>>>>>>>>>>>>>register_procedure mthd_log_writeln
59368>>>>>>>>>>>>>register_procedure mthd_api_filelist
59368>>>>>>>>>>>>>register_procedure mthd_api_file
59368>>>>>>>>>>>>>register_procedure mthd_api_field
59368>>>>>>>>>>>>>register_procedure mthd_api_index
59368>>>>>>>>>>>>>register_procedure mthd_api_idxseg
59368>>>>>>>>>>>>>register_procedure mthd_api_structure_abort
59368>>>>>>>>>>>>>register_procedure mthd_api_structure_end
59368>>>>>>>>>>>>>register_procedure mthd_api_probe_end
59368>>>>>>>>>>>>>register_procedure mthd_api_deleteindex
59368>>>>>>>>>>>>>register_procedure mthd_api_deletefield
59368>>>>>>>>>>>>>register_procedure mthd_api_appendfield
59368>>>>>>>>>>>>>register_procedure mthd_api_createfield
59368>>>>>>>>>>>>>register_procedure mthd_api_setfieldnumber
59368>>>>>>>>>>>>>
59368>>>>>>>>>>>>>integer oVM_CurrentlyExecuting#
59368>>>>>>>>>>>>>class cBasicVirtualMachine is an cArray
59369>>>>>>>>>>>>> procedure construct_object integer img#
59371>>>>>>>>>>>>> forward send construct_object img#
59373>>>>>>>>>>>>> property integer piProgramCounter public 0
59374>>>>>>>>>>>>> property integer piInvalidProgram public 0
59375>>>>>>>>>>>>> property integer piDebugState public 0
59376>>>>>>>>>>>>> property integer piDebugSingleStep public 0
59377>>>>>>>>>>>>> property string psDebugLine public ""
59378>>>>>>>>>>>>> property integer pCurrentOpCodeLine public 0
59379>>>>>>>>>>>>> property integer pProgramEnded public 0
59380>>>>>>>>>>>>> property integer private.piLogChannel public -1
59381>>>>>>>>>>>>> property string private.psLogFileName public ""
59382>>>>>>>>>>>>> property integer phFDX_Server public 0
59383>>>>>>>>>>>>> object oOpcodes is a cOpCodes // OpCodes -> messages id's
59385>>>>>>>>>>>>> send add_opcode OP_NOP "No operation" msg_mthd_Nop 0 0
59386>>>>>>>>>>>>> send add_opcode OP_ABORT "EndProgram." msg_mthd_Abort 0 0
59387>>>>>>>>>>>>> send add_opcode OP_CLEARSCREEN "ClearScreen" msg_mthd_ClearScreen 0 0
59388>>>>>>>>>>>>> send add_opcode OP_GOSUB "Gosub" msg_mthd_Gosub 1 0
59389>>>>>>>>>>>>> send add_opcode OP_GOTO "Goto" msg_mthd_Goto 1 0
59390>>>>>>>>>>>>> send add_opcode OP_RETURN "Return" msg_mthd_Return 0 0
59391>>>>>>>>>>>>> send add_opcode OP_SHOWLN "ShowLn" msg_mthd_ShowLn 1 0
59392>>>>>>>>>>>>> send add_opcode OP_SHOW "Show" msg_mthd_Show 1 0
59393>>>>>>>>>>>>> send add_opcode OP_SEQFILE "SeqFile" msg_mthd_SeqFile 2 0
59394>>>>>>>>>>>>> send add_opcode OP_WRITELN "WriteLn" msg_mthd_WriteLn 1 0
59395>>>>>>>>>>>>> send add_opcode OP_MSGBOX "MsgBox" msg_mthd_MsgBox 1 0
59396>>>>>>>>>>>>> send add_opcode OP_INPUT "Input" msg_mthd_Input 2 0
59397>>>>>>>>>>>>> send add_opcode OP_GOTOXY "GotoXY" msg_mthd_GotoXY 2 0
59398>>>>>>>>>>>>> send add_opcode OP_PAUSE "Pause" msg_mthd_Pause 0 0
59399>>>>>>>>>>>>> send add_opcode OP_ASSIGN "Assign" msg_mthd_Assign 2 0
59400>>>>>>>>>>>>> send add_opcode OP_GVAR_INCR "gVarIncrement" msg_mthd_gVar_Incr 2 0
59401>>>>>>>>>>>>> send add_opcode OP_GVAR_DISPLAY "gVarDisplay" msg_mthd_gVar_Display 0 0
59402>>>>>>>>>>>>> send add_opcode OP_IF_GOTO "IfGoto" msg_mthd_if_goto 2 0
59403>>>>>>>>>>>>> send add_opcode OP_IF_GOSUB "IfGoSub" msg_mthd_if_gosub 2 0
59404>>>>>>>>>>>>> send add_opcode OP_IFTEST_GOTO "IfTestGoto" msg_mthd_iftest_goto 4 0
59405>>>>>>>>>>>>> send add_opcode OP_IFTEST_GOSUB "IfTestGoSub" msg_mthd_iftest_gosub 4 0
59406>>>>>>>>>>>>> send add_opcode OP_DEBUG "Debug" msg_mthd_debug 1 0
59407>>>>>>>>>>>>> send add_opcode OP_LOG_OPEN "LogOpen" msg_mthd_log_open 2 0
59408>>>>>>>>>>>>> send add_opcode OP_LOG_CLOSE "LogClose" msg_mthd_log_close 0 0
59409>>>>>>>>>>>>> send add_opcode OP_LOG_DISPLAY "LogDisplay" msg_mthd_log_display 0 0
59410>>>>>>>>>>>>> send add_opcode OP_LOG_FLUSH "LogFlush" msg_mthd_log_flush 0 0
59411>>>>>>>>>>>>> send add_opcode OP_LOG_WRITE "LogWrite" msg_mthd_log_write 1 0
59412>>>>>>>>>>>>> send add_opcode OP_LOG_WRITELN "LogWriteLn" msg_mthd_log_writeln 1 0
59413>>>>>>>>>>>>> send add_opcode OP_API_FILELIST "SetAttrFileList" msg_mthd_api_filelist 3 0
59414>>>>>>>>>>>>> send add_opcode OP_API_FILE "SetAttrFile" msg_mthd_api_file 2 0
59415>>>>>>>>>>>>> send add_opcode OP_API_FIELD "SetAttrField" msg_mthd_api_field 3 0
59416>>>>>>>>>>>>> send add_opcode OP_API_INDEX "SetAttrIndex" msg_mthd_api_index 3 0
59417>>>>>>>>>>>>> send add_opcode OP_API_IDXSEG "SetAttrIdxSeg" msg_mthd_api_idxseg 4 0
59418>>>>>>>>>>>>> send add_opcode OP_API_STRUCTURE_ABORT "StructureAbort" msg_mthd_api_structure_abort 0 0
59419>>>>>>>>>>>>> send add_opcode OP_API_STRUCTURE_END "StructureEnd" msg_mthd_api_structure_end 0 0
59420>>>>>>>>>>>>> send add_opcode OP_API_PROBE_END "ProbeEnd" msg_mthd_api_probe_end 0 0
59421>>>>>>>>>>>>> send add_opcode OP_API_DELETEINDEX "DeleteIndex" msg_mthd_api_deleteindex 1 0
59422>>>>>>>>>>>>> send add_opcode OP_API_DELETEFIELD "DeleteField" msg_mthd_api_deletefield 1 0
59423>>>>>>>>>>>>> send add_opcode OP_API_APPENDFIELD "AppendField" msg_mthd_api_appendfield 2 0
59424>>>>>>>>>>>>> send add_opcode OP_API_CREATEFIELD "CreateField" msg_mthd_api_createfield 3 0
59425>>>>>>>>>>>>> send add_opcode OP_API_SETFIELDNUMBER "SetFieldNumber" msg_mthd_api_setfieldnumber 1 0
59426>>>>>>>>>>>>> end_object
59427>>>>>>>>>>>>> object oLabels is a cLabels no_image // Used during program entry
59429>>>>>>>>>>>>> end_object
59430>>>>>>>>>>>>> object oReturnAddressStack is a cStack no_image // Return addresses (Gosub's)
59432>>>>>>>>>>>>> end_object
59433>>>>>>>>>>>>> object oVariables is a cVariables no_image
59435>>>>>>>>>>>>> end_object
59436>>>>>>>>>>>>> object oDeclaredArrays is a cDeclaredArrays no_image
59438>>>>>>>>>>>>> end_object
59439>>>>>>>>>>>>> object oDeclaredFunctions is a cDeclaredFunctions no_image
59441>>>>>>>>>>>>> end_object
59442>>>>>>>>>>>>> object oExprEvalSequences is a cEvalSequence no_image
59444>>>>>>>>>>>>> set piFunctionObject to (oDeclaredFunctions(self))
59445>>>>>>>>>>>>> end_object
59446>>>>>>>>>>>>> end_procedure
59447>>>>>>>>>>>>>
59447>>>>>>>>>>>>> procedure add_opcode integer opcode# string name# integer msg# integer params# integer special_add_msg#
59449>>>>>>>>>>>>> send add_opcode to (oOpcodes(self)) opcode# name# msg# params# special_add_msg#
59450>>>>>>>>>>>>> end_procedure
59451>>>>>>>>>>>>>
59451>>>>>>>>>>>>> function sEvalExpression integer id# returns string
59453>>>>>>>>>>>>> function_return (sExec_Expression.i(oExprEvalSequences(self),id#))
59454>>>>>>>>>>>>> end_function
59455>>>>>>>>>>>>>
59455>>>>>>>>>>>>> function sArgValue.is integer type# string arg# returns string
59457>>>>>>>>>>>>> if type# eq AT_VARNO get sVarValue arg# to arg#
59460>>>>>>>>>>>>> if type# eq AT_EXPR get sEvalExpression arg# to arg#
59463>>>>>>>>>>>>> if type# eq AT_FIELDNO get_field_value (hi(integer(arg#))) (low(integer(arg#))) to arg#
59468>>>>>>>>>>>>> if type# eq AT_ARRAY_ELEM get sAssigned_Value.ii of (oDeclaredArrays(self)) (hi(integer(arg#))) (low(integer(arg#))) to arg#
59471>>>>>>>>>>>>> function_return arg#
59472>>>>>>>>>>>>> end_function
59473>>>>>>>>>>>>>
59473>>>>>>>>>>>>> function sArgType.is integer type# string arg# returns string
59475>>>>>>>>>>>>> integer rval#
59475>>>>>>>>>>>>> move -1 to rval# // Unknown type
59476>>>>>>>>>>>>> if type# eq AT_CINT move VARTYP_INTEGER to rval#
59479>>>>>>>>>>>>> if type# eq AT_CSTR move VARTYP_STRING to rval#
59482>>>>>>>>>>>>> if type# eq AT_CNUM move VARTYP_NUMBER to rval#
59485>>>>>>>>>>>>> if type# eq AT_CDAT move VARTYP_DATE to rval#
59488>>>>>>>>>>>>> if type# eq AT_FIELDNO begin
59490>>>>>>>>>>>>> get_attribute DF_FIELD_TYPE of (hi(integer(arg#))) (low(integer(arg#))) to type#
59493>>>>>>>>>>>>> if type# eq DF_ASCII move VARTYP_STRING to type#
59496>>>>>>>>>>>>> if type# eq DF_BCD move VARTYP_NUMBER to type#
59499>>>>>>>>>>>>> if type# eq DF_DATE move VARTYP_DATE to type#
59502>>>>>>>>>>>>> if type# eq DF_OVERLAP move VARTYP_STRING to type#
59505>>>>>>>>>>>>> if type# eq DF_TEXT move VARTYP_STRING to type#
59508>>>>>>>>>>>>> if type# eq DF_BINARY move VARTYP_STRING to type#
59511>>>>>>>>>>>>> end
59511>>>>>>>>>>>>>>
59511>>>>>>>>>>>>> if type# eq AT_VARNO begin
59513>>>>>>>>>>>>> get piType.i of (oVariables(self)) arg# to rval#
59514>>>>>>>>>>>>> function_return rval#
59515>>>>>>>>>>>>> end
59515>>>>>>>>>>>>>>
59515>>>>>>>>>>>>> if type# eq AT_EXPR function_return (psVar.i(oExprEvalSequences(self),integer(arg#)-1))
59518>>>>>>>>>>>>> if type# eq AT_ARRAY_ELEM function_return (piType.i(oDeclaredArrays(self),hi(integer(arg#))))
59521>>>>>>>>>>>>> function_return rval#
59522>>>>>>>>>>>>> end_function
59523>>>>>>>>>>>>>
59523>>>>>>>>>>>>> function iVarType.i integer varno# returns integer
59525>>>>>>>>>>>>> function_return (piType.i(oVariables(self),varno#))
59526>>>>>>>>>>>>> end_function
59527>>>>>>>>>>>>> function iVarType.s string name# returns integer
59529>>>>>>>>>>>>> integer varno#
59529>>>>>>>>>>>>> get iVarNameToVarNo name# to varno#
59530>>>>>>>>>>>>> if varno# eq -1 function_return -1
59533>>>>>>>>>>>>> function_return (piType.i(oVariables(self),varno#))
59534>>>>>>>>>>>>> end_function
59535>>>>>>>>>>>>>
59535>>>>>>>>>>>>> // -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
59535>>>>>>>>>>>>> // These procedures are used when EXECUTING each valid OP-code
59535>>>>>>>>>>>>> procedure mthd_Nop
59537>>>>>>>>>>>>> end_procedure
59538>>>>>>>>>>>>> procedure mthd_ClearScreen
59540>>>>>>>>>>>>> clearscreen
59541>>>>>>>>>>>>>>
59541>>>>>>>>>>>>> end_procedure
59542>>>>>>>>>>>>> procedure mthd_Abort
59544>>>>>>>>>>>>> send reset // Clean up variables and arrays
59545>>>>>>>>>>>>> set pProgramEnded to 1
59546>>>>>>>>>>>>> end_procedure
59547>>>>>>>>>>>>> procedure mthd_Gosub integer type# integer line#
59549>>>>>>>>>>>>> get sArgValue.is type# line# to line#
59550>>>>>>>>>>>>> integer pc#
59550>>>>>>>>>>>>> get piProgramCounter to pc#
59551>>>>>>>>>>>>> send Push.i to (oReturnAddressStack(self)) pc#
59552>>>>>>>>>>>>> set piProgramCounter to line#
59553>>>>>>>>>>>>> end_procedure
59554>>>>>>>>>>>>> procedure mthd_Goto integer type# integer line#
59556>>>>>>>>>>>>> get sArgValue.is type# line# to line#
59557>>>>>>>>>>>>> set piProgramCounter to line#
59558>>>>>>>>>>>>> end_procedure
59559>>>>>>>>>>>>> procedure mthd_Return
59561>>>>>>>>>>>>> set piProgramCounter to (iPop(oReturnAddressStack(self)))
59562>>>>>>>>>>>>> end_procedure
59563>>>>>>>>>>>>> procedure mthd_ShowLn integer type# string str#
59565>>>>>>>>>>>>> get sArgValue.is type# str# to str#
59566>>>>>>>>>>>>> showln str#
59568>>>>>>>>>>>>> end_procedure
59569>>>>>>>>>>>>> procedure mthd_Show integer type# string str#
59571>>>>>>>>>>>>> get sArgValue.is type# str# to str#
59572>>>>>>>>>>>>> show str#
59573>>>>>>>>>>>>> end_procedure
59574>>>>>>>>>>>>> procedure mthd_SeqFile integer type1# integer op# integer type2# string fn#
59576>>>>>>>>>>>>> end_procedure
59577>>>>>>>>>>>>> procedure mthd_WriteLn integer type# string str#
59579>>>>>>>>>>>>> end_procedure
59580>>>>>>>>>>>>> procedure mthd_MsgBox integer type# string str#
59582>>>>>>>>>>>>> get sArgValue.is type# str# to str#
59583>>>>>>>>>>>>> send obs str#
59584>>>>>>>>>>>>> end_procedure
59585>>>>>>>>>>>>> procedure mthd_GotoXY integer t1# integer v1# integer t2# integer v2#
59587>>>>>>>>>>>>> get sArgValue.is t1# v1# to v1#
59588>>>>>>>>>>>>> get sArgValue.is t2# v2# to v2#
59589>>>>>>>>>>>>> gotoxy v1# v2#
59590>>>>>>>>>>>>>>
59590>>>>>>>>>>>>> end_procedure
59591>>>>>>>>>>>>> procedure mthd_Input integer type# integer varno# integer type2# string label#
59593>>>>>>>>>>>>> string value#
59593>>>>>>>>>>>>> get sArgValue.is type2# label# to label#
59594>>>>>>>>>>>>> show label#
59595>>>>>>>>>>>>> input value#
59596>>>>>>>>>>>>>>
59596>>>>>>>>>>>>> send VarAssign to (oVariables(self)) varno# value#
59597>>>>>>>>>>>>> end_procedure
59598>>>>>>>>>>>>> procedure mthd_Pause
59600>>>>>>>>>>>>> string grb#
59600>>>>>>>>>>>>> inkey grb#
59601>>>>>>>>>>>>>>
59601>>>>>>>>>>>>> end_procedure
59602>>>>>>>>>>>>> procedure mthd_Assign integer type# string varno# integer type2# string value#
59604>>>>>>>>>>>>>// send obs "mthd_Assign" type# varno# type2# value#
59604>>>>>>>>>>>>> get sArgValue.is type2# value# to value# // Source value
59605>>>>>>>>>>>>> if type# eq AT_FIELDNO set_field_value (hi(integer(varno#))) (low(integer(varno#))) to value#
59610>>>>>>>>>>>>> else if type# eq AT_ARRAY_ELEM send Assign_Value to (oDeclaredArrays(self)) (hi(integer(varno#))) (low(integer(varno#))) value#
59614>>>>>>>>>>>>> else send VarAssign to (oVariables(self)) varno# value#
59616>>>>>>>>>>>>> end_procedure
59617>>>>>>>>>>>>> procedure mthd_gVar_Incr integer type# integer varno# integer type2# integer amount#
59619>>>>>>>>>>>>> get sArgValue.is type2# amount# to amount#
59620>>>>>>>>>>>>> send VarIncrement to (oVariables(self)) varno# amount#
59621>>>>>>>>>>>>> end_procedure
59622>>>>>>>>>>>>> procedure mthd_gVar_Display
59624>>>>>>>>>>>>> send VarDisplay to (oVariables(self))
59625>>>>>>>>>>>>> end_procedure
59626>>>>>>>>>>>>> procedure mthd_if_goto integer type# integer varno# integer type2# integer line#
59628>>>>>>>>>>>>> integer bool#
59628>>>>>>>>>>>>> get sArgValue.is type2# line# to line#
59629>>>>>>>>>>>>> get psValue.i of (oVariables(self)) varno# to bool#
59630>>>>>>>>>>>>> if bool# set piProgramCounter to line#
59633>>>>>>>>>>>>> end_procedure
59634>>>>>>>>>>>>> procedure mthd_if_gosub integer type# integer varno# integer type2# integer line#
59636>>>>>>>>>>>>> integer bool# pc#
59636>>>>>>>>>>>>> get sArgValue.is type2# line# to line#
59637>>>>>>>>>>>>> get psValue.i of (oVariables(self)) varno# to bool#
59638>>>>>>>>>>>>> if bool# begin
59640>>>>>>>>>>>>> get piProgramCounter to pc#
59641>>>>>>>>>>>>> send Push.i to (oReturnAddressStack(self)) pc#
59642>>>>>>>>>>>>> set piProgramCounter to line#
59643>>>>>>>>>>>>> end
59643>>>>>>>>>>>>>>
59643>>>>>>>>>>>>> end_procedure
59644>>>>>>>>>>>>> function iIfTest_Help.iiiiii integer t1# string arg1# ; integer t2# integer comp# ; integer t3# string arg2# returns integer
59646>>>>>>>>>>>>> integer vcomp# type# i1# i2# bool#
59646>>>>>>>>>>>>> number n1# n2#
59646>>>>>>>>>>>>> date d1# d2#
59646>>>>>>>>>>>>> move -1 to bool#
59647>>>>>>>>>>>>> get sArgType.is t1# arg1# to type#
59648>>>>>>>>>>>>> get sArgValue.is t1# arg1# to arg1#
59649>>>>>>>>>>>>> get sArgValue.is t3# arg2# to arg2#
59650>>>>>>>>>>>>> if type# eq VARTYP_INTEGER begin
59652>>>>>>>>>>>>> move 0 to bool#
59653>>>>>>>>>>>>> move arg1# to i1#
59654>>>>>>>>>>>>> move arg2# to i2#
59655>>>>>>>>>>>>> if comp# eq COMP_LT move (i1#<i2#) to bool#
59658>>>>>>>>>>>>> if comp# eq COMP_LE move (i1#<=i2#) to bool#
59661>>>>>>>>>>>>> if comp# eq COMP_EQ move (i1#=i2#) to bool#
59664>>>>>>>>>>>>> if comp# eq COMP_GE move (i1#>=i2#) to bool#
59667>>>>>>>>>>>>> if comp# eq COMP_GT move (i1#>i2#) to bool#
59670>>>>>>>>>>>>> if comp# eq COMP_NE move (i1#<>i2#) to bool#
59673>>>>>>>>>>>>> end
59673>>>>>>>>>>>>>>
59673>>>>>>>>>>>>> if type# eq VARTYP_NUMBER begin
59675>>>>>>>>>>>>> move 0 to bool#
59676>>>>>>>>>>>>> move arg1# to n1#
59677>>>>>>>>>>>>> move arg2# to n2#
59678>>>>>>>>>>>>> if comp# eq COMP_LT move (n1#<n2#) to bool#
59681>>>>>>>>>>>>> if comp# eq COMP_LE move (n1#<=n2#) to bool#
59684>>>>>>>>>>>>> if comp# eq COMP_EQ move (n1#=n2#) to bool#
59687>>>>>>>>>>>>> if comp# eq COMP_GE move (n1#>=n2#) to bool#
59690>>>>>>>>>>>>> if comp# eq COMP_GT move (n1#>n2#) to bool#
59693>>>>>>>>>>>>> if comp# eq COMP_NE move (n1#<>n2#) to bool#
59696>>>>>>>>>>>>> end
59696>>>>>>>>>>>>>>
59696>>>>>>>>>>>>> if type# eq VARTYP_DATE begin
59698>>>>>>>>>>>>> move 0 to bool#
59699>>>>>>>>>>>>> move arg1# to d1#
59700>>>>>>>>>>>>> move arg2# to d2#
59701>>>>>>>>>>>>> if comp# eq COMP_LT move (d1#<d2#) to bool#
59704>>>>>>>>>>>>> if comp# eq COMP_LE move (d1#<=d2#) to bool#
59707>>>>>>>>>>>>> if comp# eq COMP_EQ move (d1#=d2#) to bool#
59710>>>>>>>>>>>>> if comp# eq COMP_GE move (d1#>=d2#) to bool#
59713>>>>>>>>>>>>> if comp# eq COMP_GT move (d1#>d2#) to bool#
59716>>>>>>>>>>>>> if comp# eq COMP_NE move (d1#<>d2#) to bool#
59719>>>>>>>>>>>>> end
59719>>>>>>>>>>>>>>
59719>>>>>>>>>>>>> if type# eq VARTYP_STRING begin
59721>>>>>>>>>>>>> move 0 to bool#
59722>>>>>>>>>>>>> if comp# eq COMP_LT if arg1# LT arg2# move 1 to bool#
59727>>>>>>>>>>>>> if comp# eq COMP_LE if arg1# LE arg2# move 1 to bool#
59732>>>>>>>>>>>>> if comp# eq COMP_EQ if arg1# EQ arg2# move 1 to bool#
59737>>>>>>>>>>>>> if comp# eq COMP_GE if arg1# GE arg2# move 1 to bool#
59742>>>>>>>>>>>>> if comp# eq COMP_GT if arg1# GT arg2# move 1 to bool#
59747>>>>>>>>>>>>> if comp# eq COMP_NE if arg1# NE arg2# move 1 to bool#
59752>>>>>>>>>>>>> end
59752>>>>>>>>>>>>>>
59752>>>>>>>>>>>>> if bool# eq -1 send obs "Bad comparison, if-test failed"
59755>>>>>>>>>>>>> function_return bool#
59756>>>>>>>>>>>>> end_function
59757>>>>>>>>>>>>> procedure mthd_iftest_goto integer t1# string varno1# integer t2# integer comp# integer t3# string varno2# integer t4# integer line#
59759>>>>>>>>>>>>> integer bool# pc#
59759>>>>>>>>>>>>> get sArgValue.is t4# line# to line#
59760>>>>>>>>>>>>> get iIfTest_Help.iiiiii t1# varno1# t2# comp# t3# varno2# to bool#
59761>>>>>>>>>>>>> if bool# set piProgramCounter to line#
59764>>>>>>>>>>>>> end_procedure
59765>>>>>>>>>>>>> procedure mthd_iftest_gosub integer t1# string varno1# integer t2# integer comp# integer t3# string varno2# integer t4# integer line#
59767>>>>>>>>>>>>> integer bool# pc#
59767>>>>>>>>>>>>> get sArgValue.is t4# line# to line#
59768>>>>>>>>>>>>> get iIfTest_Help.iiiiii t1# varno1# t2# comp# t3# varno2# to bool#
59769>>>>>>>>>>>>> if bool# begin
59771>>>>>>>>>>>>> get piProgramCounter to pc#
59772>>>>>>>>>>>>> send Push.i to (oReturnAddressStack(self)) pc#
59773>>>>>>>>>>>>> set piProgramCounter to line#
59774>>>>>>>>>>>>> end
59774>>>>>>>>>>>>>>
59774>>>>>>>>>>>>> end_procedure
59775>>>>>>>>>>>>> enumeration_list
59775>>>>>>>>>>>>> define DBG.OFF
59775>>>>>>>>>>>>> define DBG.ON
59775>>>>>>>>>>>>> define DBG.SINGLESTEP
59775>>>>>>>>>>>>> define DBG.VARDISPLAY
59775>>>>>>>>>>>>> end_enumeration_list
59775>>>>>>>>>>>>> procedure mthd_debug integer t1# string value#
59777>>>>>>>>>>>>> get sArgValue.is t1# value# to value#
59778>>>>>>>>>>>>> if (integer(value#)) eq DBG.OFF begin
59780>>>>>>>>>>>>> set piDebugState to 0
59781>>>>>>>>>>>>> set piDebugSingleStep to 0
59782>>>>>>>>>>>>> end
59782>>>>>>>>>>>>>>
59782>>>>>>>>>>>>> if (integer(value#)) eq DBG.ON begin
59784>>>>>>>>>>>>> set piDebugState to 1
59785>>>>>>>>>>>>> set piDebugSingleStep to 0
59786>>>>>>>>>>>>> end
59786>>>>>>>>>>>>>>
59786>>>>>>>>>>>>> if (integer(value#)) eq DBG.SINGLESTEP begin
59788>>>>>>>>>>>>> set piDebugState to 1
59789>>>>>>>>>>>>> set piDebugSingleStep to 1
59790>>>>>>>>>>>>> end
59790>>>>>>>>>>>>>>
59790>>>>>>>>>>>>> if (integer(value#)) eq DBG.VARDISPLAY send VarDisplay to (oVariables(self))
59793>>>>>>>>>>>>> end_procedure
59794>>>>>>>>>>>>> procedure mthd_log_open integer t1# string fn# integer t2# string append#
59796>>>>>>>>>>>>> integer ch#
59796>>>>>>>>>>>>> get sArgValue.is t1# fn# to fn#
59797>>>>>>>>>>>>> get sArgValue.is t2# append# to append#
59798>>>>>>>>>>>>> get private.piLogChannel to ch#
59799>>>>>>>>>>>>> if ch# eq -1 begin
59801>>>>>>>>>>>>> if (integer(append#)) move (SEQ_AppendOutput(fn#)) to ch#
59804>>>>>>>>>>>>> else move (SEQ_DirectOutput(fn#)) to ch#
59806>>>>>>>>>>>>> set private.piLogChannel to ch#
59807>>>>>>>>>>>>> set private.psLogFileName to fn#
59808>>>>>>>>>>>>> end
59808>>>>>>>>>>>>>>
59808>>>>>>>>>>>>> // else some kind of runtime error
59808>>>>>>>>>>>>> end_procedure
59809>>>>>>>>>>>>> procedure mthd_log_close
59811>>>>>>>>>>>>> integer ch#
59811>>>>>>>>>>>>> get private.piLogChannel to ch#
59812>>>>>>>>>>>>> if (ch#>=0) begin
59814>>>>>>>>>>>>> send SEQ_CloseOutput ch#
59815>>>>>>>>>>>>> set private.piLogChannel to -1
59816>>>>>>>>>>>>> end
59816>>>>>>>>>>>>>>
59816>>>>>>>>>>>>> // else some kind of runtime error
59816>>>>>>>>>>>>> end_procedure
59817>>>>>>>>>>>>> procedure mthd_log_display
59819>>>>>>>>>>>>> send output.display_file (private.psLogFileName(self))
59820>>>>>>>>>>>>> end_procedure
59821>>>>>>>>>>>>> procedure mthd_log_flush
59823>>>>>>>>>>>>> integer ch#
59823>>>>>>>>>>>>> get private.piLogChannel to ch#
59824>>>>>>>>>>>>> if (ch#>=0) begin
59826>>>>>>>>>>>>> close_output channel ch#
59828>>>>>>>>>>>>> append_output channel ch# (private.psLogFileName(self))
59830>>>>>>>>>>>>> end
59830>>>>>>>>>>>>>>
59830>>>>>>>>>>>>> // else some kind of runtime error
59830>>>>>>>>>>>>> end_procedure
59831>>>>>>>>>>>>> procedure mthd_log_write integer type# string str#
59833>>>>>>>>>>>>> integer ch#
59833>>>>>>>>>>>>> get sArgValue.is type# str# to str#
59834>>>>>>>>>>>>> get private.piLogChannel to ch#
59835>>>>>>>>>>>>> if (ch#>=0) write channel ch# str#
59839>>>>>>>>>>>>> end_procedure
59840>>>>>>>>>>>>> procedure mthd_log_writeln integer type# string str#
59842>>>>>>>>>>>>> integer ch#
59842>>>>>>>>>>>>> get sArgValue.is type# str# to str#
59843>>>>>>>>>>>>> get private.piLogChannel to ch#
59844>>>>>>>>>>>>> if (ch#>=0) writeln channel ch# str#
59849>>>>>>>>>>>>> end_procedure
59850>>>>>>>>>>>>> procedure mthd_api_filelist integer t1# string a1# integer t2# string a2# integer t3# string a3#
59852>>>>>>>>>>>>> get sArgValue.is t1# a1# to a1#
59853>>>>>>>>>>>>> get sArgValue.is t2# a2# to a2#
59854>>>>>>>>>>>>> get sArgValue.is t3# a3# to a3#
59855>>>>>>>>>>>>> send RS_SetFileListAttr a1# a2# a3#
59856>>>>>>>>>>>>> end_procedure
59857>>>>>>>>>>>>> procedure mthd_api_file integer t1# string a1# integer t2# string a2#
59859>>>>>>>>>>>>> get sArgValue.is t1# a1# to a1#
59860>>>>>>>>>>>>> get sArgValue.is t2# a2# to a2#
59861>>>>>>>>>>>>> send RS_SetFileAttr a1# a2#
59862>>>>>>>>>>>>> end_procedure
59863>>>>>>>>>>>>> procedure mthd_api_field integer t1# string a1# integer t2# string a2# integer t3# string a3#
59865>>>>>>>>>>>>> get sArgValue.is t1# a1# to a1#
59866>>>>>>>>>>>>> get sArgValue.is t2# a2# to a2#
59867>>>>>>>>>>>>> get sArgValue.is t3# a3# to a3#
59868>>>>>>>>>>>>> send RS_SetFieldAttr a1# a2# a3#
59869>>>>>>>>>>>>> end_procedure
59870>>>>>>>>>>>>> procedure mthd_api_index integer t1# string a1# integer t2# string a2# integer t3# string a3#
59872>>>>>>>>>>>>> get sArgValue.is t1# a1# to a1#
59873>>>>>>>>>>>>> get sArgValue.is t2# a2# to a2#
59874>>>>>>>>>>>>> get sArgValue.is t3# a3# to a3#
59875>>>>>>>>>>>>> send RS_SetIndexAttr a1# a2# a3#
59876>>>>>>>>>>>>> end_procedure
59877>>>>>>>>>>>>> procedure mthd_api_idxseg integer t1# string a1# integer t2# string a2# integer t3# string a3# integer t4# string a4#
59879>>>>>>>>>>>>> get sArgValue.is t1# a1# to a1#
59880>>>>>>>>>>>>> get sArgValue.is t2# a2# to a2#
59881>>>>>>>>>>>>> get sArgValue.is t3# a3# to a3#
59882>>>>>>>>>>>>> get sArgValue.is t4# a4# to a4#
59883>>>>>>>>>>>>> send RS_SetIndexSegAttr a1# a2# a3# a4#
59884>>>>>>>>>>>>> end_procedure
59885>>>>>>>>>>>>> procedure mthd_api_structure_abort
59887>>>>>>>>>>>>> send RS_Structure_Abort
59888>>>>>>>>>>>>> end_procedure
59889>>>>>>>>>>>>> procedure mthd_api_structure_end
59891>>>>>>>>>>>>> send RS_Structure_End
59892>>>>>>>>>>>>> end_procedure
59893>>>>>>>>>>>>> procedure mthd_api_probe_end
59895>>>>>>>>>>>>> send RS_Probe_End
59896>>>>>>>>>>>>> end_procedure
59897>>>>>>>>>>>>> procedure mthd_api_DeleteIndex integer t1# string a1#
59899>>>>>>>>>>>>> get sArgValue.is t1# a1# to a1#
59900>>>>>>>>>>>>> send RS_DeleteIndex a1#
59901>>>>>>>>>>>>> end_procedure
59902>>>>>>>>>>>>> procedure mthd_api_DeleteField integer t1# string a1#
59904>>>>>>>>>>>>> get sArgValue.is t1# a1# to a1#
59905>>>>>>>>>>>>> send RS_DeleteField a1#
59906>>>>>>>>>>>>> end_procedure
59907>>>>>>>>>>>>> procedure mthd_api_AppendField integer t1# string a1# integer t2# string a2#
59909>>>>>>>>>>>>> get sArgValue.is t1# a1# to a1#
59910>>>>>>>>>>>>> get sArgValue.is t2# a2# to a2#
59911>>>>>>>>>>>>> send RS_AppendField a1# a2#
59912>>>>>>>>>>>>> end_procedure
59913>>>>>>>>>>>>> procedure mthd_api_CreateField integer t1# string a1# integer t2# string a2# integer t3# string a3#
59915>>>>>>>>>>>>> get sArgValue.is t1# a1# to a1#
59916>>>>>>>>>>>>> get sArgValue.is t2# a2# to a2#
59917>>>>>>>>>>>>> get sArgValue.is t3# a3# to a3#
59918>>>>>>>>>>>>> send RS_CreateField a1# a2# a3#
59919>>>>>>>>>>>>> end_procedure
59920>>>>>>>>>>>>> procedure mthd_api_SetFieldNumber integer t1# string a1#
59922>>>>>>>>>>>>> get sArgValue.is t1# a1# to a1#
59923>>>>>>>>>>>>> send RS_SetFieldNumber a1#
59924>>>>>>>>>>>>> end_procedure
59925>>>>>>>>>>>>> // -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
59925>>>>>>>>>>>>> procedure add_ct_error integer line# string msg#
59927>>>>>>>>>>>>> send obs ("Error in line "+string(line#)) msg#
59928>>>>>>>>>>>>> set piInvalidProgram to true
59929>>>>>>>>>>>>> end_procedure
59930>>>>>>>>>>>>> procedure reset
59932>>>>>>>>>>>>> send delete_data
59933>>>>>>>>>>>>> send reset to (oLabels(self))
59934>>>>>>>>>>>>> send reset to (oDeclaredArrays(self))
59935>>>>>>>>>>>>> send reset to (oDeclaredFunctions(self))
59936>>>>>>>>>>>>> send reset to (oExprEvalSequences(self))
59937>>>>>>>>>>>>> send delete_data to (oReturnAddressStack(self))
59938>>>>>>>>>>>>> send delete_data to (oVariables(self))
59939>>>>>>>>>>>>> set piProgramCounter to 0
59940>>>>>>>>>>>>> set piInvalidProgram to 0
59941>>>>>>>>>>>>> set pCurrentOpCodeLine to 0
59942>>>>>>>>>>>>> set pProgramEnded to 0
59943>>>>>>>>>>>>> set private.piLogChannel to -1
59944>>>>>>>>>>>>> set private.psLogFileName to ""
59945>>>>>>>>>>>>> end_procedure
59946>>>>>>>>>>>>> procedure increment_pc integer tmp_amount#
59948>>>>>>>>>>>>> integer amount#
59948>>>>>>>>>>>>> if num_arguments move tmp_amount# to amount#
59951>>>>>>>>>>>>> else move 1 to amount#
59953>>>>>>>>>>>>> set piProgramCounter to (piProgramCounter(self)+amount#)
59954>>>>>>>>>>>>> end_procedure
59955>>>>>>>>>>>>> function sGetData returns string
59957>>>>>>>>>>>>> string rval#
59957>>>>>>>>>>>>> get value item (piProgramCounter(self)) to rval#
59958>>>>>>>>>>>>> send increment_pc
59959>>>>>>>>>>>>> function_return rval#
59960>>>>>>>>>>>>> end_function
59961>>>>>>>>>>>>> // -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
59961>>>>>>>>>>>>> // These procedures are used for EXECUTING a program
59961>>>>>>>>>>>>> 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#
59963>>>>>>>>>>>>> integer num_arguments#
59963>>>>>>>>>>>>> string grb# str#
59963>>>>>>>>>>>>> get piParameters.i of (oOpcodes(self)) item opcode# to num_arguments#
59964>>>>>>>>>>>>> move "Line #: #" to str#
59965>>>>>>>>>>>>> replace "#" in str# with (IntToStrRzf(pCurrentOpCodeLine(self),length(string(item_count(self)-1))))
59967>>>>>>>>>>>>> replace "#" in str# with (psName.i(oOpcodes(self),opcode#))
59969>>>>>>>>>>>>> if num_arguments# ge 1 move (str#+" "+sArgtype_Name.i(typ1#)+"["+arg1#+"]") to str#
59972>>>>>>>>>>>>> if num_arguments# ge 2 move (str#+" "+sArgtype_Name.i(typ2#)+"["+arg2#+"]") to str#
59975>>>>>>>>>>>>> if num_arguments# ge 3 move (str#+" "+sArgtype_Name.i(typ3#)+"["+arg3#+"]") to str#
59978>>>>>>>>>>>>> if num_arguments# ge 4 move (str#+" "+sArgtype_Name.i(typ4#)+"["+arg4#+"]") to str#
59981>>>>>>>>>>>>> if num_arguments# ge 5 move (str#+" "+sArgtype_Name.i(typ5#)+"["+arg5#+"]") to str#
59984>>>>>>>>>>>>> if num_arguments# ge 6 move (str#+" "+sArgtype_Name.i(typ6#)+"["+arg6#+"]") to str#
59987>>>>>>>>>>>>> set psDebugLine to str#
59988>>>>>>>>>>>>> if display# begin
59990>>>>>>>>>>>>> showln str#
59992>>>>>>>>>>>>> if (piDebugSingleStep(self)) inkey grb#
59995>>>>>>>>>>>>> end
59995>>>>>>>>>>>>>>
59995>>>>>>>>>>>>> end_procedure
59996>>>>>>>>>>>>> procedure illegal_opcode integer opcode#
59998>>>>>>>>>>>>> send add_ct_error (piProgramCounter(self)-1) ("Illegal OPCODE ("+string(opcode#)+")")
59999>>>>>>>>>>>>> end_procedure
60000>>>>>>>>>>>>> procedure exec_instruction integer opcode# integer exec#
60002>>>>>>>>>>>>> integer msg# num_arguments# oOpCodes#
60002>>>>>>>>>>>>> integer typ1# typ2# typ3# typ4# typ5# typ6#
60002>>>>>>>>>>>>> string arg1# arg2# arg3# arg4# arg5# arg6#
60002>>>>>>>>>>>>> //send obs (psName.i(oOpCodes(self),opcode#))
60002>>>>>>>>>>>>> move (oOpCodes(self)) to oOpCodes#
60003>>>>>>>>>>>>> get piMessage.i of oOpCodes# opcode# to msg#
60004>>>>>>>>>>>>> get piParameters.i of oOpCodes# opcode# to num_arguments#
60005>>>>>>>>>>>>> if num_arguments# ge 1 get sGetData to typ1#
60008>>>>>>>>>>>>> if num_arguments# ge 1 get sGetData to arg1#
60011>>>>>>>>>>>>> if num_arguments# ge 2 get sGetData to typ2#
60014>>>>>>>>>>>>> if num_arguments# ge 2 get sGetData to arg2#
60017>>>>>>>>>>>>> if num_arguments# ge 3 get sGetData to typ3#
60020>>>>>>>>>>>>> if num_arguments# ge 3 get sGetData to arg3#
60023>>>>>>>>>>>>> if num_arguments# ge 4 get sGetData to typ4#
60026>>>>>>>>>>>>> if num_arguments# ge 4 get sGetData to arg4#
60029>>>>>>>>>>>>> if num_arguments# ge 5 get sGetData to typ5#
60032>>>>>>>>>>>>> if num_arguments# ge 5 get sGetData to arg5#
60035>>>>>>>>>>>>> if num_arguments# ge 6 get sGetData to typ6#
60038>>>>>>>>>>>>> if num_arguments# ge 6 get sGetData to arg6#
60041>>>>>>>>>>>>> if (piDebugState(self)) ; send add_debug_line exec# opcode# typ1# arg1# typ2# arg2# typ3# arg3# typ4# arg4# typ5# arg5# typ6# arg6#
60044>>>>>>>>>>>>> if exec# begin
60046>>>>>>>>>>>>> if num_arguments# eq 0 send msg#
60049>>>>>>>>>>>>> if num_arguments# eq 1 send msg# typ1# arg1#
60052>>>>>>>>>>>>> if num_arguments# eq 2 send msg# typ1# arg1# typ2# arg2#
60055>>>>>>>>>>>>> if num_arguments# eq 3 send msg# typ1# arg1# typ2# arg2# typ3# arg3#
60058>>>>>>>>>>>>> if num_arguments# eq 4 send msg# typ1# arg1# typ2# arg2# typ3# arg3# typ4# arg4#
60061>>>>>>>>>>>>> if num_arguments# eq 5 send msg# typ1# arg1# typ2# arg2# typ3# arg3# typ4# arg4# typ5# arg5#
60064>>>>>>>>>>>>> if num_arguments# eq 6 send msg# typ1# arg1# typ2# arg2# typ3# arg3# typ4# arg4# typ5# arg5# typ6# arg6#
60067>>>>>>>>>>>>> end
60067>>>>>>>>>>>>>>
60067>>>>>>>>>>>>> end_procedure
60068>>>>>>>>>>>>> function sExecutingLine returns string
60070>>>>>>>>>>>>> integer opcode# st#
60070>>>>>>>>>>>>> get piDebugState to st#
60071>>>>>>>>>>>>> set piDebugState to true
60072>>>>>>>>>>>>> set piProgramCounter to (pCurrentOpCodeLine(self))
60073>>>>>>>>>>>>> get value item (pCurrentOpCodeLine(self)) to opcode#
60074>>>>>>>>>>>>> send increment_pc
60075>>>>>>>>>>>>> send exec_instruction opcode# 0
60076>>>>>>>>>>>>> set piDebugState to st#
60077>>>>>>>>>>>>> function_return (psDebugLine(self))
60078>>>>>>>>>>>>> end_function
60079>>>>>>>>>>>>> procedure run_script
60081>>>>>>>>>>>>> integer pc# max# opcode# max_line#
60081>>>>>>>>>>>>> ifnot (piInvalidProgram(self)) begin
60083>>>>>>>>>>>>> set piProgramCounter to 0
60084>>>>>>>>>>>>> set pProgramEnded to 0
60085>>>>>>>>>>>>> move self to oVM_CurrentlyExecuting#
60086>>>>>>>>>>>>> send delete_data to (oReturnAddressStack(self))
60087>>>>>>>>>>>>> move 0 to max_line#
60088>>>>>>>>>>>>> send DFScriptError_On
60089>>>>>>>>>>>>> get piProgramCounter to pc#
60090>>>>>>>>>>>>> get item_count to max#
60091>>>>>>>>>>>>> screenmode 1
60092>>>>>>>>>>>>> while (pc#<max# and not(pProgramEnded(self))) // Program ends if we reach the end of the array
60096>>>>>>>>>>>>> get value item pc# to opcode#
60097>>>>>>>>>>>>> set pCurrentOpCodeLine to pc#
60098>>>>>>>>>>>>> send increment_pc
60099>>>>>>>>>>>>> send exec_instruction opcode# 1
60100>>>>>>>>>>>>> get piProgramCounter to pc#
60101>>>>>>>>>>>>> increment max_line#
60102>>>>>>>>>>>>> if max_line# gt 10000 begin
60104>>>>>>>>>>>>> if (MB_Verify4("","Max lines encountered!","Execute another "+string(10000)+" instructions?","",1)) move 0 to max_line#
60107>>>>>>>>>>>>> else set pProgramEnded to true
60109>>>>>>>>>>>>> end
60109>>>>>>>>>>>>>>
60109>>>>>>>>>>>>> end
60110>>>>>>>>>>>>>>
60110>>>>>>>>>>>>> if (private.piLogChannel(self)<>-1) begin // Close log file and release channel
60112>>>>>>>>>>>>> send SEQ_CloseOutput (private.piLogChannel(self))
60113>>>>>>>>>>>>> set private.piLogChannel to -1
60114>>>>>>>>>>>>> end
60114>>>>>>>>>>>>>>
60114>>>>>>>>>>>>> send DFScriptError_Off
60115>>>>>>>>>>>>> end
60115>>>>>>>>>>>>>>
60115>>>>>>>>>>>>> else send obs "Errors where found during" "script interpretation." "The program will not execute!"
60117>>>>>>>>>>>>> move 0 to oVM_CurrentlyExecuting#
60118>>>>>>>>>>>>> end_procedure
60119>>>>>>>>>>>>>
60119>>>>>>>>>>>>> procedure program_init
60121>>>>>>>>>>>>> set private.piLogChannel to -1
60122>>>>>>>>>>>>> //intended for augmentation (Define SCREENEND and the like)
60122>>>>>>>>>>>>> end_procedure
60123>>>>>>>>>>>>>
60123>>>>>>>>>>>>> procedure AddOpcode.i integer opcode#
60125>>>>>>>>>>>>> set value item (piProgramCounter(self)) to opcode#
60126>>>>>>>>>>>>> send increment_pc
60127>>>>>>>>>>>>> end_procedure
60128>>>>>>>>>>>>> procedure script_begin
60130>>>>>>>>>>>>> send reset
60131>>>>>>>>>>>>> send program_init
60132>>>>>>>>>>>>> end_procedure
60133>>>>>>>>>>>>> procedure private.resolve_labels
60135>>>>>>>>>>>>> integer self#
60135>>>>>>>>>>>>> string unresolved_label#
60135>>>>>>>>>>>>> move self to self#
60136>>>>>>>>>>>>> get sResolve_Labels.i of (oLabels(self)) self# to unresolved_label#
60137>>>>>>>>>>>>> if unresolved_label# ne "" send add_ct_error (piProgramCounter(self)-1) ("Unresolved label ("+unresolved_label#+")")
60140>>>>>>>>>>>>> end_procedure
60141>>>>>>>>>>>>> procedure script_end
60143>>>>>>>>>>>>> send private.resolve_labels
60144>>>>>>>>>>>>> end_procedure
60145>>>>>>>>>>>>> procedure declare_label string name#
60147>>>>>>>>>>>>> integer self#
60147>>>>>>>>>>>>> move self to self#
60148>>>>>>>>>>>>> send add_resolved_label to (oLabels(self)) name# (piProgramCounter(self#))
60149>>>>>>>>>>>>> end_procedure
60150>>>>>>>>>>>>> procedure declare_label_no_error string name# // Makes no error if label is already defined
60152>>>>>>>>>>>>> integer self#
60152>>>>>>>>>>>>> move self to self#
60153>>>>>>>>>>>>> send add_resolved_label_no_error to (oLabels(self)) name# (piProgramCounter(self#))
60154>>>>>>>>>>>>> end_procedure
60155>>>>>>>>>>>>> function iIsLabelNameUsed.s string name# returns integer
60157>>>>>>>>>>>>> function_return (iIsLabelNameUsed.s(oLabels(self),name#))
60158>>>>>>>>>>>>> end_function
60159>>>>>>>>>>>>> // ====== Variable procedures =======================================
60159>>>>>>>>>>>>> function iVarValue integer varno# returns integer
60161>>>>>>>>>>>>> function_return (psValue.i(oVariables(self),varno#))
60162>>>>>>>>>>>>> end_function
60163>>>>>>>>>>>>> function dVarValue integer varno# returns integer
60165>>>>>>>>>>>>> function_return (psValue.i(oVariables(self),varno#))
60166>>>>>>>>>>>>> end_function
60167>>>>>>>>>>>>> function nVarValue integer varno# returns number
60169>>>>>>>>>>>>> function_return (psValue.i(oVariables(self),varno#))
60170>>>>>>>>>>>>> end_function
60171>>>>>>>>>>>>> function sVarValue integer varno# returns string
60173>>>>>>>>>>>>> function_return (psValue.i(oVariables(self),varno#))
60174>>>>>>>>>>>>> end_function
60175>>>>>>>>>>>>> procedure declare_var string varid# integer type#
60177>>>>>>>>>>>>> send VarNameDeclare to (oVariables(self)) varid# type#
60178>>>>>>>>>>>>> end_procedure
60179>>>>>>>>>>>>> function iIsVarDeclared.s string varid# returns integer
60181>>>>>>>>>>>>> integer rval#
60181>>>>>>>>>>>>> get iVarNameToVarNo of (oVariables(self)) varid# to rval#
60182>>>>>>>>>>>>> function_return (rval#<>-1)
60183>>>>>>>>>>>>> end_function
60184>>>>>>>>>>>>> procedure declare_var_cond string varid# integer type# // Declare if not already declared
60186>>>>>>>>>>>>> ifnot (iIsVarDeclared.s(self,varid#)) send declare_var varid# type#
60189>>>>>>>>>>>>> end_procedure
60190>>>>>>>>>>>>> function iVarNameToVarNo string varid# returns integer
60192>>>>>>>>>>>>> integer rval#
60192>>>>>>>>>>>>> get iVarNameToVarNo of (oVariables(self)) varid# to rval#
60193>>>>>>>>>>>>> function_return rval#
60194>>>>>>>>>>>>> end_function
60195>>>>>>>>>>>>> // ====== Field stuff ============================================
60195>>>>>>>>>>>>> function iFileField.s string lsSymbol returns integer
60197>>>>>>>>>>>>> string lsFile lsField
60197>>>>>>>>>>>>> integer liFile liField lhFdx
60197>>>>>>>>>>>>> move (uppercase(ExtractWord(lsSymbol,".",1))) to lsFile
60198>>>>>>>>>>>>> move (uppercase(ExtractWord(lsSymbol,".",2))) to lsField
60199>>>>>>>>>>>>> get phFDX_Server to lhFdx
60200>>>>>>>>>>>>> if (lsFile<>"" and lsField<>"") begin
60202>>>>>>>>>>>>> get FDX_FindLogicalName lhFdx lsFile 0 to liFile
60203>>>>>>>>>>>>> if (liFile>-1) get FDX_FindField lhFdx liFile lsField to liField
60206>>>>>>>>>>>>> else move -1 to liField
60208>>>>>>>>>>>>> if (liField>-1) function_return (liFile*65536+liField)
60211>>>>>>>>>>>>> end
60211>>>>>>>>>>>>>>
60211>>>>>>>>>>>>> function_return 0
60212>>>>>>>>>>>>> end_function
60213>>>>>>>>>>>>> function iFieldType.i integer liFileField returns integer
60215>>>>>>>>>>>>> integer lhFdx liType
60215>>>>>>>>>>>>> get phFDX_Server to lhFdx
60216>>>>>>>>>>>>> get FDX_AttrValue_FIELD lhFdx DF_FIELD_TYPE (liFileField/65536) (mod(liFileField,65536)) to liType
60217>>>>>>>>>>>>> if liType eq DF_ASCII function_return FLDTYP_STRING
60220>>>>>>>>>>>>> if liType eq DF_BCD function_return FLDTYP_NUMBER
60223>>>>>>>>>>>>> if liType eq DF_DATE function_return FLDTYP_DATE
60226>>>>>>>>>>>>> if liType eq DF_TEXT function_return FLDTYP_STRING
60229>>>>>>>>>>>>> if liType eq DF_BINARY function_return FLDTYP_STRING
60232>>>>>>>>>>>>> if liType eq DF_OVERLAP function_return FLDTYP_STRING
60235>>>>>>>>>>>>> end_function
60236>>>>>>>>>>>>>
60236>>>>>>>>>>>>> // ====== Function stuff ============================================
60236>>>>>>>>>>>>> function iFuncNameToFuncNo.s string name# returns integer
60238>>>>>>>>>>>>> function_return (iNameToNumber.s(oDeclaredFunctions(self),name#))
60239>>>>>>>>>>>>> end_function
60240>>>>>>>>>>>>> function iFuncType.i integer id# returns integer
60242>>>>>>>>>>>>> function_return (piReturnType.i(oDeclaredFunctions(self),id#))
60243>>>>>>>>>>>>> end_function
60244>>>>>>>>>>>>> function sFuncParams.i integer id# returns string
60246>>>>>>>>>>>>> function_return (psParameterList.i(oDeclaredFunctions(self),id#))
60247>>>>>>>>>>>>> end_function
60248>>>>>>>>>>>>> function sFuncClass.i integer id# returns string
60250>>>>>>>>>>>>> function_return (piFuncClass.i(oDeclaredFunctions(self),id#))
60251>>>>>>>>>>>>> end_function
60252>>>>>>>>>>>>> // ====== Array stuff ===============================================
60252>>>>>>>>>>>>> procedure declare_array string name# integer type#
60254>>>>>>>>>>>>> send declare_array (oDeclaredArrays(self)) name# type#
60255>>>>>>>>>>>>> end_procedure
60256>>>>>>>>>>>>> // ====== Procedures used for entering a program ====================
60256>>>>>>>>>>>>> procedure add_argument_label string labelid#
60258>>>>>>>>>>>>> integer self# line#
60258>>>>>>>>>>>>> move self to self#
60259>>>>>>>>>>>>> send add_label_reference to (oLabels(self)) labelid# self# (piProgramCounter(self#))
60260>>>>>>>>>>>>> send increment_pc
60261>>>>>>>>>>>>> end_procedure
60262>>>>>>>>>>>>> procedure add_argument_gvar string varid#
60264>>>>>>>>>>>>> integer varno#
60264>>>>>>>>>>>>> get iVarNameToVarNo of (oVariables(self)) varid# to varno#
60265>>>>>>>>>>>>> if varno# eq -1 send add_ct_error (piProgramCounter(self)) ("Undefined variable name: "+varid#)
60268>>>>>>>>>>>>> set value item (piProgramCounter(self)) to varno#
60269>>>>>>>>>>>>> send increment_pc
60270>>>>>>>>>>>>> end_procedure
60271>>>>>>>>>>>>> procedure add_argument_field string lsFieldName
60273>>>>>>>>>>>>> integer liFileField
60273>>>>>>>>>>>>> get iFileField.s lsFieldName to liFileField
60274>>>>>>>>>>>>> if liFileField eq 0 send add_ct_error (piProgramCounter(self)) ("Undefined field name: "+lsFieldName)
60277>>>>>>>>>>>>> set value item (piProgramCounter(self)) to liFileField
60278>>>>>>>>>>>>> send increment_pc
60279>>>>>>>>>>>>> end_procedure
60280>>>>>>>>>>>>> procedure AddData.s integer arg_type# string data#
60282>>>>>>>>>>>>> if arg_type# eq AT_VAR begin
60284>>>>>>>>>>>>> set value item (piProgramCounter(self)) to AT_VARNO
60285>>>>>>>>>>>>> send increment_pc
60286>>>>>>>>>>>>> send add_argument_gvar data#
60287>>>>>>>>>>>>> end
60287>>>>>>>>>>>>>>
60287>>>>>>>>>>>>> if arg_type# eq AT_LBL begin
60289>>>>>>>>>>>>> set value item (piProgramCounter(self)) to AT_LBL
60290>>>>>>>>>>>>> send increment_pc
60291>>>>>>>>>>>>> send add_argument_label data#
60292>>>>>>>>>>>>> end
60292>>>>>>>>>>>>>>
60292>>>>>>>>>>>>> if (iArgType_Const.i(arg_type#)) begin
60294>>>>>>>>>>>>> set value item (piProgramCounter(self)) to arg_type#
60295>>>>>>>>>>>>> send increment_pc
60296>>>>>>>>>>>>> set value item (piProgramCounter(self)) to data#
60297>>>>>>>>>>>>> send increment_pc
60298>>>>>>>>>>>>> end
60298>>>>>>>>>>>>>>
60298>>>>>>>>>>>>> if arg_type# eq AT_EXPR begin
60300>>>>>>>>>>>>> set value item (piProgramCounter(self)) to arg_type#
60301>>>>>>>>>>>>> send increment_pc
60302>>>>>>>>>>>>> set value item (piProgramCounter(self)) to data#
60303>>>>>>>>>>>>> send increment_pc
60304>>>>>>>>>>>>> end
60304>>>>>>>>>>>>>>
60304>>>>>>>>>>>>> if arg_type# eq AT_FIELD begin
60306>>>>>>>>>>>>> set value item (piProgramCounter(self)) to AT_FIELDNO
60307>>>>>>>>>>>>> send increment_pc
60308>>>>>>>>>>>>> send add_argument_field data#
60309>>>>>>>>>>>>> end
60309>>>>>>>>>>>>>>
60309>>>>>>>>>>>>> if arg_type# eq AT_ARRAY_ELEM begin
60311>>>>>>>>>>>>> set value item (piProgramCounter(self)) to AT_ARRAY_ELEM
60312>>>>>>>>>>>>> end
60312>>>>>>>>>>>>>>
60312>>>>>>>>>>>>> end_procedure
60313>>>>>>>>>>>>> procedure add_instruction integer opcode# string arg#
60315>>>>>>>>>>>>> integer iArg num_arguments# special_add_msg# oOpCodes# argtype# count#
60315>>>>>>>>>>>>> string data#
60315>>>>>>>>>>>>> string arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#
60315>>>>>>>>>>>>> move (oOpcodes(self)) to oOpCodes#
60316>>>>>>>>>>>>> get piParameters.i of oOpCodes# item opcode# to num_arguments#
60317>>>>>>>>>>>>> if num_arguments# ne (num_arguments-1/2) begin
60319>>>>>>>>>>>>> send add_ct_error (piProgramCounter(self)) "Wrong number of arguments"
60320>>>>>>>>>>>>> send add_ct_error (piProgramCounter(self)) ("Command: "+psName.i(oOpcodes#,opcode#)+"(Gets "+string(num_arguments-1/2)+", expects "+string(num_arguments#)+")")
60321>>>>>>>>>>>>> end
60321>>>>>>>>>>>>>>
60321>>>>>>>>>>>>> else begin
60322>>>>>>>>>>>>> get piSpecialAddMsg.i of oOpCodes# item opcode# to special_add_msg#
60323>>>>>>>>>>>>> if special_add_msg# begin
60325>>>>>>>>>>>>> for iArg from 2 to num_arguments
60331>>>>>>>>>>>>>>
60331>>>>>>>>>>>>> if iArg eq 2 MoveStr iArg& to arg1#
60334>>>>>>>>>>>>> if iArg eq 3 MoveStr iArg& to arg2#
60337>>>>>>>>>>>>> if iArg eq 4 MoveStr iArg& to arg3#
60340>>>>>>>>>>>>> if iArg eq 5 MoveStr iArg& to arg4#
60343>>>>>>>>>>>>> if iArg eq 6 MoveStr iArg& to arg5#
60346>>>>>>>>>>>>> if iArg eq 7 MoveStr iArg& to arg6#
60349>>>>>>>>>>>>> if iArg eq 8 MoveStr iArg& to arg7#
60352>>>>>>>>>>>>> if iArg eq 9 MoveStr iArg& to arg8#
60355>>>>>>>>>>>>> if iArg eq 10 MoveStr iArg& to arg9#
60358>>>>>>>>>>>>> if iArg eq 11 MoveStr iArg& to arg10#
60361>>>>>>>>>>>>> if iArg eq 12 MoveStr iArg& to arg11#
60364>>>>>>>>>>>>> if iArg eq 13 MoveStr iArg& to arg12#
60367>>>>>>>>>>>>> loop
60368>>>>>>>>>>>>>>
60368>>>>>>>>>>>>> if num_arguments eq 1 send special_add_msg# opcode#
60371>>>>>>>>>>>>> if num_arguments eq 2 send special_add_msg# opcode# arg1#
60374>>>>>>>>>>>>> if num_arguments eq 3 send special_add_msg# opcode# arg1# arg2#
60377>>>>>>>>>>>>> if num_arguments eq 4 send special_add_msg# opcode# arg1# arg2# arg3#
60380>>>>>>>>>>>>> if num_arguments eq 5 send special_add_msg# opcode# arg1# arg2# arg3# arg4#
60383>>>>>>>>>>>>> if num_arguments eq 6 send special_add_msg# opcode# arg1# arg2# arg3# arg4# arg5#
60386>>>>>>>>>>>>> if num_arguments eq 7 send special_add_msg# opcode# arg1# arg2# arg3# arg4# arg5# arg6#
60389>>>>>>>>>>>>> if num_arguments eq 8 send special_add_msg# opcode# arg1# arg2# arg3# arg4# arg5# arg6# arg7#
60392>>>>>>>>>>>>> if num_arguments eq 9 send special_add_msg# opcode# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8#
60395>>>>>>>>>>>>> if num_arguments eq 10 send special_add_msg# opcode# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9#
60398>>>>>>>>>>>>> if num_arguments eq 11 send special_add_msg# opcode# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10#
60401>>>>>>>>>>>>> if num_arguments eq 12 send special_add_msg# opcode# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11#
60404>>>>>>>>>>>>> if num_arguments eq 13 send special_add_msg# opcode# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#
60407>>>>>>>>>>>>> end
60407>>>>>>>>>>>>>>
60407>>>>>>>>>>>>> else begin
60408>>>>>>>>>>>>> send AddOpcode.i opcode#
60409>>>>>>>>>>>>> for count# from 1 to num_arguments#
60415>>>>>>>>>>>>>>
60415>>>>>>>>>>>>> move (count#-1*2+2) to iArg
60416>>>>>>>>>>>>> MoveStr iArg& to argtype# // tricky way to parse passed arguments
60417>>>>>>>>>>>>>>
60417>>>>>>>>>>>>> increment iArg
60418>>>>>>>>>>>>> MoveStr iArg& to data# // tricky way to parse passed arguments
60419>>>>>>>>>>>>>>
60419>>>>>>>>>>>>> send AddData.s argtype# data#
60420>>>>>>>>>>>>> loop
60421>>>>>>>>>>>>>>
60421>>>>>>>>>>>>> end
60421>>>>>>>>>>>>>>
60421>>>>>>>>>>>>> end
60421>>>>>>>>>>>>>>
60421>>>>>>>>>>>>> //send display_array
60421>>>>>>>>>>>>> end_procedure
60422>>>>>>>>>>>>> // ==================================================================
60422>>>>>>>>>>>>> procedure display_array
60424>>>>>>>>>>>>> integer max# itm#
60424>>>>>>>>>>>>> get item_count to max#
60425>>>>>>>>>>>>> showln
60426>>>>>>>>>>>>> show ">> "
60427>>>>>>>>>>>>> for itm# from 0 to (max#-1)
60433>>>>>>>>>>>>>>
60433>>>>>>>>>>>>> show ("["+value(self,itm#)+"]")
60434>>>>>>>>>>>>> loop
60435>>>>>>>>>>>>>>
60435>>>>>>>>>>>>> inkey itm#
60436>>>>>>>>>>>>>>
60436>>>>>>>>>>>>> end_procedure
60437>>>>>>>>>>>>>end_class // cBasicVirtualMachine
60438>>>>>>>>>>>>>
60438>>>>>>>>>>>>>// ========================================================================
60438>>>>>>>>>>>>>// SEC2: =================================================================
60438>>>>>>>>>>>>>// ========================================================================
60438>>>>>>>>>>>>>
60438>>>>>>>>>>>>>Enumeration_List // Operation codes
60438>>>>>>>>>>>>> Enumeration_List_Set_Enum_Value cBasicVirtualMachine.NEXT_OP
60438>>>>>>>>>>>>> define OP_WHILE
60438>>>>>>>>>>>>> define OP_FOR
60438>>>>>>>>>>>>> define OP_LOOP
60438>>>>>>>>>>>>> define OP_IF_BEGIN
60438>>>>>>>>>>>>> define OP_ELSE
60438>>>>>>>>>>>>> define OP_ENDIF
60438>>>>>>>>>>>>> define OP_REPEAT
60438>>>>>>>>>>>>> define OP_UNTIL
60438>>>>>>>>>>>>> define cVirtualMachine.NEXT_OP // Augmentation codes starts here
60438>>>>>>>>>>>>>End_Enumeration_List
60438>>>>>>>>>>>>>
60438>>>>>>>>>>>>>register_procedure add_macro_while
60438>>>>>>>>>>>>>register_procedure add_macro_for
60438>>>>>>>>>>>>>register_procedure add_macro_loop
60438>>>>>>>>>>>>>register_procedure add_macro_if_begin
60438>>>>>>>>>>>>>register_procedure add_macro_else
60438>>>>>>>>>>>>>register_procedure add_macro_endif
60438>>>>>>>>>>>>>register_procedure add_macro_repeat
60438>>>>>>>>>>>>>register_procedure add_macro_until
60438>>>>>>>>>>>>>
60438>>>>>>>>>>>>>class cVirtualMachine is an cBasicVirtualMachine
60439>>>>>>>>>>>>> procedure construct_object integer img#
60441>>>>>>>>>>>>> forward send construct_object img#
60443>>>>>>>>>>>>> send add_opcode OP_WHILE "While" 0 3 msg_add_macro_while //
60444>>>>>>>>>>>>> send add_opcode OP_FOR "For" 0 3 msg_add_macro_for //
60445>>>>>>>>>>>>> send add_opcode OP_LOOP "Loop" 0 0 msg_add_macro_loop //
60446>>>>>>>>>>>>> send add_opcode OP_IF_BEGIN "If" 0 3 msg_add_macro_if_begin //
60447>>>>>>>>>>>>> send add_opcode OP_ELSE "Else" 0 0 msg_add_macro_else //
60448>>>>>>>>>>>>> send add_opcode OP_ENDIF "End" 0 0 msg_add_macro_endif //
60449>>>>>>>>>>>>> send add_opcode OP_REPEAT "Repeat" 0 0 msg_add_macro_repeat //
60450>>>>>>>>>>>>> send add_opcode OP_UNTIL "Until" 0 3 msg_add_macro_until //
60451>>>>>>>>>>>>> object oIfStack is a cStack
60453>>>>>>>>>>>>> end_object
60454>>>>>>>>>>>>> property integer pUniqueLabelID public 0 // Used for generating unique labels
60455>>>>>>>>>>>>> end_procedure
60456>>>>>>>>>>>>> procedure reset
60458>>>>>>>>>>>>> forward send reset
60460>>>>>>>>>>>>> set pUniqueLabelID to 0
60461>>>>>>>>>>>>> send delete_data to (oIfStack(self))
60462>>>>>>>>>>>>> end_procedure
60463>>>>>>>>>>>>> function sNextUniqueLabel returns string // Returns next unique label
60465>>>>>>>>>>>>> integer UniqueLabelID#
60465>>>>>>>>>>>>> string rval#
60465>>>>>>>>>>>>> get pUniqueLabelID to UniqueLabelID#
60466>>>>>>>>>>>>> move ("Label$"+string(UniqueLabelID#)) to rval#
60467>>>>>>>>>>>>> set pUniqueLabelID to (UniqueLabelID#+1)
60468>>>>>>>>>>>>> function_return rval#
60469>>>>>>>>>>>>> end_function
60470>>>>>>>>>>>>>
60470>>>>>>>>>>>>> // Repeat/Until structure:
60470>>>>>>>>>>>>> //
60470>>>>>>>>>>>>> // Repeat: LoopStart:
60470>>>>>>>>>>>>> //
60470>>>>>>>>>>>>> // Until: If Var1 Comp Var2 Goto Loopend:
60470>>>>>>>>>>>>> // Goto LoopStart:
60470>>>>>>>>>>>>> // LoopEnd:
60470>>>>>>>>>>>>> //
60470>>>>>>>>>>>>> procedure add_macro_repeat
60472>>>>>>>>>>>>> string lbl_LoopStart#
60472>>>>>>>>>>>>> get sNextUniqueLabel to lbl_LoopStart#
60473>>>>>>>>>>>>> send declare_label lbl_LoopStart#
60474>>>>>>>>>>>>> send push.s to (oIfStack(self)) lbl_LoopStart#
60475>>>>>>>>>>>>> end_procedure
60476>>>>>>>>>>>>>
60476>>>>>>>>>>>>> procedure add_macro_until integer opcode# integer t1# integer varno1# integer t2# integer comp# integer t3# integer varno2#
60478>>>>>>>>>>>>> string lbl_LoopStart# lbl_LoopEnd#
60478>>>>>>>>>>>>> get sNextUniqueLabel to lbl_LoopEnd#
60479>>>>>>>>>>>>> get sPop of (oIfStack(self)) to lbl_LoopStart#
60480>>>>>>>>>>>>> send add_instruction OP_IFTEST_GOTO t1# varno1# t2# comp# t3# varno2# AT_LBL lbl_LoopEnd#
60481>>>>>>>>>>>>> send add_instruction OP_GOTO AT_LBL lbl_LoopStart#
60482>>>>>>>>>>>>> send declare_label lbl_LoopEnd#
60483>>>>>>>>>>>>> end_procedure
60484>>>>>>>>>>>>>
60484>>>>>>>>>>>>> // For/Loop structure:
60484>>>>>>>>>>>>> //
60484>>>>>>>>>>>>> // For: VarAssign CtrlId VarFrom
60484>>>>>>>>>>>>> // Goto LoopStart
60484>>>>>>>>>>>>> // CtrlIncrement:
60484>>>>>>>>>>>>> // VarIncr CtrlId 1
60484>>>>>>>>>>>>> // LoopStart:
60484>>>>>>>>>>>>> // If CtrlId gt VarTo goto LoopEnd
60484>>>>>>>>>>>>> //
60484>>>>>>>>>>>>> // Loop: Goto CtrlIncrement
60484>>>>>>>>>>>>> // LoopEnd:
60484>>>>>>>>>>>>> //
60484>>>>>>>>>>>>> procedure add_macro_for integer opcode# integer t1# string ctrlid# integer t2# string varfrom# integer t3# string varto#
60486>>>>>>>>>>>>> string lbl_LoopStart# lbl_CtrlIncrement# lbl_LoopEnd#
60486>>>>>>>>>>>>> get sNextUniqueLabel to lbl_LoopStart#
60487>>>>>>>>>>>>> get sNextUniqueLabel to lbl_CtrlIncrement#
60488>>>>>>>>>>>>> get sNextUniqueLabel to lbl_LoopEnd#
60489>>>>>>>>>>>>> send add_instruction OP_ASSIGN AT_VAR ctrlid# t2# varfrom#
60490>>>>>>>>>>>>> send add_instruction OP_GOTO AT_LBL lbl_LoopStart#
60491>>>>>>>>>>>>> send declare_label lbl_CtrlIncrement#
60492>>>>>>>>>>>>> send add_instruction OP_GVAR_INCR AT_VAR ctrlid# AT_CINT 1
60493>>>>>>>>>>>>> send declare_label lbl_LoopStart#
60494>>>>>>>>>>>>> send add_instruction OP_IFTEST_GOTO AT_VAR ctrlid# AT_CINT COMP_GT t3# varto# AT_LBL lbl_LoopEnd#
60495>>>>>>>>>>>>> send push.s to (oIfStack(self)) lbl_CtrlIncrement#
60496>>>>>>>>>>>>> send push.s to (oIfStack(self)) lbl_LoopEnd#
60497>>>>>>>>>>>>> end_procedure
60498>>>>>>>>>>>>> procedure add_macro_loop
60500>>>>>>>>>>>>> string lbl_CtrlIncrement# lbl_LoopEnd#
60500>>>>>>>>>>>>> get sPop of (oIfStack(self)) to lbl_LoopEnd#
60501>>>>>>>>>>>>> get sPop of (oIfStack(self)) to lbl_CtrlIncrement#
60502>>>>>>>>>>>>> send add_instruction OP_GOTO AT_LBL lbl_CtrlIncrement#
60503>>>>>>>>>>>>> send declare_label lbl_LoopEnd#
60504>>>>>>>>>>>>> end_procedure
60505>>>>>>>>>>>>>
60505>>>>>>>>>>>>> // While/Loop structure:
60505>>>>>>>>>>>>> //
60505>>>>>>>>>>>>> // While: LoopStart:
60505>>>>>>>>>>>>> // If Var1 Comp Var2 Goto Continue
60505>>>>>>>>>>>>> // Goto LoopEnd
60505>>>>>>>>>>>>> // Continue:
60505>>>>>>>>>>>>> //
60505>>>>>>>>>>>>> // Loop: Goto LoopStart
60505>>>>>>>>>>>>> // LoopEnd:
60505>>>>>>>>>>>>> //
60505>>>>>>>>>>>>> procedure add_macro_while integer opcode# integer t1# integer varno1# integer t2# integer comp# integer t3# integer varno2#
60507>>>>>>>>>>>>> string lbl_LoopStart# lbl_Continue# lbl_LoopEnd#
60507>>>>>>>>>>>>> get sNextUniqueLabel to lbl_LoopStart#
60508>>>>>>>>>>>>> get sNextUniqueLabel to lbl_Continue#
60509>>>>>>>>>>>>> get sNextUniqueLabel to lbl_LoopEnd#
60510>>>>>>>>>>>>> send declare_label lbl_LoopStart#
60511>>>>>>>>>>>>> send add_instruction OP_IFTEST_GOTO t1# varno1# t2# comp# t3# varno2# AT_LBL lbl_Continue#
60512>>>>>>>>>>>>> send add_instruction OP_GOTO AT_LBL lbl_LoopEnd#
60513>>>>>>>>>>>>> send declare_label lbl_Continue#
60514>>>>>>>>>>>>> send push.s to (oIfStack(self)) lbl_LoopStart#
60515>>>>>>>>>>>>> send push.s to (oIfStack(self)) lbl_LoopEnd#
60516>>>>>>>>>>>>> end_procedure
60517>>>>>>>>>>>>>
60517>>>>>>>>>>>>> // If/Else/Endif structure:
60517>>>>>>>>>>>>> //
60517>>>>>>>>>>>>> // If: If Var1 Comp Var2 Goto IfBranch
60517>>>>>>>>>>>>> // Goto ElseBranch
60517>>>>>>>>>>>>> // IfBranch:
60517>>>>>>>>>>>>> //
60517>>>>>>>>>>>>> // Else: Goto EndIf
60517>>>>>>>>>>>>> // ElseBranch:
60517>>>>>>>>>>>>> //
60517>>>>>>>>>>>>> // EndIf: EndIf:
60517>>>>>>>>>>>>> // (ElseBranch:)
60517>>>>>>>>>>>>> procedure add_macro_if_begin integer opcode# integer t1# integer varno1# integer t2# integer comp# integer t3# integer varno2#
60519>>>>>>>>>>>>> string lbl_IfBranch# lbl_ElseBranch# lbl_EndIf#
60519>>>>>>>>>>>>> get sNextUniqueLabel to lbl_IfBranch#
60520>>>>>>>>>>>>> get sNextUniqueLabel to lbl_ElseBranch#
60521>>>>>>>>>>>>> get sNextUniqueLabel to lbl_EndIf#
60522>>>>>>>>>>>>> send add_instruction OP_IFTEST_GOTO t1# varno1# t2# comp# t3# varno2# AT_LBL lbl_IfBranch#
60523>>>>>>>>>>>>> send add_instruction OP_GOTO AT_LBL lbl_ElseBranch#
60524>>>>>>>>>>>>> send declare_label lbl_IfBranch#
60525>>>>>>>>>>>>> send push.s to (oIfStack(self)) lbl_ElseBranch#
60526>>>>>>>>>>>>> send push.s to (oIfStack(self)) lbl_EndIf#
60527>>>>>>>>>>>>> end_procedure
60528>>>>>>>>>>>>> procedure add_macro_else integer opcode#
60530>>>>>>>>>>>>> string lbl_ElseBranch# lbl_EndIf#
60530>>>>>>>>>>>>> get sPop of (oIfStack(self)) to lbl_EndIf#
60531>>>>>>>>>>>>> get sPop of (oIfStack(self)) to lbl_ElseBranch#
60532>>>>>>>>>>>>> send add_instruction OP_GOTO AT_LBL lbl_EndIf#
60533>>>>>>>>>>>>> send declare_label lbl_ElseBranch#
60534>>>>>>>>>>>>> send push.s to (oIfStack(self)) lbl_ElseBranch#
60535>>>>>>>>>>>>> send push.s to (oIfStack(self)) lbl_EndIf#
60536>>>>>>>>>>>>> end_procedure
60537>>>>>>>>>>>>> procedure add_macro_endif integer opcode#
60539>>>>>>>>>>>>> string lbl_ElseBranch# lbl_EndIf#
60539>>>>>>>>>>>>> get sPop of (oIfStack(self)) to lbl_EndIf#
60540>>>>>>>>>>>>> get sPop of (oIfStack(self)) to lbl_ElseBranch#
60541>>>>>>>>>>>>> send declare_label lbl_EndIf#
60542>>>>>>>>>>>>> send declare_label_no_error lbl_ElseBranch# // Only ifnot already declared!
60543>>>>>>>>>>>>> end_procedure
60544>>>>>>>>>>>>>end_class // cVirtualMachine
60545>>>>>>>>>>>>>
60545>>>>>>>>>>>>>Use APS // Auto Positioning and Sizing classes for VDF
60545>>>>>>>>>>>>>object oScriptError is a aps.ModalPanel label "DFScript runtime error"
60548>>>>>>>>>>>>> set Locate_Mode to CENTER_ON_SCREEN
60549>>>>>>>>>>>>> on_key kcancel send close_panel
60550>>>>>>>>>>>>> property integer piOriginalErrorObject public 0
60552>>>>>>>>>>>>>
60552>>>>>>>>>>>>> object oTb1 is a aps.TextBox label "DataFlex reported this error:"
60555>>>>>>>>>>>>> end_object
60556>>>>>>>>>>>>> object oFrm1 is a aps.Form abstract AFT_ASCII50 snap sl_down
60560>>>>>>>>>>>>> set object_shadow_state to true
60561>>>>>>>>>>>>> end_object
60562>>>>>>>>>>>>> object oFrm2 is a aps.Form abstract AFT_ASCII50 snap sl_down
60566>>>>>>>>>>>>> set object_shadow_state to true
60567>>>>>>>>>>>>> end_object
60568>>>>>>>>>>>>> object oTb2 is a aps.TextBox label "While executing this DFScript instruction:" snap sl_down
60572>>>>>>>>>>>>> end_object
60573>>>>>>>>>>>>> object oFrm3 is a aps.Form abstract AFT_ASCII50 snap sl_down
60577>>>>>>>>>>>>> set object_shadow_state to true
60578>>>>>>>>>>>>> end_object
60579>>>>>>>>>>>>> object oFrm4 is a aps.Form abstract AFT_ASCII50 snap sl_down
60583>>>>>>>>>>>>> set object_shadow_state to true
60584>>>>>>>>>>>>> end_object
60585>>>>>>>>>>>>> object oFrm5 is a aps.Form abstract AFT_ASCII50 snap sl_down
60589>>>>>>>>>>>>> set object_shadow_state to true
60590>>>>>>>>>>>>> end_object
60591>>>>>>>>>>>>> object oBtn1 is a aps.Multi_Button
60593>>>>>>>>>>>>> on_item "End script" send end_script
60594>>>>>>>>>>>>> end_object
60595>>>>>>>>>>>>> object oBtn2 is a aps.Multi_Button
60597>>>>>>>>>>>>> on_item "Display def" send display_definition
60598>>>>>>>>>>>>> end_object
60599>>>>>>>>>>>>> object oBtn3 is a aps.Multi_Button
60601>>>>>>>>>>>>> on_item "Continue" send close_panel
60602>>>>>>>>>>>>> end_object
60603>>>>>>>>>>>>> send aps_locate_multi_buttons
60604>>>>>>>>>>>>> procedure Error_Report integer ErrNum integer Err_Line string str#
60607>>>>>>>>>>>>> integer grb#
60607>>>>>>>>>>>>> string str1# str2#
60607>>>>>>>>>>>>> set value of (oFrm1(self)) item 0 to (Error_Description(self,ErrNum,str#))
60608>>>>>>>>>>>>> set value of (oFrm2(self)) item 0 to ("(Error "+string(ErrNum)+" on line "+string(Err_Line)+")")
60609>>>>>>>>>>>>> move (sExecutingLine(oVM_CurrentlyExecuting#)) to str1#
60610>>>>>>>>>>>>> move (StringRightBut(str1#,64)) to str2#
60611>>>>>>>>>>>>> set value of (oFrm3(self)) item 0 to str1#
60612>>>>>>>>>>>>> set value of (oFrm4(self)) item 0 to str2#
60613>>>>>>>>>>>>> set value of (oFrm5(self)) item 0 to Struc$ErrDescr
60614>>>>>>>>>>>>> send popup
60615>>>>>>>>>>>>> end_procedure
60616>>>>>>>>>>>>>
60616>>>>>>>>>>>>> // Stolen right out of error.pkg:
60616>>>>>>>>>>>>> //*** Build complete error description from Flexerrs and user error message.
60616>>>>>>>>>>>>> function Error_Description integer Error# string ErrMsg returns string
60619>>>>>>>>>>>>> string Full_Error_Text
60619>>>>>>>>>>>>> trim ErrMsg to ErrMsg
60620>>>>>>>>>>>>>>
60620>>>>>>>>>>>>> move (trim(error_text(DESKTOP,Error#))) to Full_Error_Text
60621>>>>>>>>>>>>> if ErrMsg ne "" begin
60623>>>>>>>>>>>>> if ((Full_Error_Text ne "") AND error_text_available(DESKTOP,Error#)) append Full_Error_Text " " ErrMsg
60627>>>>>>>>>>>>> else move ErrMsg to Full_Error_Text
60629>>>>>>>>>>>>> end
60629>>>>>>>>>>>>>>
60629>>>>>>>>>>>>> function_return Full_Error_Text
60630>>>>>>>>>>>>> end_function
60631>>>>>>>>>>>>>
60631>>>>>>>>>>>>> procedure end_script
60634>>>>>>>>>>>>> set pProgramEnded of oVM_CurrentlyExecuting# to true
60635>>>>>>>>>>>>> send close_panel
60636>>>>>>>>>>>>> end_procedure
60637>>>>>>>>>>>>>
60637>>>>>>>>>>>>> procedure display_definition
60640>>>>>>>>>>>>> send RS_DisplayDef
60641>>>>>>>>>>>>> end_procedure
60642>>>>>>>>>>>>>end_object
60643>>>>>>>>>>>>>
60643>>>>>>>>>>>>>procedure DFScriptError_On global // Set error trapping mode to DFScript
60645>>>>>>>>>>>>> integer obj#
60645>>>>>>>>>>>>> move (oScriptError(self)) to obj#
60646>>>>>>>>>>>>> if Error_Object_Id ne obj# begin
60648>>>>>>>>>>>>> set piOriginalErrorObject of obj# to Error_Object_Id
60649>>>>>>>>>>>>> move obj# to Error_Object_Id
60650>>>>>>>>>>>>> end
60650>>>>>>>>>>>>>>
60650>>>>>>>>>>>>>end_procedure
60651>>>>>>>>>>>>>procedure DFScriptError_Off global // Set error trapping mode back to normal
60653>>>>>>>>>>>>> integer obj#
60653>>>>>>>>>>>>> move (oScriptError(self)) to obj#
60654>>>>>>>>>>>>> if Error_Object_Id eq obj# ; get piOriginalErrorObject of obj# to Error_Object_Id
60657>>>>>>>>>>>>>end_procedure
60658>>>>>>>>>>>>>
60658>>>>>>>>>>>>>
60658>>>>>>>>>>>>>//
60658>>>>>>>>>>>>>// This is what the interface looks like if you don't put an interpreter
60658>>>>>>>>>>>>>// object in front of the Virtual Machine
60658>>>>>>>>>>>>>//
60658>>>>>>>>>>>>>// object oVM is a cVirtualMachine
60658>>>>>>>>>>>>>// set piDebugState to DFFALSE
60658>>>>>>>>>>>>>// set piDebugSingleStep to DFFALSE
60658>>>>>>>>>>>>>// send script_begin // Optag program
60658>>>>>>>>>>>>>// send declare_var "i" VARTYP_INTEGER
60658>>>>>>>>>>>>>// send declare_var "j" VARTYP_INTEGER
60658>>>>>>>>>>>>>// send add_instruction OP_FOR AT_VAR "i" AT_CINT 1 AT_CINT 2
60658>>>>>>>>>>>>>// send add_instruction OP_FOR AT_VAR "j" AT_CINT 1 AT_CINT 10
60658>>>>>>>>>>>>>// send add_instruction OP_SHOWLN AT_VAR "j"
60658>>>>>>>>>>>>>// send add_instruction OP_LOOP
60658>>>>>>>>>>>>>// send add_instruction OP_LOOP
60658>>>>>>>>>>>>>// send declare_var "A" VARTYP_INTEGER
60658>>>>>>>>>>>>>// send declare_var "B" VARTYP_INTEGER
60658>>>>>>>>>>>>>// send declare_var "C" VARTYP_INTEGER
60658>>>>>>>>>>>>>// send declare_var "D" VARTYP_INTEGER
60658>>>>>>>>>>>>>// send add_instruction OP_ASSIGN AT_VAR "A" AT_CINT 7878
60658>>>>>>>>>>>>>// send add_instruction OP_ASSIGN AT_VAR "B" AT_VAR "A"
60658>>>>>>>>>>>>>// send add_instruction OP_GVAR_DISPLAY
60658>>>>>>>>>>>>>// send add_instruction OP_GVAR_INCR AT_VAR "B" AT_CINT 1
60658>>>>>>>>>>>>>// send add_instruction OP_ASSIGN AT_VAR "C" AT_VAR "B"
60658>>>>>>>>>>>>>// send add_instruction OP_GVAR_INCR AT_VAR "C" AT_CINT 1
60658>>>>>>>>>>>>>// send add_instruction OP_ASSIGN AT_VAR "D" AT_VAR "C"
60658>>>>>>>>>>>>>// send add_instruction OP_GVAR_INCR AT_VAR "D" AT_CINT 1
60658>>>>>>>>>>>>>// send add_instruction OP_GVAR_DISPLAY
60658>>>>>>>>>>>>>// send add_instruction OP_INPUT AT_VAR "D" AT_CSTR "Enter something: "
60658>>>>>>>>>>>>>// send add_instruction OP_NOP // NOP means No OPeration (= do nothing)
60658>>>>>>>>>>>>>// send add_instruction OP_NOP
60658>>>>>>>>>>>>>// send add_instruction OP_NOP
60658>>>>>>>>>>>>>// send add_instruction OP_GOSUB AT_LBL "MyFirstLabel"
60658>>>>>>>>>>>>>// send add_instruction OP_ABORT // End program!
60658>>>>>>>>>>>>>// send declare_label "MyFirstLabel"
60658>>>>>>>>>>>>>// send add_instruction OP_NOP
60658>>>>>>>>>>>>>// send add_instruction OP_NOP
60658>>>>>>>>>>>>>// send add_instruction OP_IF_GOTO AT_VAR "A" AT_LBL "MySecondLabel"
60658>>>>>>>>>>>>>// send add_instruction OP_SHOWLN AT_CSTR "Didn't jump"
60658>>>>>>>>>>>>>// send declare_label "MySecondLabel"
60658>>>>>>>>>>>>>// send add_instruction OP_SHOWLN AT_CSTR "Jumped"
60658>>>>>>>>>>>>>// send add_instruction OP_RETURN
60658>>>>>>>>>>>>>// send script_end
60658>>>>>>>>>>>>>// end_object
60658>>>>>>>>>>>>>//
60658>>>>>>>>>>>>>// send obs "Begin"
60658>>>>>>>>>>>>>// send run_script to (oVM(self))
60658>>>>>>>>>>>>>// inkey windowindex
60658>>>>>>>>>>>Use Set.utl // cArray, cSet and cStack classes
60658>>>>>>>>>>>Use Array.nui // Item_Property command
60658>>>>>>>>>>>Use Strings.nui // String manipulation for VDF
60658>>>>>>>>>>>Use Files.utl // Utilities for handling file related stuff
60658>>>>>>>>>>>Use API_Attr.utl // Database API attributes characteristics
60658>>>>>>>>>>>
60658>>>>>>>>>>>// /DFScript.RS_Program.hdr
60658>>>>>>>>>>>// __ Program generated on __/__/____ ________ by ___________________
60658>>>>>>>>>>>//
60658>>>>>>>>>>>// integer iFile __
60658>>>>>>>>>>>// integer iField __
60658>>>>>>>>>>>// integer iError __
60658>>>>>>>>>>>// integer iPrecond __
60658>>>>>>>>>>>// integer iWarning __
60658>>>>>>>>>>>// string sFileName __
60658>>>>>>>>>>>//
60658>>>>>>>>>>>// log_open "dfscript.log" 0
60658>>>>>>>>>>>//
60658>>>>>>>>>>>// /DFScript.RS_Program.ftr
60658>>>>>>>>>>>// log_close
60658>>>>>>>>>>>// log_display
60658>>>>>>>>>>>// system
60658>>>>>>>>>>>// /*
60658>>>>>>>>>>>//
60658>>>>>>>>>>>// object oScriptSource is an cArray
60658>>>>>>>>>>>// property integer piRS_Header_Inserted public 0
60658>>>>>>>>>>>// procedure reset
60658>>>>>>>>>>>// send delete_data
60658>>>>>>>>>>>// set piRS_Header_Inserted to false
60658>>>>>>>>>>>// end_procedure
60658>>>>>>>>>>>// procedure append_line string str#
60658>>>>>>>>>>>// set value item (item_count(self)) to str#
60658>>>>>>>>>>>// end_procedure
60658>>>>>>>>>>>// procedure Insert_Image integer img#
60658>>>>>>>>>>>// integer ch# seqeof#
60658>>>>>>>>>>>// string str#
60658>>>>>>>>>>>// move (SEQ_DirectInput("image:"+string(img#))) to ch#
60658>>>>>>>>>>>// if (ch#>=0) begin
60658>>>>>>>>>>>// repeat
60658>>>>>>>>>>>// readln channel ch# str#
60658>>>>>>>>>>>// move (seqeof) to seqeof#
60658>>>>>>>>>>>// ifnot seqeof# send append_line str#
60658>>>>>>>>>>>// until seqeof#
60658>>>>>>>>>>>// send SEQ_CloseInput ch#
60658>>>>>>>>>>>// end
60658>>>>>>>>>>>// end_procedure
60658>>>>>>>>>>>// procedure Insert_RS_Header string author#
60658>>>>>>>>>>>// ifnot (piRS_Header_Inserted(self)) begin
60658>>>>>>>>>>>// autopage DFScript.RS_Program.hdr
60658>>>>>>>>>>>// print ("/"+"/")
60658>>>>>>>>>>>// print (dSysDate())
60658>>>>>>>>>>>// print (sSysTime())
60658>>>>>>>>>>>// print author#
60658>>>>>>>>>>>// print ("/"+"/")
60658>>>>>>>>>>>// print ("/"+"/")
60658>>>>>>>>>>>// print ("/"+"/")
60658>>>>>>>>>>>// print ("/"+"/")
60658>>>>>>>>>>>// print ("/"+"/")
60658>>>>>>>>>>>// send Insert_Image DFScript.RS_Program.hdr.N
60658>>>>>>>>>>>// set piRS_Header_Inserted to true
60658>>>>>>>>>>>// end
60658>>>>>>>>>>>// end_procedure
60658>>>>>>>>>>>// end_object
60658>>>>>>>>>>>
60658>>>>>>>>>>>
60658>>>>>>>>>>>function ScriptError_Text global integer error# returns string
60660>>>>>>>>>>> enumeration_list
60660>>>>>>>>>>> define_script_error ERR.SCRIPT.NO_ERROR "No error"
60663>>>>>>>>>>> define_script_error ERR.SCRIPT.ERROR_ILLEGAL_CHAR "Illegal character"
60666>>>>>>>>>>> define_script_error ERR.SCRIPT.COMMAND_NOT_FOUND "Command not found"
60669>>>>>>>>>>> define_script_error ERR.SCRIPT.ILLEGAL_VARNAME "Illegal variable name"
60672>>>>>>>>>>> define_script_error ERR.SCRIPT.SYMBOL_ALREADY_DEF "Symbol already defined"
60675>>>>>>>>>>> define_script_error ERR.SCRIPT.TOO_MANY_ARGUMENTS "Too many arguments for command"
60678>>>>>>>>>>> define_script_error ERR.SCRIPT.MISSING_ARGUMENT "Missing argument(s)"
60681>>>>>>>>>>> define_script_error ERR.SCRIPT.UNDEFINED_SYMBOL "Undefined symbol"
60684>>>>>>>>>>> define_script_error ERR.SCRIPT.CIRCULAR_REFERENCE "Circular reference in symbol replace"
60687>>>>>>>>>>> define_script_error ERR.SCRIPT.ARGUMENT_TYPED "Argument may not be typed"
60690>>>>>>>>>>> define_script_error ERR.SCRIPT.CLASS_CHECK_ERROR "Unknown symbol" //"Class check error"
60693>>>>>>>>>>> define_script_error ERR.SCRIPT.TYPE_CHECK_ERROR "Type check error"
60696>>>>>>>>>>> define_script_error ERR.SCRIPT.KEYWORD_EXPECTED "Keyword expected"
60699>>>>>>>>>>> define_script_error ERR.SCRIPT.KEYWORD_DEBUG "Keyword must be ON, OFF, SINGLE_STEP or DISPLAY_VAR"
60702>>>>>>>>>>> define_script_error ERR.SCRIPT.SHOULD_BE_END "END command expected"
60705>>>>>>>>>>> define_script_error ERR.SCRIPT.SHOULD_BE_ENDIF "ENDIF command expected"
60708>>>>>>>>>>> define_script_error ERR.SCRIPT.SHOULD_BE_LOOP "LOOP command expected"
60711>>>>>>>>>>> define_script_error ERR.SCRIPT.SHOULD_BE_UNTIL "UNTIL command expected"
60714>>>>>>>>>>> define_script_error ERR.SCRIPT.UNINITIATED_END "Un-initiated END command"
60717>>>>>>>>>>> define_script_error ERR.SCRIPT.UNINITIATED_ELSE "Un-initiated ELSE command"
60720>>>>>>>>>>> define_script_error ERR.SCRIPT.UNINITIATED_ENDIF "Un-initiated ENDIF command"
60723>>>>>>>>>>> define_script_error ERR.SCRIPT.UNINITIATED_LOOP "Un-initiated LOOP command"
60726>>>>>>>>>>> define_script_error ERR.SCRIPT.UNINITIATED_UNTIL "Un-initiated UNTIL command"
60729>>>>>>>>>>> define_script_error ERR.SCRIPT.UNFINISHED_STRUCT "Missing END/UNTIL or LOOP"
60732>>>>>>>>>>> define_script_error ERR.SCRIPT.ILLEGAL_SYMBNAME "Illegal symbol name"
60735>>>>>>>>>>> define_script_error ERR.SCRIPT.MISSING_END_QUOTE "Missing end quote"
60738>>>>>>>>>>> define_script_error ERR.SCRIPT.BAD_PARAM_COUNT "Wrong number of parameters for function"
60741>>>>>>>>>>> define_script_error ERR.SCRIPT.FUNC_MISSING_PAR "Function name must be followed by left parenthesis"
60744>>>>>>>>>>> define_script_error ERR.SCRIPT.UNMOTIVATED_PARAM "Unmotivated parameter"
60747>>>>>>>>>>> define_script_error ERR.SCRIPT.MISSING_CONTENTS "No contents in ()"
60750>>>>>>>>>>> define_script_error ERR.SCRIPT.UNMOTIVATED_SYMBOL "Unmotivated symbol"
60753>>>>>>>>>>> define_script_error ERR.SCRIPT.MISSING_OPERATOR "Missing operator or comma"
60756>>>>>>>>>>> define_script_error ERR.SCRIPT.ONE_OPERATOR_TO_M "One operator too many"
60759>>>>>>>>>>> define_script_error ERR.SCRIPT.OPERATOR_NEEDS_OPE "Operator must be followed by operand"
60762>>>>>>>>>>> define_script_error ERR.SCRIPT.ATTR_NO_CHANGING "Changing of API attribute not supported"
60765>>>>>>>>>>> define_script_error ERR.SCRIPT.ATTR_IMPLICIT "Setting of implicit API attributes not supported yet"
60768>>>>>>>>>>> define_script_error ERR.SCRIPT.ATTR_NO_SET "This attribute can only be read, not set"
60771>>>>>>>>>>> end_enumeration_list
60771>>>>>>>>>>>end_function
60772>>>>>>>>>>>
60772>>>>>>>>>>>
60772>>>>>>>>>>>function ExprItemType_Text global integer liType returns string
60774>>>>>>>>>>> enumeration_list
60774>>>>>>>>>>> define_expr_item_type EIT.ERROR "Error"
60777>>>>>>>>>>> define_expr_item_type EIT.LEFT "LftP"
60780>>>>>>>>>>> define_expr_item_type EIT.RIGHT "RgtP"
60783>>>>>>>>>>> define_expr_item_type EIT.OPERATOR "Oper"
60786>>>>>>>>>>> define_expr_item_type EIT.SYMBOL "Symbol"
60789>>>>>>>>>>> define_expr_item_type EIT.COMMA "Comma"
60792>>>>>>>>>>> end_enumeration_list
60792>>>>>>>>>>>end_function
60793>>>>>>>>>>>
60793>>>>>>>>>>>
60793>>>>>>>>>>>define TYPE.UNKNOWN for 0 // Argument types (UNKNOWN *must* be 0)
60793>>>>>>>>>>>define TYPE.UNTYPED for 1
60793>>>>>>>>>>>define TYPE.INTEGER for 2
60793>>>>>>>>>>>define TYPE.DATE for 4
60793>>>>>>>>>>>define TYPE.NUMBER for 8
60793>>>>>>>>>>>define TYPE.STRING for 16
60793>>>>>>>>>>>
60793>>>>>>>>>>>function iTypeToVT.i global integer liType returns integer
60795>>>>>>>>>>> if liType eq TYPE.INTEGER function_return VARTYP_INTEGER
60798>>>>>>>>>>> if liType eq TYPE.DATE function_return VARTYP_DATE
60801>>>>>>>>>>> if liType eq TYPE.NUMBER function_return VARTYP_NUMBER
60804>>>>>>>>>>> if liType eq TYPE.STRING function_return VARTYP_STRING
60807>>>>>>>>>>> function_return VARTYP_VOID
60808>>>>>>>>>>>end_function
60809>>>>>>>>>>>
60809>>>>>>>>>>>define CLASS.UNKNOWN for 0 // Argument classes (UNKNOWN *must* be 0)
60809>>>>>>>>>>>define CLASS.LABEL for 1
60809>>>>>>>>>>>define CLASS.VAR for 2
60809>>>>>>>>>>>define CLASS.CONST for 4
60809>>>>>>>>>>>define CLASS.EXPR for 8
60809>>>>>>>>>>>define CLASS.KEYWORD for 16
60809>>>>>>>>>>>define CLASS.COMMAND for 32
60809>>>>>>>>>>>define CLASS.REPLACE_SYMBOL for 64
60809>>>>>>>>>>>define CLASS.FIELD for 128
60809>>>>>>>>>>>define CLASS.FUNCTION for 256
60809>>>>>>>>>>>
60809>>>>>>>>>>>string charlist.all.legal 100
60809>>>>>>>>>>>move ('!"#$%&'+"'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~") to charlist.all.legal
60810>>>>>>>>>>>
60810>>>>>>>>>>>
60810>>>>>>>>>>>function iOperatorNameToID.s global string lsName returns integer
60812>>>>>>>>>>> enumeration_list
60812>>>>>>>>>>> define_operator OPERATOR.NONE ""
60815>>>>>>>>>>> define_operator OPERATOR.PLUS "+"
60818>>>>>>>>>>> define_operator OPERATOR.MINUS "-"
60821>>>>>>>>>>> define_operator OPERATOR.MULTIPLY "*"
60824>>>>>>>>>>> define_operator OPERATOR.DIVIDE "/"
60827>>>>>>>>>>> define_operator OPERATOR.LT "<"
60830>>>>>>>>>>> define_operator OPERATOR.LE "<="
60833>>>>>>>>>>> define_operator OPERATOR.EQ "="
60836>>>>>>>>>>> define_operator OPERATOR.NE "<>"
60839>>>>>>>>>>> define_operator OPERATOR.GE ">="
60842>>>>>>>>>>> define_operator OPERATOR.GT ">"
60845>>>>>>>>>>> define_operator OPERATOR.MIN "MIN"
60848>>>>>>>>>>> define_operator OPERATOR.MAX "MAX"
60851>>>>>>>>>>> define_operator OPERATOR.AND "AND"
60854>>>>>>>>>>> define_operator OPERATOR.OR "OR"
60857>>>>>>>>>>> end_enumeration_list
60857>>>>>>>>>>>end_function
60858>>>>>>>>>>>function sOperatorSymbol.i global integer op# returns string
60860>>>>>>>>>>> if op# eq OPERATOR.NONE function_return ""
60863>>>>>>>>>>> if op# eq OPERATOR.PLUS function_return "+"
60866>>>>>>>>>>> if op# eq OPERATOR.MINUS function_return "-"
60869>>>>>>>>>>> if op# eq OPERATOR.MULTIPLY function_return "*"
60872>>>>>>>>>>> if op# eq OPERATOR.DIVIDE function_return "/"
60875>>>>>>>>>>> if op# eq OPERATOR.LT function_return "<"
60878>>>>>>>>>>> if op# eq OPERATOR.LE function_return "<="
60881>>>>>>>>>>> if op# eq OPERATOR.EQ function_return "="
60884>>>>>>>>>>> if op# eq OPERATOR.NE function_return "<>"
60887>>>>>>>>>>> if op# eq OPERATOR.GE function_return ">="
60890>>>>>>>>>>> if op# eq OPERATOR.GT function_return ">"
60893>>>>>>>>>>> if op# eq OPERATOR.MIN function_return "MIN"
60896>>>>>>>>>>> if op# eq OPERATOR.MAX function_return "MAX"
60899>>>>>>>>>>> if op# eq OPERATOR.AND function_return "AND"
60902>>>>>>>>>>> if op# eq OPERATOR.OR function_return "OR"
60905>>>>>>>>>>>end_function
60906>>>>>>>>>>>
60906>>>>>>>>>>>register_function pVM_Object returns integer
60906>>>>>>>>>>>class cExpressionParser is an cArray
60907>>>>>>>>>>> procedure construct_object integer img#
60909>>>>>>>>>>> forward send construct_object img#
60911>>>>>>>>>>> property integer piExprType public TYPE.UNKNOWN
60912>>>>>>>>>>> object oParamCountStack is a cStack NO_IMAGE
60914>>>>>>>>>>> end_object
60915>>>>>>>>>>> object oImpliedTypesStack is a cStack NO_IMAGE
60917>>>>>>>>>>> end_object
60918>>>>>>>>>>> object oEvalSequence is a cEvalSequence NO_IMAGE
60920>>>>>>>>>>> end_object
60921>>>>>>>>>>> end_procedure
60922>>>>>>>>>>> item_property_list
60922>>>>>>>>>>> item_property string psItem.i // The item in clear text
60922>>>>>>>>>>> item_property integer piStructType.i // What part of the expression is this?
60922>>>>>>>>>>> item_property integer piPos.i // What is the starting position?
60922>>>>>>>>>>> item_property integer piClass.i // If item, what is item class?
60922>>>>>>>>>>> item_property integer piType.i // If item, what is item type?
60922>>>>>>>>>>> item_property integer piEvalLevel.i // When evaluating
60922>>>>>>>>>>> item_property integer piFuncParams.i // Number of parameters
60922>>>>>>>>>>> item_property integer piOperator.i // Type of operator
60922>>>>>>>>>>> item_property integer piAux.i //
60922>>>>>>>>>>> item_property integer piEvalOrder.i //
60922>>>>>>>>>>> end_item_property_list cExpressionParser
#REM 60978 DEFINE FUNCTION PIEVALORDER.I INTEGER LIROW RETURNS INTEGER
#REM 60982 DEFINE PROCEDURE SET PIEVALORDER.I INTEGER LIROW INTEGER VALUE
#REM 60986 DEFINE FUNCTION PIAUX.I INTEGER LIROW RETURNS INTEGER
#REM 60990 DEFINE PROCEDURE SET PIAUX.I INTEGER LIROW INTEGER VALUE
#REM 60994 DEFINE FUNCTION PIOPERATOR.I INTEGER LIROW RETURNS INTEGER
#REM 60998 DEFINE PROCEDURE SET PIOPERATOR.I INTEGER LIROW INTEGER VALUE
#REM 61002 DEFINE FUNCTION PIFUNCPARAMS.I INTEGER LIROW RETURNS INTEGER
#REM 61006 DEFINE PROCEDURE SET PIFUNCPARAMS.I INTEGER LIROW INTEGER VALUE
#REM 61010 DEFINE FUNCTION PIEVALLEVEL.I INTEGER LIROW RETURNS INTEGER
#REM 61014 DEFINE PROCEDURE SET PIEVALLEVEL.I INTEGER LIROW INTEGER VALUE
#REM 61018 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 61022 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 61026 DEFINE FUNCTION PICLASS.I INTEGER LIROW RETURNS INTEGER
#REM 61030 DEFINE PROCEDURE SET PICLASS.I INTEGER LIROW INTEGER VALUE
#REM 61034 DEFINE FUNCTION PIPOS.I INTEGER LIROW RETURNS INTEGER
#REM 61038 DEFINE PROCEDURE SET PIPOS.I INTEGER LIROW INTEGER VALUE
#REM 61042 DEFINE FUNCTION PISTRUCTTYPE.I INTEGER LIROW RETURNS INTEGER
#REM 61046 DEFINE PROCEDURE SET PISTRUCTTYPE.I INTEGER LIROW INTEGER VALUE
#REM 61050 DEFINE FUNCTION PSITEM.I INTEGER LIROW RETURNS STRING
#REM 61054 DEFINE PROCEDURE SET PSITEM.I INTEGER LIROW STRING VALUE
61059>>>>>>>>>>> procedure add_item integer liType string item# integer pos#
61061>>>>>>>>>>> integer liRow
61061>>>>>>>>>>> get row_count to liRow
61062>>>>>>>>>>> set psItem.i liRow to item#
61063>>>>>>>>>>> set piStructType.i liRow to liType
61064>>>>>>>>>>> set piPos.i liRow to pos#
61065>>>>>>>>>>> set piClass.i liRow to 0
61066>>>>>>>>>>> set piType.i liRow to 0
61067>>>>>>>>>>> set piEvalLevel.i liRow to 0
61068>>>>>>>>>>> set piFuncParams.i liRow to 0
61069>>>>>>>>>>> set piOperator.i liRow to 0
61070>>>>>>>>>>> set piAux.i liRow to 0
61071>>>>>>>>>>> end_procedure
61072>>>>>>>>>>> procedure reset
61074>>>>>>>>>>> send delete_data
61075>>>>>>>>>>> send delete_data to (oParamCountStack(self))
61076>>>>>>>>>>> send delete_data to (oImpliedTypesStack(self))
61077>>>>>>>>>>> set piExprType to TYPE.UNKNOWN
61078>>>>>>>>>>> end_procedure
61079>>>>>>>>>>> procedure split_expression_in_items string str# integer pos_offset#
61081>>>>>>>>>>> integer pos# len# in_item# in_string# oper_type# start_pos#
61081>>>>>>>>>>> string char# char2# item# quote# quotes#
61081>>>>>>>>>>> send reset
61082>>>>>>>>>>> move (length(str#)) to len#
61083>>>>>>>>>>> move 0 to in_string#
61084>>>>>>>>>>> move "" to item#
61085>>>>>>>>>>> move 0 to in_item#
61086>>>>>>>>>>> move ("'"+'"') to quotes#
61087>>>>>>>>>>> for pos# from 1 to len#
61093>>>>>>>>>>>>
61093>>>>>>>>>>> move (mid(str#,1,pos#)) to char#
61094>>>>>>>>>>> if in_item# begin
61096>>>>>>>>>>> if in_string# begin
61098>>>>>>>>>>> move (item#+char#) to item#
61099>>>>>>>>>>> if char# eq quote# begin
61101>>>>>>>>>>> send add_item EIT.SYMBOL item# (start_pos#+pos_offset#)
61102>>>>>>>>>>> move 0 to in_string#
61103>>>>>>>>>>> move 0 to in_item#
61104>>>>>>>>>>> move "" to item#
61105>>>>>>>>>>> end
61105>>>>>>>>>>>>
61105>>>>>>>>>>> end
61105>>>>>>>>>>>>
61105>>>>>>>>>>> else begin // We're not in a string
61106>>>>>>>>>>> if char# eq "(" begin
61108>>>>>>>>>>> send add_item EIT.SYMBOL item# (start_pos#+pos_offset#)
61109>>>>>>>>>>> send add_item EIT.LEFT char# (pos#+pos_offset#)
61110>>>>>>>>>>> move 0 to in_item#
61111>>>>>>>>>>> move "" to item#
61112>>>>>>>>>>> end
61112>>>>>>>>>>>>
61112>>>>>>>>>>> else if char# eq ")" begin
61115>>>>>>>>>>> send add_item EIT.SYMBOL item# (start_pos#+pos_offset#)
61116>>>>>>>>>>> send add_item EIT.RIGHT char# (pos#+pos_offset#)
61117>>>>>>>>>>> move 0 to in_item#
61118>>>>>>>>>>> move "" to item#
61119>>>>>>>>>>> end
61119>>>>>>>>>>>>
61119>>>>>>>>>>> else if char# eq " " begin
61122>>>>>>>>>>> send add_item EIT.SYMBOL item# (start_pos#+pos_offset#)
61123>>>>>>>>>>> move 0 to in_item#
61124>>>>>>>>>>> move "" to item#
61125>>>>>>>>>>> end
61125>>>>>>>>>>>>
61125>>>>>>>>>>> else if char# eq "," begin
61128>>>>>>>>>>> send add_item EIT.SYMBOL item# (start_pos#+pos_offset#)
61129>>>>>>>>>>> send add_item EIT.COMMA char# (pos#+pos_offset#)
61130>>>>>>>>>>> move 0 to in_item#
61131>>>>>>>>>>> move "" to item#
61132>>>>>>>>>>> end
61132>>>>>>>>>>>>
61132>>>>>>>>>>> else if char# in "=+-*/<>" begin
61135>>>>>>>>>>> send add_item EIT.SYMBOL item# (start_pos#+pos_offset#)
61136>>>>>>>>>>> move 0 to in_item#
61137>>>>>>>>>>> move "" to item#
61138>>>>>>>>>>> move (mid(str#,1,pos#+1)) to char2#
61139>>>>>>>>>>> get iOperatorNameToID.s (char#+char2#) to oper_type#
61140>>>>>>>>>>> if oper_type# ne OPERATOR.NONE begin
61142>>>>>>>>>>> increment pos# // Dirty trick to handle two-character operators
61143>>>>>>>>>>> send add_item EIT.OPERATOR (char#+char2#) (pos#+pos_offset#)
61144>>>>>>>>>>> end
61144>>>>>>>>>>>>
61144>>>>>>>>>>> else begin
61145>>>>>>>>>>> get iOperatorNameToID.s char# to oper_type#
61146>>>>>>>>>>> send add_item EIT.OPERATOR char# (pos#+pos_offset#)
61147>>>>>>>>>>> end
61147>>>>>>>>>>>>
61147>>>>>>>>>>> set piOperator.i (row_count(self)-1) to oper_type#
61148>>>>>>>>>>> end
61148>>>>>>>>>>>>
61148>>>>>>>>>>> else move (item#+char#) to item#
61150>>>>>>>>>>> end
61150>>>>>>>>>>>>
61150>>>>>>>>>>> end
61150>>>>>>>>>>>>
61150>>>>>>>>>>> else begin // We're not in an item
61151>>>>>>>>>>> if char# ne " " begin // Ignore blanks
61153>>>>>>>>>>> if char# in quotes# begin // Now we're in a string
61155>>>>>>>>>>> move 1 to in_string#
61156>>>>>>>>>>> move 1 to in_item#
61157>>>>>>>>>>> move pos# to start_pos#
61158>>>>>>>>>>> move char# to item#
61159>>>>>>>>>>> move char# to quote#
61160>>>>>>>>>>> end
61160>>>>>>>>>>>>
61160>>>>>>>>>>> else if char# in "=<>+-*/" begin
61163>>>>>>>>>>> move (mid(str#,1,pos#+1)) to char2#
61164>>>>>>>>>>> get iOperatorNameToID.s (char#+char2#) to oper_type#
61165>>>>>>>>>>> if oper_type# ne OPERATOR.NONE begin
61167>>>>>>>>>>> increment pos# // Dirty trick to handle two-character operators
61168>>>>>>>>>>> send add_item EIT.OPERATOR (char#+char2#) (pos#+pos_offset#)
61169>>>>>>>>>>> end
61169>>>>>>>>>>>>
61169>>>>>>>>>>> else begin
61170>>>>>>>>>>> get iOperatorNameToID.s char# to oper_type#
61171>>>>>>>>>>> send add_item EIT.OPERATOR char# (pos#+pos_offset#)
61172>>>>>>>>>>> end
61172>>>>>>>>>>>>
61172>>>>>>>>>>> set piOperator.i (row_count(self)-1) to oper_type#
61173>>>>>>>>>>> end
61173>>>>>>>>>>>>
61173>>>>>>>>>>> else if char# eq "(" send add_item EIT.LEFT "(" (pos#+pos_offset#)
61177>>>>>>>>>>> else if char# eq ")" send add_item EIT.RIGHT ")" (pos#+pos_offset#)
61181>>>>>>>>>>> else if char# eq "," send add_item EIT.COMMA "," pos#
61185>>>>>>>>>>> else begin
61186>>>>>>>>>>> move 1 to in_item#
61187>>>>>>>>>>> move pos# to start_pos#
61188>>>>>>>>>>> move char# to item#
61189>>>>>>>>>>> end
61189>>>>>>>>>>>>
61189>>>>>>>>>>> end
61189>>>>>>>>>>>>
61189>>>>>>>>>>> end
61189>>>>>>>>>>>>
61189>>>>>>>>>>> loop
61190>>>>>>>>>>>>
61190>>>>>>>>>>> if in_string# send ScriptError ERR.SCRIPT.MISSING_END_QUOTE (start_pos#+pos_offset#)
61193>>>>>>>>>>> if in_item# send add_item EIT.SYMBOL item# (start_pos#+pos_offset#)
61196>>>>>>>>>>> end_procedure
61197>>>>>>>>>>> function iErrorOccured returns integer
61199>>>>>>>>>>> integer error#
61199>>>>>>>>>>> get piErrorCode to error#
61200>>>>>>>>>>> function_return (error#<>ERR.SCRIPT.NO_ERROR)
61201>>>>>>>>>>> end_function
61202>>>>>>>>>>> procedure DoReplaces // Perform symbol replaces
61204>>>>>>>>>>> integer liRow max#
61204>>>>>>>>>>> string name#
61204>>>>>>>>>>> get row_count to max#
61205>>>>>>>>>>> for liRow from 0 to (max#-1)
61211>>>>>>>>>>>>
61211>>>>>>>>>>> move (psItem.i(self,liRow)) to name#
61212>>>>>>>>>>> get sReplaceNameToNo.s name# to name#
61213>>>>>>>>>>> set psItem.i liRow to name#
61214>>>>>>>>>>> loop
61215>>>>>>>>>>>>
61215>>>>>>>>>>> end_procedure
61216>>>>>>>>>>> procedure DoClassColumn // Identify the classes
61218>>>>>>>>>>> integer liRow max# class# stype#
61218>>>>>>>>>>> string item#
61218>>>>>>>>>>> get row_count to max#
61219>>>>>>>>>>> for liRow from 0 to (max#-1)
61225>>>>>>>>>>>>
61225>>>>>>>>>>> move (piStructType.i(self,liRow)) to stype#
61226>>>>>>>>>>> if (stype#=EIT.SYMBOL) begin
61228>>>>>>>>>>> move (psItem.i(self,liRow)) to item#
61229>>>>>>>>>>> if ("|"+uppercase(item#)+"|") in "|AND|OR|MIN|MAX|" begin
61231>>>>>>>>>>> set piStructType.i liRow to EIT.OPERATOR
61232>>>>>>>>>>> set piOperator.i liRow to (iOperatorNameToID.s(uppercase(item#)))
61233>>>>>>>>>>> end
61233>>>>>>>>>>>>
61233>>>>>>>>>>> else begin
61234>>>>>>>>>>> get iSymbolClass.s item# to class#
61235>>>>>>>>>>> set piClass.i liRow to class#
61236>>>>>>>>>>> end
61236>>>>>>>>>>>>
61236>>>>>>>>>>> end
61236>>>>>>>>>>>>
61236>>>>>>>>>>> loop
61237>>>>>>>>>>>>
61237>>>>>>>>>>> end_procedure
61238>>>>>>>>>>> procedure DoTypeColumn // Identify the types
61240>>>>>>>>>>> integer liRow liMax liClass liType liStructType
61240>>>>>>>>>>> string lsItem
61240>>>>>>>>>>> get row_count to liMax
61241>>>>>>>>>>> for liRow from 0 to (liMax-1)
61247>>>>>>>>>>>>
61247>>>>>>>>>>> move (piStructType.i(self,liRow)) to liStructType
61248>>>>>>>>>>> if (liStructType=EIT.SYMBOL) begin
61250>>>>>>>>>>> move (psItem.i(self,liRow)) to lsItem
61251>>>>>>>>>>> get piClass.i liRow to liClass
61252>>>>>>>>>>> get iSymbolType.si lsItem liClass to liType
61253>>>>>>>>>>> set piType.i liRow to liType
61254>>>>>>>>>>> if liClass eq CLASS.UNKNOWN send ScriptError ERR.SCRIPT.CLASS_CHECK_ERROR (piPos.i(self,liRow)) ("Symbol: "+lsItem)
61257>>>>>>>>>>> else if liType eq TYPE.UNKNOWN send ScriptError ERR.SCRIPT.TYPE_CHECK_ERROR (piPos.i(self,liRow)) ("Symbol: "+lsItem)
61261>>>>>>>>>>> end
61261>>>>>>>>>>>>
61261>>>>>>>>>>> loop
61262>>>>>>>>>>>>
61262>>>>>>>>>>> end_procedure
61263>>>>>>>>>>> procedure DoFuncParams
61265>>>>>>>>>>> integer liRow max# func_row# level# stack# stype# id#
61265>>>>>>>>>>> integer current_left_pos# param_count# gets# expects#
61265>>>>>>>>>>> string params#
61265>>>>>>>>>>> get row_count to max#
61266>>>>>>>>>>> move 0 to level#
61267>>>>>>>>>>> move 0 to func_row#
61268>>>>>>>>>>> move -1 to current_left_pos#
61269>>>>>>>>>>> move 0 to param_count#
61270>>>>>>>>>>> move (oParamCountStack(self)) to stack#
61271>>>>>>>>>>> send delete_data to stack#
61272>>>>>>>>>>> for liRow from 0 to (max#-1)
61278>>>>>>>>>>>>
61278>>>>>>>>>>> move (piStructType.i(self,liRow)) to stype#
61279>>>>>>>>>>> if (piClass.i(self,liRow)=CLASS.FUNCTION) begin
61281>>>>>>>>>>> get iFuncNameToFuncNo.s of (pVM_Object(self)) (psItem.i(self,liRow)) to id#
61282>>>>>>>>>>> get sFuncParams.i of (pVM_Object(self)) id# to params#
61283>>>>>>>>>>> set piAux.i liRow to id#
61284>>>>>>>>>>> set piFuncParams.i liRow to (length(params#))
61285>>>>>>>>>>> end
61285>>>>>>>>>>>>
61285>>>>>>>>>>> if (stype#=EIT.LEFT) begin
61287>>>>>>>>>>> send push.i to stack# param_count#
61288>>>>>>>>>>> send push.i to stack# current_left_pos#
61289>>>>>>>>>>> move liRow to current_left_pos#
61290>>>>>>>>>>> move 0 to param_count#
61291>>>>>>>>>>> increment level#
61292>>>>>>>>>>> end
61292>>>>>>>>>>>>
61292>>>>>>>>>>> if (stype#=EIT.RIGHT) begin
61294>>>>>>>>>>> set piFuncParams.i current_left_pos# to param_count#
61295>>>>>>>>>>> decrement level#
61296>>>>>>>>>>> move (iPop(stack#)) to current_left_pos#
61297>>>>>>>>>>> move (iPop(stack#)) to param_count#
61298>>>>>>>>>>> if param_count# eq 0 increment param_count#
61301>>>>>>>>>>> end
61301>>>>>>>>>>>>
61301>>>>>>>>>>> if (stype#=EIT.SYMBOL) if param_count# eq 0 increment param_count#
61306>>>>>>>>>>> if (stype#=EIT.COMMA) increment param_count#
61309>>>>>>>>>>> set piEvalLevel.i liRow to level#
61310>>>>>>>>>>> loop
61311>>>>>>>>>>>>
61311>>>>>>>>>>> // Now check that all function gets the expected number of parameters
61311>>>>>>>>>>> for liRow from 0 to (max#-1)
61317>>>>>>>>>>>>
61317>>>>>>>>>>> ifnot (iErrorOccured(self)) begin
61319>>>>>>>>>>> if (piClass.i(self,liRow)=CLASS.FUNCTION) begin
61321>>>>>>>>>>> move (piStructType.i(self,liRow+1)) to stype#
61322>>>>>>>>>>> if stype# eq EIT.LEFT begin
61324>>>>>>>>>>> move (piFuncParams.i(self,liRow)) to expects#
61325>>>>>>>>>>> move (piFuncParams.i(self,liRow+1)) to gets#
61326>>>>>>>>>>> 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")
61329>>>>>>>>>>> end
61329>>>>>>>>>>>>
61329>>>>>>>>>>> else begin
61330>>>>>>>>>>> if (liRow+1) ge max# send ScriptError ERR.SCRIPT.FUNC_MISSING_PAR (piPos.i(self,liRow))
61333>>>>>>>>>>> else send ScriptError ERR.SCRIPT.FUNC_MISSING_PAR (piPos.i(self,liRow+1))
61335>>>>>>>>>>> end
61335>>>>>>>>>>>>
61335>>>>>>>>>>> end
61335>>>>>>>>>>>>
61335>>>>>>>>>>> end
61335>>>>>>>>>>>>
61335>>>>>>>>>>> loop
61336>>>>>>>>>>>>
61336>>>>>>>>>>> end_procedure
61337>>>>>>>>>>> procedure DoFinalChecks
61339>>>>>>>>>>> integer liRow max# stype# next_stype# params#
61339>>>>>>>>>>> get row_count to max#
61340>>>>>>>>>>> for liRow from 0 to (max#-1)
61346>>>>>>>>>>>>
61346>>>>>>>>>>> ifnot (iErrorOccured(self)) begin
61348>>>>>>>>>>> move (piStructType.i(self,liRow)) to stype#
61349>>>>>>>>>>> move (piStructType.i(self,liRow+1)) to next_stype#
61350>>>>>>>>>>>
61350>>>>>>>>>>> // If left parenthesis and the previous row is not a function
61350>>>>>>>>>>> // then there must be exactly 1 parameter in the p-pair:
61350>>>>>>>>>>> if stype# eq EIT.LEFT begin
61352>>>>>>>>>>> if (piClass.i(self,liRow-1)<>CLASS.FUNCTION) begin
61354>>>>>>>>>>> get piFuncParams.i liRow to params#
61355>>>>>>>>>>> if params# gt 1 send ScriptError ERR.SCRIPT.UNMOTIVATED_PARAM (piPos.i(self,liRow+1))
61358>>>>>>>>>>> if params# lt 1 send ScriptError ERR.SCRIPT.MISSING_CONTENTS (piPos.i(self,liRow))
61361>>>>>>>>>>> end
61361>>>>>>>>>>>>
61361>>>>>>>>>>> end
61361>>>>>>>>>>>>
61361>>>>>>>>>>>
61361>>>>>>>>>>> // If SYMBOL there can not be a symbols next to it:
61361>>>>>>>>>>> ifnot (iErrorOccured(self)) if (stype#=EIT.SYMBOL and next_stype#=EIT.SYMBOL) send ScriptError ERR.SCRIPT.UNMOTIVATED_SYMBOL (piPos.i(self,liRow+1))
61366>>>>>>>>>>>
61366>>>>>>>>>>> // If right paranthesis it cannot be followed by a left paranthesis:
61366>>>>>>>>>>> ifnot (iErrorOccured(self)) if (stype#=EIT.RIGHT and next_stype#=EIT.LEFT) send ScriptError ERR.SCRIPT.MISSING_OPERATOR (piPos.i(self,liRow+1))
61371>>>>>>>>>>>
61371>>>>>>>>>>> // If OPERATOR there can not be an operator next to it (unless it's monadic minus)
61371>>>>>>>>>>> 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))
61376>>>>>>>>>>>
61376>>>>>>>>>>> // In fact, if operator it MUST be followed by a symbol (operand)
61376>>>>>>>>>>> ifnot (iErrorOccured(self)) begin
61378>>>>>>>>>>> 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))
61381>>>>>>>>>>> end
61381>>>>>>>>>>>>
61381>>>>>>>>>>> end
61381>>>>>>>>>>>>
61381>>>>>>>>>>> loop
61382>>>>>>>>>>>>
61382>>>>>>>>>>> end_procedure
61383>>>>>>>>>>>
61383>>>>>>>>>>> function iNewType.iii integer t1# integer op# integer t2# returns integer
61385>>>>>>>>>>> if op# eq OPERATOR.NONE function_return t2#
61388>>>>>>>>>>> if op# eq OPERATOR.PLUS function_return (t1# max t2#)
61391>>>>>>>>>>> if op# eq OPERATOR.MINUS function_return (t1# max t2#)
61394>>>>>>>>>>> if op# eq OPERATOR.MULTIPLY function_return (t1# max t2#)
61397>>>>>>>>>>> if op# eq OPERATOR.DIVIDE function_return (t1# max t2#)
61400>>>>>>>>>>> if op# eq OPERATOR.LT function_return TYPE.INTEGER
61403>>>>>>>>>>> if op# eq OPERATOR.LE function_return TYPE.INTEGER
61406>>>>>>>>>>> if op# eq OPERATOR.EQ function_return TYPE.INTEGER
61409>>>>>>>>>>> if op# eq OPERATOR.NE function_return TYPE.INTEGER
61412>>>>>>>>>>> if op# eq OPERATOR.GE function_return TYPE.INTEGER
61415>>>>>>>>>>> if op# eq OPERATOR.GT function_return TYPE.INTEGER
61418>>>>>>>>>>> if op# eq OPERATOR.MIN function_return (t1# max t2#)
61421>>>>>>>>>>> if op# eq OPERATOR.MAX function_return (t1# max t2#)
61424>>>>>>>>>>> if op# eq OPERATOR.AND function_return TYPE.INTEGER
61427>>>>>>>>>>> if op# eq OPERATOR.OR function_return TYPE.INTEGER
61430>>>>>>>>>>> function_return t2#
61431>>>>>>>>>>> end_function
61432>>>>>>>>>>>
61432>>>>>>>>>>> function PreceededByFunction integer liRow returns integer
61434>>>>>>>>>>> integer class#
61434>>>>>>>>>>> get piClass.i (liRow-1) to class#
61435>>>>>>>>>>> function_return (class#=CLASS.FUNCTION)
61436>>>>>>>>>>> end_function
61437>>>>>>>>>>> procedure DoImpliedTypes
61439>>>>>>>>>>> integer stack# liRow max# current_type# stype# class# liType
61439>>>>>>>>>>> integer current_operator# otype#
61439>>>>>>>>>>> integer current_left_pos#
61439>>>>>>>>>>> string item#
61439>>>>>>>>>>> move (oImpliedTypesStack(self)) to stack#
61440>>>>>>>>>>> send delete_data to stack#
61441>>>>>>>>>>> get row_count to max#
61442>>>>>>>>>>> move -1 to current_left_pos#
61443>>>>>>>>>>> move OPERATOR.NONE to current_operator#
61444>>>>>>>>>>> move TYPE.UNKNOWN to current_type#
61445>>>>>>>>>>> for liRow from 0 to (max#-1)
61451>>>>>>>>>>>>
61451>>>>>>>>>>> get psItem.i liRow to item#
61452>>>>>>>>>>> get piStructType.i liRow to stype#
61453>>>>>>>>>>> get piClass.i liRow to class#
61454>>>>>>>>>>> get piType.i liRow to liType
61455>>>>>>>>>>> get piOperator.i liRow to otype#
61456>>>>>>>>>>> if stype# eq EIT.LEFT begin
61458>>>>>>>>>>> send push.i to stack# current_left_pos#
61459>>>>>>>>>>> send push.i to stack# current_operator#
61460>>>>>>>>>>> send push.i to stack# current_type#
61461>>>>>>>>>>> move liRow to current_left_pos#
61462>>>>>>>>>>> move OPERATOR.NONE to current_operator#
61463>>>>>>>>>>> move TYPE.UNKNOWN to current_type#
61464>>>>>>>>>>> end
61464>>>>>>>>>>>>
61464>>>>>>>>>>> if stype# eq EIT.RIGHT begin
61466>>>>>>>>>>> if (PreceededByFunction(self,current_left_pos#)) move (ipop(stack#)) to current_type#
61469>>>>>>>>>>> else move (ipop(stack#)) to current_operator# // Through away liType // current_type#
61471>>>>>>>>>>> set piType.i current_left_pos# to current_type#
61472>>>>>>>>>>> move (ipop(stack#)) to current_operator#
61473>>>>>>>>>>> move (ipop(stack#)) to current_left_pos#
61474>>>>>>>>>>> end
61474>>>>>>>>>>>>
61474>>>>>>>>>>> if stype# eq EIT.COMMA begin
61476>>>>>>>>>>> set piType.i current_left_pos# to current_type#
61477>>>>>>>>>>> move OPERATOR.NONE to current_operator#
61478>>>>>>>>>>> move TYPE.UNKNOWN to current_type#
61479>>>>>>>>>>> //move liRow to current_left_pos#
61479>>>>>>>>>>> end
61479>>>>>>>>>>>>
61479>>>>>>>>>>> if stype# eq EIT.OPERATOR move otype# to current_operator#
61482>>>>>>>>>>> if stype# eq EIT.SYMBOL move (iNewType.iii(self,current_type#,current_operator#,liType)) to current_type#
61485>>>>>>>>>>> loop
61486>>>>>>>>>>>>
61486>>>>>>>>>>> set piExprType to (piType.i(self,0))
61487>>>>>>>>>>> end_procedure
61488>>>>>>>>>>>
61488>>>>>>>>>>> procedure add_expr_op integer op# string var#
61490>>>>>>>>>>> send add_expr_instruction to (oEvalSequence(self)) op# var#
61491>>>>>>>>>>> end_procedure
61492>>>>>>>>>>>
61492>>>>>>>>>>> function iFuncEvalSeparately.i integer liRow returns integer
61494>>>>>>>>>>> integer rval# funcclass#
61494>>>>>>>>>>> if (piClass.i(self,liRow)=CLASS.FUNCTION) get sFuncClass.i of (pVM_Object(self)) (piAux.i(self,liRow)) to funcclass#
61497>>>>>>>>>>> else move FTYPE.BUILTIN to funcclass#
61499>>>>>>>>>>> function_return (funcclass#<>FTYPE.BUILTIN)
61500>>>>>>>>>>> end_function
61501>>>>>>>>>>>
61501>>>>>>>>>>> function iCreateExprEvaluator.ii integer liRow integer level# returns integer
61503>>>>>>>>>>> integer emergency_stop# balance# funcclass# sType# class# id# prev_stype#
61503>>>>>>>>>>> integer oType# max# vType# funcid# oVar# fType# liType liFileField
61503>>>>>>>>>>> get row_count to max#
61504>>>>>>>>>>> move -1 to prev_stype#
61505>>>>>>>>>>> move (oVariables(pVM_Object(self))) to oVar#
61506>>>>>>>>>>> if level# begin // then we are sure to be evaluating parameters for a function
61508>>>>>>>>>>> move EIT.LEFT to prev_stype#
61509>>>>>>>>>>> increment liRow // Skip parenthesis
61510>>>>>>>>>>> move 1 to balance# // Because we just skipped a (
61511>>>>>>>>>>> end
61511>>>>>>>>>>>>
61511>>>>>>>>>>> repeat
61511>>>>>>>>>>>>
61511>>>>>>>>>>> if (iFuncEvalSeparately.i(self,liRow)) begin
61513>>>>>>>>>>> send add_expr_op EXPROP.PUSH_EXPRESSION ""
61514>>>>>>>>>>> get piAux.i liRow to funcid#
61515>>>>>>>>>>> get iFuncType.i of (pVM_Object(self)) funcid# to fType#
61516>>>>>>>>>>> get iCreateExprEvaluator.ii (liRow+1) (level#+1) to liRow
61517>>>>>>>>>>> if fType# eq VARTYP_STRING send add_expr_op EXPROP.EXEC_SFUNCTION funcid#
61520>>>>>>>>>>> else send add_expr_op EXPROP.EXEC_FUNCTION funcid#
61522>>>>>>>>>>> end
61522>>>>>>>>>>>>
61522>>>>>>>>>>> else begin
61523>>>>>>>>>>> get piStructType.i liRow to sType#
61524>>>>>>>>>>> if sType# eq EIT.LEFT begin
61526>>>>>>>>>>> increment balance#
61527>>>>>>>>>>> send add_expr_op EXPROP.APPEND "("
61528>>>>>>>>>>> end
61528>>>>>>>>>>>>
61528>>>>>>>>>>> if sType# eq EIT.RIGHT begin
61530>>>>>>>>>>> decrement balance#
61531>>>>>>>>>>> if balance# eq 0 begin
61533>>>>>>>>>>> if level# begin
61535>>>>>>>>>>> if prev_stype# ne EIT.LEFT send add_expr_op EXPROP.PUSH_PARAM ""
61538>>>>>>>>>>> end
61538>>>>>>>>>>>>
61538>>>>>>>>>>> else send add_expr_op EXPROP.APPEND ")"
61540>>>>>>>>>>> function_return liRow // Skip right parenthesis
61541>>>>>>>>>>> end
61541>>>>>>>>>>>>
61541>>>>>>>>>>> send add_expr_op EXPROP.APPEND ")"
61542>>>>>>>>>>> end
61542>>>>>>>>>>>>
61542>>>>>>>>>>> if sType# eq EIT.OPERATOR begin
61544>>>>>>>>>>> // Operators may just be added except that AND OR MIN and MAX
61544>>>>>>>>>>> // must have blanks around them:
61544>>>>>>>>>>> get piOperator.i liRow to oType#
61545>>>>>>>>>>> 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)+" ")
61548>>>>>>>>>>> else send add_expr_op EXPROP.APPEND (psItem.i(self,liRow))
61550>>>>>>>>>>> end
61550>>>>>>>>>>>>
61550>>>>>>>>>>> if sType# eq EIT.SYMBOL begin
61552>>>>>>>>>>> get piClass.i liRow to class#
61553>>>>>>>>>>> // Constants may just be added:
61553>>>>>>>>>>> if class# eq CLASS.CONST send add_expr_op EXPROP.APPEND (psItem.i(self,liRow))
61556>>>>>>>>>>> // If it's a function we can safely just add it. Would it have been
61556>>>>>>>>>>> // a function that we were supposed to handle manually it would
61556>>>>>>>>>>> // have been filtered out by the iFuncEvalSeparately test in the
61556>>>>>>>>>>> // beginning of this function:
61556>>>>>>>>>>> if class# eq CLASS.FUNCTION send add_expr_op EXPROP.APPEND (psItem.i(self,liRow))
61559>>>>>>>>>>> // For variables we dare inserting a (local) function call and let
61559>>>>>>>>>>> // the EVAL function retrieve the value:
61559>>>>>>>>>>> if class# eq CLASS.VAR begin
61561>>>>>>>>>>> get iVarNameToVarNo of (pVM_Object(self)) (psItem.i(self,liRow)) to id#
61562>>>>>>>>>>> get iVarType.i of (pVM_Object(self)) id# to vType#
61563>>>>>>>>>>> if vType# eq VARTYP_INTEGER send add_expr_op EXPROP.GET_IVAR id#
61566>>>>>>>>>>> if vType# eq VARTYP_DATE send add_expr_op EXPROP.GET_DVAR id#
61569>>>>>>>>>>> if vType# eq VARTYP_NUMBER send add_expr_op EXPROP.GET_NVAR id#
61572>>>>>>>>>>> if vType# eq VARTYP_STRING send add_expr_op EXPROP.GET_SVAR id#
61575>>>>>>>>>>> end
61575>>>>>>>>>>>>
61575>>>>>>>>>>> if class# eq CLASS.FIELD begin
61577>>>>>>>>>>> get piType.i liRow to liType
61578>>>>>>>>>>> get iFileField.s of (pVM_Object(self)) (psItem.i(self,liRow)) to liFileField
61579>>>>>>>>>>> if liType eq TYPE.STRING send add_expr_op EXPROP.GET_SFIELD liFileField
61582>>>>>>>>>>> if liType eq TYPE.NUMBER send add_expr_op EXPROP.GET_NFIELD liFileField
61585>>>>>>>>>>> if liType eq TYPE.DATE send add_expr_op EXPROP.GET_DFIELD liFileField
61588>>>>>>>>>>> end
61588>>>>>>>>>>>>
61588>>>>>>>>>>> end
61588>>>>>>>>>>>>
61588>>>>>>>>>>> if sType# eq EIT.COMMA begin
61590>>>>>>>>>>> // Level>0 means: We are in a "manual" function
61590>>>>>>>>>>> // Under that assumption balance=1 MUST mean that we are dealing
61590>>>>>>>>>>> // with a parameter to that function.
61590>>>>>>>>>>> if (level#>0 and balance#=1) send add_expr_op EXPROP.PUSH_PARAM ""
61593>>>>>>>>>>> else send add_expr_op EXPROP.APPEND ","
61595>>>>>>>>>>> end
61595>>>>>>>>>>>>
61595>>>>>>>>>>> move stype# to prev_stype#
61596>>>>>>>>>>> end
61596>>>>>>>>>>>>
61596>>>>>>>>>>> increment liRow
61597>>>>>>>>>>> until (balance#=0 or liRow>=max#)
61599>>>>>>>>>>> send add_expr_op EXPROP.ERROR ""
61600>>>>>>>>>>> function_return 1000
61601>>>>>>>>>>> end_function
61602>>>>>>>>>>>
61602>>>>>>>>>>> procedure DoCreateEvaluator
61604>>>>>>>>>>> integer grb#
61604>>>>>>>>>>> send delete_data to (oEvalSequence(self))
61605>>>>>>>>>>> send add_expr_op EXPROP.TYPE (iTypeToVT.i(piExprType(self)))
61606>>>>>>>>>>> get iCreateExprEvaluator.ii 0 0 to grb#
61607>>>>>>>>>>> send add_expr_op EXPROP.END ""
61608>>>>>>>>>>> end_procedure
61609>>>>>>>>>>>
61609>>>>>>>>>>> function iParse_expression.si string lsExpression integer liPosOffset returns integer
61611>>>>>>>>>>> integer lhObj liExprId
61611>>>>>>>>>>> if liPosOffset decrement liPosOffset
61614>>>>>>>>>>> send split_expression_in_items lsExpression liPosOffset
61615>>>>>>>>>>> ifnot (iErrorOccured(self)) send DoReplaces
61618>>>>>>>>>>> ifnot (iErrorOccured(self)) send DoClassColumn
61621>>>>>>>>>>> ifnot (iErrorOccured(self)) send DoTypeColumn
61624>>>>>>>>>>> ifnot (iErrorOccured(self)) send DoFuncParams
61627>>>>>>>>>>> ifnot (iErrorOccured(self)) send DoFinalChecks
61630>>>>>>>>>>> ifnot (iErrorOccured(self)) send DoImpliedTypes
61633>>>>>>>>>>> ifnot (iErrorOccured(self)) send DoCreateEvaluator
61636>>>>>>>>>>> if (piDebugState(self)) send DisplayExpressionDebugInfo self
61639>>>>>>>>>>> if (piDebugState(self)) send DisplayEvalSequence (oEvalSequence(self))
61642>>>>>>>>>>> send Optimize to (oEvalSequence(self))
61643>>>>>>>>>>> if (piDebugState(self)) send DisplayEvalSequence (oEvalSequence(self))
61646>>>>>>>>>>> // Add to VM's expression array:
61646>>>>>>>>>>> move (oExprEvalSequences(pVM_Object(self))) to lhObj
61647>>>>>>>>>>> get iAppendToOtherSequence of (oEvalSequence(self)) lhObj to liExprId
61648>>>>>>>>>>>// send obs "Kopierer program" (oEvalSequence(self)) lhObj (name(lhObj))
61648>>>>>>>>>>> function_return (liExprId+1) // Skip typedef
61649>>>>>>>>>>> end_function
61650>>>>>>>>>>>end_class // cExpressionParser
61651>>>>>>>>>>>
61651>>>>>>>>>>>class cScriptErrors is a cArray
61652>>>>>>>>>>> procedure construct_object integer img#
61654>>>>>>>>>>> forward send construct_object img#
61656>>>>>>>>>>> property string piListingFN public "dfscript.err"
61657>>>>>>>>>>> property integer piListingFile public 0
61658>>>>>>>>>>> property integer piOnScreen public 1
61659>>>>>>>>>>> end_procedure
61660>>>>>>>>>>> item_property_list
61660>>>>>>>>>>> item_property integer piError.i
61660>>>>>>>>>>> item_property integer piLine.i
61660>>>>>>>>>>> item_property integer piPosition.i
61660>>>>>>>>>>> item_property string psFileName.i
61660>>>>>>>>>>> item_property string psMessage.i
61660>>>>>>>>>>> end_item_property_list cScriptErrors
#REM 61701 DEFINE FUNCTION PSMESSAGE.I INTEGER LIROW RETURNS STRING
#REM 61705 DEFINE PROCEDURE SET PSMESSAGE.I INTEGER LIROW STRING VALUE
#REM 61709 DEFINE FUNCTION PSFILENAME.I INTEGER LIROW RETURNS STRING
#REM 61713 DEFINE PROCEDURE SET PSFILENAME.I INTEGER LIROW STRING VALUE
#REM 61717 DEFINE FUNCTION PIPOSITION.I INTEGER LIROW RETURNS INTEGER
#REM 61721 DEFINE PROCEDURE SET PIPOSITION.I INTEGER LIROW INTEGER VALUE
#REM 61725 DEFINE FUNCTION PILINE.I INTEGER LIROW RETURNS INTEGER
#REM 61729 DEFINE PROCEDURE SET PILINE.I INTEGER LIROW INTEGER VALUE
#REM 61733 DEFINE FUNCTION PIERROR.I INTEGER LIROW RETURNS INTEGER
#REM 61737 DEFINE PROCEDURE SET PIERROR.I INTEGER LIROW INTEGER VALUE
61742>>>>>>>>>>> procedure display_error.i integer liRow
61744>>>>>>>>>>> integer pos#
61744>>>>>>>>>>> string msg#
61744>>>>>>>>>>> get piPosition.i liRow to pos#
61745>>>>>>>>>>> get psMessage.i liRow to msg#
61746>>>>>>>>>>> move (trim(msg#)) to msg#
61747>>>>>>>>>>> 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#
61748>>>>>>>>>>> end_procedure
61749>>>>>>>>>>> procedure add_error integer Error# integer Line# integer Position# string FileName# string Message#
61751>>>>>>>>>>> integer liRow
61751>>>>>>>>>>> get row_count to liRow
61752>>>>>>>>>>> set piError.i liRow to Error#
61753>>>>>>>>>>> set piLine.i liRow to Line#
61754>>>>>>>>>>> set piPosition.i liRow to Position#
61755>>>>>>>>>>> set psFileName.i liRow to FileName#
61756>>>>>>>>>>> set psMessage.i liRow to Message#
61757>>>>>>>>>>> if (piOnScreen(self)) send display_error.i liRow
61760>>>>>>>>>>> end_procedure
61761>>>>>>>>>>>end_class
61762>>>>>>>>>>>class cStructuralStack is a cArray
61763>>>>>>>>>>> procedure construct_object integer img#
61765>>>>>>>>>>> forward send construct_object img#
61767>>>>>>>>>>> end_procedure
61768>>>>>>>>>>> item_property_list
61768>>>>>>>>>>> item_property integer piStackingCmd.i // WHILE, BEGIN, REPEAT etc.
61768>>>>>>>>>>> item_property integer piPendingCmd.i // END, LOOP, UNTIL
61768>>>>>>>>>>> item_property string psFileName.i // Name of source file
61768>>>>>>>>>>> item_property integer piLine.i // In which line was the structure initiated?
61768>>>>>>>>>>> end_item_property_list cStructuralStack
#REM 61806 DEFINE FUNCTION PILINE.I INTEGER LIROW RETURNS INTEGER
#REM 61810 DEFINE PROCEDURE SET PILINE.I INTEGER LIROW INTEGER VALUE
#REM 61814 DEFINE FUNCTION PSFILENAME.I INTEGER LIROW RETURNS STRING
#REM 61818 DEFINE PROCEDURE SET PSFILENAME.I INTEGER LIROW STRING VALUE
#REM 61822 DEFINE FUNCTION PIPENDINGCMD.I INTEGER LIROW RETURNS INTEGER
#REM 61826 DEFINE PROCEDURE SET PIPENDINGCMD.I INTEGER LIROW INTEGER VALUE
#REM 61830 DEFINE FUNCTION PISTACKINGCMD.I INTEGER LIROW RETURNS INTEGER
#REM 61834 DEFINE PROCEDURE SET PISTACKINGCMD.I INTEGER LIROW INTEGER VALUE
61839>>>>>>>>>>> function iTopStackingCmd returns integer
61841>>>>>>>>>>> function_return (piStackingCmd.i(self,row_count(self)-1))
61842>>>>>>>>>>> end_function
61843>>>>>>>>>>> function iTopPendingCmd returns integer
61845>>>>>>>>>>> function_return (piPendingCmd.i(self,row_count(self)-1))
61846>>>>>>>>>>> end_function
61847>>>>>>>>>>> procedure push_struct integer cmd1# integer cmd2# string fn# integer line#
61849>>>>>>>>>>> integer liRow
61849>>>>>>>>>>> get row_count to liRow
61850>>>>>>>>>>> set piStackingCmd.i liRow to cmd1#
61851>>>>>>>>>>> set piPendingCmd.i liRow to cmd2#
61852>>>>>>>>>>> set psFileName.i liRow to fn#
61853>>>>>>>>>>> set piLine.i liRow to line#
61854>>>>>>>>>>> end_procedure
61855>>>>>>>>>>> procedure pop_struct
61857>>>>>>>>>>> send delete_row (row_count(self)-1)
61858>>>>>>>>>>> end_procedure
61859>>>>>>>>>>>end_class // cStructuralStack
61860>>>>>>>>>>>
61860>>>>>>>>>>>register_procedure Interpret_Date
61860>>>>>>>>>>>register_procedure Interpret_Else
61860>>>>>>>>>>>register_procedure Interpret_End
61860>>>>>>>>>>>register_procedure Interpret_EndIf
61860>>>>>>>>>>>register_procedure Interpret_For
61860>>>>>>>>>>>register_procedure Interpret_Gosub
61860>>>>>>>>>>>register_procedure Interpret_Goto
61860>>>>>>>>>>>register_procedure Interpret_If
61860>>>>>>>>>>>register_procedure Interpret_Pause
61860>>>>>>>>>>>register_procedure Interpret_GotoXY
61860>>>>>>>>>>>register_procedure Interpret_Input
61860>>>>>>>>>>>register_procedure Interpret_Integer
61860>>>>>>>>>>>register_procedure Interpret_Loop
61860>>>>>>>>>>>register_procedure Interpret_Move
61860>>>>>>>>>>>register_procedure Interpret_Number
61860>>>>>>>>>>>register_procedure Interpret_Return
61860>>>>>>>>>>>register_procedure Interpret_Showln
61860>>>>>>>>>>>register_procedure Interpret_Show
61860>>>>>>>>>>>register_procedure Interpret_String
61860>>>>>>>>>>>register_procedure Interpret_Abort
61860>>>>>>>>>>>register_procedure Interpret_ClearScreen
61860>>>>>>>>>>>register_procedure Interpret_While
61860>>>>>>>>>>>register_procedure Interpret_#use
61860>>>>>>>>>>>register_procedure Interpret_#include
61860>>>>>>>>>>>register_procedure Interpret_#replace
61860>>>>>>>>>>>register_procedure Interpret_#noisy
61860>>>>>>>>>>>register_procedure Interpret_Increment
61860>>>>>>>>>>>register_procedure Interpret_Decrement
61860>>>>>>>>>>>register_procedure Interpret_Debug
61860>>>>>>>>>>>register_procedure Interpret_Repeat
61860>>>>>>>>>>>register_procedure Interpret_Until
61860>>>>>>>>>>>register_procedure Interpret_Log_Open
61860>>>>>>>>>>>register_procedure Interpret_Log_Close
61860>>>>>>>>>>>register_procedure Interpret_Log_Display
61860>>>>>>>>>>>register_procedure Interpret_Log_Flush
61860>>>>>>>>>>>register_procedure Interpret_Log_Write
61860>>>>>>>>>>>register_procedure Interpret_Log_Writeln
61860>>>>>>>>>>>register_procedure Interpret_Set_Attribute
61860>>>>>>>>>>>register_procedure Interpret_Create_Field
61860>>>>>>>>>>>register_procedure Interpret_Append_Field
61860>>>>>>>>>>>register_procedure Interpret_Delete_Field
61860>>>>>>>>>>>register_procedure Interpret_Delete_Index
61860>>>>>>>>>>>register_procedure Interpret_Structure_Abort
61860>>>>>>>>>>>register_procedure Interpret_Structure_End
61860>>>>>>>>>>>register_procedure Interpret_Probe_End
61860>>>>>>>>>>>register_procedure Interpret_Set_Field
61860>>>>>>>>>>>register_procedure Interpret_InfoBox
61860>>>>>>>>>>>
61860>>>>>>>>>>>// Support commands:
61860>>>>>>>>>>>
61860>>>>>>>>>>>
61860>>>>>>>>>>>class cCommandList is a cArray
61861>>>>>>>>>>> item_property_list
61861>>>>>>>>>>> item_property string psName.i
61861>>>>>>>>>>> item_property integer piCompileMsg.i
61861>>>>>>>>>>> end_item_property_list cCommandList
#REM 61893 DEFINE FUNCTION PICOMPILEMSG.I INTEGER LIROW RETURNS INTEGER
#REM 61897 DEFINE PROCEDURE SET PICOMPILEMSG.I INTEGER LIROW INTEGER VALUE
#REM 61901 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 61905 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
61910>>>>>>>>>>> procedure add_command integer cmd# string name# integer msg#
61912>>>>>>>>>>> set psName.i cmd# to (uppercase(name#))
61913>>>>>>>>>>> set piCompileMsg.i cmd# to msg#
61914>>>>>>>>>>> end_procedure
61915>>>>>>>>>>> procedure construct_object integer img#
61917>>>>>>>>>>> forward send construct_object img#
61919>>>>>>>>>>> enumeration_list
61919>>>>>>>>>>> define_cmd CMD_DATE "DATE" msg_Interpret_Date
61920>>>>>>>>>>> define_cmd CMD_ELSE "ELSE" msg_Interpret_Else
61921>>>>>>>>>>> define_cmd CMD_END "END" msg_Interpret_End
61922>>>>>>>>>>> define_cmd CMD_ENDIF "ENDIF" msg_Interpret_EndIf
61923>>>>>>>>>>> define_cmd CMD_FOR "FOR" msg_Interpret_For
61924>>>>>>>>>>> define_cmd CMD_GOSUB "GOSUB" msg_Interpret_Gosub
61925>>>>>>>>>>> define_cmd CMD_GOTO "GOTO" msg_Interpret_Goto
61926>>>>>>>>>>> define_cmd CMD_IF "IF" msg_Interpret_If
61927>>>>>>>>>>> define_cmd CMD_PAUSE "PAUSE" msg_Interpret_Pause
61928>>>>>>>>>>> define_cmd CMD_INPUT "INPUT" msg_Interpret_Input
61929>>>>>>>>>>> define_cmd CMD_GOTOXY "GOTOXY" msg_Interpret_GotoXY
61930>>>>>>>>>>> define_cmd CMD_INTEGER "INTEGER" msg_Interpret_Integer
61931>>>>>>>>>>> define_cmd CMD_LOOP "LOOP" msg_Interpret_Loop
61932>>>>>>>>>>> define_cmd CMD_MOVE "MOVE" msg_Interpret_Move
61933>>>>>>>>>>> define_cmd CMD_NUMBER "NUMBER" msg_Interpret_Number
61934>>>>>>>>>>> define_cmd CMD_RETURN "RETURN" msg_Interpret_Return
61935>>>>>>>>>>> define_cmd CMD_SHOWLN "SHOWLN" msg_Interpret_Showln
61936>>>>>>>>>>> define_cmd CMD_SHOW "SHOW" msg_Interpret_Show
61937>>>>>>>>>>> define_cmd CMD_STRING "STRING" msg_Interpret_String
61938>>>>>>>>>>> define_cmd CMD_ABORT "ABORT" msg_Interpret_Abort
61939>>>>>>>>>>> define_cmd CMD_CLEARSCREEN "CLEARSCREEN" msg_Interpret_ClearScreen
61940>>>>>>>>>>> define_cmd CMD_WHILE "WHILE" msg_Interpret_While
61941>>>>>>>>>>> define_cmd CMD_#USE "#USE" msg_Interpret_#use // Not implemented
61942>>>>>>>>>>> define_cmd CMD_#INCLUDE "#INCLUDE" msg_Interpret_#include // Not implemented
61943>>>>>>>>>>> define_cmd CMD_#REPLACE "#REPLACE" msg_Interpret_#replace
61944>>>>>>>>>>> define_cmd CMD_#NOISY "#NOISY" msg_Interpret_#noisy
61945>>>>>>>>>>> define_cmd CMD_INCREMENT "INCREMENT" msg_Interpret_Increment
61946>>>>>>>>>>> define_cmd CMD_DECREMENT "DECREMENT" msg_Interpret_DeCrement
61947>>>>>>>>>>> define_cmd CMD_DEBUG "DEBUG" msg_Interpret_Debug
61948>>>>>>>>>>> define_cmd CMD_REPEAT "REPEAT" msg_Interpret_Repeat
61949>>>>>>>>>>> define_cmd CMD_UNTIL "UNTIL" msg_Interpret_Until
61950>>>>>>>>>>> define_cmd CMD_LOG_OPEN "LOG_OPEN" msg_Interpret_Log_Open
61951>>>>>>>>>>> define_cmd CMD_LOG_CLOSE "LOG_CLOSE" msg_Interpret_Log_Close
61952>>>>>>>>>>> define_cmd CMD_LOG_DISPLAY "LOG_DISPLAY" msg_Interpret_Log_Display
61953>>>>>>>>>>> define_cmd CMD_LOG_FLUSH "LOG_FLUSH" msg_Interpret_Log_Flush
61954>>>>>>>>>>> define_cmd CMD_LOG_WRITE "LOG_WRITE" msg_Interpret_Log_Write
61955>>>>>>>>>>> define_cmd CMD_LOG_WRITELN "LOG_WRITELN" msg_Interpret_Log_Writeln
61956>>>>>>>>>>> define_cmd CMD_SET_ATTRIBUTE "SET_ATTRIBUTE" msg_Interpret_Set_Attribute
61957>>>>>>>>>>> define_cmd CMD_CREATE_FIELD "CREATE_FIELD" msg_Interpret_Create_Field
61958>>>>>>>>>>> define_cmd CMD_APPEND_FIELD "APPEND_FIELD" msg_Interpret_Append_Field
61959>>>>>>>>>>> define_cmd CMD_DELETE_FIELD "DELETE_FIELD" msg_Interpret_Delete_Field
61960>>>>>>>>>>> define_cmd CMD_DELETE_INDEX "DELETE_INDEX" msg_Interpret_Delete_Index
61961>>>>>>>>>>> define_cmd CMD_STRUCTURE_ABORT "STRUCTURE_ABORT" msg_Interpret_Structure_Abort
61962>>>>>>>>>>> define_cmd CMD_STRUCTURE_END "STRUCTURE_END" msg_Interpret_Structure_End
61963>>>>>>>>>>> define_cmd CMD_PROBE_END "PROBE_END" msg_Interpret_Probe_End
61964>>>>>>>>>>> define_cmd CMD_SET_FIELD "SET_FIELD" msg_Interpret_Set_Field
61965>>>>>>>>>>> define_cmd CMD_INFOBOX "INFOBOX" msg_Interpret_InfoBox
61966>>>>>>>>>>> end_enumeration_list
61966>>>>>>>>>>> end_procedure
61967>>>>>>>>>>> function iCommand.s string command# returns integer
61969>>>>>>>>>>> integer liRow max#
61969>>>>>>>>>>> move (uppercase(command#)) to command#
61970>>>>>>>>>>> get row_count to max#
61971>>>>>>>>>>> for liRow from 0 to (max#-1)
61977>>>>>>>>>>>>
61977>>>>>>>>>>> if command# eq (psName.i(self,liRow)) function_return liRow
61980>>>>>>>>>>> loop
61981>>>>>>>>>>>>
61981>>>>>>>>>>> function_return -1 // Not found
61982>>>>>>>>>>> end_function
61983>>>>>>>>>>>end_class // cCommandList
61984>>>>>>>>>>>
61984>>>>>>>>>>>class cReplaces is a cArray
61985>>>>>>>>>>> item_property_list
61985>>>>>>>>>>> item_property string psName.i
61985>>>>>>>>>>> item_property string psValue.i
61985>>>>>>>>>>> end_item_property_list cReplaces
#REM 62017 DEFINE FUNCTION PSVALUE.I INTEGER LIROW RETURNS STRING
#REM 62021 DEFINE PROCEDURE SET PSVALUE.I INTEGER LIROW STRING VALUE
#REM 62025 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 62029 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
62034>>>>>>>>>>>
62034>>>>>>>>>>> procedure construct_object integer img#
62036>>>>>>>>>>> forward send construct_object img#
62038>>>>>>>>>>> property integer piFlexInit_Count public 0
62039>>>>>>>>>>> send initial_replaces
62040>>>>>>>>>>> end_procedure
62041>>>>>>>>>>>
62041>>>>>>>>>>> procedure reset
62043>>>>>>>>>>> integer max# liRow max_flexinit#
62043>>>>>>>>>>> get piFlexInit_Count to max_flexinit#
62044>>>>>>>>>>> get row_count to max#
62045>>>>>>>>>>> for_ex liRow from (max#-1) down_to max_flexinit#
62052>>>>>>>>>>> send delete_row liRow
62053>>>>>>>>>>> loop
62054>>>>>>>>>>>>
62054>>>>>>>>>>> end_procedure
62055>>>>>>>>>>>
62055>>>>>>>>>>> function iNameToNo.s string name# returns integer
62057>>>>>>>>>>> integer liRow max# rval#
62057>>>>>>>>>>> move (uppercase(name#)) to name#
62058>>>>>>>>>>> get row_count to max#
62059>>>>>>>>>>> move -1 to rval#
62060>>>>>>>>>>> move 0 to liRow
62061>>>>>>>>>>> while (liRow<max# and rval#=-1)
62065>>>>>>>>>>> if name# eq (psName.i(self,liRow)) move liRow to rval#
62068>>>>>>>>>>> increment liRow
62069>>>>>>>>>>> end
62070>>>>>>>>>>>>
62070>>>>>>>>>>> function_return rval#
62071>>>>>>>>>>> end_function
62072>>>>>>>>>>>
62072>>>>>>>>>>> function sNameToValue.s string name# returns string
62074>>>>>>>>>>> integer liRow
62074>>>>>>>>>>> get iNameToNo.s name# to liRow
62075>>>>>>>>>>> if liRow eq -1 function_return name#
62078>>>>>>>>>>> function_return (sNameToValue.s(self,psValue.i(self,liRow)))
62079>>>>>>>>>>> end_function
62080>>>>>>>>>>>
62080>>>>>>>>>>> function iCircular.ss string name# string symbol_list# returns integer
62082>>>>>>>>>>> integer liRow rval#
62082>>>>>>>>>>> move 0 to rval#
62083>>>>>>>>>>> if symbol_list# eq "" move "³" to symbol_list#
62086>>>>>>>>>>> if ("³"+name#+"³") in symbol_list# function_return 1 // Circular ref!
62089>>>>>>>>>>> get iNameToNo.s name# to liRow
62090>>>>>>>>>>> if liRow ne -1 get iCircular.ss (psValue.i(self,liRow)) (symbol_list#+name#+"³") to rval#
62093>>>>>>>>>>> function_return rval#
62094>>>>>>>>>>> end_function
62095>>>>>>>>>>>
62095>>>>>>>>>>> function iNameDeclare.ss string name# string value# returns integer
62097>>>>>>>>>>> integer liRow rval#
62097>>>>>>>>>>> move ERR.SCRIPT.NO_ERROR to rval#
62098>>>>>>>>>>> move (uppercase(name#)) to name#
62099>>>>>>>>>>> get iNameToNo.s name# to liRow
62100>>>>>>>>>>> if liRow eq -1 begin
62102>>>>>>>>>>> get row_count to liRow
62103>>>>>>>>>>> set psName.i liRow to name#
62104>>>>>>>>>>> set psValue.i liRow to value#
62105>>>>>>>>>>> end
62105>>>>>>>>>>>>
62105>>>>>>>>>>> else move ERR.SCRIPT.SYMBOL_ALREADY_DEF to rval#
62107>>>>>>>>>>> ifnot rval# if (iCircular.ss(self,name#,value#)) begin
62111>>>>>>>>>>> move ERR.SCRIPT.CIRCULAR_REFERENCE to rval#
62112>>>>>>>>>>> send delete_row liRow
62113>>>>>>>>>>> end
62113>>>>>>>>>>>>
62113>>>>>>>>>>> function_return rval#
62114>>>>>>>>>>> end_function
62115>>>>>>>>>>> procedure add_initial_replace string name# string value#
62117>>>>>>>>>>> integer liRow
62117>>>>>>>>>>> get row_count to liRow
62118>>>>>>>>>>> set psName.i liRow to name#
62119>>>>>>>>>>> set psValue.i liRow to value#
62120>>>>>>>>>>> end_procedure
62121>>>>>>>>>>> procedure initial_replaces
62123>>>>>>>>>>> send add_initial_replace "FALSE" 0
62124>>>>>>>>>>> send add_initial_replace "TRUE" 1
62125>>>>>>>>>>> send add_initial_replace "DFTRUE" DFTRUE
62126>>>>>>>>>>> send add_initial_replace "DFFALSE" DFFALSE
62127>>>>>>>>>>> if DFTRUE begin // DATE STUFF
62129>>>>>>>>>>> send add_initial_replace "DS_DAY" DS_DAY
62130>>>>>>>>>>> send add_initial_replace "DS_WEEK" DS_WEEK
62131>>>>>>>>>>> send add_initial_replace "DS_MONTH" DS_MONTH
62132>>>>>>>>>>> send add_initial_replace "DS_YEAR" DS_YEAR
62133>>>>>>>>>>> send add_initial_replace "LargestPossibleDate" LargestPossibleDate
62134>>>>>>>>>>> send add_initial_replace "Jan1st1900" Jan1st1900
62135>>>>>>>>>>> send add_initial_replace "Jan1st2000" Jan1st2000
62136>>>>>>>>>>> send add_initial_replace "Jan1st1930" Jan1st1930
62137>>>>>>>>>>> send add_initial_replace "Jan1st1000" Jan1st1000
62138>>>>>>>>>>> send add_initial_replace "Jan1st105" Jan1st105
62139>>>>>>>>>>> send add_initial_replace "Jan1st100" Jan1st100
62140>>>>>>>>>>> end
62140>>>>>>>>>>>>
62140>>>>>>>>>>> if DFFALSE begin
62142>>>>>>>>>>> send add_initial_replace "IMPLICIT_FIELD" -1
62143>>>>>>>>>>> send add_initial_replace "DF_LOCK_DELAY" DF_LOCK_DELAY
62144>>>>>>>>>>> send add_initial_replace "DF_LOCK_TIMEOUT" DF_LOCK_TIMEOUT
62145>>>>>>>>>>> send add_initial_replace "DF_OPEN_PATH" DF_OPEN_PATH
62146>>>>>>>>>>> send add_initial_replace "DF_DATE_FORMAT" DF_DATE_FORMAT
62147>>>>>>>>>>> send add_initial_replace "DF_DATE_SEPARATOR" DF_DATE_SEPARATOR
62148>>>>>>>>>>> send add_initial_replace "DF_DECIMAL_SEPARATOR" DF_DECIMAL_SEPARATOR
62149>>>>>>>>>>> send add_initial_replace "DF_THOUSANDS_SEPARATOR" DF_THOUSANDS_SEPARATOR
62150>>>>>>>>>>> send add_initial_replace "DF_ALL_FILES_TOUCHED" DF_ALL_FILES_TOUCHED
62151>>>>>>>>>>> send add_initial_replace "DF_HIGH_DATA_INTEGRITY" DF_HIGH_DATA_INTEGRITY
62152>>>>>>>>>>> send add_initial_replace "DF_TRAN_COUNT" DF_TRAN_COUNT
62153>>>>>>>>>>> send add_initial_replace "DF_TRANSACTION_ABORT" DF_TRANSACTION_ABORT
62154>>>>>>>>>>> send add_initial_replace "DF_REREAD_REQUIRED" DF_REREAD_REQUIRED
62155>>>>>>>>>>> send add_initial_replace "DF_FILELIST_NAME" DF_FILELIST_NAME
62156>>>>>>>>>>> send add_initial_replace "DF_REPORT_UNSUPPORTED_ATTRIBUTES" DF_REPORT_UNSUPPORTED_ATTRIBUTES
62157>>>>>>>>>>> send add_initial_replace "DF_STRICT_ATTRIBUTES" DF_STRICT_ATTRIBUTES
62158>>>>>>>>>>> send add_initial_replace "DF_NUMBER_DRIVERS" DF_NUMBER_DRIVERS
62159>>>>>>>>>>> send add_initial_replace "DF_DRIVER_NAME" DF_DRIVER_NAME
62160>>>>>>>>>>> send add_initial_replace "DF_DRIVER_NUMBER_SERVERS" DF_DRIVER_NUMBER_SERVERS
62161>>>>>>>>>>> send add_initial_replace "DF_DRIVER_SERVER_NAME" DF_DRIVER_SERVER_NAME
62162>>>>>>>>>>> send add_initial_replace "DF_API_DISABLED" DF_API_DISABLED
62163>>>>>>>>>>> send add_initial_replace "DF_API_DISABLED_ERROR" DF_API_DISABLED_ERROR
62164>>>>>>>>>>> send add_initial_replace "DF_FILE_STATUS" DF_FILE_STATUS
62165>>>>>>>>>>> send add_initial_replace "DF_FILE_MODE" DF_FILE_MODE
62166>>>>>>>>>>> send add_initial_replace "DF_FILE_MAX_RECORDS" DF_FILE_MAX_RECORDS
62167>>>>>>>>>>> send add_initial_replace "DF_FILE_RECORDS_USED" DF_FILE_RECORDS_USED
62168>>>>>>>>>>> send add_initial_replace "DF_FILE_TYPE" DF_FILE_TYPE
62169>>>>>>>>>>> send add_initial_replace "DF_FILE_MULTIUSER" DF_FILE_MULTIUSER
62170>>>>>>>>>>> send add_initial_replace "DF_FILE_REUSE_DELETED" DF_FILE_REUSE_DELETED
62171>>>>>>>>>>> send add_initial_replace "DF_FILE_NUMBER" DF_FILE_NUMBER
62172>>>>>>>>>>> send add_initial_replace "DF_FILE_COMPRESSION" DF_FILE_COMPRESSION
62173>>>>>>>>>>> send add_initial_replace "DF_FILE_LAST_INDEX_NUMBER" DF_FILE_LAST_INDEX_NUMBER
62174>>>>>>>>>>> send add_initial_replace "DF_FILE_NUMBER_FIELDS" DF_FILE_NUMBER_FIELDS
62175>>>>>>>>>>> send add_initial_replace "DF_FILE_LOGICAL_NAME" DF_FILE_LOGICAL_NAME
62176>>>>>>>>>>> send add_initial_replace "DF_FILE_ROOT_NAME" DF_FILE_ROOT_NAME
62177>>>>>>>>>>> send add_initial_replace "DF_FILE_CHANGED" DF_FILE_CHANGED
62178>>>>>>>>>>> send add_initial_replace "DF_FILE_ALIAS" DF_FILE_ALIAS
62179>>>>>>>>>>> send add_initial_replace "DF_FILE_TOUCHED" DF_FILE_TOUCHED
62180>>>>>>>>>>> send add_initial_replace "DF_FILE_TRANSACTION" DF_FILE_TRANSACTION
62181>>>>>>>>>>> send add_initial_replace "DF_FILE_OPENED" DF_FILE_OPENED
62182>>>>>>>>>>> send add_initial_replace "DF_FILE_DISPLAY_NAME" DF_FILE_DISPLAY_NAME
62183>>>>>>>>>>> send add_initial_replace "DF_FILE_PHYSICAL_NAME" DF_FILE_PHYSICAL_NAME
62184>>>>>>>>>>> send add_initial_replace "DF_FILE_NEXT_OPENED" DF_FILE_NEXT_OPENED
62185>>>>>>>>>>> send add_initial_replace "DF_FILE_NEXT_USED" DF_FILE_NEXT_USED
62186>>>>>>>>>>> send add_initial_replace "DF_FILE_NEXT_EMPTY" DF_FILE_NEXT_EMPTY
62187>>>>>>>>>>> send add_initial_replace "DF_FILE_RECORD_LENGTH" DF_FILE_RECORD_LENGTH
62188>>>>>>>>>>> send add_initial_replace "DF_FILE_RESTRUCTURE" DF_FILE_RESTRUCTURE
62189>>>>>>>>>>> send add_initial_replace "DF_FILE_OPEN_MODE" DF_FILE_OPEN_MODE
62190>>>>>>>>>>> send add_initial_replace "DF_FILE_INTEGRITY_CHECK" DF_FILE_INTEGRITY_CHECK
62191>>>>>>>>>>> send add_initial_replace "DF_FILE_OWNER" DF_FILE_OWNER
62192>>>>>>>>>>> send add_initial_replace "DF_FILE_IS_SYSTEM_FILE" DF_FILE_IS_SYSTEM_FILE
62193>>>>>>>>>>> send add_initial_replace "DF_FILE_LOCK_TYPE" DF_FILE_LOCK_TYPE
62194>>>>>>>>>>> send add_initial_replace "DF_FILE_COMMITTED" DF_FILE_COMMITTED
62195>>>>>>>>>>> send add_initial_replace "DF_FILE_DRIVER" DF_FILE_DRIVER
62196>>>>>>>>>>> send add_initial_replace "DF_FILE_RECORD_LENGTH_USED" DF_FILE_RECORD_LENGTH_USED
62197>>>>>>>>>>> send add_initial_replace "DF_FILE_HANDLE_TYPE" DF_FILE_HANDLE_TYPE
62198>>>>>>>>>>> send add_initial_replace "DF_FILE_RECORD_IDENTITY" DF_FILE_RECORD_IDENTITY
62199>>>>>>>>>>> send add_initial_replace "DF_FILE_LOGIN" DF_FILE_LOGIN
62200>>>>>>>>>>> send add_initial_replace "DF_FILE_RECORD_PRIVILEGE" DF_FILE_RECORD_PRIVILEGE
62201>>>>>>>>>>> send add_initial_replace "DF_FILE_PRIVILEGE" DF_FILE_PRIVILEGE
62202>>>>>>>>>>> send add_initial_replace "DF_FILE_CREATION_SERIAL" DF_FILE_CREATION_SERIAL
62203>>>>>>>>>>> send add_initial_replace "DF_FILE_REVISION" DF_FILE_REVISION
62204>>>>>>>>>>> send add_initial_replace "DF_FILE_RELATED_COUNT" DF_FILE_RELATED_COUNT
62205>>>>>>>>>>> send add_initial_replace "DF_FILE_RELATED_FIELDS" DF_FILE_RELATED_FIELDS
62206>>>>>>>>>>> send add_initial_replace "DF_FILE_SYSTEM_FILE" DF_FILE_SYSTEM_FILE
62207>>>>>>>>>>> send add_initial_replace "DF_FILE_SYSTEM_FIELD" DF_FILE_SYSTEM_FIELD
62208>>>>>>>>>>> send add_initial_replace "DF_FILE_RECORD_REREAD" DF_FILE_RECORD_REREAD
62209>>>>>>>>>>> send add_initial_replace "DF_FIELD_NUMBER" DF_FIELD_NUMBER
62210>>>>>>>>>>> send add_initial_replace "DF_FIELD_TYPE" DF_FIELD_TYPE
62211>>>>>>>>>>> send add_initial_replace "DF_FIELD_LENGTH" DF_FIELD_LENGTH
62212>>>>>>>>>>> send add_initial_replace "DF_FIELD_PRECISION" DF_FIELD_PRECISION
62213>>>>>>>>>>> send add_initial_replace "DF_FIELD_RELATED_FILE" DF_FIELD_RELATED_FILE
62214>>>>>>>>>>> send add_initial_replace "DF_FIELD_RELATED_FIELD" DF_FIELD_RELATED_FIELD
62215>>>>>>>>>>> send add_initial_replace "DF_FIELD_NAME" DF_FIELD_NAME
62216>>>>>>>>>>> send add_initial_replace "DF_FIELD_INDEX" DF_FIELD_INDEX
62217>>>>>>>>>>> send add_initial_replace "DF_FIELD_OFFSET" DF_FIELD_OFFSET
62218>>>>>>>>>>> send add_initial_replace "DF_FIELD_OLD_NUMBER" DF_FIELD_OLD_NUMBER
62219>>>>>>>>>>> send add_initial_replace "DF_FIELD_OVERLAP" DF_FIELD_OVERLAP
62220>>>>>>>>>>> send add_initial_replace "DF_FIELD_NATIVE_LENGTH" DF_FIELD_NATIVE_LENGTH
62221>>>>>>>>>>> send add_initial_replace "DF_INDEX_NUMBER_SEGMENTS" DF_INDEX_NUMBER_SEGMENTS
62222>>>>>>>>>>> send add_initial_replace "DF_INDEX_NUMBER_BUFFERS" DF_INDEX_NUMBER_BUFFERS
62223>>>>>>>>>>> send add_initial_replace "DF_INDEX_TYPE" DF_INDEX_TYPE
62224>>>>>>>>>>> send add_initial_replace "DF_INDEX_LEVELS" DF_INDEX_LEVELS
62225>>>>>>>>>>> send add_initial_replace "DF_INDEX_KEY_LENGTH" DF_INDEX_KEY_LENGTH
62226>>>>>>>>>>> send add_initial_replace "DF_INDEX_SEGMENT_DIRECTION" DF_INDEX_SEGMENT_DIRECTION
62227>>>>>>>>>>> send add_initial_replace "DF_INDEX_SEGMENT_CASE" DF_INDEX_SEGMENT_CASE
62228>>>>>>>>>>> send add_initial_replace "DF_INDEX_SEGMENT_FIELD" DF_INDEX_SEGMENT_FIELD
62229>>>>>>>>>>> send add_initial_replace "DF_DATE_USA" DF_DATE_USA
62230>>>>>>>>>>> send add_initial_replace "DF_DATE_EUROPEAN" DF_DATE_EUROPEAN
62231>>>>>>>>>>> send add_initial_replace "DF_DATE_MILITARY" DF_DATE_MILITARY
62232>>>>>>>>>>> send add_initial_replace "DF_MESSAGE_TEXT" DF_MESSAGE_TEXT
62233>>>>>>>>>>> send add_initial_replace "DF_MESSAGE_HEADING_1" DF_MESSAGE_HEADING_1
62234>>>>>>>>>>> send add_initial_replace "DF_MESSAGE_HEADING_2" DF_MESSAGE_HEADING_2
62235>>>>>>>>>>> send add_initial_replace "DF_MESSAGE_HEADING_3" DF_MESSAGE_HEADING_3
62236>>>>>>>>>>> send add_initial_replace "DF_MESSAGE_HEADING_4" DF_MESSAGE_HEADING_4
62237>>>>>>>>>>> send add_initial_replace "DF_MESSAGE_HEADING_5" DF_MESSAGE_HEADING_5
62238>>>>>>>>>>> send add_initial_replace "DF_MESSAGE_WARNING" DF_MESSAGE_WARNING
62239>>>>>>>>>>> send add_initial_replace "DF_MESSAGE_PROGRESS_TITLE" DF_MESSAGE_PROGRESS_TITLE
62240>>>>>>>>>>> send add_initial_replace "DF_MESSAGE_PROGRESS_VALUE" DF_MESSAGE_PROGRESS_VALUE
62241>>>>>>>>>>> send add_initial_replace "DF_AUX_FILE_FD" DF_AUX_FILE_FD
62242>>>>>>>>>>> send add_initial_replace "DF_AUX_FILE_DEF" DF_AUX_FILE_DEF
62243>>>>>>>>>>> send add_initial_replace "DF_FILE_INACTIVE" DF_FILE_INACTIVE
62244>>>>>>>>>>> send add_initial_replace "DF_FILE_ACTIVE" DF_FILE_ACTIVE
62245>>>>>>>>>>> send add_initial_replace "DF_FILE_ACTIVE_CHANGED" DF_FILE_ACTIVE_CHANGED
62246>>>>>>>>>>> send add_initial_replace "DF_FILE_USER_SINGLE" DF_FILE_USER_SINGLE
62247>>>>>>>>>>> send add_initial_replace "DF_FILE_USER_MULTI" DF_FILE_USER_MULTI
62248>>>>>>>>>>> send add_initial_replace "DF_FILE_DELETED_NOREUSE" DF_FILE_DELETED_NOREUSE
62249>>>>>>>>>>> send add_initial_replace "DF_FILE_DELETED_REUSE" DF_FILE_DELETED_REUSE
62250>>>>>>>>>>> send add_initial_replace "DF_FILE_COMPRESS_NONE" DF_FILE_COMPRESS_NONE
62251>>>>>>>>>>> send add_initial_replace "DF_FILE_COMPRESS_FAST" DF_FILE_COMPRESS_FAST
62252>>>>>>>>>>> send add_initial_replace "DF_FILE_COMPRESS_STANDARD" DF_FILE_COMPRESS_STANDARD
62253>>>>>>>>>>> send add_initial_replace "DF_FILE_COMPRESS_CUSTOM" DF_FILE_COMPRESS_CUSTOM
62254>>>>>>>>>>> send add_initial_replace "DF_FILE_ALIAS_DEFAULT" DF_FILE_ALIAS_DEFAULT
62255>>>>>>>>>>> send add_initial_replace "DF_FILE_IS_MASTER" DF_FILE_IS_MASTER
62256>>>>>>>>>>> send add_initial_replace "DF_FILE_IS_ALIAS" DF_FILE_IS_ALIAS
62257>>>>>>>>>>> send add_initial_replace "DF_FILE_HANDLE_BAD" DF_FILE_HANDLE_BAD
62258>>>>>>>>>>> send add_initial_replace "DF_FILE_HANDLE_CLOSED" DF_FILE_HANDLE_CLOSED
62259>>>>>>>>>>> send add_initial_replace "DF_FILE_HANDLE_OPENED" DF_FILE_HANDLE_OPENED
62260>>>>>>>>>>> send add_initial_replace "DF_FILE_HANDLE_EXISTING_RESTRUCTURE" DF_FILE_HANDLE_EXISTING_RESTRUCTURE
62261>>>>>>>>>>> send add_initial_replace "DF_FILE_HANDLE_NEW_RESTRUCTURE" DF_FILE_HANDLE_NEW_RESTRUCTURE
62262>>>>>>>>>>> send add_initial_replace "DF_FILE_TRANSACTION_NONE" DF_FILE_TRANSACTION_NONE
62263>>>>>>>>>>> send add_initial_replace "DF_FILE_TRANSACTION_CLIENT_ATOMIC" DF_FILE_TRANSACTION_CLIENT_ATOMIC
62264>>>>>>>>>>> send add_initial_replace "DF_FILE_TRANSACTION_SERVER_ATOMIC" DF_FILE_TRANSACTION_SERVER_ATOMIC
62265>>>>>>>>>>> send add_initial_replace "DF_FILE_TRANSACTION_SERVER_LOGGED" DF_FILE_TRANSACTION_SERVER_LOGGED
62266>>>>>>>>>>> send add_initial_replace "DF_NO_RESTRUCTURE" DF_NO_RESTRUCTURE
62267>>>>>>>>>>> send add_initial_replace "DF_RESTRUCTURE_FILE" DF_RESTRUCTURE_FILE
62268>>>>>>>>>>> send add_initial_replace "DF_RESTRUCTURE_INDEX" DF_RESTRUCTURE_INDEX
62269>>>>>>>>>>> send add_initial_replace "DF_RESTRUCTURE_BOTH" DF_RESTRUCTURE_BOTH
62270>>>>>>>>>>> send add_initial_replace "DF_FILE_NOT_TOUCHED" DF_FILE_NOT_TOUCHED
62271>>>>>>>>>>> send add_initial_replace "DF_FILE_TOUCHED_INACTIVE" DF_FILE_TOUCHED_INACTIVE
62272>>>>>>>>>>> send add_initial_replace "DF_FILE_TOUCHED_ACTIVE" DF_FILE_TOUCHED_ACTIVE
62273>>>>>>>>>>> send add_initial_replace "DF_FILEMODE_ORIGINAL" DF_FILEMODE_ORIGINAL
62274>>>>>>>>>>> send add_initial_replace "DF_FILEMODE_DEFAULT" DF_FILEMODE_DEFAULT
62275>>>>>>>>>>> send add_initial_replace "DF_FILEMODE_NO_REREAD" DF_FILEMODE_NO_REREAD
62276>>>>>>>>>>> send add_initial_replace "DF_FILEMODE_NO_LOCKS" DF_FILEMODE_NO_LOCKS
62277>>>>>>>>>>> send add_initial_replace "DF_FILEMODE_NO_EDITS" DF_FILEMODE_NO_EDITS
62278>>>>>>>>>>> send add_initial_replace "DF_FILEMODE_NO_DELETES" DF_FILEMODE_NO_DELETES
62279>>>>>>>>>>> send add_initial_replace "DF_FILEMODE_NO_FINDS" DF_FILEMODE_NO_FINDS
62280>>>>>>>>>>> send add_initial_replace "DF_FILEMODE_NO_CREATES" DF_FILEMODE_NO_CREATES
62281>>>>>>>>>>> send add_initial_replace "DF_FILEMODE_READONLY" DF_FILEMODE_READONLY
62282>>>>>>>>>>> send add_initial_replace "DF_FILEMODE_SINGLE_USER" DF_FILEMODE_SINGLE_USER
62283>>>>>>>>>>> send add_initial_replace "DF_PERMANENT" DF_PERMANENT
62284>>>>>>>>>>> send add_initial_replace "DF_TEMPORARY" DF_TEMPORARY
62285>>>>>>>>>>> send add_initial_replace "DF_LOCK_TYPE_NONE" DF_LOCK_TYPE_NONE
62286>>>>>>>>>>> send add_initial_replace "DF_LOCK_TYPE_FILE" DF_LOCK_TYPE_FILE
62287>>>>>>>>>>> send add_initial_replace "DF_LOCK_TYPE_RECORD" DF_LOCK_TYPE_RECORD
62288>>>>>>>>>>> send add_initial_replace "DF_SHARE" DF_SHARE
62289>>>>>>>>>>> send add_initial_replace "DF_EXCLUSIVE" DF_EXCLUSIVE
62290>>>>>>>>>>> send add_initial_replace "DF_INDEX_TYPE_ONLINE" DF_INDEX_TYPE_ONLINE
62291>>>>>>>>>>> send add_initial_replace "DF_INDEX_TYPE_BATCH" DF_INDEX_TYPE_BATCH
62292>>>>>>>>>>> send add_initial_replace "DF_CASE_USED" DF_CASE_USED
62293>>>>>>>>>>> send add_initial_replace "DF_CASE_IGNORED" DF_CASE_IGNORED
62294>>>>>>>>>>> send add_initial_replace "DF_ASCENDING" DF_ASCENDING
62295>>>>>>>>>>> send add_initial_replace "DF_DESCENDING" DF_DESCENDING
62296>>>>>>>>>>> send add_initial_replace "DF_ASCII" DF_ASCII
62297>>>>>>>>>>> send add_initial_replace "DF_BCD" DF_BCD
62298>>>>>>>>>>> send add_initial_replace "DF_DATE" DF_DATE
62299>>>>>>>>>>> send add_initial_replace "DF_OVERLAP" DF_OVERLAP
62300>>>>>>>>>>> send add_initial_replace "DF_TEXT" DF_TEXT
62301>>>>>>>>>>> send add_initial_replace "DF_BINARY" DF_BINARY
62302>>>>>>>>>>> send add_initial_replace "DF_STRUCTEND_OPT_NONE" DF_STRUCTEND_OPT_NONE
62303>>>>>>>>>>> send add_initial_replace "DF_STRUCTEND_OPT_FORCE" DF_STRUCTEND_OPT_FORCE
62304>>>>>>>>>>> send add_initial_replace "DF_STRUCTEND_OPT_RECOMPRESS" DF_STRUCTEND_OPT_RECOMPRESS
62305>>>>>>>>>>> send add_initial_replace "DF_STRUCTEND_OPT_IN_PLACE" DF_STRUCTEND_OPT_IN_PLACE
62306>>>>>>>>>>> send add_initial_replace "DF_SORT_OPTION_NONE" DF_SORT_OPTION_NONE
62307>>>>>>>>>>> send add_initial_replace "DF_SORT_OPTION_NO_DATA_CHECK" DF_SORT_OPTION_NO_DATA_CHECK
62308>>>>>>>>>>> send add_initial_replace "DF_SORT_OPTION_BAD_DATA_FIXUP" DF_SORT_OPTION_BAD_DATA_FIXUP
62309>>>>>>>>>>> send add_initial_replace "DF_SORT_OPTION_BAD_DATA_FILE" DF_SORT_OPTION_BAD_DATA_FILE
62310>>>>>>>>>>> send add_initial_replace "DF_SORT_OPTION_BAD_DATA_ABORT" DF_SORT_OPTION_BAD_DATA_ABORT
62311>>>>>>>>>>> send add_initial_replace "DF_SORT_OPTION_DUP_DATA_FILE" DF_SORT_OPTION_DUP_DATA_FILE
62312>>>>>>>>>>> send add_initial_replace "DF_SORT_OPTION_DUP_DATA_ABORT" DF_SORT_OPTION_DUP_DATA_ABORT
62313>>>>>>>>>>> send add_initial_replace "DF_HIGH" DF_HIGH
62314>>>>>>>>>>> send add_initial_replace "DF_LOW" DF_LOW
62315>>>>>>>>>>> end
62315>>>>>>>>>>>>
62315>>>>>>>>>>> set piFlexInit_Count to (row_count(self))
62316>>>>>>>>>>> end_procedure
62317>>>>>>>>>>>end_class // cReplaces
62318>>>>>>>>>>>
62318>>>>>>>>>>>function dfscript_item_type global integer liType returns string
62320>>>>>>>>>>> ifnot liType function_return "unknown"
62323>>>>>>>>>>> if liType eq TYPE.UNKNOWN function_return "unknown"
62326>>>>>>>>>>> if liType eq TYPE.UNTYPED function_return "un-typed"
62329>>>>>>>>>>> if liType eq TYPE.DATE function_return "date"
62332>>>>>>>>>>> if liType eq TYPE.INTEGER function_return "integer"
62335>>>>>>>>>>> if liType eq TYPE.NUMBER function_return "number"
62338>>>>>>>>>>> if liType eq TYPE.STRING function_return "string"
62341>>>>>>>>>>> function_return "ERROR"
62342>>>>>>>>>>>end_function
62343>>>>>>>>>>>function dfscript_item_class global integer class# returns string
62345>>>>>>>>>>> ifnot class# function_return "unknown"
62348>>>>>>>>>>> if class# eq CLASS.UNKNOWN function_return "unknown"
62351>>>>>>>>>>> if class# eq CLASS.LABEL function_return "label"
62354>>>>>>>>>>> if class# eq CLASS.VAR function_return "var"
62357>>>>>>>>>>> if class# eq CLASS.CONST function_return "const"
62360>>>>>>>>>>> if class# eq CLASS.EXPR function_return "expr"
62363>>>>>>>>>>> if class# eq CLASS.KEYWORD function_return "keyword"
62366>>>>>>>>>>> if class# eq CLASS.COMMAND function_return "command"
62369>>>>>>>>>>> if class# eq CLASS.REPLACE_SYMBOL function_return "replacable"
62372>>>>>>>>>>> if class# eq CLASS.FIELD function_return "field"
62375>>>>>>>>>>> if class# eq CLASS.FUNCTION function_return "function"
62378>>>>>>>>>>> function_return "ERROR"
62379>>>>>>>>>>>end_function
62380>>>>>>>>>>>
62380>>>>>>>>>>>class cScriptInterpreter is a cArray
62381>>>>>>>>>>> procedure construct_object integer img#
62383>>>>>>>>>>> forward send construct_object img#
62385>>>>>>>>>>> property string psLineBeingParsed public ""
62386>>>>>>>>>>> property string psExprBeingParsed public ""
62387>>>>>>>>>>> property integer piErrorCode public 0
62388>>>>>>>>>>> property integer piErrorPos public 0
62389>>>>>>>>>>> property integer piLine public 0
62390>>>>>>>>>>> property integer pVM_Object public 0 // Virtual Machine object
62391>>>>>>>>>>> property string psFileName public "dfs.src"
62392>>>>>>>>>>> property integer piDebugState public 0
62393>>>>>>>>>>> property string psListingFile public "dfscript.prn"
62394>>>>>>>>>>> property integer piListingFileState public 1
62395>>>>>>>>>>> property integer piListingFileCh public 0
62396>>>>>>>>>>> object oCommandList is a cCommandList
62398>>>>>>>>>>> end_object
62399>>>>>>>>>>> object oKeyWords is a cSet
62401>>>>>>>>>>> send element_add "FROM"
62402>>>>>>>>>>> send element_add "TO"
62403>>>>>>>>>>> send element_add "LT"
62404>>>>>>>>>>> send element_add "LE"
62405>>>>>>>>>>> send element_add "EQ"
62406>>>>>>>>>>> send element_add "NE"
62407>>>>>>>>>>> send element_add "GE"
62408>>>>>>>>>>> send element_add "GT"
62409>>>>>>>>>>> send element_add "IN"
62410>>>>>>>>>>> send element_add "AND"
62411>>>>>>>>>>> send element_add "OR"
62412>>>>>>>>>>> send element_add "MIN"
62413>>>>>>>>>>> send element_add "MAX"
62414>>>>>>>>>>> end_object
62415>>>>>>>>>>> object oReplaces is a cReplaces
62417>>>>>>>>>>> end_object
62418>>>>>>>>>>> object oScriptErrors is a cScriptErrors
62420>>>>>>>>>>> end_object
62421>>>>>>>>>>> object oStructuralStack is a cStructuralStack
62423>>>>>>>>>>> end_object
62424>>>>>>>>>>> object oExpressionParser is a cExpressionParser
62426>>>>>>>>>>> end_object
62427>>>>>>>>>>> property integer piExprType public 0
62428>>>>>>>>>>> property integer piExprID public 0
62429>>>>>>>>>>> end_procedure
62430>>>>>>>>>>>
62430>>>>>>>>>>> procedure reset
62432>>>>>>>>>>> send delete_data to (oScriptErrors(self))
62433>>>>>>>>>>> send delete_data to (oStructuralStack(self))
62434>>>>>>>>>>> send reset to (oReplaces(self))
62435>>>>>>>>>>> send reset to (oExpressionParser(self))
62436>>>>>>>>>>> set piErrorCode to 0
62437>>>>>>>>>>> set piErrorPos to 0
62438>>>>>>>>>>> set piLine to 0
62439>>>>>>>>>>> end_procedure
62440>>>>>>>>>>>
62440>>>>>>>>>>> function iCommand.s string command# returns integer
62442>>>>>>>>>>> function_return (iCommand.s(oCommandList(self),command#))
62443>>>>>>>>>>> end_function
62444>>>>>>>>>>>
62444>>>>>>>>>>> procedure ScriptError integer error# integer pos# string tmp_str#
62446>>>>>>>>>>> string str#
62446>>>>>>>>>>> if num_arguments gt 2 move tmp_str# to str#
62449>>>>>>>>>>> else move "" to str#
62451>>>>>>>>>>> send add_error to (oScriptErrors(self)) error# (piLine(self)) pos# (psFileName(self)) str#
62452>>>>>>>>>>> set piErrorCode to error#
62453>>>>>>>>>>> set piErrorPos to pos#
62454>>>>>>>>>>> end_procedure
62455>>>>>>>>>>>
62455>>>>>>>>>>> item_property_list
62455>>>>>>>>>>> item_property string psItem.i // The item itself
62455>>>>>>>>>>> item_property integer piPos.i // Original starting position in original line
62455>>>>>>>>>>> item_property integer piClass.i // Item class
62455>>>>>>>>>>> item_property integer piType.i // Item type
62455>>>>>>>>>>> item_property integer piAuxVal.i // Means different stuff
62455>>>>>>>>>>> end_item_property_list cScriptInterpreter
#REM 62496 DEFINE FUNCTION PIAUXVAL.I INTEGER LIROW RETURNS INTEGER
#REM 62500 DEFINE PROCEDURE SET PIAUXVAL.I INTEGER LIROW INTEGER VALUE
#REM 62504 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 62508 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 62512 DEFINE FUNCTION PICLASS.I INTEGER LIROW RETURNS INTEGER
#REM 62516 DEFINE PROCEDURE SET PICLASS.I INTEGER LIROW INTEGER VALUE
#REM 62520 DEFINE FUNCTION PIPOS.I INTEGER LIROW RETURNS INTEGER
#REM 62524 DEFINE PROCEDURE SET PIPOS.I INTEGER LIROW INTEGER VALUE
#REM 62528 DEFINE FUNCTION PSITEM.I INTEGER LIROW RETURNS STRING
#REM 62532 DEFINE PROCEDURE SET PSITEM.I INTEGER LIROW STRING VALUE
62537>>>>>>>>>>>
62537>>>>>>>>>>> function iIsLabelDeclaration.s string str# returns integer
62539>>>>>>>>>>> if (right(str#,1)) eq ":" function_return 1
62542>>>>>>>>>>> end_function
62543>>>>>>>>>>>
62543>>>>>>>>>>> function iSymbolClass.s string name# returns integer
62545>>>>>>>>>>> integer rval#
62545>>>>>>>>>>> move (uppercase(name#)) to name#
62546>>>>>>>>>>> // Is symbol defined in variable list of VM object?
62546>>>>>>>>>>> get iVarNameToVarNo of (pVM_Object(self)) name# to rval#
62547>>>>>>>>>>> if rval# ne -1 function_return CLASS.VAR
62550>>>>>>>>>>> get iIsLabelNameUsed.s of (pVM_Object(self)) name# to rval#
62551>>>>>>>>>>> if rval# function_return CLASS.LABEL
62554>>>>>>>>>>> // get iCommand.s name# to rval#
62554>>>>>>>>>>> // if rval# ne -1 function_return CLASS.COMMAND
62554>>>>>>>>>>> get iNameToNo.s of (oReplaces(self)) name# to rval#
62555>>>>>>>>>>> if rval# ne -1 function_return CLASS.REPLACE_SYMBOL
62558>>>>>>>>>>> get iConstType.s name# to rval#
62559>>>>>>>>>>> if rval# ne TYPE.UNKNOWN function_return CLASS.CONST
62562>>>>>>>>>>> get element_find of (oKeyWords(self)) name# to rval#
62563>>>>>>>>>>> if rval# ne -1 function_return CLASS.KEYWORD
62566>>>>>>>>>>> if (left(name#,1)) eq "(" function_return CLASS.EXPR
62569>>>>>>>>>>> get iFuncNameToFuncNo.s of (pVM_Object(self)) name# to rval#
62570>>>>>>>>>>> if rval# ne -1 function_return CLASS.FUNCTION
62573>>>>>>>>>>> get iFileField.s of (pVM_Object(self)) name# to rval#
62574>>>>>>>>>>> if rval# function_return CLASS.FIELD
62577>>>>>>>>>>> function_return CLASS.UNKNOWN // Which is 0
62578>>>>>>>>>>> end_function // iSymbolClass.s
62579>>>>>>>>>>>
62579>>>>>>>>>>> function iIsIntegerConstant.s string value# returns integer
62581>>>>>>>>>>> integer pos# len#
62581>>>>>>>>>>> if (left(value#,1)="-") move (replace("-",value#,"")) to value# // monadic minus
62584>>>>>>>>>>> move (length(value#)) to len#
62585>>>>>>>>>>> if len# eq 0 function_return 1
62588>>>>>>>>>>> for pos# from 1 to len#
62594>>>>>>>>>>>>
62594>>>>>>>>>>> ifnot (mid(value#,1,pos#)) in "0123456789" function_return 0
62597>>>>>>>>>>> loop
62598>>>>>>>>>>>>
62598>>>>>>>>>>> function_return 1
62599>>>>>>>>>>> end_function
62600>>>>>>>>>>> function iIsNumberConstant.s string value# returns integer
62602>>>>>>>>>>> if "." in value# function_return (iIsIntegerConstant.s(self,replace(".",value#,"")))
62605>>>>>>>>>>> // function_return 0
62605>>>>>>>>>>> end_function
62606>>>>>>>>>>> function iIsStringConstant.s string value# returns integer
62608>>>>>>>>>>> string quote#
62608>>>>>>>>>>> move (left(value#,1)) to quote#
62609>>>>>>>>>>> if quote# in ("'"+'"') if (right(value#,1)) eq quote# if (length(value#)) ge 2 begin
62615>>>>>>>>>>> move (replace(quote#,value#,"")) to value#
62616>>>>>>>>>>> move (replace(quote#,value#,"")) to value#
62617>>>>>>>>>>> ifnot quote# in value# function_return 1
62620>>>>>>>>>>> end
62620>>>>>>>>>>>>
62620>>>>>>>>>>> // function_return 0
62620>>>>>>>>>>> end_function
62621>>>>>>>>>>> function iIsDateConstant.s string value# returns integer
62623>>>>>>>>>>> string m# d# y#
62623>>>>>>>>>>> ifnot " " in value# begin
62625>>>>>>>>>>> if (HowManyWords(value#,"/")=3) begin
62627>>>>>>>>>>> move (ExtractWord(value#,"/",1)) to m#
62628>>>>>>>>>>> move (ExtractWord(value#,"/",2)) to d#
62629>>>>>>>>>>> move (ExtractWord(value#,"/",3)) to y#
62630>>>>>>>>>>> if (iIsIntegerConstant.s(self,m#) and iIsIntegerConstant.s(self,d#) and iIsIntegerConstant.s(self,y#)) begin
62632>>>>>>>>>>> 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
62635>>>>>>>>>>> end
62635>>>>>>>>>>>>
62635>>>>>>>>>>> end
62635>>>>>>>>>>>>
62635>>>>>>>>>>> end
62635>>>>>>>>>>>>
62635>>>>>>>>>>> // function_return 0
62635>>>>>>>>>>> end_function
62636>>>>>>>>>>>
62636>>>>>>>>>>> function iConstType.s string value# returns integer
62638>>>>>>>>>>> // The function returns TRUE if name is a constant. In fact, it returns
62638>>>>>>>>>>> // the type of the constant IF indeed it is a constant
62638>>>>>>>>>>> if (iIsIntegerConstant.s(self,value#)) function_return TYPE.INTEGER
62641>>>>>>>>>>> if (iIsStringConstant.s(self,value#)) function_return TYPE.STRING
62644>>>>>>>>>>> if (iIsDateConstant.s(self,value#)) function_return TYPE.DATE
62647>>>>>>>>>>> if (iIsNumberConstant.s(self,value#)) function_return TYPE.NUMBER
62650>>>>>>>>>>> function_return TYPE.UNKNOWN
62651>>>>>>>>>>> end_function
62652>>>>>>>>>>>
62652>>>>>>>>>>> function iSymbolType.si string name# integer class# returns integer
62654>>>>>>>>>>> integer liType id# liFileField
62654>>>>>>>>>>> if class# eq CLASS.UNKNOWN get iSymbolClass.s name# to class#
62657>>>>>>>>>>> if class# eq CLASS.LABEL function_return TYPE.UNTYPED
62660>>>>>>>>>>> if class# eq CLASS.VAR begin
62662>>>>>>>>>>> get iVarType.s of (pVM_Object(self)) name# to liType
62663>>>>>>>>>>> if liType eq VARTYP_INTEGER function_return TYPE.INTEGER
62666>>>>>>>>>>> if liType eq VARTYP_NUMBER function_return TYPE.NUMBER
62669>>>>>>>>>>> if liType eq VARTYP_DATE function_return TYPE.DATE
62672>>>>>>>>>>> if liType eq VARTYP_STRING function_return TYPE.STRING
62675>>>>>>>>>>> end
62675>>>>>>>>>>>>
62675>>>>>>>>>>> if class# eq CLASS.CONST function_return (iConstType.s(self,name#))
62678>>>>>>>>>>> if class# eq CLASS.EXPR function_return TYPE.UNKNOWN
62681>>>>>>>>>>> if class# eq CLASS.KEYWORD function_return TYPE.UNTYPED
62684>>>>>>>>>>> if class# eq CLASS.COMMAND function_return TYPE.UNTYPED
62687>>>>>>>>>>> if class# eq CLASS.REPLACE_SYMBOL begin
62689>>>>>>>>>>> end
62689>>>>>>>>>>>>
62689>>>>>>>>>>> if class# eq CLASS.FUNCTION begin
62691>>>>>>>>>>> get iFuncNameToFuncNo.s of (pVM_Object(self)) name# to id#
62692>>>>>>>>>>> get iFuncType.i of (pVM_Object(self)) id# to liType
62693>>>>>>>>>>> if liType eq VARTYP_INTEGER function_return TYPE.INTEGER
62696>>>>>>>>>>> if liType eq VARTYP_NUMBER function_return TYPE.NUMBER
62699>>>>>>>>>>> if liType eq VARTYP_DATE function_return TYPE.DATE
62702>>>>>>>>>>> if liType eq VARTYP_STRING function_return TYPE.STRING
62705>>>>>>>>>>> end
62705>>>>>>>>>>>>
62705>>>>>>>>>>> if class# eq CLASS.FIELD begin
62707>>>>>>>>>>> get iFileField.s of (pVM_Object(self)) name# to liFileField
62708>>>>>>>>>>> get iFieldType.i of (pVM_Object(self)) liFileField to liType
62709>>>>>>>>>>> if liType eq FLDTYP_STRING function_return TYPE.STRING
62712>>>>>>>>>>> if liType eq FLDTYP_NUMBER function_return TYPE.NUMBER
62715>>>>>>>>>>> if liType eq FLDTYP_DATE function_return TYPE.DATE
62718>>>>>>>>>>> end
62718>>>>>>>>>>>>
62718>>>>>>>>>>> function_return TYPE.UNKNOWN
62719>>>>>>>>>>> end_function
62720>>>>>>>>>>>
62720>>>>>>>>>>> function iVM_ArgType.ii integer class# integer liType returns integer
62722>>>>>>>>>>> if class# eq CLASS.UNKNOWN function_return AT_NOT_VALID
62725>>>>>>>>>>> else if class# eq CLASS.LABEL function_return AT_LBL
62729>>>>>>>>>>> else if class# eq CLASS.VAR function_return AT_VAR
62733>>>>>>>>>>> else if class# eq CLASS.CONST begin
62736>>>>>>>>>>> if liType eq TYPE.UNKNOWN function_return AT_NOT_VALID
62739>>>>>>>>>>> else if liType eq TYPE.UNTYPED function_return AT_NOT_VALID
62743>>>>>>>>>>> else if liType eq TYPE.INTEGER function_return AT_CINT
62747>>>>>>>>>>> else if liType eq TYPE.STRING function_return AT_CSTR
62751>>>>>>>>>>> else if liType eq TYPE.NUMBER function_return AT_CNUM
62755>>>>>>>>>>> else if liType eq TYPE.DATE function_return AT_CDAT
62759>>>>>>>>>>> end
62759>>>>>>>>>>>>
62759>>>>>>>>>>> else if class# eq CLASS.EXPR function_return AT_EXPR
62763>>>>>>>>>>> else if class# eq CLASS.KEYWORD function_return AT_NOT_VALID
62767>>>>>>>>>>> else if class# eq CLASS.COMMAND function_return AT_NOT_VALID
62771>>>>>>>>>>> else if class# eq CLASS.REPLACE_SYMBOL function_return AT_NOT_VALID
62775>>>>>>>>>>> else if class# eq CLASS.FIELD function_return AT_FIELD
62779>>>>>>>>>>> function_return AT_NOT_VALID
62780>>>>>>>>>>> end_function
62781>>>>>>>>>>>
62781>>>>>>>>>>> function iVM_ArgType.i integer arg# returns integer
62783>>>>>>>>>>> function_return (iVM_ArgType.ii(self,piClass.i(self,arg#),piType.i(self,arg#)))
62784>>>>>>>>>>> end_function
62785>>>>>>>>>>>
62785>>>>>>>>>>> function sReplaceNameToNo.s string name# returns string
62787>>>>>>>>>>> function_return (sNameToValue.s(oReplaces(self),name#))
62788>>>>>>>>>>> end_function
62789>>>>>>>>>>>
62789>>>>>>>>>>> function iIsLegalVarName.s string name# returns integer
62791>>>>>>>>>>> integer pos# len#
62791>>>>>>>>>>> ifnot (left(name#,1)) in CHARLIST.SYMBOL.START function_return 0
62794>>>>>>>>>>> move (length(name#)) to len#
62795>>>>>>>>>>> for pos# from 1 to len#
62801>>>>>>>>>>>>
62801>>>>>>>>>>> ifnot (mid(name#,1,pos#)) in (CHARLIST.SYMBOL.START+CHARLIST.SYMBOL.CHAR) function_return 0
62804>>>>>>>>>>> loop
62805>>>>>>>>>>>>
62805>>>>>>>>>>> function_return 1
62806>>>>>>>>>>> end_function
62807>>>>>>>>>>>
62807>>>>>>>>>>> function iCheckNumberOfArguments.i integer should_be# returns integer
62809>>>>>>>>>>> integer max#
62809>>>>>>>>>>> get row_count to max#
62810>>>>>>>>>>> decrement max#
62811>>>>>>>>>>> if max# gt should_be# send ScriptError ERR.SCRIPT.TOO_MANY_ARGUMENTS 0
62814>>>>>>>>>>> if max# lt should_be# send ScriptError ERR.SCRIPT.MISSING_ARGUMENT 0
62817>>>>>>>>>>> if max# eq should_be# function_return 1
62820>>>>>>>>>>> end_function
62821>>>>>>>>>>>
62821>>>>>>>>>>> procedure declare_variable integer liType
62823>>>>>>>>>>> integer liRow max#
62823>>>>>>>>>>> string name#
62823>>>>>>>>>>> get row_count to max#
62824>>>>>>>>>>> for liRow from 1 to (max#-1)
62830>>>>>>>>>>>>
62830>>>>>>>>>>> get psItem.i liRow to name#
62831>>>>>>>>>>> move (uppercase(name#)) to name#
62832>>>>>>>>>>> if (iIsLegalVarName.s(self,name#)) begin
62834>>>>>>>>>>> ifnot (iSymbolClass.s(self,name#)) ; send declare_var to (pVM_Object(self)) name# liType
62837>>>>>>>>>>> else send ScriptError ERR.SCRIPT.SYMBOL_ALREADY_DEF (piPos.i(self,liRow)) ("Delaring variable: "+name#)
62839>>>>>>>>>>> end
62839>>>>>>>>>>>>
62839>>>>>>>>>>> else send ScriptError ERR.SCRIPT.ILLEGAL_VARNAME (piPos.i(self,liRow)) ("Delaring variable: "+name#)
62841>>>>>>>>>>> loop
62842>>>>>>>>>>>>
62842>>>>>>>>>>> end_procedure
62843>>>>>>>>>>>
62843>>>>>>>>>>> procedure replace_symbol string name# string value#
62845>>>>>>>>>>> move (uppercase(name#)) to name#
62846>>>>>>>>>>> if (iIsLegalVarName.s(self,name#)) begin
62848>>>>>>>>>>> ifnot (iSymbolClass.s(self,name#)) begin
62850>>>>>>>>>>> if (iNameDeclare.ss(oReplaces(self),name#,value#)) ; send ScriptError ERR.SCRIPT.CIRCULAR_REFERENCE 0 ("Defining replace: "+name#+" -> "+value#)
62853>>>>>>>>>>> end
62853>>>>>>>>>>>>
62853>>>>>>>>>>> else send ScriptError ERR.SCRIPT.SYMBOL_ALREADY_DEF 0 ("Defining replace: "+name#+" -> "+value#)
62855>>>>>>>>>>> end
62855>>>>>>>>>>>>
62855>>>>>>>>>>> else send ScriptError ERR.SCRIPT.ILLEGAL_SYMBNAME 0 ("Defining replace: "+name#+" -> "+value#)
62857>>>>>>>>>>> end_procedure
62858>>>>>>>>>>>
62858>>>>>>>>>>> // Symbol checking (positive logic):
62858>>>>>>>>>>> //
62858>>>>>>>>>>> // I Integer TYPE.INTEGER
62858>>>>>>>>>>> // D Date TYPE.DATE
62858>>>>>>>>>>> // N Number TYPE.NUMBER
62858>>>>>>>>>>> // S String TYPE.STRING
62858>>>>>>>>>>> // t Any type TYPE.INTEGER TYPE.DATE TYPE.NUMBER TYPE.STRING
62858>>>>>>>>>>>
62858>>>>>>>>>>> // C Constant CLASS.CONST
62858>>>>>>>>>>> // V Variable CLASS.VAR
62858>>>>>>>>>>> // E Expression CLASS.EXPR
62858>>>>>>>>>>> // F File element CLASS.FIELD
62858>>>>>>>>>>> // c Any of the above classes CLASS.CONST CLASS.VAR CLASS.EXPR CLASS.FIELD
62858>>>>>>>>>>>
62858>>>>>>>>>>> // L Label CLASS.LABEL
62858>>>>>>>>>>>
62858>>>>>>>>>>> // R Required -
62858>>>>>>>>>>> // U Untyped -
62858>>>>>>>>>>> // . No more arguments -
62858>>>>>>>>>>>
62858>>>>>>>>>>> function iCheckItemPattern.isi integer quiet# string pattern# integer arg# returns integer
62860>>>>>>>>>>> integer max# itm# rval# len# pos# liType class#
62860>>>>>>>>>>> string key_word# char#
62860>>>>>>>>>>> get piClass.i arg# to class#
62861>>>>>>>>>>> get piType.i arg# to liType
62862>>>>>>>>>>> if pattern# eq "L" begin
62864>>>>>>>>>>> if (class#=CLASS.LABEL or class#=CLASS.UNKNOWN) function_return 1
62867>>>>>>>>>>> ifnot quiet# send ScriptError ERR.SCRIPT.CLASS_CHECK_ERROR (piPos.i(self,arg#)) ("Symbol: "+psItem.i(self,arg#))
62870>>>>>>>>>>> function_return 0
62871>>>>>>>>>>> end
62871>>>>>>>>>>>>
62871>>>>>>>>>>> if '"' in pattern# begin // Keyword indication(s)
62873>>>>>>>>>>> move 0 to rval#
62874>>>>>>>>>>> move (HowManyWords(pattern#,'"')) to max#
62875>>>>>>>>>>> for itm# from 1 to max#
62881>>>>>>>>>>>>
62881>>>>>>>>>>> if (uppercase(psItem.i(self,arg#))) eq (uppercase(ExtractWord(pattern#,'"',itm#))) move 1 to rval#
62884>>>>>>>>>>> loop
62885>>>>>>>>>>>>
62885>>>>>>>>>>> ifnot rval# ifnot quiet# send ScriptError ERR.SCRIPT.KEYWORD_EXPECTED (piPos.i(self,arg#))
62890>>>>>>>>>>> end
62890>>>>>>>>>>>>
62890>>>>>>>>>>> else begin
62891>>>>>>>>>>> move (length(pattern#)) to len#
62892>>>>>>>>>>> move 1 to rval#
62893>>>>>>>>>>> for pos# from 1 to len#
62899>>>>>>>>>>>>
62899>>>>>>>>>>> move (mid(pattern#,1,pos#)) to char#
62900>>>>>>>>>>> if (char#=".") begin
62902>>>>>>>>>>> if (row_count(self)>arg#) begin
62904>>>>>>>>>>> ifnot quiet# send ScriptError ERR.SCRIPT.TOO_MANY_ARGUMENTS (piPos.i(self,arg#))
62907>>>>>>>>>>> function_return 0
62908>>>>>>>>>>> end
62908>>>>>>>>>>>>
62908>>>>>>>>>>> else function_return 1 // There are no more arguments!
62910>>>>>>>>>>> end
62910>>>>>>>>>>>>
62910>>>>>>>>>>> if (char#="R" and row_count(self)<arg#+1) begin
62912>>>>>>>>>>> ifnot quiet# send ScriptError ERR.SCRIPT.MISSING_ARGUMENT 0
62915>>>>>>>>>>> function_return 0
62916>>>>>>>>>>> end
62916>>>>>>>>>>>>
62916>>>>>>>>>>> if (char#="U" and not(piType.i(self,arg#)=TYPE.UNKNOWN or piType.i(self,arg#)=TYPE.UNTYPED)) begin
62918>>>>>>>>>>> ifnot quiet# send ScriptError ERR.SCRIPT.ARGUMENT_TYPED (piPos.i(self,arg#))
62921>>>>>>>>>>> function_return 0
62922>>>>>>>>>>> end
62922>>>>>>>>>>>>
62922>>>>>>>>>>> loop
62923>>>>>>>>>>>>
62923>>>>>>>>>>> if rval# begin // If we pass the above testing
62925>>>>>>>>>>> move 0 to rval#
62926>>>>>>>>>>> if class# eq CLASS.CONST if "C" in pattern# move 1 to rval#
62931>>>>>>>>>>> if class# eq CLASS.CONST if "c" in pattern# move 1 to rval#
62936>>>>>>>>>>> if class# eq CLASS.VAR if "V" in pattern# move 1 to rval#
62941>>>>>>>>>>> if class# eq CLASS.VAR if "c" in pattern# move 1 to rval#
62946>>>>>>>>>>> if class# eq CLASS.EXPR if "E" in pattern# move 1 to rval#
62951>>>>>>>>>>> if class# eq CLASS.EXPR if "c" in pattern# move 1 to rval#
62956>>>>>>>>>>> if class# eq CLASS.FIELD if "F" in pattern# move 1 to rval#
62961>>>>>>>>>>> if class# eq CLASS.FIELD if "c" in pattern# move 1 to rval#
62966>>>>>>>>>>> if class# eq CLASS.LABEL if "L" in pattern# move 1 to rval#
62971>>>>>>>>>>> if class# eq CLASS.UNKNOWN if "U" in pattern# move 1 to rval#
62976>>>>>>>>>>> if rval# begin
62978>>>>>>>>>>> move 0 to rval#
62979>>>>>>>>>>> if liType eq TYPE.INTEGER if "I" in pattern# move 1 to rval#
62984>>>>>>>>>>> if liType eq TYPE.INTEGER if "t" in pattern# move 1 to rval#
62989>>>>>>>>>>> if liType eq TYPE.DATE if "D" in pattern# move 1 to rval#
62994>>>>>>>>>>> if liType eq TYPE.DATE if "t" in pattern# move 1 to rval#
62999>>>>>>>>>>> if liType eq TYPE.NUMBER if "N" in pattern# move 1 to rval#
63004>>>>>>>>>>> if liType eq TYPE.NUMBER if "t" in pattern# move 1 to rval#
63009>>>>>>>>>>> if liType eq TYPE.STRING if "S" in pattern# move 1 to rval#
63014>>>>>>>>>>> if liType eq TYPE.STRING if "t" in pattern# move 1 to rval#
63019>>>>>>>>>>> if liType eq TYPE.UNKNOWN if "U" in pattern# move 1 to rval#
63024>>>>>>>>>>> if liType eq TYPE.UNTYPED if "U" in pattern# move 1 to rval#
63029>>>>>>>>>>> ifnot rval# ifnot quiet# send ScriptError ERR.SCRIPT.TYPE_CHECK_ERROR (piPos.i(self,arg#))
63034>>>>>>>>>>> end
63034>>>>>>>>>>>>
63034>>>>>>>>>>> else ifnot quiet# send ScriptError ERR.SCRIPT.CLASS_CHECK_ERROR (piPos.i(self,arg#)) ("Symbol: "+psItem.i(self,arg#))
63038>>>>>>>>>>> end
63038>>>>>>>>>>>>
63038>>>>>>>>>>> end
63038>>>>>>>>>>>>
63038>>>>>>>>>>> function_return rval#
63039>>>>>>>>>>> end_function
63040>>>>>>>>>>>
63040>>>>>>>>>>> function iCheckPattern.is integer quiet# string pattern# returns integer
63042>>>>>>>>>>> integer itm# max# rval#
63042>>>>>>>>>>> move (HowManyWords(pattern#," ")) to max#
63043>>>>>>>>>>> move 1 to rval#
63044>>>>>>>>>>> for itm# from 1 to max#
63050>>>>>>>>>>>>
63050>>>>>>>>>>> if rval# get iCheckItemPattern.isi quiet# (ExtractWord(pattern#," ",itm#)) itm# to rval#
63053>>>>>>>>>>> loop
63054>>>>>>>>>>>>
63054>>>>>>>>>>> function_return rval#
63055>>>>>>>>>>> end_function
63056>>>>>>>>>>>
63056>>>>>>>>>>> function iStructureCheck.i integer cmd# returns integer
63058>>>>>>>>>>> integer obj# shouldbe# rval# pos#
63058>>>>>>>>>>> move (piPos.i(self,0)) to pos#
63059>>>>>>>>>>> move 1 to rval#
63060>>>>>>>>>>> move (oStructuralStack(self)) to obj#
63061>>>>>>>>>>> if (item_count(obj#)) begin
63063>>>>>>>>>>> get iTopPendingCmd of obj# to shouldbe#
63064>>>>>>>>>>> send pop_struct to obj#
63065>>>>>>>>>>> if shouldbe# ne cmd# begin
63067>>>>>>>>>>> if shouldbe# eq CMD_END send ScriptError ERR.SCRIPT.SHOULD_BE_END pos#
63070>>>>>>>>>>> if shouldbe# eq CMD_ENDIF send ScriptError ERR.SCRIPT.SHOULD_BE_ENDIF pos#
63073>>>>>>>>>>> if shouldbe# eq CMD_LOOP send ScriptError ERR.SCRIPT.SHOULD_BE_LOOP pos#
63076>>>>>>>>>>> if shouldbe# eq CMD_UNTIL send ScriptError ERR.SCRIPT.SHOULD_BE_UNTIL pos#
63079>>>>>>>>>>> move 0 to rval#
63080>>>>>>>>>>> end
63080>>>>>>>>>>>>
63080>>>>>>>>>>> end
63080>>>>>>>>>>>>
63080>>>>>>>>>>> else begin
63081>>>>>>>>>>> if cmd# eq CMD_END send ScriptError ERR.SCRIPT.UNINITIATED_END pos#
63084>>>>>>>>>>> if cmd# eq CMD_ENDIF send ScriptError ERR.SCRIPT.UNINITIATED_ENDIF pos#
63087>>>>>>>>>>> if cmd# eq CMD_LOOP send ScriptError ERR.SCRIPT.UNINITIATED_LOOP pos#
63090>>>>>>>>>>> if cmd# eq CMD_UNTIL send ScriptError ERR.SCRIPT.UNINITIATED_UNTIL pos#
63093>>>>>>>>>>> move 0 to rval#
63094>>>>>>>>>>> end
63094>>>>>>>>>>>>
63094>>>>>>>>>>> function_return rval#
63095>>>>>>>>>>> end_function
63096>>>>>>>>>>> // ==================== INTERPRETATION METHODS ====================
63096>>>>>>>>>>> procedure Interpret_Date
63098>>>>>>>>>>> send declare_variable VARTYP_DATE
63099>>>>>>>>>>> end_procedure
63100>>>>>>>>>>> procedure Interpret_If
63102>>>>>>>>>>> integer comp#
63102>>>>>>>>>>> send push_struct to (oStructuralStack(self)) CMD_IF CMD_ENDIF (psFileName(self)) (piLine(self))
63103>>>>>>>>>>> if (iCheckPattern.is(self,1,'ct .')) begin
63105>>>>>>>>>>> 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
63108>>>>>>>>>>> end
63108>>>>>>>>>>>>
63108>>>>>>>>>>> else begin
63109>>>>>>>>>>> if (iCheckPattern.is(self,0,'ct "LT""LE""EQ""NE""GE""GT" ct .')) begin
63111>>>>>>>>>>> move (iCompStringToInt.s(psItem.i(self,2))) to comp#
63112>>>>>>>>>>> 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))
63113>>>>>>>>>>> end
63113>>>>>>>>>>>>
63113>>>>>>>>>>> end
63113>>>>>>>>>>>>
63113>>>>>>>>>>> end_procedure
63114>>>>>>>>>>> procedure Interpret_Else
63116>>>>>>>>>>> integer cmd#
63116>>>>>>>>>>> if (iCheckPattern.is(self,0,'.')) begin
63118>>>>>>>>>>> get iTopStackingCmd of (oStructuralStack(self)) to cmd#
63119>>>>>>>>>>> if cmd# eq CMD_IF send add_instruction to (pVM_Object(self)) OP_ELSE
63122>>>>>>>>>>> else send ScriptError ERR.SCRIPT.UNINITIATED_ELSE (piPos.i(self,0))
63124>>>>>>>>>>> end
63124>>>>>>>>>>>>
63124>>>>>>>>>>> end_procedure
63125>>>>>>>>>>> procedure Interpret_EndIf
63127>>>>>>>>>>> if (iStructureCheck.i(self,CMD_ENDIF) and iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_ENDIF
63130>>>>>>>>>>> end_procedure
63131>>>>>>>>>>> procedure Interpret_End
63133>>>>>>>>>>> integer cmd#
63133>>>>>>>>>>> get iTopStackingCmd of (oStructuralStack(self)) to cmd#
63134>>>>>>>>>>> if (iStructureCheck.i(self,CMD_END) and iCheckPattern.is(self,0,'.')) begin
63136>>>>>>>>>>> if cmd# eq CMD_WHILE send add_instruction to (pVM_Object(self)) OP_LOOP
63139>>>>>>>>>>> else send add_instruction to (pVM_Object(self)) OP_ENDIF
63141>>>>>>>>>>> end
63141>>>>>>>>>>>>
63141>>>>>>>>>>> end_procedure
63142>>>>>>>>>>> procedure Interpret_For // For iVar FROM cI TO
63144>>>>>>>>>>> send push_struct to (oStructuralStack(self)) CMD_FOR CMD_LOOP (psFileName(self)) (piLine(self))
63145>>>>>>>>>>> if (iCheckPattern.is(self,0,'IV "FROM" Ic "TO" Ic .')) begin
63147>>>>>>>>>>> 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))
63148>>>>>>>>>>> end
63148>>>>>>>>>>>>
63148>>>>>>>>>>> end_procedure
63149>>>>>>>>>>> procedure Interpret_While
63151>>>>>>>>>>> integer comp#
63151>>>>>>>>>>> send push_struct to (oStructuralStack(self)) CMD_WHILE CMD_END (psFileName(self)) (piLine(self))
63152>>>>>>>>>>> if (iCheckPattern.is(self,1,'ct .')) begin
63154>>>>>>>>>>> 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
63157>>>>>>>>>>> end
63157>>>>>>>>>>>>
63157>>>>>>>>>>> else begin
63158>>>>>>>>>>> if (iCheckPattern.is(self,0,'ct "LT""LE""NE""EQ""GE""GT" ct .')) begin
63160>>>>>>>>>>> move (iCompStringToInt.s(psItem.i(self,2))) to comp#
63161>>>>>>>>>>> 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))
63162>>>>>>>>>>> end
63162>>>>>>>>>>>>
63162>>>>>>>>>>> end
63162>>>>>>>>>>>>
63162>>>>>>>>>>> end_procedure
63163>>>>>>>>>>> procedure Interpret_Gosub
63165>>>>>>>>>>> if (iCheckPattern.is(self,0,'L .')) send add_instruction to (pVM_Object(self)) OP_GOSUB AT_LBL (psItem.i(self,1))
63168>>>>>>>>>>> end_procedure
63169>>>>>>>>>>> procedure Interpret_Goto
63171>>>>>>>>>>> if (iCheckPattern.is(self,0,'L .')) send add_instruction to (pVM_Object(self)) OP_GOTO AT_LBL (psItem.i(self,1))
63174>>>>>>>>>>> end_procedure
63175>>>>>>>>>>> procedure Interpret_Pause
63177>>>>>>>>>>> if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_PAUSE
63180>>>>>>>>>>> end_procedure
63181>>>>>>>>>>> procedure Interpret_GotoXY
63183>>>>>>>>>>> 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))
63186>>>>>>>>>>> end_procedure
63187>>>>>>>>>>> procedure Interpret_Input
63189>>>>>>>>>>> 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))
63192>>>>>>>>>>> end_procedure
63193>>>>>>>>>>> procedure Interpret_Integer
63195>>>>>>>>>>> send declare_variable VARTYP_INTEGER
63196>>>>>>>>>>> end_procedure
63197>>>>>>>>>>> procedure Interpret_Loop
63199>>>>>>>>>>> if (iStructureCheck.i(self,CMD_LOOP) and iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_LOOP
63202>>>>>>>>>>> end_procedure
63203>>>>>>>>>>> procedure Interpret_Move
63205>>>>>>>>>>> integer liClass
63205>>>>>>>>>>> if (iCheckPattern.is(self,0,'Rtc "TO" RtVF .')) begin
63207>>>>>>>>>>>// send obs OP_ASSIGN AT_VAR (psItem.i(self,3)) (iVM_ArgType.i(self,1)) (psItem.i(self,1))
63207>>>>>>>>>>> get piClass.i 3 to liClass // Class of target
63208>>>>>>>>>>> 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))
63211>>>>>>>>>>> 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))
63214>>>>>>>>>>> end
63214>>>>>>>>>>>>
63214>>>>>>>>>>> end_procedure
63215>>>>>>>>>>> procedure Interpret_Number
63217>>>>>>>>>>> send declare_variable VARTYP_NUMBER
63218>>>>>>>>>>> end_procedure
63219>>>>>>>>>>> procedure Interpret_Return
63221>>>>>>>>>>> if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_RETURN
63224>>>>>>>>>>> end_procedure
63225>>>>>>>>>>> procedure Interpret_Showln
63227>>>>>>>>>>> send Interpret_Show
63228>>>>>>>>>>> send add_instruction to (pVM_Object(self)) OP_SHOWLN AT_CSTR ""
63229>>>>>>>>>>> end_procedure
63230>>>>>>>>>>> procedure Interpret_Show
63232>>>>>>>>>>> integer arg# max#
63232>>>>>>>>>>> get row_count to max#
63233>>>>>>>>>>> for arg# from 1 to (max#-1)
63239>>>>>>>>>>>>
63239>>>>>>>>>>> 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#))
63242>>>>>>>>>>> loop
63243>>>>>>>>>>>>
63243>>>>>>>>>>> end_procedure
63244>>>>>>>>>>> procedure Interpret_String
63246>>>>>>>>>>> send declare_variable VARTYP_STRING
63247>>>>>>>>>>> end_procedure
63248>>>>>>>>>>> procedure Interpret_ClearScreen
63250>>>>>>>>>>> if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_CLEARSCREEN
63253>>>>>>>>>>> end_procedure
63254>>>>>>>>>>> procedure Interpret_Abort
63256>>>>>>>>>>> if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_ABORT
63259>>>>>>>>>>> end_procedure
63260>>>>>>>>>>> procedure Interpret_#use
63262>>>>>>>>>>> end_procedure
63263>>>>>>>>>>> procedure Interpret_#include
63265>>>>>>>>>>> end_procedure
63266>>>>>>>>>>> procedure Interpret_Increment
63268>>>>>>>>>>> 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
63271>>>>>>>>>>> end_procedure
63272>>>>>>>>>>> procedure Interpret_Decrement
63274>>>>>>>>>>> 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
63277>>>>>>>>>>> end_procedure
63278>>>>>>>>>>> procedure Interpret_#noisy
63280>>>>>>>>>>> if (iCheckPattern.is(self,0,'CI .')) set piDebugState to (integer(psItem.i(self,1)))
63283>>>>>>>>>>> end_procedure
63284>>>>>>>>>>> procedure Interpret_#replace
63286>>>>>>>>>>> if (iCheckNumberOfArguments.i(self,2)) send replace_symbol (psItem.i(self,1)) (psItem.i(self,2))
63289>>>>>>>>>>> end_procedure
63290>>>>>>>>>>> procedure Interpret_Debug
63292>>>>>>>>>>> string mode#
63292>>>>>>>>>>> if (iCheckPattern.is(self,0,'"ON""OFF""SINGLE_STEP""DISPLAY_VAR" .')) begin
63294>>>>>>>>>>> move (uppercase(psItem.i(self,1))) to mode#
63295>>>>>>>>>>> if mode# eq "ON" send add_instruction to (pVM_Object(self)) OP_DEBUG AT_CINT DBG.ON
63298>>>>>>>>>>> else if mode# eq "OFF" send add_instruction to (pVM_Object(self)) OP_DEBUG AT_CINT DBG.OFF
63302>>>>>>>>>>> else if mode# eq "SINGLE_STEP" send add_instruction to (pVM_Object(self)) OP_DEBUG AT_CINT DBG.SINGLESTEP
63306>>>>>>>>>>> else if mode# eq "DISPLAY_VAR" send add_instruction to (pVM_Object(self)) OP_DEBUG AT_CINT DBG.VARDISPLAY
63310>>>>>>>>>>> else send ScriptError ERR.SCRIPT.KEYWORD_DEBUG (piPos.i(self,1))
63312>>>>>>>>>>> end
63312>>>>>>>>>>>>
63312>>>>>>>>>>> end_procedure
63313>>>>>>>>>>> procedure Interpret_Repeat
63315>>>>>>>>>>> send push_struct to (oStructuralStack(self)) CMD_REPEAT CMD_UNTIL (psFileName(self)) (piLine(self))
63316>>>>>>>>>>> if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_REPEAT
63319>>>>>>>>>>> end_procedure
63320>>>>>>>>>>> procedure Interpret_Until
63322>>>>>>>>>>> integer comp#
63322>>>>>>>>>>> if (iCheckPattern.is(self,1,'ct .')) begin
63324>>>>>>>>>>> if (iCheckPattern.is(self,0,'cI .')) begin
63326>>>>>>>>>>> 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
63329>>>>>>>>>>> end
63329>>>>>>>>>>>>
63329>>>>>>>>>>> end
63329>>>>>>>>>>>>
63329>>>>>>>>>>> else begin
63330>>>>>>>>>>> if (iStructureCheck.i(self,CMD_UNTIL) and iCheckPattern.is(self,0,'ct "LT""LE""EQ""NE""GE""GT" ct .')) begin
63332>>>>>>>>>>> move (iCompStringToInt.s(psItem.i(self,2))) to comp#
63333>>>>>>>>>>> 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))
63334>>>>>>>>>>> end
63334>>>>>>>>>>>>
63334>>>>>>>>>>> end
63334>>>>>>>>>>>>
63334>>>>>>>>>>> end_procedure
63335>>>>>>>>>>> procedure Interpret_Log_Open
63337>>>>>>>>>>> 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))
63340>>>>>>>>>>> end_procedure
63341>>>>>>>>>>> procedure Interpret_Log_Close
63343>>>>>>>>>>> if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_LOG_CLOSE
63346>>>>>>>>>>> end_procedure
63347>>>>>>>>>>> procedure Interpret_Log_Display
63349>>>>>>>>>>> if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_LOG_DISPLAY
63352>>>>>>>>>>> end_procedure
63353>>>>>>>>>>> procedure Interpret_Log_Flush
63355>>>>>>>>>>> if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_LOG_FLUSH
63358>>>>>>>>>>> end_procedure
63359>>>>>>>>>>> procedure Interpret_Log_Write
63361>>>>>>>>>>> integer arg# max#
63361>>>>>>>>>>> get row_count to max#
63362>>>>>>>>>>> for arg# from 1 to (max#-1)
63368>>>>>>>>>>>>
63368>>>>>>>>>>> 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#))
63371>>>>>>>>>>> loop
63372>>>>>>>>>>>>
63372>>>>>>>>>>> end_procedure
63373>>>>>>>>>>> procedure Interpret_Log_Writeln
63375>>>>>>>>>>> send Interpret_Log_Write
63376>>>>>>>>>>> send add_instruction to (pVM_Object(self)) OP_LOG_WRITELN AT_CSTR ""
63377>>>>>>>>>>> end_procedure
63378>>>>>>>>>>> procedure Interpret_Set_Attribute // liType
63380>>>>>>>>>>> integer params# attr# liRow max# attrtype#
63380>>>>>>>>>>> integer t1# t2# t3# t4# t5# t6#
63380>>>>>>>>>>> string a1# a2# a3# a4# a5# a6#
63380>>>>>>>>>>> if (iCheckPattern.is(self,1,'CI')) begin
63382>>>>>>>>>>> // If we go in this branch an explicit attribute was specified
63382>>>>>>>>>>> // and we are therefore able to check the number of parameters
63382>>>>>>>>>>> move (psItem.i(self,1)) to attr#
63383>>>>>>>>>>> ifnot (API_Attr_WriteAccess(attr#)) send ScriptError ERR.SCRIPT.ATTR_NO_SET (piPos.i(self,1)) (API_Attr_Name(attr#))
63386>>>>>>>>>>> move (API_Attr_NumberOfParams(attr#)) to params#
63387>>>>>>>>>>> if (API_AttrWorksOnStructure(attr#)) decrement params# // For these attributes the file handle is implicit
63390>>>>>>>>>>> if (iCheckItemPattern.isi(self,0,'"TO"',params#+2)) begin
63392>>>>>>>>>>> move (API_AttrType(attr#)) to attrtype#
63393>>>>>>>>>>> if (attrtype#=ATTRTYPE_FILELIST or attrtype#=ATTRTYPE_FILE or attrtype#=ATTRTYPE_FIELD or attrtype#=ATTRTYPE_INDEX or attrtype#=ATTRTYPE_IDXSEG) begin
63395>>>>>>>>>>> if attrtype# eq ATTRTYPE_FILELIST begin
63397>>>>>>>>>>> move (iVM_ArgType.i(self,2)) to t2#
63398>>>>>>>>>>> move (psItem.i(self,2)) to a2#
63399>>>>>>>>>>> move (iVM_ArgType.i(self,4)) to t4#
63400>>>>>>>>>>> move (psItem.i(self,4)) to a4#
63401>>>>>>>>>>> send add_instruction to (pVM_Object(self)) OP_API_FILELIST AT_CINT attr# t2# a2# t4# a4#
63402>>>>>>>>>>> end
63402>>>>>>>>>>>>
63402>>>>>>>>>>> if attrtype# eq ATTRTYPE_FILE begin
63404>>>>>>>>>>> move (iVM_ArgType.i(self,3)) to t3#
63405>>>>>>>>>>> move (psItem.i(self,3)) to a3#
63406>>>>>>>>>>> send add_instruction to (pVM_Object(self)) OP_API_FILE AT_CINT attr# t3# a3#
63407>>>>>>>>>>> end
63407>>>>>>>>>>>>
63407>>>>>>>>>>> if attrtype# eq ATTRTYPE_FIELD begin
63409>>>>>>>>>>> move (iVM_ArgType.i(self,2)) to t2#
63410>>>>>>>>>>> move (psItem.i(self,2)) to a2#
63411>>>>>>>>>>> move (iVM_ArgType.i(self,4)) to t4#
63412>>>>>>>>>>> move (psItem.i(self,4)) to a4#
63413>>>>>>>>>>> send add_instruction to (pVM_Object(self)) OP_API_FIELD AT_CINT attr# t2# a2# t4# a4#
63414>>>>>>>>>>> end
63414>>>>>>>>>>>>
63414>>>>>>>>>>> if attrtype# eq ATTRTYPE_INDEX begin
63416>>>>>>>>>>> move (iVM_ArgType.i(self,2)) to t2#
63417>>>>>>>>>>> move (psItem.i(self,2)) to a2#
63418>>>>>>>>>>> move (iVM_ArgType.i(self,4)) to t4#
63419>>>>>>>>>>> move (psItem.i(self,4)) to a4#
63420>>>>>>>>>>> send add_instruction to (pVM_Object(self)) OP_API_INDEX AT_CINT attr# t2# a2# t4# a4#
63421>>>>>>>>>>> end
63421>>>>>>>>>>>>
63421>>>>>>>>>>> if attrtype# eq ATTRTYPE_IDXSEG begin
63423>>>>>>>>>>> move (iVM_ArgType.i(self,2)) to t2#
63424>>>>>>>>>>> move (psItem.i(self,2)) to a2#
63425>>>>>>>>>>> move (iVM_ArgType.i(self,3)) to t3#
63426>>>>>>>>>>> move (psItem.i(self,3)) to a3#
63427>>>>>>>>>>> move (iVM_ArgType.i(self,5)) to t5#
63428>>>>>>>>>>> move (psItem.i(self,5)) to a5#
63429>>>>>>>>>>> send add_instruction to (pVM_Object(self)) OP_API_IDXSEG AT_CINT attr# t2# a2# t3# a3# t5# a5#
63430>>>>>>>>>>> end
63430>>>>>>>>>>>>
63430>>>>>>>>>>> end
63430>>>>>>>>>>>>
63430>>>>>>>>>>> else begin
63431>>>>>>>>>>> // OK, it's got to be one of these which we do not support setting:
63431>>>>>>>>>>> // ATTRTYPE_GLOBAL ATTRTYPE_DRIVER ATTRTYPE_DRVSRV
63431>>>>>>>>>>> // ATTRTYPE_SPECIAL1 ATTRTYPE_FLSTNAV
63431>>>>>>>>>>> send ScriptError ERR.SCRIPT.ATTR_NO_CHANGING (piPos.i(self,1))
63432>>>>>>>>>>> end
63432>>>>>>>>>>>>
63432>>>>>>>>>>> end
63432>>>>>>>>>>>>
63432>>>>>>>>>>> end
63432>>>>>>>>>>>>
63432>>>>>>>>>>> else begin
63433>>>>>>>>>>> // If we go in this branch an attribute in the form of a variable was
63433>>>>>>>>>>> // handed, and we just fill up with parameters. We can't type check it
63433>>>>>>>>>>> // until we execute it and know which attribute is actually set.
63433>>>>>>>>>>> send ScriptError ERR.SCRIPT.ATTR_IMPLICIT (piPos.i(self,1))
63434>>>>>>>>>>> end
63434>>>>>>>>>>>>
63434>>>>>>>>>>> end_procedure
63435>>>>>>>>>>> procedure Interpret_Create_Field // field# name# liType
63437>>>>>>>>>>> integer t1# t2# t3#
63437>>>>>>>>>>> string a1# a2# a3#
63437>>>>>>>>>>> if (iCheckPattern.is(self,0,'cI cS cI .')) begin
63439>>>>>>>>>>> move (iVM_ArgType.i(self,1)) to t1#
63440>>>>>>>>>>> move (iVM_ArgType.i(self,2)) to t2#
63441>>>>>>>>>>> move (iVM_ArgType.i(self,3)) to t3#
63442>>>>>>>>>>> move (psItem.i(self,1)) to a1#
63443>>>>>>>>>>> move (psItem.i(self,2)) to a2#
63444>>>>>>>>>>> move (psItem.i(self,3)) to a3#
63445>>>>>>>>>>> send add_instruction to (pVM_Object(self)) OP_API_CREATEFIELD t1# a1# t2# a2# t3# a3#
63446>>>>>>>>>>> end
63446>>>>>>>>>>>>
63446>>>>>>>>>>> end_procedure
63447>>>>>>>>>>> procedure Interpret_Append_Field // name liType
63449>>>>>>>>>>> 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))
63452>>>>>>>>>>> end_procedure
63453>>>>>>>>>>> procedure Interpret_Delete_Field //
63455>>>>>>>>>>> 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))
63458>>>>>>>>>>> end_procedure
63459>>>>>>>>>>> procedure Interpret_Delete_Index //
63461>>>>>>>>>>> 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))
63464>>>>>>>>>>> end_procedure
63465>>>>>>>>>>> procedure Interpret_Structure_Abort
63467>>>>>>>>>>> if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_API_STRUCTURE_ABORT
63470>>>>>>>>>>> end_procedure
63471>>>>>>>>>>> procedure Interpret_Structure_End
63473>>>>>>>>>>> if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_API_STRUCTURE_END
63476>>>>>>>>>>> end_procedure
63477>>>>>>>>>>> procedure Interpret_Probe_End
63479>>>>>>>>>>> if (iCheckPattern.is(self,0,'.')) send add_instruction to (pVM_Object(self)) OP_API_PROBE_END
63482>>>>>>>>>>> end_procedure
63483>>>>>>>>>>> procedure Interpret_Set_Field //
63485>>>>>>>>>>> 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))
63488>>>>>>>>>>> end_procedure
63489>>>>>>>>>>> procedure Interpret_InfoBox
63491>>>>>>>>>>> if (iCheckPattern.is(self,0,'ct .')) send add_instruction to (pVM_Object(self)) OP_MSGBOX (iVM_ArgType.i(self,1)) (psItem.i(self,1))
63494>>>>>>>>>>> end_procedure
63495>>>>>>>>>>>
63495>>>>>>>>>>> procedure add_item.si string str# integer pos#
63497>>>>>>>>>>> integer liRow
63497>>>>>>>>>>> get row_count to liRow
63498>>>>>>>>>>> set psItem.i liRow to str#
63499>>>>>>>>>>> set piPos.i liRow to pos#
63500>>>>>>>>>>> set piClass.i liRow to CLASS.UNKNOWN
63501>>>>>>>>>>> set piType.i liRow to TYPE.UNKNOWN
63502>>>>>>>>>>> end_procedure
63503>>>>>>>>>>>
63503>>>>>>>>>>> enumeration_list
63503>>>>>>>>>>> define ITEMTYPE.NOT_IN_ITEM
63503>>>>>>>>>>> define ITEMTYPE.UNKNOWN
63503>>>>>>>>>>> define ITEMTYPE.STRING_CONSTANT
63503>>>>>>>>>>> define ITEMTYPE.EXPRESSION
63503>>>>>>>>>>> define ITEMTYPE.EXPRESSION_STRING_PART
63503>>>>>>>>>>> end_enumeration_list
63503>>>>>>>>>>>
63503>>>>>>>>>>> procedure split_line_in_items string str#
63505>>>>>>>>>>> integer pos# len# start_pos# item_type# error_code# error_pos# balance# comment#
63505>>>>>>>>>>> string item# char# decr_balance_char# incr_balance_char#
63505>>>>>>>>>>> string expr_string_const_stopper#
63505>>>>>>>>>>> move (length(str#)) to len#
63506>>>>>>>>>>> move 0 to start_pos#
63507>>>>>>>>>>> move 0 to comment#
63508>>>>>>>>>>> move "" to item#
63509>>>>>>>>>>> move ERR.SCRIPT.NO_ERROR to error_code#
63510>>>>>>>>>>> move 0 to error_pos#
63511>>>>>>>>>>> move ITEMTYPE.NOT_IN_ITEM to item_type#
63512>>>>>>>>>>> for pos# from 1 to len#
63518>>>>>>>>>>>>
63518>>>>>>>>>>> if (error_code#=0 and comment#<>2) begin
63520>>>>>>>>>>> move (mid(str#,1,pos#)) to char#
63521>>>>>>>>>>> if start_pos# begin // We are currently in an item
63523>>>>>>>>>>> if comment# begin
63525>>>>>>>>>>> if char# eq "/" begin
63527>>>>>>>>>>> move 0 to start_pos#
63528>>>>>>>>>>> move 2 to comment#
63529>>>>>>>>>>> end
63529>>>>>>>>>>>>
63529>>>>>>>>>>> else move 0 to comment#
63531>>>>>>>>>>> end
63531>>>>>>>>>>>>
63531>>>>>>>>>>> if comment# ne 2 begin
63533>>>>>>>>>>> if item_type# eq ITEMTYPE.EXPRESSION_STRING_PART begin
63535>>>>>>>>>>> if char# eq expr_string_const_stopper# begin
63537>>>>>>>>>>> move ITEMTYPE.EXPRESSION to item_type#
63538>>>>>>>>>>> end
63538>>>>>>>>>>>>
63538>>>>>>>>>>> move (item#+char#) to item#
63539>>>>>>>>>>> end
63539>>>>>>>>>>>>
63539>>>>>>>>>>> else if item_type# eq ITEMTYPE.EXPRESSION begin
63542>>>>>>>>>>> if char# eq '"' begin
63544>>>>>>>>>>> move ITEMTYPE.EXPRESSION_STRING_PART to item_type#
63545>>>>>>>>>>> move char# to expr_string_const_stopper#
63546>>>>>>>>>>> end
63546>>>>>>>>>>>>
63546>>>>>>>>>>> if char# eq "'" begin
63548>>>>>>>>>>> move ITEMTYPE.EXPRESSION_STRING_PART to item_type#
63549>>>>>>>>>>> move char# to expr_string_const_stopper#
63550>>>>>>>>>>> end
63550>>>>>>>>>>>>
63550>>>>>>>>>>> if char# eq decr_balance_char# decrement balance#
63553>>>>>>>>>>> if char# eq incr_balance_char# increment balance#
63556>>>>>>>>>>> move (item#+char#) to item#
63557>>>>>>>>>>> if balance# eq 0 begin
63559>>>>>>>>>>> send add_item.si item# start_pos#
63560>>>>>>>>>>> move 0 to start_pos#
63561>>>>>>>>>>> move "" to item#
63562>>>>>>>>>>> move ITEMTYPE.NOT_IN_ITEM to item_type#
63563>>>>>>>>>>> end
63563>>>>>>>>>>>>
63563>>>>>>>>>>> end
63563>>>>>>>>>>>>
63563>>>>>>>>>>> else if item_type# eq ITEMTYPE.STRING_CONSTANT begin
63566>>>>>>>>>>> move (item#+char#) to item#
63567>>>>>>>>>>> if char# eq decr_balance_char# begin
63569>>>>>>>>>>> send add_item.si item# start_pos#
63570>>>>>>>>>>> move 0 to start_pos#
63571>>>>>>>>>>> move "" to item#
63572>>>>>>>>>>> move ITEMTYPE.NOT_IN_ITEM to item_type#
63573>>>>>>>>>>> end
63573>>>>>>>>>>>>
63573>>>>>>>>>>> end
63573>>>>>>>>>>>>
63573>>>>>>>>>>> else if item_type# eq ITEMTYPE.UNKNOWN begin
63576>>>>>>>>>>> if char# eq " " begin
63578>>>>>>>>>>> send add_item.si item# start_pos#
63579>>>>>>>>>>> move 0 to start_pos#
63580>>>>>>>>>>> move "" to item#
63581>>>>>>>>>>> move ITEMTYPE.NOT_IN_ITEM to item_type#
63582>>>>>>>>>>> end
63582>>>>>>>>>>>>
63582>>>>>>>>>>> else begin
63583>>>>>>>>>>> move (item#+char#) to item#
63584>>>>>>>>>>> if char# eq ":" begin
63586>>>>>>>>>>> send add_item.si item# start_pos#
63587>>>>>>>>>>> move 0 to start_pos#
63588>>>>>>>>>>> move "" to item#
63589>>>>>>>>>>> move ITEMTYPE.NOT_IN_ITEM to item_type#
63590>>>>>>>>>>> end
63590>>>>>>>>>>>>
63590>>>>>>>>>>> end
63590>>>>>>>>>>>>
63590>>>>>>>>>>> end
63590>>>>>>>>>>>>
63590>>>>>>>>>>> end
63590>>>>>>>>>>>>
63590>>>>>>>>>>> end
63590>>>>>>>>>>>>
63590>>>>>>>>>>> else begin // We are currently not in an item
63591>>>>>>>>>>> if char# eq "/" ifnot comment# increment comment#
63596>>>>>>>>>>> if char# ne " " begin
63598>>>>>>>>>>> if char# in CHARLIST.ILLEGAL_ITEM_START begin
63600>>>>>>>>>>> move ERR.SCRIPT.ERROR_ILLEGAL_CHAR to error_code#
63601>>>>>>>>>>> move pos# to error_pos#
63602>>>>>>>>>>> end
63602>>>>>>>>>>>>
63602>>>>>>>>>>> else begin
63603>>>>>>>>>>> if char# eq "(" begin
63605>>>>>>>>>>> move "(" to incr_balance_char#
63606>>>>>>>>>>> move ")" to decr_balance_char#
63607>>>>>>>>>>> move 1 to balance#
63608>>>>>>>>>>> move ITEMTYPE.EXPRESSION to item_type#
63609>>>>>>>>>>> end
63609>>>>>>>>>>>>
63609>>>>>>>>>>> else if char# eq "{" begin
63612>>>>>>>>>>> move "{" to incr_balance_char#
63613>>>>>>>>>>> move "}" to decr_balance_char#
63614>>>>>>>>>>> move 1 to balance#
63615>>>>>>>>>>> move ITEMTYPE.EXPRESSION to item_type#
63616>>>>>>>>>>> end
63616>>>>>>>>>>>>
63616>>>>>>>>>>> else if char# eq "[" begin
63619>>>>>>>>>>> move "[" to incr_balance_char#
63620>>>>>>>>>>> move "]" to decr_balance_char#
63621>>>>>>>>>>> move 1 to balance#
63622>>>>>>>>>>> move ITEMTYPE.EXPRESSION to item_type#
63623>>>>>>>>>>> end
63623>>>>>>>>>>>>
63623>>>>>>>>>>> else if char# eq "'" begin
63626>>>>>>>>>>> move "'" to decr_balance_char#
63627>>>>>>>>>>> move ITEMTYPE.STRING_CONSTANT to item_type#
63628>>>>>>>>>>> end
63628>>>>>>>>>>>>
63628>>>>>>>>>>> else if char# eq '"' begin
63631>>>>>>>>>>> move '"' to decr_balance_char#
63632>>>>>>>>>>> move ITEMTYPE.STRING_CONSTANT to item_type#
63633>>>>>>>>>>> end
63633>>>>>>>>>>>>
63633>>>>>>>>>>> else move ITEMTYPE.UNKNOWN to item_type#
63635>>>>>>>>>>> move char# to item#
63636>>>>>>>>>>> move pos# to start_pos#
63637>>>>>>>>>>> end
63637>>>>>>>>>>>>
63637>>>>>>>>>>> end
63637>>>>>>>>>>>>
63637>>>>>>>>>>> end
63637>>>>>>>>>>>>
63637>>>>>>>>>>> end
63637>>>>>>>>>>>>
63637>>>>>>>>>>> loop
63638>>>>>>>>>>>>
63638>>>>>>>>>>> if start_pos# send add_item.si item# start_pos#
63641>>>>>>>>>>> if (error_code#=0 and item_type#=ITEMTYPE.STRING_CONSTANT) begin
63643>>>>>>>>>>> move ERR.SCRIPT.MISSING_END_QUOTE to error_code#
63644>>>>>>>>>>> move pos# to error_pos#
63645>>>>>>>>>>> end
63645>>>>>>>>>>>>
63645>>>>>>>>>>> if error_code# ne ERR.SCRIPT.NO_ERROR send ScriptError error_code# error_pos#
63648>>>>>>>>>>> end_procedure
63649>>>>>>>>>>>
63649>>>>>>>>>>> // Label declarations are supposed to be at the beginning of the line.
63649>>>>>>>>>>> // The DoLabels procedure will declare any such labels in the VM and
63649>>>>>>>>>>> // remove them from the list of items.
63649>>>>>>>>>>> procedure DoLabels
63651>>>>>>>>>>> integer liRow max# islabel#
63651>>>>>>>>>>> string str#
63651>>>>>>>>>>> get row_count to max#
63652>>>>>>>>>>> move 0 to liRow
63653>>>>>>>>>>> repeat
63653>>>>>>>>>>>>
63653>>>>>>>>>>> get psItem.i liRow to str#
63654>>>>>>>>>>> get iIsLabelDeclaration.s str# to islabel#
63655>>>>>>>>>>> if islabel# begin
63657>>>>>>>>>>> move (StringLeftBut(str#,1)) to str#
63658>>>>>>>>>>> ifnot (iSymbolClass.s(self,str#)) send declare_label to (pVM_Object(self)) str#
63661>>>>>>>>>>> else send ScriptError ERR.SCRIPT.SYMBOL_ALREADY_DEF (piPos.i(self,liRow))
63663>>>>>>>>>>> increment liRow
63664>>>>>>>>>>> end
63664>>>>>>>>>>>>
63664>>>>>>>>>>> until (not(islabel#))
63666>>>>>>>>>>> // Now, delete the labels from the list:
63666>>>>>>>>>>> decrement liRow
63667>>>>>>>>>>> while liRow ge 0
63671>>>>>>>>>>> send delete_row liRow
63672>>>>>>>>>>> decrement liRow
63673>>>>>>>>>>> loop
63674>>>>>>>>>>>>
63674>>>>>>>>>>> end_procedure
63675>>>>>>>>>>>
63675>>>>>>>>>>> procedure DoCommand
63677>>>>>>>>>>> integer cmd#
63677>>>>>>>>>>> if (row_count(self)) begin
63679>>>>>>>>>>> // Get Command ID of command in row 0:
63679>>>>>>>>>>> get iCommand.s (psItem.i(self,0)) to cmd#
63680>>>>>>>>>>> // Set the aux value of row 0 to the Command ID
63680>>>>>>>>>>> if cmd# ge 0 set piAuxVal.i 0 to cmd#
63683>>>>>>>>>>> else send ScriptError ERR.SCRIPT.COMMAND_NOT_FOUND (piPos.i(self,0)) ("Command: "+psItem.i(self,0))
63685>>>>>>>>>>> end
63685>>>>>>>>>>>>
63685>>>>>>>>>>> end_procedure
63686>>>>>>>>>>>
63686>>>>>>>>>>> procedure DoReplaces // Perform symbol replaces
63688>>>>>>>>>>> integer liRow max#
63688>>>>>>>>>>> get row_count to max#
63689>>>>>>>>>>> for liRow from 1 to (max#-1) // We do not replace the command column
63695>>>>>>>>>>>>
63695>>>>>>>>>>> set psItem.i liRow to (sReplaceNameToNo.s(self,psItem.i(self,liRow)))
63696>>>>>>>>>>> loop
63697>>>>>>>>>>>>
63697>>>>>>>>>>> end_procedure
63698>>>>>>>>>>>
63698>>>>>>>>>>> procedure DoClassColumn // Identify the classes
63700>>>>>>>>>>> integer liRow max# liClass
63700>>>>>>>>>>> string lsItem
63700>>>>>>>>>>> get row_count to max#
63701>>>>>>>>>>> for liRow from 0 to (max#-1)
63707>>>>>>>>>>>>
63707>>>>>>>>>>> get psItem.i liRow to lsItem
63708>>>>>>>>>>> get iSymbolClass.s lsItem to liClass
63709>>>>>>>>>>> set piClass.i liRow to liClass
63710>>>>>>>>>>> loop
63711>>>>>>>>>>>>
63711>>>>>>>>>>> end_procedure
63712>>>>>>>>>>>
63712>>>>>>>>>>> procedure DoTypeColumn // Identify the types
63714>>>>>>>>>>> integer liRow max#
63714>>>>>>>>>>> get row_count to max#
63715>>>>>>>>>>> for liRow from 0 to (max#-1)
63721>>>>>>>>>>>>
63721>>>>>>>>>>> set piType.i liRow to (iSymbolType.si(self,psItem.i(self,liRow),piClass.i(self,liRow)))
63722>>>>>>>>>>> loop
63723>>>>>>>>>>>>
63723>>>>>>>>>>> end_procedure
63724>>>>>>>>>>>
63724>>>>>>>>>>> procedure DoExpressions
63726>>>>>>>>>>> integer liRow max# exprid#
63726>>>>>>>>>>> get row_count to max#
63727>>>>>>>>>>> for liRow from 1 to (max#-1)
63733>>>>>>>>>>>>
63733>>>>>>>>>>> if (piErrorCode(self)=ERR.SCRIPT.NO_ERROR) begin
63735>>>>>>>>>>> if (piClass.i(self,liRow)=CLASS.EXPR and piType.i(self,liRow)=TYPE.UNKNOWN) begin
63737>>>>>>>>>>> set psExprBeingParsed to (psItem.i(self,liRow))
63738>>>>>>>>>>> get iParse_expression.si of (oExpressionParser(self)) (psItem.i(self,liRow)) (piPos.i(self,liRow)) to exprid#
63739>>>>>>>>>>> set piType.i liRow to (piExprType(oExpressionParser(self)))
63740>>>>>>>>>>> set psItem.i liRow to exprid#
63741>>>>>>>>>>> if (piDebugState(self)) send DisplayExpressionDebugInfo (oExpressionParser(self))
63744>>>>>>>>>>> end
63744>>>>>>>>>>>>
63744>>>>>>>>>>> end
63744>>>>>>>>>>>>
63744>>>>>>>>>>> end
63745>>>>>>>>>>>>
63745>>>>>>>>>>> end_procedure
63746>>>>>>>>>>>
63746>>>>>>>>>>> procedure DoPrepareArguments
63748>>>>>>>>>>> integer liRow max#
63748>>>>>>>>>>> get row_count to max#
63749>>>>>>>>>>> for liRow from 1 to (max#-1)
63755>>>>>>>>>>>>
63755>>>>>>>>>>> // Remove quotation characters from string constants:
63755>>>>>>>>>>> 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))
63758>>>>>>>>>>> loop
63759>>>>>>>>>>>>
63759>>>>>>>>>>> end_procedure
63760>>>>>>>>>>>
63760>>>>>>>>>>> procedure parse_line string str# integer line# string fn#
63762>>>>>>>>>>> integer msg#
63762>>>>>>>>>>> set piErrorCode to 0
63763>>>>>>>>>>> set piErrorPos to 0
63764>>>>>>>>>>> set piLine to line#
63765>>>>>>>>>>> set psFileName to fn#
63766>>>>>>>>>>> set psLineBeingParsed to str#
63767>>>>>>>>>>> send ListingFileWriteLn (string(piProgramCounter(pVM_Object(self)))+"> "+str#)
63768>>>>>>>>>>> send delete_data
63769>>>>>>>>>>> send split_line_in_items str#
63770>>>>>>>>>>> ifnot (piErrorCode(self)) begin
63772>>>>>>>>>>> send DoLabels //
63773>>>>>>>>>>> send DoCommand
63774>>>>>>>>>>> ifnot (piErrorCode(self)) begin
63776>>>>>>>>>>> ifnot (piErrorCode(self)) send DoReplaces
63779>>>>>>>>>>> ifnot (piErrorCode(self)) send DoClassColumn
63782>>>>>>>>>>> ifnot (piErrorCode(self)) send DoTypeColumn
63785>>>>>>>>>>> ifnot (piErrorCode(self)) send DoExpressions
63788>>>>>>>>>>> ifnot (piErrorCode(self)) send DoPrepareArguments
63791>>>>>>>>>>> get piCompileMsg.i of (oCommandList(self)) (piAuxVal.i(self,0)) to msg#
63792>>>>>>>>>>> ifnot (piErrorCode(self)) send msg#
63795>>>>>>>>>>> end
63795>>>>>>>>>>>>
63795>>>>>>>>>>> end
63795>>>>>>>>>>>>
63795>>>>>>>>>>> if (piErrorCode(self)) ne ERR.SCRIPT.NO_ERROR set piInvalidProgram of (pVM_Object(self)) to true
63798>>>>>>>>>>> if (piDebugState(self) and item_count(self)) send DisplayInterpreterDebugInfo self
63801>>>>>>>>>>> end_procedure
63802>>>>>>>>>>> function iParse_Line.sis string str# integer line# string fn# returns integer
63804>>>>>>>>>>> send parse_line str# line# fn#
63805>>>>>>>>>>> if (piErrorCode(self)) function_return (piLine(self)*65536+piErrorPos(self))
63808>>>>>>>>>>> //function_return 0
63808>>>>>>>>>>> end_function
63809>>>>>>>>>>> // After having called this function you may query the piExprType
63809>>>>>>>>>>> // and piExprID properties
63809>>>>>>>>>>> function iParse_Expr.s string lsExpression returns integer
63811>>>>>>>>>>> integer lhExpr
63811>>>>>>>>>>> set piErrorCode to 0
63812>>>>>>>>>>> set piErrorPos to 0
63813>>>>>>>>>>> set piLine to 0
63814>>>>>>>>>>> set psFileName to "Expression"
63815>>>>>>>>>>>// send obs lsExpression
63815>>>>>>>>>>> get iParse_expression.si of (oExpressionParser(self)) lsExpression 1 to lhExpr
63816>>>>>>>>>>> set piExprType to (piExprType(oExpressionParser(self)))
63817>>>>>>>>>>> set piExprID to lhExpr
63818>>>>>>>>>>> if (piDebugState(self)) send DisplayExpressionDebugInfo (oExpressionParser(self))
63821>>>>>>>>>>> if (piErrorCode(self)) function_return (piLine(self)*65536+piErrorPos(self))
63824>>>>>>>>>>> //function_return 0
63824>>>>>>>>>>> end_function
63825>>>>>>>>>>> procedure ListingFileWriteLn string str#
63827>>>>>>>>>>> if (piListingFileState(self)) writeln channel (piListingFileCh(self)) str#
63832>>>>>>>>>>> end_procedure
63833>>>>>>>>>>> procedure script_begin
63835>>>>>>>>>>> if (piListingFileState(self)) begin
63837>>>>>>>>>>> set piListingFileCh to (SEQ_DirectOutput(psListingFile(self)))
63838>>>>>>>>>>> send ListingFileWriteLn "Script interpreter listing file"
63839>>>>>>>>>>> send ListingFileWriteLn (string(dSysdate())+", "+sSysTime())
63840>>>>>>>>>>> end
63840>>>>>>>>>>>>
63840>>>>>>>>>>> send reset
63841>>>>>>>>>>> send script_begin to (pVM_Object(self))
63842>>>>>>>>>>> end_procedure
63843>>>>>>>>>>> procedure script_end
63845>>>>>>>>>>> if (item_count(oStructuralStack(self))) send ScriptError ERR.SCRIPT.UNFINISHED_STRUCT 0
63848>>>>>>>>>>> send script_end to (pVM_Object(self))
63849>>>>>>>>>>> if (piListingFileState(self)) send SEQ_CloseOutput (piListingFileCh(self))
63852>>>>>>>>>>> end_procedure
63853>>>>>>>>>>> procedure run_script
63855>>>>>>>>>>> send run_script to (pVM_Object(self))
63856>>>>>>>>>>> end_procedure
63857>>>>>>>>>>>end_class // cScriptInterpreter
63858>>>>>>>>>>>
63858>>>>>>>>>>>object oDFScriptParserTest is a aps.ModalPanel label "Line being parsed"
63861>>>>>>>>>>> set locate_mode to CENTER_ON_SCREEN
63862>>>>>>>>>>> object oFrm is a aps.Form abstract AFT_ASCII80
63865>>>>>>>>>>> set object_shadow_state to true
63866>>>>>>>>>>> end_object
63867>>>>>>>>>>> send aps_goto_max_row
63868>>>>>>>>>>> object oLst is a aps.Grid
63870>>>>>>>>>>> set highlight_row_state to true
63871>>>>>>>>>>> set highlight_row_color to (rgb(0,255,255))
63872>>>>>>>>>>> set current_item_color to (rgb(0,255,255))
63873>>>>>>>>>>> set select_mode to no_select
63874>>>>>>>>>>> set size to 196 0
63875>>>>>>>>>>> set line_width to 5 0
63876>>>>>>>>>>> set form_margin item 0 to 35
63877>>>>>>>>>>> set form_margin item 1 to 4
63878>>>>>>>>>>> set form_margin item 2 to 13
63879>>>>>>>>>>> set form_margin item 3 to 13
63880>>>>>>>>>>> set form_margin item 4 to 6
63881>>>>>>>>>>> set header_label item 0 to "Item"
63882>>>>>>>>>>> set header_label item 1 to "Pos"
63883>>>>>>>>>>> set header_label item 2 to "Class"
63884>>>>>>>>>>> set header_label item 3 to "Type"
63885>>>>>>>>>>> set header_label item 4 to "Aux"
63886>>>>>>>>>>> on_key knext_item send switch
63887>>>>>>>>>>> on_key kprevious_item send switch_back
63888>>>>>>>>>>> procedure fill_list.i integer obj#
63891>>>>>>>>>>> integer max# liRow pos# class# liType aux#
63891>>>>>>>>>>> string str#
63891>>>>>>>>>>> send delete_data
63892>>>>>>>>>>> get row_count of obj# to max#
63893>>>>>>>>>>> for liRow from 0 to (max#-1)
63899>>>>>>>>>>>>
63899>>>>>>>>>>> get psItem.i of obj# liRow to str#
63900>>>>>>>>>>> get piPos.i of obj# liRow to pos#
63901>>>>>>>>>>> get piClass.i of obj# liRow to class#
63902>>>>>>>>>>> get piType.i of obj# liRow to liType
63903>>>>>>>>>>> get piAuxVal.i of obj# liRow to aux#
63904>>>>>>>>>>> send add_item msg_none str#
63905>>>>>>>>>>> send add_item msg_none (string(pos#))
63906>>>>>>>>>>> send add_item msg_none (dfscript_item_class(class#))
63907>>>>>>>>>>> send add_item msg_none (dfscript_item_type(liType))
63908>>>>>>>>>>> send add_item msg_none (string(aux#))
63909>>>>>>>>>>> loop
63910>>>>>>>>>>>>
63910>>>>>>>>>>> get item_count to max#
63911>>>>>>>>>>> for liRow from 0 to (max#-1)
63917>>>>>>>>>>>>
63917>>>>>>>>>>> set entry_state item liRow to false
63918>>>>>>>>>>> loop
63919>>>>>>>>>>>>
63919>>>>>>>>>>> end_procedure
63920>>>>>>>>>>> end_object
63921>>>>>>>>>>> object oBtn is a aps.Multi_Button
63923>>>>>>>>>>> on_item t.btn.close send close_panel
63924>>>>>>>>>>> end_object
63925>>>>>>>>>>> send aps_locate_multi_buttons
63926>>>>>>>>>>> procedure run.i integer obj#
63929>>>>>>>>>>> set value of (oFrm(self)) item 0 to (psLineBeingParsed(obj#))
63930>>>>>>>>>>> send fill_list.i to (oLst(self)) obj#
63931>>>>>>>>>>> send popup
63932>>>>>>>>>>> end_procedure
63933>>>>>>>>>>>end_object
63934>>>>>>>>>>>
63934>>>>>>>>>>>procedure DisplayInterpreterDebugInfo global integer obj#
63936>>>>>>>>>>> send run.i to (oDFScriptParserTest(self)) obj#
63937>>>>>>>>>>>end_procedure
63938>>>>>>>>>>>
63938>>>>>>>>>>>object oDFScriptExprTest is a aps.ModalPanel label "Expression parsed"
63941>>>>>>>>>>> set locate_mode to CENTER_ON_SCREEN
63942>>>>>>>>>>> object oFrm is a aps.Form abstract AFT_ASCII80
63945>>>>>>>>>>> set object_shadow_state to true
63946>>>>>>>>>>> end_object
63947>>>>>>>>>>> send aps_goto_max_row
63948>>>>>>>>>>> object oLst is a aps.Grid
63950>>>>>>>>>>> set line_width to 8 0
63951>>>>>>>>>>> set highlight_row_state to true
63952>>>>>>>>>>> set highlight_row_color to (rgb(0,255,255))
63953>>>>>>>>>>> set current_item_color to (rgb(0,255,255))
63954>>>>>>>>>>> set select_mode to no_select
63955>>>>>>>>>>> set size to 196 0
63956>>>>>>>>>>> set form_margin item 0 to 14
63957>>>>>>>>>>> set form_margin item 1 to 4
63958>>>>>>>>>>> set form_margin item 2 to 6
63959>>>>>>>>>>> set form_margin item 3 to 3
63960>>>>>>>>>>> set form_margin item 4 to 8
63961>>>>>>>>>>> set form_margin item 5 to 7
63962>>>>>>>>>>> set form_margin item 6 to 3
63963>>>>>>>>>>> set form_margin item 7 to 3
63964>>>>>>>>>>> set header_label item 0 to "Item"
63965>>>>>>>>>>> set header_label item 1 to "Pos"
63966>>>>>>>>>>> set header_label item 2 to "EIT"
63967>>>>>>>>>>> set header_label item 3 to "Opr"
63968>>>>>>>>>>> set header_label item 4 to "Class"
63969>>>>>>>>>>> set header_label item 5 to "Type"
63970>>>>>>>>>>> set header_label item 6 to "Lvl"
63971>>>>>>>>>>> set header_label item 7 to "Par"
63972>>>>>>>>>>> on_key kenter send close_panel
63973>>>>>>>>>>> on_key knext_item send switch
63974>>>>>>>>>>> on_key kprevious_item send switch_back
63975>>>>>>>>>>> procedure fill_list.i integer obj#
63978>>>>>>>>>>> string item#
63978>>>>>>>>>>> integer pos# class# liType structtype# level# max# liRow params# op_type#
63978>>>>>>>>>>> send delete_data
63979>>>>>>>>>>> get row_count of obj# to max#
63980>>>>>>>>>>> for liRow from 0 to (max#-1)
63986>>>>>>>>>>>>
63986>>>>>>>>>>> get psItem.i of obj# liRow to item# // The item in clear text
63987>>>>>>>>>>> get piStructType.i of obj# liRow to structtype# // What part of the expression is this?
63988>>>>>>>>>>> get piPos.i of obj# liRow to pos# // What is the starting position?
63989>>>>>>>>>>> get piClass.i of obj# liRow to class# // If item, what is item class?
63990>>>>>>>>>>> get piType.i of obj# liRow to liType // If item, what is item type?
63991>>>>>>>>>>> get piEvalLevel.i of obj# liRow to level# // When evaluating
63992>>>>>>>>>>> get piFuncParams.i of obj# liRow to params# // Number of params#
63993>>>>>>>>>>> get piOperator.i of obj# liRow to op_type# // If operator, which one?
63994>>>>>>>>>>>
63994>>>>>>>>>>> send add_item msg_none item#
63995>>>>>>>>>>> send add_item msg_none (string(pos#))
63996>>>>>>>>>>> send add_item msg_none (ExprItemType_Text(structtype#))
63997>>>>>>>>>>> send add_item msg_none (sOperatorSymbol.i(op_type#))
63998>>>>>>>>>>> if (structtype#=EIT.SYMBOL or structtype#=EIT.LEFT or structtype#=EIT.COMMA) begin
64000>>>>>>>>>>> send add_item msg_none (dfscript_item_class(class#))
64001>>>>>>>>>>> send add_item msg_none (dfscript_item_type(liType))
64002>>>>>>>>>>> end
64002>>>>>>>>>>>>
64002>>>>>>>>>>> else begin
64003>>>>>>>>>>> send add_item msg_none ""
64004>>>>>>>>>>> send add_item msg_none ""
64005>>>>>>>>>>> end
64005>>>>>>>>>>>>
64005>>>>>>>>>>> send add_item msg_none (string(level#))
64006>>>>>>>>>>> send add_item msg_none (string(params#))
64007>>>>>>>>>>> loop
64008>>>>>>>>>>>>
64008>>>>>>>>>>> get item_count to max#
64009>>>>>>>>>>> for liRow from 0 to (max#-1)
64015>>>>>>>>>>>>
64015>>>>>>>>>>> set entry_state item liRow to false
64016>>>>>>>>>>> loop
64017>>>>>>>>>>>>
64017>>>>>>>>>>> end_procedure
64018>>>>>>>>>>> end_object
64019>>>>>>>>>>> object oBtn is a aps.Multi_Button
64021>>>>>>>>>>> on_item t.btn.close send close_panel
64022>>>>>>>>>>> end_object
64023>>>>>>>>>>> send aps_locate_multi_buttons
64024>>>>>>>>>>> procedure run.i integer obj#
64027>>>>>>>>>>> set value of (oFrm(self)) item 0 to (psExprBeingParsed(obj#))
64028>>>>>>>>>>> send fill_list.i to (oLst(self)) obj#
64029>>>>>>>>>>> send popup
64030>>>>>>>>>>> end_procedure
64031>>>>>>>>>>>end_object
64032>>>>>>>>>>>
64032>>>>>>>>>>>procedure DisplayExpressionDebugInfo global integer obj#
64034>>>>>>>>>>> send run.i to (oDFScriptExprTest(self)) obj#
64035>>>>>>>>>>>end_procedure
64036>>>>>>>>>>>
64036>>>>>>>>>>>object oDFScriptExprSequence is a aps.ModalPanel label "Expression evaluation sequence"
64039>>>>>>>>>>> set locate_mode to CENTER_ON_SCREEN
64040>>>>>>>>>>> object oLst is a aps.Grid
64042>>>>>>>>>>> set line_width to 2 0
64043>>>>>>>>>>> set highlight_row_state to true
64044>>>>>>>>>>> set highlight_row_color to (rgb(0,255,255))
64045>>>>>>>>>>> set current_item_color to (rgb(0,255,255))
64046>>>>>>>>>>> set select_mode to no_select
64047>>>>>>>>>>> set size to 196 0
64048>>>>>>>>>>> set form_margin item 0 to 14
64049>>>>>>>>>>> set form_margin item 1 to 60
64050>>>>>>>>>>> set header_label item 0 to "OP-Code"
64051>>>>>>>>>>> set header_label item 1 to "Value"
64052>>>>>>>>>>> on_key kenter send close_panel
64053>>>>>>>>>>> on_key knext_item send switch
64054>>>>>>>>>>> on_key kprevious_item send switch_back
64055>>>>>>>>>>> procedure fill_list.i integer obj#
64058>>>>>>>>>>> integer max# liRow class# op# liType
64058>>>>>>>>>>> string val#
64058>>>>>>>>>>> send delete_data
64059>>>>>>>>>>> get row_count of obj# to max#
64060>>>>>>>>>>> for liRow from 0 to (max#-1)
64066>>>>>>>>>>>>
64066>>>>>>>>>>> get piOpCode.i of obj# liRow to op#
64067>>>>>>>>>>> get psVar.i of obj# liRow to val#
64068>>>>>>>>>>> send add_item msg_none (sExprOp_Text.i(op#))
64069>>>>>>>>>>> send add_item msg_none val#
64070>>>>>>>>>>> loop
64071>>>>>>>>>>>>
64071>>>>>>>>>>> end_procedure
64072>>>>>>>>>>> end_object
64073>>>>>>>>>>> object oBtn is a aps.Multi_Button
64075>>>>>>>>>>> on_item t.btn.close send close_panel
64076>>>>>>>>>>> end_object
64077>>>>>>>>>>> send aps_locate_multi_buttons
64078>>>>>>>>>>> procedure run.i integer obj#
64081>>>>>>>>>>> integer grb#
64081>>>>>>>>>>> send fill_list.i to (oLst(self)) obj#
64082>>>>>>>>>>> send popup
64083>>>>>>>>>>> end_procedure
64084>>>>>>>>>>>end_object
64085>>>>>>>>>>>procedure DisplayEvalSequence global integer obj#
64087>>>>>>>>>>> send run.i to (oDFScriptExprSequence(self)) obj#
64088>>>>>>>>>>>end_procedure
64089>>>>>>>>>>>
64089>>>>>>>>>Use vMachine.utl // Virtual machine class (heart of DFScript)
64089>>>>>>>>>Use Strings.utl // String manipulation for VDF
64089>>>>>>>>>Use FDX_Attr.nui // FDX compatible attribute functions
64089>>>>>>>>>Use FdxField.utl // FDX Field things
64089>>>>>>>>>
64089>>>>>>>>> define t.QryExpr.Expression for "Expression"
64089>>>>>>>>> define t.QryExpr.Tables for "Tables"
64089>>>>>>>>> define t.QryExpr.Fields for "Fields"
64089>>>>>>>>> define t.QryExpr.Functions for "Functions"
64089>>>>>>>>> define t.QryExpr.LongLabel for "Long label"
64089>>>>>>>>> define t.QryExpr.ShortLabel for "Short label"
64089>>>>>>>>> define t.QryExpr.Width for "Width"
64089>>>>>>>>> define t.QryExpr._Characters for " characters"
64089>>>>>>>>> define t.QryExpr.ReturnType for "Return type"
64089>>>>>>>>> define t.QryExpr.EditNumExpr for "Edit numeric expression"
64089>>>>>>>>> define t.QryExpr.EditStrExpr for "Edit string expression"
64089>>>>>>>>> define t.QryExpr.EditDatExpr for "Edit date expression"
64089>>>>>>>>> define t.QryExpr.CreateCC_1 for "Create calculated column"
64089>>>>>>>>> define t.QryExpr.CreateCC_2 for "Edit calculated column (#"
64089>>>>>>>>> define t.QryExpr.Type_Numeric for "Numeric"
64089>>>>>>>>> define t.QryExpr.Type_String for "String"
64089>>>>>>>>> define t.QryExpr.Type_Text for "Text"
64089>>>>>>>>> define t.QryExpr.Type_Date for "Date"
64089>>>>>>>>> define t.QryExpr.DecimalPlaces for "Decimal places"
64089>>>>>>>>>
64089>>>>>>>>>// The cVirtualMachine is subclassed in order to
64089>>>>>>>>>class cQueryExpressionVirtualMachine is a cVirtualMachine
64090>>>>>>>>> procedure construct_object integer liImage
64092>>>>>>>>> forward send construct_object liImage
64094>>>>>>>>> property integer pbAllowAllState public DFFALSE
64095>>>>>>>>> object oAllowedTables is a cSet NO_IMAGE
64097>>>>>>>>> end_object
64098>>>>>>>>> end_procedure
64099>>>>>>>>>
64099>>>>>>>>> procedure AllowedTables_Reset
64101>>>>>>>>> send delete_data to (oAllowedTables(self))
64102>>>>>>>>> end_procedure
64103>>>>>>>>> procedure AllowedTables_Add integer liFile
64105>>>>>>>>> send element_add to (oAllowedTables(self)) liFile
64106>>>>>>>>> end_procedure
64107>>>>>>>>>
64107>>>>>>>>> function iFileField.s string lsSymbol returns integer
64109>>>>>>>>> string lsFile lsField
64109>>>>>>>>> integer liFile liField lhFdx liRval
64109>>>>>>>>> move (uppercase(ExtractWord(lsSymbol,".",1))) to lsFile
64110>>>>>>>>> move (uppercase(ExtractWord(lsSymbol,".",2))) to lsField
64111>>>>>>>>> get phFDX_Server to lhFdx
64112>>>>>>>>> if (lsFile<>"" and lsField<>"") begin
64114>>>>>>>>> get FDX_FindLogicalName lhFdx lsFile 0 to liFile
64115>>>>>>>>> if (liFile>-1 and (pbAllowAllState(self) or element_find(oAllowedTables(self),liFile)<>-1)) begin
64117>>>>>>>>> forward get iFileField.s lsSymbol to liRval
64119>>>>>>>>> function_return liRval
64120>>>>>>>>> end
64120>>>>>>>>>>
64120>>>>>>>>> end
64120>>>>>>>>>>
64120>>>>>>>>> function_return 0
64121>>>>>>>>> end_function
64122>>>>>>>>>end_class // cQueryExpressionVirtualMachine
64123>>>>>>>>>
64123>>>>>>>>>class cQueryExpression is a cScriptInterpreter
64124>>>>>>>>> procedure construct_object integer liImage
64126>>>>>>>>> forward send construct_object liImage
64128>>>>>>>>> set piListingFileState to DFFALSE
64129>>>>>>>>> object oArray is a cArray NO_IMAGE
64131>>>>>>>>> end_object
64132>>>>>>>>> end_procedure
64133>>>>>>>>> function sPrepareExpression.s string lsExpression returns string
64135>>>>>>>>> integer lhArr liPos
64135>>>>>>>>> string lsChar10
64135>>>>>>>>> move (oArray(self)) to lhArr
64136>>>>>>>>> move (character(10)) to lsChar10
64137>>>>>>>>> send delete_data to lhArr
64138>>>>>>>>> repeat
64138>>>>>>>>>>
64138>>>>>>>>> move (pos(lsChar10,lsExpression)) to liPos
64139>>>>>>>>> if liPos begin
64141>>>>>>>>> set value of lhArr item (item_count(lhArr)) to liPos
64142>>>>>>>>> move (replace(lsChar10,lsExpression,"")) to lsExpression
64143>>>>>>>>> end
64143>>>>>>>>>>
64143>>>>>>>>> until (liPos=0)
64145>>>>>>>>> function_return lsExpression
64146>>>>>>>>> end_function
64147>>>>>>>>> function iTheRealErrorPosition integer liErrorPos returns integer
64149>>>>>>>>> integer lhArr liItem liMax liLen liLine
64149>>>>>>>>> move (oArray(self)) to lhArr
64150>>>>>>>>> get item_count of lhArr to liMax
64151>>>>>>>>> move 0 to liItem
64152>>>>>>>>> move 1 to liLine
64153>>>>>>>>> repeat
64153>>>>>>>>>>
64153>>>>>>>>> if (liItem<liMax) begin
64155>>>>>>>>> get value of lhArr item liItem to liLen
64156>>>>>>>>> if (liErrorPos>liLen) begin
64158>>>>>>>>> move (liErrorPos-liLen+1) to liErrorPos
64159>>>>>>>>> increment liLine
64160>>>>>>>>> end
64160>>>>>>>>>>
64160>>>>>>>>> else function_return (liLine*65536+liErrorPos)
64162>>>>>>>>> increment liItem
64163>>>>>>>>> end
64163>>>>>>>>>>
64163>>>>>>>>> until (liItem>=liMax)
64165>>>>>>>>> function_return (liLine*65536+liErrorPos)
64166>>>>>>>>> end_function
64167>>>>>>>>>end_class // cQueryExpression
64168>>>>>>>>>
64168>>>>>>>>>desktop_section
64173>>>>>>>>> object Query_ExprEvaluator is a cQueryExpressionVirtualMachine NO_IMAGE
64175>>>>>>>>> end_object
64176>>>>>>>>>
64176>>>>>>>>> object Query_ExprParser is a cQueryExpression NO_IMAGE
64178>>>>>>>>> set pVM_Object to (Query_ExprEvaluator(self))
64179>>>>>>>>> procedure AllowedTables_Reset
64182>>>>>>>>> send AllowedTables_Reset to (pVM_Object(self))
64183>>>>>>>>> end_procedure
64184>>>>>>>>> procedure AllowedTables_Add integer liFile
64187>>>>>>>>> send AllowedTables_Add to (pVM_Object(self)) liFile
64188>>>>>>>>> end_procedure
64189>>>>>>>>> procedure set pbAllowAllState integer lbValue
64192>>>>>>>>> set pbAllowAllState of (pVM_Object(self)) to lbValue
64193>>>>>>>>> end_procedure
64194>>>>>>>>> end_object
64195>>>>>>>>>end_desktop_section
64200>>>>>>>>>
64200>>>>>>>>>class Query_cExprArrayErrors is a cArray
64201>>>>>>>>> item_property_list
64201>>>>>>>>> item_property integer piExprRow.i
64201>>>>>>>>> item_property string psError.i
64201>>>>>>>>> item_property integer piErrorPos.i
64201>>>>>>>>> end_item_property_list Query_cExprArrayErrors
#REM 64236 DEFINE FUNCTION PIERRORPOS.I INTEGER LIROW RETURNS INTEGER
#REM 64240 DEFINE PROCEDURE SET PIERRORPOS.I INTEGER LIROW INTEGER VALUE
#REM 64244 DEFINE FUNCTION PSERROR.I INTEGER LIROW RETURNS STRING
#REM 64248 DEFINE PROCEDURE SET PSERROR.I INTEGER LIROW STRING VALUE
#REM 64252 DEFINE FUNCTION PIEXPRROW.I INTEGER LIROW RETURNS INTEGER
#REM 64256 DEFINE PROCEDURE SET PIEXPRROW.I INTEGER LIROW INTEGER VALUE
64261>>>>>>>>> procedure Show_Errors
64263>>>>>>>>> integer liRow liMax
64263>>>>>>>>> get row_count to liMax
64264>>>>>>>>> decrement liMax
64265>>>>>>>>> for liRow from 0 to liMax
64271>>>>>>>>>>
64271>>>>>>>>> show (piExprRow.i (self,liRow)) " "
64273>>>>>>>>> show (psError.i (self,liRow)) " "
64275>>>>>>>>> showln (piErrorPos.i(self,liRow))
64277>>>>>>>>> loop
64278>>>>>>>>>>
64278>>>>>>>>> end_procedure
64279>>>>>>>>> procedure AddError integer liExprRow string lsError integer liErrorPos
64281>>>>>>>>> integer liRow
64281>>>>>>>>> get row_count to liRow
64282>>>>>>>>> set piExprRow.i liRow to liExprRow
64283>>>>>>>>> set psError.i liRow to lsError
64284>>>>>>>>> set piErrorPos.i liRow to liErrorPos
64285>>>>>>>>> end_procedure
64286>>>>>>>>>end_class // Query_cExprArrayErrors
64287>>>>>>>>>
64287>>>>>>>>>class Query_cExprArray is a cArray NO_IMAGE
64288>>>>>>>>> procedure construct_object integer liImage
64290>>>>>>>>> forward send construct_object liImage
64292>>>>>>>>> object oInterpreterErrors is a Query_cExprArrayErrors
64294>>>>>>>>> end_object
64295>>>>>>>>> end_procedure
64296>>>>>>>>> item_property_list
64296>>>>>>>>> item_property string psLongLabel.i
64296>>>>>>>>> item_property string psLabel.i
64296>>>>>>>>> item_property integer piType.i
64296>>>>>>>>> item_property integer piWidth.i
64296>>>>>>>>> item_property integer piDecimals.i
64296>>>>>>>>>
64296>>>>>>>>> item_property string psExpression.i
64296>>>>>>>>> item_property integer piExprId.i // Temporarily used when compiled
64296>>>>>>>>> item_property integer pbCleanupInUse.i // Temporarily used when cleaning up
64296>>>>>>>>> item_property integer pbCleanupNewRow.i
64296>>>>>>>>> end_item_property_list Query_cExprArray
#REM 64349 DEFINE FUNCTION PBCLEANUPNEWROW.I INTEGER LIROW RETURNS INTEGER
#REM 64353 DEFINE PROCEDURE SET PBCLEANUPNEWROW.I INTEGER LIROW INTEGER VALUE
#REM 64357 DEFINE FUNCTION PBCLEANUPINUSE.I INTEGER LIROW RETURNS INTEGER
#REM 64361 DEFINE PROCEDURE SET PBCLEANUPINUSE.I INTEGER LIROW INTEGER VALUE
#REM 64365 DEFINE FUNCTION PIEXPRID.I INTEGER LIROW RETURNS INTEGER
#REM 64369 DEFINE PROCEDURE SET PIEXPRID.I INTEGER LIROW INTEGER VALUE
#REM 64373 DEFINE FUNCTION PSEXPRESSION.I INTEGER LIROW RETURNS STRING
#REM 64377 DEFINE PROCEDURE SET PSEXPRESSION.I INTEGER LIROW STRING VALUE
#REM 64381 DEFINE FUNCTION PIDECIMALS.I INTEGER LIROW RETURNS INTEGER
#REM 64385 DEFINE PROCEDURE SET PIDECIMALS.I INTEGER LIROW INTEGER VALUE
#REM 64389 DEFINE FUNCTION PIWIDTH.I INTEGER LIROW RETURNS INTEGER
#REM 64393 DEFINE PROCEDURE SET PIWIDTH.I INTEGER LIROW INTEGER VALUE
#REM 64397 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 64401 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 64405 DEFINE FUNCTION PSLABEL.I INTEGER LIROW RETURNS STRING
#REM 64409 DEFINE PROCEDURE SET PSLABEL.I INTEGER LIROW STRING VALUE
#REM 64413 DEFINE FUNCTION PSLONGLABEL.I INTEGER LIROW RETURNS STRING
#REM 64417 DEFINE PROCEDURE SET PSLONGLABEL.I INTEGER LIROW STRING VALUE
64422>>>>>>>>>
64422>>>>>>>>> function iInterpretAll returns integer // DFTRUE means OK
64424>>>>>>>>> integer liRow liMax liErrorPos liExprId lbRval liError
64424>>>>>>>>> string lsExpression lsError lsMessage
64424>>>>>>>>> move DFTRUE to lbRval
64425>>>>>>>>> send delete_data to (oInterpreterErrors(self))
64426>>>>>>>>> get row_count to liMax
64427>>>>>>>>> send script_begin to (Query_ExprParser(self))
64428>>>>>>>>> decrement liMax
64429>>>>>>>>> for liRow from 0 to liMax
64435>>>>>>>>>>
64435>>>>>>>>> set piExprId.i liRow to -1
64436>>>>>>>>> get psExpression.i liRow to lsExpression
64437>>>>>>>>> // This puts the expression in one line:
64437>>>>>>>>> get sPrepareExpression.s of (Query_ExprParser(self)) lsExpression to lsExpression
64438>>>>>>>>> if (trim(lsExpression)<>"") begin
64440>>>>>>>>> send delete_data to (oScriptErrors(Query_ExprParser(self)))
64441>>>>>>>>> get iParse_Expr.s of (Query_ExprParser(self)) lsExpression to liErrorPos
64442>>>>>>>>> if (liErrorPos=0) begin
64444>>>>>>>>> get piExprID of (Query_ExprParser(self)) to liExprId
64445>>>>>>>>> set piExprId.i liRow to liExprId
64446>>>>>>>>> end
64446>>>>>>>>>>
64446>>>>>>>>> else begin
64447>>>>>>>>> get iTheRealErrorPosition of (Query_ExprParser(self)) liErrorPos to liErrorPos
64448>>>>>>>>> get piError.i of (oScriptErrors(Query_ExprParser(self))) 0 to liError
64449>>>>>>>>> get psMessage.i of (oScriptErrors(Query_ExprParser(self))) 0 to lsMessage
64450>>>>>>>>> move (ScriptError_Text(liError)) to lsError
64451>>>>>>>>> move (lsError+", "+lsMessage) to lsError
64452>>>>>>>>> send AddError to (oInterpreterErrors(self)) liRow lsError liErrorPos
64453>>>>>>>>> move DFFALSE to lbRval
64454>>>>>>>>> end
64454>>>>>>>>>>
64454>>>>>>>>> end
64454>>>>>>>>>>
64454>>>>>>>>> else begin
64455>>>>>>>>> send AddError to (oInterpreterErrors(self)) liRow "Empty expression" 0
64456>>>>>>>>> move DFFALSE to lbRval
64457>>>>>>>>> end
64457>>>>>>>>>>
64457>>>>>>>>> loop
64458>>>>>>>>>>
64458>>>>>>>>> send script_end to (Query_ExprParser(self))
64459>>>>>>>>> function_return lbRval
64460>>>>>>>>> end_function
64461>>>>>>>>>
64461>>>>>>>>> procedure DisplayErrors
64463>>>>>>>>> send Show_Errors to (oInterpreterErrors(self))
64464>>>>>>>>> send obs "Errors were found"
64465>>>>>>>>> end_procedure
64466>>>>>>>>>
64466>>>>>>>>> procedure SEQ_Write integer liChannel
64468>>>>>>>>> integer liRow liMax
64468>>>>>>>>> string lsExpression
64468>>>>>>>>> get row_count to liMax
64469>>>>>>>>> decrement liMax
64470>>>>>>>>> writeln channel liChannel (row_count(self)-1)
64473>>>>>>>>> for liRow from 0 to liMax
64479>>>>>>>>>>
64479>>>>>>>>> writeln (psLongLabel.i(self,liRow))
64481>>>>>>>>> writeln (psLabel.i(self,liRow))
64483>>>>>>>>> writeln (piType.i(self,liRow))
64485>>>>>>>>> writeln (piWidth.i(self,liRow))
64487>>>>>>>>> writeln (piDecimals.i(self,liRow))
64489>>>>>>>>> get psExpression.i liRow to lsExpression
64490>>>>>>>>> writeln (length(lsExpression))
64492>>>>>>>>> write lsExpression
64493>>>>>>>>> loop
64494>>>>>>>>>>
64494>>>>>>>>> end_procedure
64495>>>>>>>>> procedure SEQ_Read integer liChannel
64497>>>>>>>>> integer liRow liMax liLen
64497>>>>>>>>> string lsExpression
64497>>>>>>>>> send delete_data
64498>>>>>>>>> readln channel liChannel liMax
64500>>>>>>>>> for liRow from 0 to liMax
64506>>>>>>>>>>
64506>>>>>>>>> set psLongLabel.i liRow to (SEQ_ReadLn(liChannel))
64507>>>>>>>>> set psLabel.i liRow to (SEQ_ReadLn(liChannel))
64508>>>>>>>>> set piType.i liRow to (SEQ_ReadLn(liChannel))
64509>>>>>>>>> set piWidth.i liRow to (SEQ_ReadLn(liChannel))
64510>>>>>>>>> set piDecimals.i liRow to (SEQ_ReadLn(liChannel))
64511>>>>>>>>> readln liLen
64512>>>>>>>>> read_block lsExpression liLen
64513>>>>>>>>> set psExpression.i liRow to lsExpression
64514>>>>>>>>> loop
64515>>>>>>>>>>
64515>>>>>>>>> end_procedure
64516>>>>>>>>>
64516>>>>>>>>> procedure CleanUp_Prepare
64518>>>>>>>>> integer liRow liMax
64518>>>>>>>>> get row_count to liMax
64519>>>>>>>>> decrement liMax
64520>>>>>>>>> for liRow from 0 to liMax
64526>>>>>>>>>>
64526>>>>>>>>> set pbCleanupInUse.i liRow to DFFALSE
64527>>>>>>>>> set pbCleanupNewRow.i liRow to -1
64528>>>>>>>>> loop
64529>>>>>>>>>>
64529>>>>>>>>> end_procedure
64530>>>>>>>>> procedure CleanUp_MarkAsUsed integer liRow
64532>>>>>>>>> set pbCleanupInUse.i liRow to DFTRUE
64533>>>>>>>>> end_procedure
64534>>>>>>>>> procedure CleanUp_CalcNewRow
64536>>>>>>>>> integer liRow liMax liNewRow
64536>>>>>>>>> move 0 to liNewRow
64537>>>>>>>>> get row_count to liMax
64538>>>>>>>>> decrement liMax
64539>>>>>>>>> for liRow from 0 to liMax
64545>>>>>>>>>>
64545>>>>>>>>> if (pbCleanupInUse.i(self,liRow)) begin
64547>>>>>>>>> set pbCleanupNewRow.i liRow to liNewRow
64548>>>>>>>>> increment liNewRow
64549>>>>>>>>> end
64549>>>>>>>>>>
64549>>>>>>>>> loop
64550>>>>>>>>>>
64550>>>>>>>>> end_procedure
64551>>>>>>>>> procedure CleanUp_Purge
64553>>>>>>>>> integer liRow liMax
64553>>>>>>>>> get row_count to liMax
64554>>>>>>>>> decrement liMax
64555>>>>>>>>> for_ex liRow from liMax down_to 0
64562>>>>>>>>> ifnot (pbCleanupInUse.i(self,liRow)) send delete_row liRow
64565>>>>>>>>> loop
64566>>>>>>>>>>
64566>>>>>>>>> end_procedure
64567>>>>>>>>>end_class // Query_cExprArray
64568>>>>>>>>>
64568>>>>>>>>>
64568>>>>>>>>>// UI Part
64568>>>>>>>>>
64568>>>>>>>>>Use Edit.utl // cEditor class
Including file: edit.utl (C:\Apps\VDFQuery\AppSrc\edit.utl)
64568>>>>>>>>>>>// Use Edit.utl // cEditor class
64568>>>>>>>>>>>
64568>>>>>>>>>>>Use Files.utl // Utilities for handling file related stuff
64568>>>>>>>>>>>Use Strings.utl // String manipulation for VDF
64568>>>>>>>>>>>
64568>>>>>>>>>>>class cEditor is an aps.Edit
64569>>>>>>>>>>> procedure construct_object integer img#
64571>>>>>>>>>>> if num_arguments gt 0 forward send construct_object img#
64575>>>>>>>>>>> else forward send construct_object
64578>>>>>>>>>>> property integer piLeadInKey private 0 // 0=none, 1=cQ, 2=cK
64579>>>>>>>>>>> on_key key_ctrl+key_right_arrow send word_right
64580>>>>>>>>>>> on_key key_ctrl+key_left_arrow send word_left
64581>>>>>>>>>>> end_procedure
64582>>>>>>>>>>> procedure word_left
64584>>>>>>>>>>> send key kword_left
64585>>>>>>>>>>> end_procedure
64586>>>>>>>>>>> procedure word_right
64588>>>>>>>>>>> send key kword_right
64589>>>>>>>>>>> end_procedure
64590>>>>>>>>>>> procedure display_position
64592>>>>>>>>>>> end_procedure
64593>>>>>>>>>>> procedure block_cut
64595>>>>>>>>>>> send copy 1 clipboard true
64596>>>>>>>>>>> set dynamic_update_state to true
64597>>>>>>>>>>> end_procedure
64598>>>>>>>>>>> procedure block_copy
64600>>>>>>>>>>> send copy 0 clipboard true
64601>>>>>>>>>>> set dynamic_update_state to true
64602>>>>>>>>>>> end_procedure
64603>>>>>>>>>>> procedure buffer_insert
64605>>>>>>>>>>> send beginning_of_data to clipboard
64606>>>>>>>>>>> send mark_on
64607>>>>>>>>>>> send end_of_data to clipboard
64608>>>>>>>>>>> send paste to clipboard 0 self 0
64609>>>>>>>>>>> set dynamic_update_state to true
64610>>>>>>>>>>> end_procedure
64611>>>>>>>>>>> procedure line_mark
64613>>>>>>>>>>> integer pos#
64613>>>>>>>>>>> get position to pos#
64614>>>>>>>>>>> send move_absolute (hi(pos#)) 0
64615>>>>>>>>>>> send mark_on
64616>>>>>>>>>>> end_procedure
64617>>>>>>>>>>> procedure block_delete
64619>>>>>>>>>>> send cut false clipboard true
64620>>>>>>>>>>> end_procedure
64621>>>>>>>>>>> procedure external_edit
64623>>>>>>>>>>> string path#
64623>>>>>>>>>>> send write "extedit.tmp" 0
64624>>>>>>>>>>> runprogram wait "e extedit.tmp"
64625>>>>>>>>>>> send delete_data
64626>>>>>>>>>>> send read "extedit.tmp"
64627>>>>>>>>>>> get SEQ_FindFileAlongDfPath "extedit.tmp" to path#
64628>>>>>>>>>>> get SEQ_ComposeAbsoluteFileName path# "extedit.tmp" to path#
64629>>>>>>>>>>> get SEQ_TranslatePathToAbsolute path# to path#
64630>>>>>>>>>>> erasefile path#
64631>>>>>>>>>>>>
64631>>>>>>>>>>> send refresh_screen
64632>>>>>>>>>>> send beginning_of_data
64633>>>>>>>>>>> end_procedure
64634>>>>>>>>>>> procedure key integer key#
64636>>>>>>>>>>> integer LeadInKey#
64636>>>>>>>>>>> get cEditor.piLeadInKey to LeadInKey#
64637>>>>>>>>>>> if LeadInKey# eq 1 begin // LeadIn=Q?
64639>>>>>>>>>>> if key# eq key_ctrl+key_y send delete_to_eol
64642>>>>>>>>>>> set cEditor.piLeadInKey to 0
64643>>>>>>>>>>> end
64643>>>>>>>>>>>>
64643>>>>>>>>>>> else if LeadInKey# eq 2 begin // LeadIn=K?
64646>>>>>>>>>>> if key# eq key_ctrl+key_h send mark_off
64649>>>>>>>>>>> if key# eq key_ctrl+key_b send mark_on
64652>>>>>>>>>>> if key# eq key_ctrl+key_y send block_delete
64655>>>>>>>>>>> set cEditor.piLeadInKey to 0
64656>>>>>>>>>>> end
64656>>>>>>>>>>>>
64656>>>>>>>>>>> else begin
64657>>>>>>>>>>> if key# eq key_ctrl+key_q set cEditor.piLeadInKey to 1
64660>>>>>>>>>>> else if key# eq key_ctrl+key_k set cEditor.piLeadInKey to 2
64664>>>>>>>>>>> else begin
64665>>>>>>>>>>> set cEditor.piLeadInKey to 0
64666>>>>>>>>>>> if key# eq key_ctrl+key_y send delete_line
64669>>>>>>>>>>> else if key# eq key_alt+key_k send mark_on
64673>>>>>>>>>>> else if key# eq key_alt+key_l send line_mark
64677>>>>>>>>>>> else if key# eq key_ctrl+key_c send block_copy
64681>>>>>>>>>>> else if key# eq key_ctrl+key_v send buffer_insert
64685>>>>>>>>>>> else if key# eq key_ctrl+key_x send block_cut
64689>>>>>>>>>>> else if key# eq key_alt+key_u send mark_off
64693>>>>>>>>>>> else if key# eq key_alt+key_e send external_edit
64697>>>>>>>>>>> else forward send key key#
64700>>>>>>>>>>> end
64700>>>>>>>>>>>>
64700>>>>>>>>>>> end
64700>>>>>>>>>>>>
64700>>>>>>>>>>> send display_position
64701>>>>>>>>>>> end_procedure
64702>>>>>>>>>>> procedure set psValueAsString string str#
64704>>>>>>>>>>> send Text_SetEditObjectValue self str#
64705>>>>>>>>>>> end_procedure
64706>>>>>>>>>>> function psValueAsString returns string // That's a parameter for a global function
64708>>>>>>>>>>> function_return (Text_EditObjectValue(self))
64709>>>>>>>>>>> end_function
64710>>>>>>>>>>>end_class
64711>>>>>>>>>
64711>>>>>>>>>class cQuery_ExpressionEditorUndoer is a cArray
64712>>>>>>>>> procedure construct_object integer liImage
64714>>>>>>>>> forward send construct_object liImage
64716>>>>>>>>> property integer piCurrentUndoPos public 0
64717>>>>>>>>> end_procedure
64718>>>>>>>>> item_property_list
64718>>>>>>>>> item_property integer piCursor.i
64718>>>>>>>>> item_property integer piSelectRange.i
64718>>>>>>>>> item_property string psValue.i
64718>>>>>>>>> item_property string psOperation.i
64718>>>>>>>>> end_item_property_list cQuery_ExpressionEditorUndoer
#REM 64756 DEFINE FUNCTION PSOPERATION.I INTEGER LIROW RETURNS STRING
#REM 64760 DEFINE PROCEDURE SET PSOPERATION.I INTEGER LIROW STRING VALUE
#REM 64764 DEFINE FUNCTION PSVALUE.I INTEGER LIROW RETURNS STRING
#REM 64768 DEFINE PROCEDURE SET PSVALUE.I INTEGER LIROW STRING VALUE
#REM 64772 DEFINE FUNCTION PISELECTRANGE.I INTEGER LIROW RETURNS INTEGER
#REM 64776 DEFINE PROCEDURE SET PISELECTRANGE.I INTEGER LIROW INTEGER VALUE
#REM 64780 DEFINE FUNCTION PICURSOR.I INTEGER LIROW RETURNS INTEGER
#REM 64784 DEFINE PROCEDURE SET PICURSOR.I INTEGER LIROW INTEGER VALUE
64789>>>>>>>>> procedure ReadCurrentState string lsOperation
64791>>>>>>>>> integer liRow lhParent liPosition
64791>>>>>>>>> string lsValue
64791>>>>>>>>> move (parent(self)) to lhParent
64792>>>>>>>>> get piCurrentUndoPos to liRow
64793>>>>>>>>> get position of lhParent to liPosition
64794>>>>>>>>> get Text_EditObjectValue lhParent to lsValue
64795>>>>>>>>> set piCursor.i liRow to liPosition
64796>>>>>>>>>// showln "Snup " liPosition
64796>>>>>>>>> set piSelectRange.i liRow to 0
64797>>>>>>>>> set psValue.i liRow to lsValue
64798>>>>>>>>> set psOperation.i liRow to lsOperation
64799>>>>>>>>> increment liRow
64800>>>>>>>>> set piCurrentUndoPos to liRow
64801>>>>>>>>> end_procedure
64802>>>>>>>>> procedure DoReset
64804>>>>>>>>> send delete_data
64805>>>>>>>>> set piCurrentUndoPos to 0
64806>>>>>>>>> end_procedure
64807>>>>>>>>> procedure SetCurrentState integer liRow
64809>>>>>>>>> integer liPosition lhParent
64809>>>>>>>>> string lsValue
64809>>>>>>>>> move (parent(self)) to lhParent
64810>>>>>>>>> get piCursor.i liRow to liPosition
64811>>>>>>>>> get psValue.i liRow to lsValue
64812>>>>>>>>> send Text_SetEditObjectValue lhParent lsValue
64813>>>>>>>>>// showln "Oooog V‘rsgo " liPosition
64813>>>>>>>>> send move_absolute to lhParent (hi(liPosition)) (low(liPosition))
64814>>>>>>>>> end_procedure
64815>>>>>>>>> function iIncrementCurrentUndoPos integer liBy returns integer
64817>>>>>>>>> integer liCurrentUndoPos
64817>>>>>>>>> get piCurrentUndoPos to liCurrentUndoPos
64818>>>>>>>>> move (liCurrentUndoPos+liBy) to liCurrentUndoPos
64819>>>>>>>>> if (liCurrentUndoPos>0 and liCurrentUndoPos<row_count(self)) begin
64821>>>>>>>>> set piCurrentUndoPos to liCurrentUndoPos
64822>>>>>>>>> function_return DFTRUE
64823>>>>>>>>> end
64823>>>>>>>>>>
64823>>>>>>>>> function_return DFFALSE
64824>>>>>>>>> end_function
64825>>>>>>>>> procedure ReDo
64827>>>>>>>>> if (iIncrementCurrentUndoPos(self,1)) send SetCurrentState (piCurrentUndoPos(self))
64830>>>>>>>>> else send bell to desktop
64832>>>>>>>>> end_procedure
64833>>>>>>>>> procedure UnDo
64835>>>>>>>>> if (iIncrementCurrentUndoPos(self,-1)) send SetCurrentState (piCurrentUndoPos(self))
64838>>>>>>>>> else send bell to desktop
64840>>>>>>>>> end_procedure
64841>>>>>>>>>end_class // cQuery_ExpressionEditorUndoer
64842>>>>>>>>>
64842>>>>>>>>>
64842>>>>>>>>>class cQuery_ExpressionEditor is a cEditor
64843>>>>>>>>> procedure construct_object integer liImage
64845>>>>>>>>> forward send construct_object liImage
64847>>>>>>>>> property integer piRequiredType public 0
64848>>>>>>>>> set typeface to "Courier New"
64849>>>>>>>>> object oUnDo is a cQuery_ExpressionEditorUndoer NO_IMAGE
64851>>>>>>>>> end_object
64852>>>>>>>>> on_key KEY_CTRL+KEY_U send undo
64853>>>>>>>>> on_key KEY_CTRL+KEY_Z send redo
64854>>>>>>>>>
64854>>>>>>>>> property integer piExpressionType // TYPE.UNKNOWN TYPE.UNTYPED TYPE.INTEGER TYPE.DATE TYPE.NUMBER TYPE.STRING
64855>>>>>>>>> end_procedure
64856>>>>>>>>>
64856>>>>>>>>> procedure DoClear
64858>>>>>>>>> send delete_data
64859>>>>>>>>> end_procedure
64860>>>>>>>>>
64860>>>>>>>>> function bContentsNotOK returns integer
64862>>>>>>>>> integer lbError
64862>>>>>>>>> string lsExpression
64862>>>>>>>>>
64862>>>>>>>>> get Text_EditObjectValue self to lsExpression
64863>>>>>>>>> get sPrepareExpression.s of (Query_ExprParser(self)) lsExpression to lsExpression
64864>>>>>>>>>
64864>>>>>>>>> send script_begin to (Query_ExprParser(self))
64865>>>>>>>>> get iParse_Expr.s of (Query_ExprParser(self)) lsExpression to lbError
64866>>>>>>>>> set piExpressionType to (piExprType(Query_ExprParser(self)))
64867>>>>>>>>> send script_end to (Query_ExprParser(self))
64868>>>>>>>>> function_return lbError
64869>>>>>>>>> end_function
64870>>>>>>>>>
64870>>>>>>>>> procedure GotoErrorPos integer liErrorPos
64872>>>>>>>>> if liErrorPos begin
64874>>>>>>>>> get iTheRealErrorPosition of (Query_ExprParser(self)) liErrorPos to liErrorPos
64875>>>>>>>>> send activate
64876>>>>>>>>> send move_absolute (hi(liErrorPos)-1) (low(liErrorPos)-1)
64877>>>>>>>>> end
64877>>>>>>>>>>
64877>>>>>>>>> end_procedure
64878>>>>>>>>> procedure UnDo
64880>>>>>>>>> send UnDo to (oUndo(self))
64881>>>>>>>>> end_procedure
64882>>>>>>>>> procedure Redo
64884>>>>>>>>> send ReDo to (oUndo(self))
64885>>>>>>>>> end_procedure
64886>>>>>>>>> procedure Insert string lsValue
64888>>>>>>>>> send ReadCurrentState to (oUndo(self)) "Inds‘t"
64889>>>>>>>>> forward send Insert lsValue
64891>>>>>>>>> end_procedure
64892>>>>>>>>>end_class // cQuery_ExpressionEditor
64893>>>>>>>>>
64893>>>>>>>>>class QryExprTableList is a aps.List
64894>>>>>>>>> procedure construct_object integer liImage
64896>>>>>>>>> forward send construct_object liImage
64898>>>>>>>>> end_procedure
64899>>>>>>>>> procedure fill_list
64901>>>>>>>>> integer lhSet liItem liMax liFile
64901>>>>>>>>> set dynamic_update_state to DFFALSE
64902>>>>>>>>> send delete_data
64903>>>>>>>>> move (oAllowedTables(Query_ExprEvaluator(self))) to lhSet
64904>>>>>>>>> get item_count of lhSet to liMax
64905>>>>>>>>> decrement liMax
64906>>>>>>>>> for liItem from 0 to liMax
64912>>>>>>>>>>
64912>>>>>>>>> get value of lhSet item liItem to liFile
64913>>>>>>>>> send add_item MSG_NONE (FDX_AttrValue_FILELIST(0,DF_FILE_LOGICAL_NAME,liFile))
64914>>>>>>>>> set aux_value item (item_count(self)-1) to liFile
64915>>>>>>>>> loop
64916>>>>>>>>>>
64916>>>>>>>>> set dynamic_update_state to DFTRUE
64917>>>>>>>>> set current_item to 0
64918>>>>>>>>> send OnChange
64919>>>>>>>>> end_procedure
64920>>>>>>>>> procedure OnChange
64922>>>>>>>>> integer liFile
64922>>>>>>>>> get aux_value item (current_item(self)) to liFile
64923>>>>>>>>> send DoFillFields liFile
64924>>>>>>>>> end_procedure
64925>>>>>>>>> procedure item_change integer liItem1 integer liItem2 returns integer
64927>>>>>>>>> integer liRval liFile
64927>>>>>>>>> forward get msg_item_change liItem1 liItem2 to liRval
64929>>>>>>>>> procedure_return liRval
64930>>>>>>>>> end_procedure
64931>>>>>>>>>end_class // QryExprTableList
64932>>>>>>>>>
64932>>>>>>>>>class QryExprFieldList is a aps.List
64933>>>>>>>>> procedure construct_object integer liImage
64935>>>>>>>>> forward send construct_object liImage
64937>>>>>>>>> property integer piFile public 0
64938>>>>>>>>> end_procedure
64939>>>>>>>>> procedure OnFieldSelect string lsName
64941>>>>>>>>> end_procedure
64942>>>>>>>>> procedure InsertField
64944>>>>>>>>> integer liFile liField liItem
64944>>>>>>>>> string lsName
64944>>>>>>>>> get current_item to liItem
64945>>>>>>>>> get piFile to liFile
64946>>>>>>>>> get aux_value item liItem to liField
64947>>>>>>>>> get FDX_FieldName 0 liFile liField DFTRUE to lsName
64948>>>>>>>>> send OnFieldSelect lsName
64949>>>>>>>>> end_procedure
64950>>>>>>>>> procedure HandleField integer liFile integer liField string lsName integer liType integer liLen integer liPrec integer liRelFile integer liRelField integer liIndex integer liOffSet
64952>>>>>>>>> if (liType<>DF_OVERLAP and liType<>DF_BINARY) begin
64954>>>>>>>>> send add_item MSG_InsertField lsName
64955>>>>>>>>> set aux_value item (item_count(self)-1) to liField
64956>>>>>>>>> end
64956>>>>>>>>>>
64956>>>>>>>>> end_procedure
64957>>>>>>>>> procedure fill_list.i integer liFile
64959>>>>>>>>> integer lhSet liItem liMax
64959>>>>>>>>> if liFile begin
64961>>>>>>>>> set piFile to liFile
64962>>>>>>>>> set dynamic_update_state to DFFALSE
64963>>>>>>>>> send delete_data
64964>>>>>>>>> send FDX_FieldCallBack 0 liFile MSG_HandleField self // Protected against relating file not present
64965>>>>>>>>> set dynamic_update_state to DFTRUE
64966>>>>>>>>> set current_item to 0
64967>>>>>>>>> end
64967>>>>>>>>>>
64967>>>>>>>>> end_procedure
64968>>>>>>>>>//procedure mouse_click integer liItem integer liGrb
64968>>>>>>>>>// if ((liItem-1)<item_count(self)) send InsertField
64968>>>>>>>>>//end_procedure
64968>>>>>>>>> procedure mouse_up integer liItem integer liGrb
64970>>>>>>>>> if ((liItem-1)<item_count(self)) send InsertField
64973>>>>>>>>> end_procedure
64974>>>>>>>>>end_class // QryExprFieldList
64975>>>>>>>>>
64975>>>>>>>>>class QryExprFunctions is a aps.List
64976>>>>>>>>> procedure InsertFunction
64978>>>>>>>>> end_procedure
64979>>>>>>>>> procedure Handle_Function string lsName integer liReturnType string lsParamList string lsLongParamList
64981>>>>>>>>> integer liLen liPos
64981>>>>>>>>> string lsValue liChar
64981>>>>>>>>> move (lsName+"(") to lsValue
64982>>>>>>>>> move (length(lsParamList)) to liLen
64983>>>>>>>>> for liPos from 1 to liLen
64989>>>>>>>>>>
64989>>>>>>>>> move (mid(lsParamList,1,liPos)) to liChar
64990>>>>>>>>> if (liChar="S") move (lsValue+"s") to lsValue
64993>>>>>>>>> if (liChar="I") move (lsValue+"i") to lsValue
64996>>>>>>>>> if (liChar="N") move (lsValue+"n") to lsValue
64999>>>>>>>>> if (liChar="D") move (lsValue+"d") to lsValue
65002>>>>>>>>> if (liPos<>liLen) move (lsValue+",") to lsValue
65005>>>>>>>>> loop
65006>>>>>>>>>>
65006>>>>>>>>> move (lsValue+")") to lsValue
65007>>>>>>>>> send add_item MSG_InsertFunction lsValue
65008>>>>>>>>> end_procedure
65009>>>>>>>>> procedure fill_list
65011>>>>>>>>> integer lhObj lhSelf
65011>>>>>>>>> set dynamic_update_state to DFFALSE
65012>>>>>>>>> send delete_data
65013>>>>>>>>> move self to lhSelf
65014>>>>>>>>> move (oDeclaredFunctions(Query_ExprEvaluator(self))) to lhObj
65015>>>>>>>>> send reset to lhObj
65016>>>>>>>>> send CallBack_AllFunctions to lhObj MSG_Handle_Function lhSelf
65017>>>>>>>>> set dynamic_update_state to DFTRUE
65018>>>>>>>>> end_procedure
65019>>>>>>>>>end_class //
65020>>>>>>>>>
65020>>>>>>>>>object Query_EditCriteriaExpression is a aps.ModalPanel label t.QryExpr.Expression // "Expression"
65023>>>>>>>>> set locate_mode to CENTER_ON_SCREEN
65024>>>>>>>>> on_key ksave_record send close_panel_ok
65025>>>>>>>>> on_key kcancel send close_panel
65026>>>>>>>>> property integer piResult public DFFALSE
65028>>>>>>>>> property string psExpression public ""
65030>>>>>>>>> property integer piExprType public 0
65032>>>>>>>>> object oEdit is a cQuery_ExpressionEditor
65034>>>>>>>>> set size to 100 450
65035>>>>>>>>> end_object
65036>>>>>>>>> send aps_goto_max_row
65037>>>>>>>>> object oLbl1 is a aps.TextBox label t.QryExpr.Tables //"Tabels"
65040>>>>>>>>> end_object
65041>>>>>>>>> object oLbl2 is a aps.TextBox label t.QryExpr.Fields //"Fields"
65044>>>>>>>>> end_object
65045>>>>>>>>> object oLbl3 is a aps.TextBox label t.QryExpr.Functions //"Functions"
65048>>>>>>>>> end_object
65049>>>>>>>>> send aps_goto_max_row
65050>>>>>>>>> object oTables is a QryExprTableList
65052>>>>>>>>> set size to 114 80
65053>>>>>>>>> end_object
65054>>>>>>>>> object oFields is a QryExprFieldList
65056>>>>>>>>> set size to 114 120
65057>>>>>>>>> procedure OnFieldSelect string lsName
65060>>>>>>>>> send Insert to (oEdit(self)) lsName
65061>>>>>>>>> send activate to (oEdit(self))
65062>>>>>>>>> end_procedure
65063>>>>>>>>> end_object
65064>>>>>>>>> procedure DoFillFields integer liFile
65067>>>>>>>>> send fill_list.i to (oFields(self)) liFile
65068>>>>>>>>> end_procedure
65069>>>>>>>>>
65069>>>>>>>>> object oFunctions is a QryExprFunctions
65071>>>>>>>>> set size to 114 245
65072>>>>>>>>> procedure InsertFunction
65075>>>>>>>>> string lsValue
65075>>>>>>>>> get value item (current_item(self)) to lsValue
65076>>>>>>>>> send Insert to (oEdit(self)) lsValue
65077>>>>>>>>> send Activate to (oEdit(self))
65078>>>>>>>>> end_procedure
65079>>>>>>>>> procedure mouse_up integer liItem integer liGrb
65082>>>>>>>>> if ((liItem-1)<item_count(self)) send InsertFunction
65085>>>>>>>>> end_procedure
65086>>>>>>>>> end_object
65087>>>>>>>>>
65087>>>>>>>>> send aps_align_by_moving (oLbl1(self)) (oTables(self)) SL_ALIGN_LEFT
65088>>>>>>>>> send aps_align_by_moving (oLbl2(self)) (oFields(self)) SL_ALIGN_LEFT
65089>>>>>>>>> send aps_align_by_moving (oLbl3(self)) (oFunctions(self)) SL_ALIGN_LEFT
65090>>>>>>>>>
65090>>>>>>>>> object oBtn_Ok is a aps.Multi_Button
65092>>>>>>>>> on_item t.btn.ok send close_panel_ok
65093>>>>>>>>> end_object
65094>>>>>>>>> object oBtn_Clear is a aps.Multi_Button
65096>>>>>>>>> on_item t.btn.clear send DoClear to (oEdit(self))
65097>>>>>>>>> end_object
65098>>>>>>>>> object oBtn_Cancel is a aps.Multi_Button
65100>>>>>>>>> on_item t.btn.cancel send close_panel
65101>>>>>>>>> end_object
65102>>>>>>>>> send aps_locate_multi_buttons
65103>>>>>>>>> procedure close_panel_ok
65106>>>>>>>>> integer lbError
65106>>>>>>>>> get bContentsNotOK of (oEdit(self)) to lbError
65107>>>>>>>>> ifnot lbError begin
65109>>>>>>>>> set piResult to DFTRUE
65110>>>>>>>>> send close_panel
65111>>>>>>>>> end
65111>>>>>>>>>>
65111>>>>>>>>> else send GotoErrorPos to (oEdit(self)) lbError
65113>>>>>>>>> end_procedure
65114>>>>>>>>>
65114>>>>>>>>> function iPopup.sis string lsExpression integer liRequiredType string lsCaption returns integer
65117>>>>>>>>> integer liType
65117>>>>>>>>> set piResult to DFFALSE
65118>>>>>>>>> send Text_SetEditObjectValue (oEdit(self)) lsExpression
65119>>>>>>>>> set piRequiredType of (oEdit(self)) to liRequiredType
65120>>>>>>>>> set label to lsCaption
65121>>>>>>>>> send fill_list to (oTables(self))
65122>>>>>>>>> send fill_list to (oFunctions(self))
65123>>>>>>>>> send popup
65124>>>>>>>>> if (piResult(self)) begin
65126>>>>>>>>> set psExpression to (Text_EditObjectValue(oEdit(self)))
65127>>>>>>>>>// set piExprType
65127>>>>>>>>>
65127>>>>>>>>> function_return 1
65128>>>>>>>>> end
65128>>>>>>>>>>
65128>>>>>>>>> function_return -1
65129>>>>>>>>> end_function
65130>>>>>>>>>end_object // Query_EditCriteriaExpression
65131>>>>>>>>>
65131>>>>>>>>>object Query_ColumnExpression is a aps.ModalPanel
65133>>>>>>>>> set locate_mode to CENTER_ON_SCREEN
65134>>>>>>>>> on_key ksave_record send close_panel_ok
65135>>>>>>>>> on_key kcancel send close_panel
65136>>>>>>>>> on_key kuser send testus
65137>>>>>>>>> property integer piResult public DFFALSE
65139>>>>>>>>> property string psExpression public ""
65141>>>>>>>>>
65141>>>>>>>>> object oGrp is a aps.Group
65143>>>>>>>>> object oLongLabel is a aps.Form label (t.QryExpr.LongLabel+":") abstract AFT_ASCII30 //"Long label:"
65147>>>>>>>>> end_object
65148>>>>>>>>> object oShortLabel is a aps.Form label (t.QryExpr.ShortLabel+":") abstract AFT_ASCII15 // "Short label:"
65152>>>>>>>>> procedure OnSetFocus
65155>>>>>>>>> if (value(self,0)="") set value to (value(oLongLabel(self),0))
65158>>>>>>>>> end_procedure
65159>>>>>>>>> end_object
65160>>>>>>>>> object oWidth is a aps.form label (t.QryExpr.Width+":") abstract AFT_NUMERIC2.0
65164>>>>>>>>> end_object
65165>>>>>>>>> object oLabel is a aps.TextBox label t.QryExpr._Characters snap SL_RIGHT
65169>>>>>>>>> end_object
65170>>>>>>>>> object oExprType is a aps.ComboFormAux label (t.QryExpr.ReturnType+":") abstract AFT_ASCII10
65174>>>>>>>>> set entry_state item 0 to DFFALSE
65175>>>>>>>>> send combo_add_item t.QryExpr.Type_Numeric DF_BCD
65176>>>>>>>>> send combo_add_item t.QryExpr.Type_String DF_ASCII
65177>>>>>>>>> send combo_add_item t.QryExpr.Type_Text DF_TEXT
65178>>>>>>>>> send combo_add_item t.QryExpr.Type_Date DF_DATE
65179>>>>>>>>> register_object oDecimals
65179>>>>>>>>> procedure OnChange
65182>>>>>>>>> set enabled_state of (oDecimals(self)) to (Combo_Current_Aux_Value(self)=DF_BCD)
65183>>>>>>>>> end_procedure
65184>>>>>>>>> end_object
65185>>>>>>>>> object oDecimals is a aps.Form label (t.QryExpr.DecimalPlaces+":") abstract AFT_NUMERIC1.0 snap SL_RIGHT_SPACE
65190>>>>>>>>> end_object
65191>>>>>>>>> procedure DoExpression
65194>>>>>>>>> integer liType liTranslatedType liRval
65194>>>>>>>>> string lsExpression lsCaption
65194>>>>>>>>> get Combo_Current_Aux_Value of (oExprType(self)) to liType
65195>>>>>>>>> if (liType=DF_BCD ) move TYPE.NUMBER to liTranslatedType
65198>>>>>>>>> if (liType=DF_ASCII) move TYPE.STRING to liTranslatedType
65201>>>>>>>>> if (liType=DF_TEXT ) move TYPE.STRING to liTranslatedType
65204>>>>>>>>> if (liType=DF_DATE ) move TYPE.DATE to liTranslatedType
65207>>>>>>>>> if (liType=DF_BCD ) move t.QryExpr.EditNumExpr to lsCaption
65210>>>>>>>>> if (liType=DF_ASCII) move t.QryExpr.EditStrExpr to lsCaption
65213>>>>>>>>> if (liType=DF_TEXT ) move t.QryExpr.EditStrExpr to lsCaption
65216>>>>>>>>> if (liType=DF_DATE ) move t.QryExpr.EditDatExpr to lsCaption
65219>>>>>>>>> get psExpression to lsExpression
65220>>>>>>>>> get iPopup.sis of (Query_EditCriteriaExpression(self)) lsExpression liTranslatedType lsCaption to liRval
65221>>>>>>>>> if (liRval<>-1) set psExpression to (psExpression(Query_EditCriteriaExpression(self)))
65224>>>>>>>>> end_procedure
65225>>>>>>>>> send aps_make_row_space 5
65226>>>>>>>>> object oBtn is a aps.Button
65228>>>>>>>>> on_item t.btn.Edit send DoExpression
65229>>>>>>>>> end_object
65230>>>>>>>>> end_object
65231>>>>>>>>> object oBtn1 is a aps.Multi_Button
65233>>>>>>>>> on_item t.btn.ok send close_panel_ok
65234>>>>>>>>> end_object
65235>>>>>>>>> object oBtn2 is a aps.Multi_Button
65237>>>>>>>>> on_item t.btn.cancel send close_panel
65238>>>>>>>>> end_object
65239>>>>>>>>> send aps_locate_multi_buttons
65240>>>>>>>>> procedure aps_beautify
65243>>>>>>>>> send aps_align_inside_container_by_moving (oBtn(oGrp(self))) SL_ALIGN_CENTER
65244>>>>>>>>> end_procedure
65245>>>>>>>>> procedure close_panel_ok
65248>>>>>>>>> set piResult to DFTRUE
65249>>>>>>>>> send close_panel
65250>>>>>>>>> end_procedure
65251>>>>>>>>>
65251>>>>>>>>> procedure testus
65254>>>>>>>>> integer liTest
65254>>>>>>>>> get Combo_Current_Aux_Value of (oExprType(oGrp(self))) item 0 to liTest
65255>>>>>>>>> send obs liTest
65256>>>>>>>>> end_procedure
65257>>>>>>>>>
65257>>>>>>>>> function iPopup.ii integer lhObj integer liRow returns integer
65260>>>>>>>>> integer liType
65260>>>>>>>>> if (liRow=-1) begin
65262>>>>>>>>> set label to t.QryExpr.CreateCC_1 // "Create calculated column"
65263>>>>>>>>> set value of (oLongLabel(oGrp(self))) item 0 to ""
65264>>>>>>>>> set value of (oShortLabel(oGrp(self))) item 0 to ""
65265>>>>>>>>> set value of (oWidth(oGrp(self))) item 0 to 10
65266>>>>>>>>> set value of (oExprType(oGrp(self))) item 0 to t.QryExpr.Type_Numeric
65267>>>>>>>>> set value of (oDecimals(oGrp(self))) item 0 to 0
65268>>>>>>>>> set psExpression to ""
65269>>>>>>>>> end
65269>>>>>>>>>>
65269>>>>>>>>> else begin
65270>>>>>>>>> move (piType.i(lhObj,liRow)) to liType
65271>>>>>>>>> set label to (t.QryExpr.CreateCC_2+string(liRow)+")")
65272>>>>>>>>> set value of (oLongLabel (oGrp(self))) item 0 to (psLongLabel.i(lhObj,liRow))
65273>>>>>>>>> set value of (oShortLabel(oGrp(self))) item 0 to (psLabel.i(lhObj,liRow))
65274>>>>>>>>> set value of (oWidth(oGrp(self))) item 0 to (piWidth.i(lhObj,liRow))
65275>>>>>>>>> set Combo_Current_Aux_Value of (oExprType(oGrp(self))) to liType
65276>>>>>>>>> set value of (oDecimals(oGrp(self))) item 0 to (piDecimals.i(lhObj,liRow))
65277>>>>>>>>> set psExpression to (psExpression.i(lhObj,liRow))
65278>>>>>>>>> end
65278>>>>>>>>>>
65278>>>>>>>>> set piResult to DFFALSE
65279>>>>>>>>> send popup
65280>>>>>>>>> if (piResult(self)) begin
65282>>>>>>>>> if (liRow=-1) get row_count of lhObj to liRow
65285>>>>>>>>> set psLongLabel.i of lhObj liRow to (value(oLongLabel(oGrp(self)),0))
65286>>>>>>>>> set psLabel.i of lhObj liRow to (value(oShortLabel(oGrp(self)),0))
65287>>>>>>>>> set piType.i of lhObj liRow to (Combo_Current_Aux_Value(oExprType(oGrp(self))))
65288>>>>>>>>> set piWidth.i of lhObj liRow to (value(oWidth(oGrp(self)),0))
65289>>>>>>>>> set piDecimals.i of lhObj liRow to (value(oDecimals(oGrp(self)),0))
65290>>>>>>>>> set psExpression.i of lhObj liRow to (psExpression(self))
65291>>>>>>>>> function_return liRow
65292>>>>>>>>> end
65292>>>>>>>>>>
65292>>>>>>>>> function_return -1
65293>>>>>>>>> end_function
65294>>>>>>>>>end_object // Query_ColumnExpression
65295>>>>>>>
65295>>>>>>>
65295>>>>>>>
65295>>>>>>>
65295>>>>>>>
65295>>>>>>>
65295>>>>>>>// Function iTranslate_DFTYPE translates from DF attributes to
65295>>>>>>>// selection criteria types.
65295>>>>>>>function iTranslate_DFTYPE integer type# returns integer
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
65297>>>>>>> if type# eq DF_ASCII function_return SC_TYPE_ASCII
65300>>>>>>> if type# eq DF_BCD function_return SC_TYPE_NUMERIC
65303>>>>>>> if type# eq DF_DATE function_return SC_TYPE_DATE
65306>>>>>>> if type# eq DF_OVERLAP function_return SC_TYPE_ASCII
65309>>>>>>> if type# eq DF_TEXT function_return SC_TYPE_ASCII
65312>>>>>>> if type# eq DF_BINARY function_return SC_TYPE_ASCII
65315>>>>>>>end_function
65316>>>>>>>
65316>>>>>>>// A cBasicDataScanner sets up the sceleton for more complex scanning
65316>>>>>>>// classes. It was not meant for instantiation. It allows for setting
65316>>>>>>>// up pMainFile, search order and custom sort order for outputting.
65316>>>>>>>class cBasicDataScanner is a cArray
65317>>>>>>> procedure construct_object
65319>>>>>>> forward send construct_object
65321>>>>>>> property integer pMainFile public 0
65322>>>>>>> property integer pOrdering public 0
65323>>>>>>> property integer phDataSetObject public 0
65324>>>>>>> property integer pRecordCount public 0 // How many records have been selected?
65325>>>>>>> property integer pScanCount public 0 // How many records have been scanned?
65326>>>>>>> property integer pInterrupted public 0 // 1=user interrupt, 2=error interrupt
65327>>>>>>> property integer pRelate_State_Select public RS_GENERIC_RELATE // RS_NO_RELATE
65328>>>>>>> property integer pRelate_State public RS_GENERIC_RELATE // RS_NO_RELATE
65329>>>>>>> property integer pCustom_Sort_State public 0
65330>>>>>>> property integer pCustom_Sort_Object public 0
65331>>>>>>> property integer pFixedLengthRowID public 8 // Enough to hold a record number
65332>>>>>>> property integer pCustom_Sort_Dir public ASCENDING
65333>>>>>>> object Custom_Sort_Array is a cArray NO_IMAGE
65335>>>>>>> end_object
65336>>>>>>> end_procedure
65337>>>>>>>
65337>>>>>>> procedure initialize
65339>>>>>>> set pRecordCount to 0
65340>>>>>>> set pScanCount to 0
65341>>>>>>> set pInterrupted to 0
65342>>>>>>> send delete_data to (Custom_Sort_Array(self))
65343>>>>>>> end_procedure
65344>>>>>>>
65344>>>>>>> procedure reset
65346>>>>>>> send initialize
65347>>>>>>> end_procedure
65348>>>>>>>
65348>>>>>>> procedure jump_in
65350>>>>>>> clear (pMainFile(self))
65351>>>>>>> end_procedure
65352>>>>>>>
65352>>>>>>> function iselect returns integer
65354>>>>>>> function_return 1
65355>>>>>>> end_function
65356>>>>>>>
65356>>>>>>> function ijump_out returns integer
65358>>>>>>> end_function
65359>>>>>>>
65359>>>>>>> procedure scan_starts // Sent unconditionally at the beginning of a scan
65361>>>>>>> end_procedure
65362>>>>>>>
65362>>>>>>> procedure scan_ended // Sent unconditionally at the end of a scan
65364>>>>>>> end_procedure
65365>>>>>>>
65365>>>>>>> procedure scan_complete // Sent at the end of a scan if scan was complete
65367>>>>>>> end_procedure
65368>>>>>>>
65368>>>>>>> procedure scan_pInterrupted // Sent at the end of a scan if scan was
65370>>>>>>> end_procedure // pInterrupted
65371>>>>>>>
65371>>>>>>> procedure record_selected // Sent when a record is selected
65373>>>>>>> end_procedure
65374>>>>>>>
65374>>>>>>> procedure record_not_selected // Sent if record_selected is not sent
65376>>>>>>> end_procedure
65377>>>>>>>
65377>>>>>>> procedure record_found // Sent for each record found. This message is sent before
65379>>>>>>> end_procedure // it is determined if the record is selected or not.
65380>>>>>>>
65380>>>>>>> function Custom_Sort_Value returns string
65382>>>>>>> // This function must return the value to be sorted by if property
65382>>>>>>> // pCustom_Sort_State has been set to true
65382>>>>>>> integer obj#
65382>>>>>>> get pCustom_Sort_Object to obj#
65383>>>>>>> send ReadValues to obj#
65384>>>>>>> function_return (sIndexValue(obj#))
65385>>>>>>> end_function
65386>>>>>>>
65386>>>>>>> procedure Custom_Relate
65388>>>>>>> end_procedure
65389>>>>>>>
65389>>>>>>> function sRecordID returns integer
65391>>>>>>> // This function should return a unik identification of the active record.
65391>>>>>>> integer rec#
65391>>>>>>> get_field_value (pMainFile(self)) 0 to rec#
65394>>>>>>> function_return rec#
65395>>>>>>> end_function
65396>>>>>>>
65396>>>>>>> procedure run
65398>>>>>>> integer file# ord# pScanCount# pRecordCount# fin# found#
65398>>>>>>> integer Custom_Sort_State# Generic_Relate# Custom_Relate#
65398>>>>>>> integer Custom_Sort_Array# FixedLengthRowID# itm# max#
65398>>>>>>> integer Generic_Relate_Select# Custom_Relate_Select#
65398>>>>>>> integer IsSystemFile# lhDDO
65398>>>>>>>
65398>>>>>>> get pCustom_Sort_State to Custom_Sort_State#
65399>>>>>>> get pFixedLengthRowID to FixedLengthRowID#
65400>>>>>>>
65400>>>>>>> move (Custom_Sort_Array(self)) to Custom_Sort_Array#
65401>>>>>>>
65401>>>>>>> get pRelate_State to Generic_Relate#
65402>>>>>>> move (Generic_Relate# iand RS_CUSTOM_RELATE) to Custom_Relate#
65403>>>>>>> move (Generic_Relate# iand RS_GENERIC_RELATE) to Generic_Relate#
65404>>>>>>>
65404>>>>>>> get pRelate_State_Select to Generic_Relate_Select#
65405>>>>>>> move (Generic_Relate_Select# iand RS_CUSTOM_RELATE) to Custom_Relate_Select#
65406>>>>>>> move (Generic_Relate_Select# iand RS_GENERIC_RELATE) to Generic_Relate_Select#
65407>>>>>>>
65407>>>>>>> // If relates needs to be performed before the iSelect function we must
65407>>>>>>> // prevent it from happening after as well:
65407>>>>>>> ifnot Custom_Sort_State# begin
65409>>>>>>> if Custom_Relate_Select# move 0 to Custom_Relate#
65412>>>>>>> if Generic_Relate_Select# move 0 to Generic_Relate#
65415>>>>>>> end
65415>>>>>>>>
65415>>>>>>>
65415>>>>>>> get phDataSetObject to lhDDO
65416>>>>>>>
65416>>>>>>> if lhDDO begin
65418>>>>>>> get main_file of lhDDO to file#
65419>>>>>>> get ordering of lhDDO to ord#
65420>>>>>>> end
65420>>>>>>>>
65420>>>>>>> else begin
65421>>>>>>> get pMainFile to file#
65422>>>>>>> get pOrdering to ord#
65423>>>>>>> end
65423>>>>>>>>
65423>>>>>>>
65423>>>>>>> get_attribute DF_FILE_IS_SYSTEM_FILE of file# to IsSystemFile#
65426>>>>>>>
65426>>>>>>> move 0 to pRecordCount#
65427>>>>>>> move 0 to pScanCount#
65428>>>>>>> move 0 to fin#
65429>>>>>>> send initialize
65430>>>>>>> send scan_starts
65431>>>>>>> ifnot IsSystemFile# begin
65433>>>>>>> send jump_in
65434>>>>>>> if lhDDO send request_read to lhDDO FIRST_RECORD file# ord#
65437>>>>>>> else vfind file# ord# ge // Find first
65440>>>>>>> end
65440>>>>>>>>
65440>>>>>>> else indicate found TRUE
65442>>>>>>> repeat
65442>>>>>>>>
65442>>>>>>> if (pInterrupted(self)) indicate found FALSE
65445>>>>>>> move (found) to found#
65446>>>>>>> if found# move (not(ijump_out(self))) to found#
65449>>>>>>> ifnot found# move 1 to fin#
65452>>>>>>> else begin
65453>>>>>>> increment pScanCount#
65454>>>>>>> set pScanCount to pScanCount#
65455>>>>>>> send record_found
65456>>>>>>>
65456>>>>>>> if Generic_Relate_Select# relate file#
65459>>>>>>> if Custom_Relate_Select# send Custom_Relate
65462>>>>>>>
65462>>>>>>> if (iSelect(self)) begin
65464>>>>>>> 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#))
65467>>>>>>> else begin
65468>>>>>>> if Generic_Relate# relate file#
65471>>>>>>> if Custom_Relate# send Custom_Relate
65474>>>>>>> send record_selected
65475>>>>>>> end
65475>>>>>>>>
65475>>>>>>> increment pRecordCount#
65476>>>>>>> set pRecordCount to pRecordCount#
65477>>>>>>> end
65477>>>>>>>>
65477>>>>>>> else send record_not_selected
65479>>>>>>> if IsSystemFile# indicate found FALSE
65482>>>>>>> else begin
65483>>>>>>> if lhDDO send request_read to lhDDO GT file# ord#
65486>>>>>>> else vfind file# ord# gt // Find next
65489>>>>>>> end
65489>>>>>>>>
65489>>>>>>> end
65489>>>>>>>>
65489>>>>>>> until fin#
65491>>>>>>> if Custom_Sort_State# begin
65493>>>>>>> ifnot (pInterrupted(self)) begin
65495>>>>>>> send sort_items to Custom_Sort_Array# (pCustom_Sort_Dir(self))
65496>>>>>>> get item_count of Custom_Sort_Array# to max#
65497>>>>>>> for itm# from 0 to (max#-1)
65503>>>>>>>>
65503>>>>>>> clear file#
65504>>>>>>> set_field_value file# 0 to (right(value(Custom_Sort_Array#,itm#),FixedLengthRowID#))
65507>>>>>>> vfind file# 0 eq
65509>>>>>>> if Generic_Relate# relate file#
65512>>>>>>> if Custom_Relate# send Custom_Relate
65515>>>>>>> send record_selected
65516>>>>>>> loop
65517>>>>>>>>
65517>>>>>>> end
65517>>>>>>>>
65517>>>>>>> send delete_data to Custom_Sort_Array# // Release memory
65518>>>>>>> end
65518>>>>>>>>
65518>>>>>>> send scan_ended
65519>>>>>>> if (pInterrupted(self)) send scan_pInterrupted
65522>>>>>>> else send scan_complete
65524>>>>>>> set phDataSetObject to 0
65525>>>>>>> end_procedure
65526>>>>>>>
65526>>>>>>> procedure run.ii integer file# integer idx#
65528>>>>>>> set pMainFile to file#
65529>>>>>>> set pOrdering to idx#
65530>>>>>>> send run
65531>>>>>>> end_procedure
65532>>>>>>>end_class // cBasicDataScanner
65533>>>>>>>
65533>>>>>>>// This class is capable of evaluating a series of conditions set up
65533>>>>>>>// to decide which records should go in a report or a batch. The
65533>>>>>>>// conditions are logically AND'ed.
65533>>>>>>>//
65533>>>>>>>// Format: 0. type SIMPLE FUNCTION BOOLEAN
65533>>>>>>>// 1. file function ID Boolean expression
65533>>>>>>>// 2. field. object -
65533>>>>>>>// 3 type - -
65533>>>>>>>// 4. comp - -
65533>>>>>>>// 5. value 1 - -
65533>>>>>>>// 6. value 2 - -
65533>>>>>>>//
65533>>>>>>>class cSelectionCriteriaArray is a cArray
65534>>>>>>> procedure construct_object
65536>>>>>>> forward send construct_object
65538>>>>>>> property integer pMainFile public 0
65539>>>>>>> property integer pOrdering public 0
65540>>>>>>> send define_db_structure_layer_mixin
65541>>>>>>> object oJumpInValues is a cArray
65543>>>>>>> end_object
65544>>>>>>> object oJumpOutValues is a cArray
65546>>>>>>> end_object
65547>>>>>>> object oMustBeDestroyed is a cArray // or-list
65549>>>>>>> end_object
65550>>>>>>> end_procedure
65551>>>>>>> import_class_protocol db_structure_layer_mixin
65552>>>>>>> procedure show_Criteria
65554>>>>>>> end_procedure
65555>>>>>>> procedure show_JumpInValues
65557>>>>>>> integer obj# itm# max# base# comp#
65557>>>>>>> string val#
65557>>>>>>> DATASCAN$SHOWLN ("Jump-in values: "+idx_field_names(oIndexAnalyzer#,pOrdering(self),1,0))
65557>>>>>>> move (oJumpInValues(self)) to obj#
65558>>>>>>> move (item_count(obj#)/4-1) to max#
65559>>>>>>> for itm# from 1 to max#
65565>>>>>>>>
65565>>>>>>> move (itm#*4) to base#
65566>>>>>>> get value of obj# item (base#+1) to val#
65567>>>>>>> get value of obj# item (base#+2) to comp#
65568>>>>>>> DATASCAN$SHOWLN (" Segment "+string(itm#)+" ("+string(comp#)+"): "+val#)
65568>>>>>>> loop
65569>>>>>>>>
65569>>>>>>> end_procedure
65570>>>>>>> procedure show_JumpOutValues
65572>>>>>>> integer obj# itm# max# base# comp#
65572>>>>>>> string val#
65572>>>>>>> DATASCAN$SHOWLN ("Jump-out values: "+idx_field_names(oIndexAnalyzer#,pOrdering(self),1,0))
65572>>>>>>> move (oJumpOutValues(self)) to obj#
65573>>>>>>> move (item_count(obj#)/4-1) to max#
65574>>>>>>> for itm# from 1 to max#
65580>>>>>>>>
65580>>>>>>> move (itm#*4) to base#
65581>>>>>>> get value of obj# item (base#+1) to val#
65582>>>>>>> get value of obj# item (base#+2) to comp#
65583>>>>>>> DATASCAN$SHOWLN (" Segment "+string(itm#)+" ("+string(comp#)+"): "+val#)
65583>>>>>>> loop
65584>>>>>>>>
65584>>>>>>> end_procedure
65585>>>>>>> procedure reset
65587>>>>>>> integer lhMustBeDestroyed liMax liItm lhObj
65587>>>>>>> send delete_data
65588>>>>>>> send delete_data to (oJumpInValues(self))
65589>>>>>>> send delete_data to (oJumpOutValues(self))
65590>>>>>>> move (oMustBeDestroyed(self)) to lhMustBeDestroyed // or-list
65591>>>>>>> get item_count of lhMustBeDestroyed to liMax
65592>>>>>>> decrement liMax
65593>>>>>>> for liItm from 0 to liMax
65599>>>>>>>>
65599>>>>>>> get value of lhMustBeDestroyed item liItm to lhObj
65600>>>>>>> send request_destroy_object to lhObj
65601>>>>>>> loop
65602>>>>>>>>
65602>>>>>>> send delete_data to lhMustBeDestroyed
65603>>>>>>> end_procedure
65604>>>>>>> procedure add_criteria_boolean_expr string str#
65606>>>>>>> set value item (item_count(self)) to (SC_TYPE_BOOLEAN_EXPR*16384*16384)
65607>>>>>>> set value item (item_count(self)) to str#
65608>>>>>>> end_procedure
65609>>>>>>> // or-list
65609>>>>>>> function convert_orlist_to_array string lsValues returns integer
65611>>>>>>> integer liMax liItm lhArray lhMustBeDestroyed
65611>>>>>>> string lsItem
65611>>>>>>> object oOrListArray is a cArray
65613>>>>>>> move self to lhArray
65614>>>>>>> end_object
65615>>>>>>> get HowManyWords lsValues "|" to liMax
65616>>>>>>> for liItm from 1 to liMax
65622>>>>>>>>
65622>>>>>>> get ExtractWord lsValues "|" liItm to lsItem
65623>>>>>>> set value of lhArray item (liItm-1) to lsItem
65624>>>>>>> loop
65625>>>>>>>>
65625>>>>>>> move (oMustBeDestroyed(self)) to lhMustBeDestroyed
65626>>>>>>> set value of lhMustBeDestroyed item (item_count(lhMustBeDestroyed)) to lhArray
65627>>>>>>> function_return lhArray
65628>>>>>>> end_function
65629>>>>>>> procedure add_criteria_orlist integer liFile integer liField string lsValues // or-list
65631>>>>>>> integer type# composite# base# lhArray
65631>>>>>>> move (FieldInf_FieldType(liFile,liField)) to type#
65632>>>>>>> get iTranslate_DFTYPE type# to composite#
65633>>>>>>> move (composite#*64+SC_COMP_OR_LIST*4096+liFile*1024+liField) to composite#
65634>>>>>>> get item_count to base#
65635>>>>>>> set value item base# to composite#
65636>>>>>>> get convert_orlist_to_array lsValues to lhArray
65637>>>>>>> set value item (base#+1) to lhArray
65638>>>>>>> end_procedure
65639>>>>>>> procedure add_criteria_function integer msg# integer obj#
65641>>>>>>> set value item (item_count(self)) to (SC_TYPE_FUNCTION*16384+msg#*16384+obj#)
65642>>>>>>> end_procedure
65643>>>>>>> procedure add_criteria_simple integer file# integer fld# integer comp# string val1# string val2#
65645>>>>>>> integer type# composite# base#
65645>>>>>>> move (FieldInf_FieldType(file#,fld#)) to type#
65646>>>>>>> get iTranslate_DFTYPE type# to composite#
65647>>>>>>>// move (composite#*256+comp#*1024+file#*1024+fld#) to composite#
65647>>>>>>> move (composite#*64+comp#*4096+file#*1024+fld#) to composite#
65648>>>>>>> get item_count to base#
65649>>>>>>> set value item base# to composite#
65650>>>>>>> set value item (base#+1) to val1#
65651>>>>>>> if (comp#=SC_COMP_BETWEEN or comp#=SC_COMP_CBETWEEN) set value item (base#+2) to val2#
65654>>>>>>> end_procedure
65655>>>>>>>
65655>>>>>>> // or-list
65655>>>>>>> function bEvalOrListString integer liFile integer liField integer lhArray string lsValue returns integer
65657>>>>>>> integer liMax liItm
65657>>>>>>> get item_count of lhArray to liMax
65658>>>>>>> decrement liMax
65659>>>>>>> for liItm from 0 to liMax
65665>>>>>>>>
65665>>>>>>> if (lsValue=value(lhArray,liItm)) function_return 1
65668>>>>>>> loop
65669>>>>>>>>
65669>>>>>>> function_return 0
65670>>>>>>> end_function
65671>>>>>>>
65671>>>>>>> function bEvalOrListDate integer liFile integer liField integer lhArray date ldValue returns integer
65673>>>>>>> integer liMax liItm
65673>>>>>>> get item_count of lhArray to liMax
65674>>>>>>> decrement liMax
65675>>>>>>> for liItm from 0 to liMax
65681>>>>>>>>
65681>>>>>>> if (ldValue=value(lhArray,liItm)) function_return 1
65684>>>>>>> loop
65685>>>>>>>>
65685>>>>>>> function_return 0
65686>>>>>>> end_function
65687>>>>>>>
65687>>>>>>> function bEvalOrListNumber integer liFile integer liField integer lhArray number lnValue returns integer
65689>>>>>>> integer liMax liItm
65689>>>>>>> get item_count of lhArray to liMax
65690>>>>>>> decrement liMax
65691>>>>>>> for liItm from 0 to liMax
65697>>>>>>>>
65697>>>>>>> if (lnValue=value(lhArray,liItm)) function_return 1
65700>>>>>>> loop
65701>>>>>>>>
65701>>>>>>> function_return 0
65702>>>>>>> end_function
65703>>>>>>> //*************************************************************************
65703>>>>>>> // 1 1
65703>>>>>>> // 2 2
65703>>>>>>> // 3 4 3 2 1
65703>>>>>>> // 4 8 21098765 43210987 65432109 87654321
65703>>>>>>> // 5 16 xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx
65703>>>>>>> // 6 32
65703>>>>>>> // 7 64 Type-------TTTT
65703>>>>>>> // 8 128 Field------------------------------FF FFFFFFFF
65703>>>>>>> // 9 256 File--------------------FFFF FFFFFF
65703>>>>>>> // 10 512 Comperator-----CCCC CCCC
65703>>>>>>> // 11 1024
65703>>>>>>> // 12 2048
65703>>>>>>> // 13 4096
65703>>>>>>> // 14 8192
65703>>>>>>> // 15 16384
65703>>>>>>> // 16 32768
65703>>>>>>> // 17 65536
65703>>>>>>> function iEvaluate returns integer
65705>>>>>>> integer itm# max# sc_type# file# fld# comp# ok# composite# lhOrList
65705>>>>>>> date dat1# dat2# dat_val#
65705>>>>>>> number num1# num2# num_val#
65705>>>>>>> string str1# str2# str_val#
65705>>>>>>> get item_count to max#
65706>>>>>>> move 0 to itm#
65707>>>>>>> while itm# lt max#
65711>>>>>>> get value item itm# to composite#
65712>>>>>>> increment itm#
65713>>>>>>> move (composite#/16384/16384) to sc_type#
65714>>>>>>> if sc_type# eq SC_TYPE_BOOLEAN_EXPR begin
65716>>>>>>> get value item itm# to ok# // Overload (expression id)
65717>>>>>>> get sEvalExpression of (Query_ExprEvaluator(self)) ok# to ok#
65718>>>>>>> ifnot ok# function_return 0
65721>>>>>>> increment itm#
65722>>>>>>> end
65722>>>>>>>>
65722>>>>>>> else begin
65723>>>>>>> if sc_type# eq SC_TYPE_FUNCTION begin
65725>>>>>>> // In this section variable file# and fld# are treated as obj# and msg#
65725>>>>>>> move (composite# iand 16383) to file#
65726>>>>>>> move (composite# iand (16383*16384)) to fld#
65727>>>>>>> get fld# of file# to ok#
65728>>>>>>> ifnot ok# function_return 0
65731>>>>>>> end
65731>>>>>>>>
65731>>>>>>> else begin //
65732>>>>>>> move (composite# iand 1023) to fld#
65733>>>>>>> move ((composite# iand (4095*1024))/1024) to file#
65734>>>>>>> move ((composite# iand (63*4096*1024))/4096/1024) to comp#
65735>>>>>>>
65735>>>>>>> if comp# eq SC_COMP_OR_LIST get value item itm# to lhOrList // or-list
65738>>>>>>>
65738>>>>>>> if sc_type# eq SC_TYPE_ASCII begin
65740>>>>>>> get value item itm# to str1#
65741>>>>>>> increment itm#
65742>>>>>>> if (comp#=SC_COMP_BETWEEN or comp#=SC_COMP_CBETWEEN) begin
65744>>>>>>> get value item itm# to str2#
65745>>>>>>> increment itm#
65746>>>>>>> end
65746>>>>>>>>
65746>>>>>>> //get_field_value file# fld# to str_val#
65746>>>>>>> move (FieldInf_FieldValue(file#,fld#)) to str_val#
65747>>>>>>> if comp# eq SC_COMP_LT move (str_val#<str1#) to ok#
65750>>>>>>> if comp# eq SC_COMP_LE move (str_val#<=str1#) to ok#
65753>>>>>>> if comp# eq SC_COMP_EQ move (str_val#=str1#) to ok#
65756>>>>>>> if comp# eq SC_COMP_GE move (str_val#>=str1#) to ok#
65759>>>>>>> if comp# eq SC_COMP_GT move (str_val#>str1#) to ok#
65762>>>>>>> if comp# eq SC_COMP_NE move (str_val#<>str1#) to ok#
65765>>>>>>> if comp# eq SC_COMP_BETWEEN move (str_val#>=str1# and str_val#<=str2#) to ok#
65768>>>>>>> if comp# eq SC_COMP_IN begin
65770>>>>>>> if str1# in str_val# move 1 to ok#
65773>>>>>>> else move 0 to ok#
65775>>>>>>> end
65775>>>>>>>>
65775>>>>>>> if comp# eq SC_COMP_CONTAINS move (str_val# contains str1#) to ok#
65778>>>>>>> if comp# eq SC_COMP_CBETWEEN move (str_val#<str1# or str_val#>str2#) to ok#
65781>>>>>>> if comp# eq SC_COMP_CIN begin
65783>>>>>>>// move (not(str1# contains str_val#)) to ok#
65783>>>>>>> if str1# in str_val# move 0 to ok#
65786>>>>>>> else move 1 to ok#
65788>>>>>>> end
65788>>>>>>>>
65788>>>>>>> if comp# eq SC_COMP_CCONTAINS move (not(str_val# contains str1#)) to ok#
65791>>>>>>> if comp# eq SC_COMP_NOT_BLANK move (trim(str_val#)<>"") to ok#
65794>>>>>>> if comp# eq SC_COMP_BLANK move (trim(str_val#)="") to ok#
65797>>>>>>> if comp# eq SC_COMP_OR_LIST get bEvalOrListString file# fld# lhOrList str_val# to ok# // or-list
65800>>>>>>> end
65800>>>>>>>>
65800>>>>>>> if sc_type# eq SC_TYPE_DATE begin
65802>>>>>>> get value item itm# to dat1#
65803>>>>>>> increment itm#
65804>>>>>>> if (comp#=SC_COMP_BETWEEN or comp#=SC_COMP_CBETWEEN) begin
65806>>>>>>> get value item itm# to dat2#
65807>>>>>>> increment itm#
65808>>>>>>> end
65808>>>>>>>>
65808>>>>>>> //get_field_value file# fld# to dat_val#
65808>>>>>>> move (FieldInf_FieldValue(file#,fld#)) to dat_val#
65809>>>>>>> if comp# eq SC_COMP_LT move (dat_val#<dat1#) to ok#
65812>>>>>>> if comp# eq SC_COMP_LE move (dat_val#<=dat1#) to ok#
65815>>>>>>> if comp# eq SC_COMP_EQ move (dat_val#=dat1#) to ok#
65818>>>>>>> if comp# eq SC_COMP_GE move (dat_val#>=dat1#) to ok#
65821>>>>>>> if comp# eq SC_COMP_GT move (dat_val#>dat1#) to ok#
65824>>>>>>> if comp# eq SC_COMP_NE move (dat_val#<>dat1#) to ok#
65827>>>>>>> if comp# eq SC_COMP_BETWEEN move (dat_val#>=dat1# and dat_val#<=dat2#) to ok#
65830>>>>>>> if comp# eq SC_COMP_CBETWEEN move (dat_val#<dat1# or dat_val#>dat2#) to ok#
65833>>>>>>> if comp# eq SC_COMP_OR_LIST get bEvalOrListDate file# fld# lhOrList dat_val# to ok# // or-list
65836>>>>>>> end
65836>>>>>>>>
65836>>>>>>> if sc_type# eq SC_TYPE_NUMERIC begin
65838>>>>>>> get value item itm# to num1#
65839>>>>>>> increment itm#
65840>>>>>>> if (comp#=SC_COMP_BETWEEN or comp#=SC_COMP_CBETWEEN) begin
65842>>>>>>> get value item itm# to num2#
65843>>>>>>> increment itm#
65844>>>>>>> end
65844>>>>>>>>
65844>>>>>>> //get_field_value file# fld# to num_val#
65844>>>>>>> move (FieldInf_FieldValue(file#,fld#)) to num_val#
65845>>>>>>> if comp# eq SC_COMP_LT move (num_val#<num1#) to ok#
65848>>>>>>> if comp# eq SC_COMP_LE move (num_val#<=num1#) to ok#
65851>>>>>>> if comp# eq SC_COMP_EQ move (num_val#=num1#) to ok#
65854>>>>>>> if comp# eq SC_COMP_GE move (num_val#>=num1#) to ok#
65857>>>>>>> if comp# eq SC_COMP_GT move (num_val#>num1#) to ok#
65860>>>>>>> if comp# eq SC_COMP_NE move (num_val#<>num1#) to ok#
65863>>>>>>> if comp# eq SC_COMP_BETWEEN move (num_val#>=num1# and num_val#<=num2#) to ok#
65866>>>>>>> if comp# eq SC_COMP_CBETWEEN move (num_val#<num1# or num_val#>num2#) to ok#
65869>>>>>>> if comp# eq SC_COMP_OR_LIST get bEvalOrListNumber file# fld# lhOrList num_val# to ok# // or-list
65872>>>>>>> end
65872>>>>>>>>
65872>>>>>>> ifnot ok# function_return 0
65875>>>>>>> end
65875>>>>>>>>
65875>>>>>>> end
65875>>>>>>>>
65875>>>>>>> end
65876>>>>>>>>
65876>>>>>>> function_return 1
65877>>>>>>> end_function
65878>>>>>>> procedure AnalyzeJumpInOutValuesHelp integer testfile# integer testfld# ; integer testsegm#
65880>>>>>>> integer itm# max# sc_type# file# fld# comp# composite# current_segments#
65880>>>>>>> integer oJumpInValues# oJumpOutValues# AnyJumpIn# AnyJumpOut# hit#
65880>>>>>>> integer JumpInComp# JumpOutComp# TestType#
65880>>>>>>> date dat1# dat2# JumpInDat# JumpOutDat#
65880>>>>>>> number num1# num2# JumpInNum# JumpOutNum#
65880>>>>>>> string str1# str2# JumpInStr# JumpOutStr#
65880>>>>>>> move 0 to AnyJumpIn#
65881>>>>>>> move 0 to AnyJumpOut#
65882>>>>>>> get item_count to max#
65883>>>>>>> move 0 to itm#
65884>>>>>>> while itm# lt (max#-1)
65888>>>>>>> get value item itm# to composite#
65889>>>>>>> increment itm#
65890>>>>>>> move (composite#/16384/16384) to sc_type#
65891>>>>>>> if sc_type# eq SC_TYPE_BOOLEAN_EXPR increment itm#
65894>>>>>>> else begin
65895>>>>>>> if sc_type# ne SC_TYPE_FUNCTION begin
65897>>>>>>> move (composite# iand 1023) to fld#
65898>>>>>>> move ((composite# iand (4095*1024))/1024) to file#
65899>>>>>>> move ((composite# iand (63*4096*1024))/4096/1024) to comp#
65900>>>>>>> move (file#=testfile# and fld#=testfld#) to hit#
65901>>>>>>> if hit# begin
65903>>>>>>> move sc_type# to TestType#
65904>>>>>>> if sc_type# eq SC_TYPE_ASCII begin
65906>>>>>>> get value item itm# to str1#
65907>>>>>>> increment itm#
65908>>>>>>> if comp# eq SC_COMP_BETWEEN begin
65910>>>>>>> get value item itm# to str2#
65911>>>>>>> increment itm#
65912>>>>>>> end
65912>>>>>>>>
65912>>>>>>> if comp# eq SC_COMP_LT begin
65914>>>>>>> ifnot AnyJumpOut# move str1# to JumpOutStr#
65917>>>>>>> else if str1# lt JumpOutStr# move str1# to JumpOutStr#
65921>>>>>>> move 1 to AnyJumpOut#
65922>>>>>>> move SC_COMP_LT to JumpOutComp#
65923>>>>>>> end
65923>>>>>>>>
65923>>>>>>> if comp# eq SC_COMP_LE begin
65925>>>>>>> ifnot AnyJumpOut# move str1# to JumpOutStr#
65928>>>>>>> else if str1# lt JumpOutStr# move str1# to JumpOutStr#
65932>>>>>>> move 1 to AnyJumpOut#
65933>>>>>>> move SC_COMP_LE to JumpOutComp#
65934>>>>>>> end
65934>>>>>>>>
65934>>>>>>> if comp# eq SC_COMP_EQ begin
65936>>>>>>> ifnot AnyJumpOut# move str1# to JumpOutStr#
65939>>>>>>> else if str1# lt JumpOutStr# move str1# to JumpOutStr#
65943>>>>>>> ifnot AnyJumpIn# move str1# to JumpInStr#
65946>>>>>>> else if str1# gt JumpInStr# move str1# to JumpInStr#
65950>>>>>>> move 1 to AnyJumpOut#
65951>>>>>>> move 1 to AnyJumpIn#
65952>>>>>>> move SC_COMP_GE to JumpInComp#
65953>>>>>>> move SC_COMP_LE to JumpOutComp#
65954>>>>>>> end
65954>>>>>>>>
65954>>>>>>> if comp# eq SC_COMP_GE begin
65956>>>>>>> ifnot AnyJumpIn# move str1# to JumpInStr#
65959>>>>>>> else if str1# gt JumpInStr# move str1# to JumpInStr#
65963>>>>>>> move 1 to AnyJumpIn#
65964>>>>>>> move SC_COMP_GE to JumpInComp#
65965>>>>>>> end
65965>>>>>>>>
65965>>>>>>> if comp# eq SC_COMP_GT begin
65967>>>>>>> ifnot AnyJumpIn# move str1# to JumpInStr#
65970>>>>>>> else if str1# gt JumpInStr# move str1# to JumpInStr#
65974>>>>>>> move 1 to AnyJumpIn#
65975>>>>>>> move SC_COMP_GT to JumpInComp#
65976>>>>>>> end
65976>>>>>>>>
65976>>>>>>> if comp# eq SC_COMP_BETWEEN begin
65978>>>>>>> ifnot AnyJumpIn# move str1# to JumpInStr#
65981>>>>>>> else if str1# gt JumpInStr# move str1# to JumpInStr#
65985>>>>>>> ifnot AnyJumpOut# move str2# to JumpOutStr#
65988>>>>>>> else if str2# lt JumpOutStr# move str2# to JumpOutStr#
65992>>>>>>> move 1 to AnyJumpOut#
65993>>>>>>> move 1 to AnyJumpIn#
65994>>>>>>> move SC_COMP_GE to JumpInComp#
65995>>>>>>> move SC_COMP_LE to JumpOutComp#
65996>>>>>>> end
65996>>>>>>>>
65996>>>>>>> end // SC_TYPE_ASCII
65996>>>>>>>>
65996>>>>>>> if sc_type# eq SC_TYPE_DATE begin
65998>>>>>>> if (item_count(self)>itm#) get value item itm# to Dat1#
66001>>>>>>> else move 06/05/1962 to Dat1# // Let's just assume that you haven't a single data item on my birth date.
66003>>>>>>> increment itm#
66004>>>>>>> if comp# eq SC_COMP_BETWEEN begin
66006>>>>>>> get value item itm# to Dat2#
66007>>>>>>> increment itm#
66008>>>>>>> end
66008>>>>>>>>
66008>>>>>>> if comp# eq SC_COMP_LT begin
66010>>>>>>> ifnot AnyJumpOut# move Dat1# to JumpOutDat#
66013>>>>>>> else if Dat1# lt JumpOutDat# move Dat1# to JumpOutDat#
66017>>>>>>> move 1 to AnyJumpOut#
66018>>>>>>> move SC_COMP_LT to JumpOutComp#
66019>>>>>>> end
66019>>>>>>>>
66019>>>>>>> if comp# eq SC_COMP_LE begin
66021>>>>>>> ifnot AnyJumpOut# move Dat1# to JumpOutDat#
66024>>>>>>> else if Dat1# lt JumpOutDat# move Dat1# to JumpOutDat#
66028>>>>>>> move 1 to AnyJumpOut#
66029>>>>>>> move SC_COMP_LE to JumpOutComp#
66030>>>>>>> end
66030>>>>>>>>
66030>>>>>>> if comp# eq SC_COMP_EQ begin
66032>>>>>>> ifnot AnyJumpOut# move Dat1# to JumpOutDat#
66035>>>>>>> else if Dat1# lt JumpOutDat# move Dat1# to JumpOutDat#
66039>>>>>>> ifnot AnyJumpIn# move Dat1# to JumpInDat#
66042>>>>>>> else if Dat1# gt JumpInDat# move Dat1# to JumpInDat#
66046>>>>>>> move 1 to AnyJumpOut#
66047>>>>>>> move 1 to AnyJumpIn#
66048>>>>>>> move SC_COMP_GE to JumpInComp#
66049>>>>>>> move SC_COMP_LE to JumpOutComp#
66050>>>>>>> end
66050>>>>>>>>
66050>>>>>>> if comp# eq SC_COMP_GE begin
66052>>>>>>> ifnot AnyJumpIn# move Dat1# to JumpInDat#
66055>>>>>>> else if Dat1# gt JumpInDat# move Dat1# to JumpInDat#
66059>>>>>>> move 1 to AnyJumpIn#
66060>>>>>>> move SC_COMP_GE to JumpInComp#
66061>>>>>>> end
66061>>>>>>>>
66061>>>>>>> if comp# eq SC_COMP_GT begin
66063>>>>>>> ifnot AnyJumpIn# move Dat1# to JumpInDat#
66066>>>>>>> else if Dat1# gt JumpInDat# move Dat1# to JumpInDat#
66070>>>>>>> move 1 to AnyJumpIn#
66071>>>>>>> move SC_COMP_GT to JumpInComp#
66072>>>>>>> end
66072>>>>>>>>
66072>>>>>>> if comp# eq SC_COMP_BETWEEN begin
66074>>>>>>> ifnot AnyJumpIn# move Dat1# to JumpInDat#
66077>>>>>>> else if Dat1# gt JumpInDat# move Dat1# to JumpInDat#
66081>>>>>>> ifnot AnyJumpOut# move Dat2# to JumpOutDat#
66084>>>>>>> else if Dat2# lt JumpOutDat# move Dat2# to JumpOutDat#
66088>>>>>>> move 1 to AnyJumpOut#
66089>>>>>>> move 1 to AnyJumpIn#
66090>>>>>>> move SC_COMP_GE to JumpInComp#
66091>>>>>>> move SC_COMP_LE to JumpOutComp#
66092>>>>>>> end
66092>>>>>>>>
66092>>>>>>> end // SC_TYPE_DATE
66092>>>>>>>>
66092>>>>>>> if sc_type# eq SC_TYPE_NUMERIC begin
66094>>>>>>> get value item itm# to Num1#
66095>>>>>>> increment itm#
66096>>>>>>> if comp# eq SC_COMP_BETWEEN begin
66098>>>>>>> get value item itm# to Num2#
66099>>>>>>> increment itm#
66100>>>>>>> end
66100>>>>>>>>
66100>>>>>>> if comp# eq SC_COMP_LT begin
66102>>>>>>> ifnot AnyJumpOut# move Num1# to JumpOutNum#
66105>>>>>>> else if Num1# lt JumpOutNum# move Num1# to JumpOutNum#
66109>>>>>>> move 1 to AnyJumpOut#
66110>>>>>>> move SC_COMP_LT to JumpOutComp#
66111>>>>>>> end
66111>>>>>>>>
66111>>>>>>> if comp# eq SC_COMP_LE begin
66113>>>>>>> ifnot AnyJumpOut# move Num1# to JumpOutNum#
66116>>>>>>> else if Num1# lt JumpOutNum# move Num1# to JumpOutNum#
66120>>>>>>> move 1 to AnyJumpOut#
66121>>>>>>> move SC_COMP_LE to JumpOutComp#
66122>>>>>>> end
66122>>>>>>>>
66122>>>>>>> if comp# eq SC_COMP_EQ begin
66124>>>>>>> ifnot AnyJumpOut# move Num1# to JumpOutNum#
66127>>>>>>> else if Num1# lt JumpOutNum# move Num1# to JumpOutNum#
66131>>>>>>> ifnot AnyJumpIn# move Num1# to JumpInNum#
66134>>>>>>> else if Num1# gt JumpInNum# move Num1# to JumpInNum#
66138>>>>>>> move 1 to AnyJumpOut#
66139>>>>>>> move 1 to AnyJumpIn#
66140>>>>>>> move SC_COMP_GE to JumpInComp#
66141>>>>>>> move SC_COMP_LE to JumpOutComp#
66142>>>>>>> end
66142>>>>>>>>
66142>>>>>>> if comp# eq SC_COMP_GE begin
66144>>>>>>> ifnot AnyJumpIn# move Num1# to JumpInNum#
66147>>>>>>> else if Num1# gt JumpInNum# move Num1# to JumpInNum#
66151>>>>>>> move 1 to AnyJumpIn#
66152>>>>>>> move SC_COMP_GE to JumpInComp#
66153>>>>>>> end
66153>>>>>>>>
66153>>>>>>> if comp# eq SC_COMP_GT begin
66155>>>>>>> ifnot AnyJumpIn# move Num1# to JumpInNum#
66158>>>>>>> else if Num1# gt JumpInNum# move Num1# to JumpInNum#
66162>>>>>>> move 1 to AnyJumpIn#
66163>>>>>>> move SC_COMP_GT to JumpInComp#
66164>>>>>>> end
66164>>>>>>>>
66164>>>>>>> if comp# eq SC_COMP_BETWEEN begin
66166>>>>>>> ifnot AnyJumpIn# move Num1# to JumpInNum#
66169>>>>>>> else if Num1# gt JumpInNum# move Num1# to JumpInNum#
66173>>>>>>> ifnot AnyJumpOut# move Num2# to JumpOutNum#
66176>>>>>>> else if Num2# lt JumpOutNum# move Num2# to JumpOutNum#
66180>>>>>>> move 1 to AnyJumpOut#
66181>>>>>>> move 1 to AnyJumpIn#
66182>>>>>>> move SC_COMP_GE to JumpInComp#
66183>>>>>>> move SC_COMP_LE to JumpOutComp#
66184>>>>>>> end
66184>>>>>>>>
66184>>>>>>> end // SC_TYPE_NUMERIC
66184>>>>>>>>
66184>>>>>>> end
66184>>>>>>>>
66184>>>>>>> else begin
66185>>>>>>> increment itm#
66186>>>>>>> if comp# eq SC_COMP_BETWEEN increment itm#
66189>>>>>>> end
66189>>>>>>>>
66189>>>>>>> end
66189>>>>>>>>
66189>>>>>>> end
66189>>>>>>>>
66189>>>>>>> end
66190>>>>>>>>
66190>>>>>>>
66190>>>>>>> if AnyJumpIn# begin
66192>>>>>>> move (oJumpInValues(self)) to oJumpInValues#
66193>>>>>>> get value of oJumpInValues# item 0 to current_segments#
66194>>>>>>> if current_segments# eq (testsegm#-1) begin
66196>>>>>>> set value of oJumpInValues# item 0 to testsegm#
66197>>>>>>> set value of oJumpInValues# item (testsegm#*4+0) to TestType#
66198>>>>>>> if TestType# eq SC_TYPE_ASCII set value of oJumpInValues# item (testsegm#*4+1) to JumpInStr#
66201>>>>>>> if TestType# eq SC_TYPE_DATE set value of oJumpInValues# item (testsegm#*4+1) to JumpInDat#
66204>>>>>>> if TestType# eq SC_TYPE_NUMERIC set value of oJumpInValues# item (testsegm#*4+1) to JumpInNum#
66207>>>>>>> set value of oJumpInValues# item (testsegm#*4+2) to JumpInComp#
66208>>>>>>> set value of oJumpInValues# item (testsegm#*4+3) to TestFld#
66209>>>>>>> end
66209>>>>>>>>
66209>>>>>>> end
66209>>>>>>>>
66209>>>>>>> if AnyJumpOut# begin
66211>>>>>>> move (oJumpOutValues(self)) to oJumpOutValues#
66212>>>>>>> get value of oJumpOutValues# item 0 to current_segments#
66213>>>>>>> if current_segments# eq (testsegm#-1) begin
66215>>>>>>> set value of oJumpOutValues# item 0 to testsegm#
66216>>>>>>> set value of oJumpOutValues# item (testsegm#*4+0) to TestType#
66217>>>>>>> if TestType# eq SC_TYPE_ASCII set value of oJumpOutValues# item (testsegm#*4+1) to JumpOutStr#
66220>>>>>>> if TestType# eq SC_TYPE_DATE set value of oJumpOutValues# item (testsegm#*4+1) to JumpOutDat#
66223>>>>>>> if TestType# eq SC_TYPE_NUMERIC set value of oJumpOutValues# item (testsegm#*4+1) to JumpOutNum#
66226>>>>>>> set value of oJumpOutValues# item (testsegm#*4+2) to JumpOutComp#
66227>>>>>>> set value of oJumpOutValues# item (testsegm#*4+3) to TestFld#
66228>>>>>>> end
66228>>>>>>>>
66228>>>>>>> end // While
66228>>>>>>>>
66228>>>>>>> end_procedure
66229>>>>>>>
66229>>>>>>> procedure seed_lowest_possible integer file# integer fld# integer dir# integer seg#
66231>>>>>>> integer len# type# dec# oJumpInValues#
66231>>>>>>> date seeding_date#
66231>>>>>>> number seeding_number#
66231>>>>>>> string seeding_string#
66231>>>>>>> get_attribute DF_FIELD_TYPE of file# fld# to type#
66234>>>>>>> if type# eq DF_BCD begin
66236>>>>>>> get_attribute DF_FIELD_LENGTH of file# fld# to len#
66239>>>>>>> get_attribute DF_FIELD_PRECISION of file# fld# to dec#
66242>>>>>>> move (len#-dec#) to len#
66243>>>>>>> if dir# eq DF_DESCENDING begin // Highest possible
66245>>>>>>> if dec# move (repeat("9",len#)+CurrentDecimalSeparator()+repeat("9",dec#)) to seeding_string#
66248>>>>>>> else move (repeat("9",len#)) to seeding_string#
66250>>>>>>> end
66250>>>>>>>>
66250>>>>>>> else begin // Lowest possible
66251>>>>>>> decrement len#
66252>>>>>>> if dec# move ("-"+repeat("9",len#)+CurrentDecimalSeparator()+repeat("9",dec#)) to seeding_string#
66255>>>>>>> else move ("-"+repeat("9",len#)) to seeding_string#
66257>>>>>>> end
66257>>>>>>>>
66257>>>>>>> move seeding_string# to seeding_number#
66258>>>>>>> end
66258>>>>>>>>
66258>>>>>>> if type# eq DF_DATE if dir# eq DF_DESCENDING move LargestPossibleDate to seeding_date#
66263>>>>>>>
66263>>>>>>> get iTranslate_DFTYPE type# to type#
66264>>>>>>> move (oJumpInValues(self)) to oJumpInValues#
66265>>>>>>> set value of oJumpInValues# item (seg#*4+0) to Type#
66266>>>>>>> if Type# eq SC_TYPE_ASCII set value of oJumpInValues# item (seg#*4+1) to seeding_string#
66269>>>>>>> if Type# eq SC_TYPE_DATE set value of oJumpInValues# item (seg#*4+1) to seeding_date#
66272>>>>>>> if Type# eq SC_TYPE_NUMERIC set value of oJumpInValues# item (seg#*4+1) to seeding_number#
66275>>>>>>> set value of oJumpInValues# item (seg#*4+2) to SC_COMP_GE
66276>>>>>>> set value of oJumpInValues# item (seg#*4+3) to Fld#
66277>>>>>>> set value of oJumpInValues# item 0 to (value(oJumpInValues#,0)+1)
66278>>>>>>> end_procedure
66279>>>>>>>
66279>>>>>>> procedure AnalyzeJumpInOutValues integer file# integer idx#
66281>>>>>>> integer segment# max# fld# dir# stop#
66281>>>>>>> integer last_segment_seeded#
66281>>>>>>> string lsFields
66281>>>>>>> set pMainFile to file#
66282>>>>>>> set pOrdering to idx#
66283>>>>>>>
66283>>>>>>> //get FDX_IndexAsFields 0 file# idx# to lsFields
66283>>>>>>> //get FDX_FieldsTranslateOverlaps 0 file# lsFields to lsFields
66283>>>>>>> //if dir# eq DF_DESCENDING move ("-"+fname#) to fname#
66283>>>>>>> //get FDX_AttrValue_IDXSEG oFDX# DF_INDEX_SEGMENT_DIRECTION file# index# segment# to dir#
66283>>>>>>>
66283>>>>>>>
66283>>>>>>> send read_file_definition to oIndexAnalyzer# file#
66284>>>>>>> send idx_translate_overlaps_all to oIndexAnalyzer#
66285>>>>>>> get idx_max_segment of oIndexAnalyzer# idx# to max#
66286>>>>>>> move 0 to stop#
66287>>>>>>> move 0 to last_segment_seeded#
66288>>>>>>>
66288>>>>>>> for segment# from 1 to max#
66294>>>>>>>>
66294>>>>>>> get idx_Segment_Direction of oIndexAnalyzer# idx# segment# to dir#
66295>>>>>>> if dir# eq DF_DESCENDING move 1 to stop# // Stop seeding if descending segment.
66298>>>>>>> ifnot stop# begin
66300>>>>>>> get idx_segment of oIndexAnalyzer# idx# segment# to fld#
66301>>>>>>> send AnalyzeJumpInOutValuesHelp file# fld# segment#
66302>>>>>>> move segment# to last_segment_seeded#
66303>>>>>>> end
66303>>>>>>>>
66303>>>>>>> loop
66304>>>>>>>>
66304>>>>>>>
66304>>>>>>> if last_segment_seeded# lt max# begin // If not all segments were seeded
66306>>>>>>> // Get number of first field not seeded:
66306>>>>>>> get idx_segment of oIndexAnalyzer# idx# (last_segment_seeded#+1) to fld#
66307>>>>>>> // Get direction of first segment not seeded:
66307>>>>>>> get idx_Segment_Direction of oIndexAnalyzer# idx# (last_segment_seeded#+1) to dir#
66308>>>>>>> // Seed
66308>>>>>>> send seed_lowest_possible file# fld# dir# (last_segment_seeded#+1)
66309>>>>>>> end
66309>>>>>>>>
66309>>>>>>> end_procedure
66310>>>>>>>
66310>>>>>>> procedure seed_buffer.i integer file#
66312>>>>>>> integer Segment# max# oJumpInValues# type# Fld#
66312>>>>>>> number JumpInNum#
66312>>>>>>> date JumpInDat#
66312>>>>>>> string JumpInStr#
66312>>>>>>> move (oJumpInValues(self)) to oJumpInValues#
66313>>>>>>> get value of oJumpInValues# item 0 to max#
66314>>>>>>> for Segment# from 1 to max#
66320>>>>>>>>
66320>>>>>>> get value of oJumpInValues# item (Segment#*4+0) to type#
66321>>>>>>> if type# eq SC_TYPE_ASCII get value of oJumpInValues# item (Segment#*4+1) to JumpInStr#
66324>>>>>>> if type# eq SC_TYPE_DATE get value of oJumpInValues# item (Segment#*4+1) to JumpInDat#
66327>>>>>>> if type# eq SC_TYPE_NUMERIC get value of oJumpInValues# item (Segment#*4+1) to JumpInNum#
66330>>>>>>> get value of oJumpInValues# item (Segment#*4+3) to Fld#
66331>>>>>>> if type# eq SC_TYPE_ASCII set_field_value file# fld# to JumpInStr#
66336>>>>>>> if type# eq SC_TYPE_DATE set_field_value file# fld# to JumpInDat#
66341>>>>>>> if type# eq SC_TYPE_NUMERIC set_field_value file# fld# to JumpInNum#
66346>>>>>>> loop
66347>>>>>>>>
66347>>>>>>> end_procedure
66348>>>>>>>
66348>>>>>>> function iJumpOut.i integer file# returns integer
66350>>>>>>> integer Segment# max# oJumpOutValues# Type# Fld# Comp# lbEnough
66350>>>>>>> number JumpOutNum# nCurrentVal#
66350>>>>>>> date JumpOutDat# dCurrentVal#
66350>>>>>>> string JumpOutStr# sCurrentVal#
66350>>>>>>> move (oJumpOutValues(self)) to oJumpOutValues#
66351>>>>>>> get value of oJumpOutValues# item 0 to max#
66352>>>>>>> move DFFALSE to lbEnough
66353>>>>>>> for Segment# from 1 to max#
66359>>>>>>>>
66359>>>>>>> ifnot lbEnough begin
66361>>>>>>> get value of oJumpOutValues# item (Segment#*4+0) to Type#
66362>>>>>>> get value of oJumpOutValues# item (Segment#*4+2) to Comp#
66363>>>>>>> get value of oJumpOutValues# item (Segment#*4+3) to Fld#
66364>>>>>>> if type# eq SC_TYPE_ASCII begin
66366>>>>>>> get value of oJumpOutValues# item (Segment#*4+1) to JumpOutStr#
66367>>>>>>> get_field_value file# fld# to sCurrentVal#
66370>>>>>>> if comp# eq SC_COMP_LT if sCurrentVal# GE JumpOutStr# function_return 1
66375>>>>>>> if comp# eq SC_COMP_LE if sCurrentVal# GT JumpOutStr# function_return 1
66380>>>>>>> if sCurrentVal# NE JumpOutStr# move DFTRUE to lbEnough
66383>>>>>>> end
66383>>>>>>>>
66383>>>>>>> else if type# eq SC_TYPE_DATE begin
66386>>>>>>> get value of oJumpOutValues# item (Segment#*4+1) to JumpOutDat#
66387>>>>>>> get_field_value file# fld# to dCurrentVal#
66390>>>>>>> if comp# eq SC_COMP_LT if dCurrentVal# GE JumpOutDat# function_return 1
66395>>>>>>> if comp# eq SC_COMP_LE if dCurrentVal# GT JumpOutDat# function_return 1
66400>>>>>>> if dCurrentVal# NE JumpOutDat# move DFTRUE to lbEnough
66403>>>>>>> end
66403>>>>>>>>
66403>>>>>>> else if type# eq SC_TYPE_NUMERIC begin
66406>>>>>>> get value of oJumpOutValues# item (Segment#*4+1) to JumpOutNum#
66407>>>>>>> get_field_value file# fld# to nCurrentVal#
66410>>>>>>> if comp# eq SC_COMP_LT if nCurrentVal# GE JumpOutNum# function_return 1
66415>>>>>>> if comp# eq SC_COMP_LE if nCurrentVal# GT JumpOutNum# function_return 1
66420>>>>>>> if nCurrentVal# NE JumpOutNum# move DFTRUE to lbEnough
66423>>>>>>> end
66423>>>>>>>>
66423>>>>>>> end
66423>>>>>>>>
66423>>>>>>> loop
66424>>>>>>>>
66424>>>>>>> end_function
66425>>>>>>>end_class // cSelectionCriteriaArray
66426>>>>>>>
66426>>>>>>>class cDataScanner is a cBasicDataScanner
66427>>>>>>> procedure construct_object
66429>>>>>>> forward send construct_object
66431>>>>>>> object oSelectionCriteriaArray is a cSelectionCriteriaArray
66433>>>>>>> end_object
66434>>>>>>> end_procedure
66435>>>>>>> procedure jump_in
66437>>>>>>> integer file# idx#
66437>>>>>>> get pMainFile to file#
66438>>>>>>> get pOrdering to idx#
66439>>>>>>> forward send jump_in // Clears the record buffer
66441>>>>>>> send seed_buffer.i to (oSelectionCriteriaArray(self)) file#
66442>>>>>>> end_procedure
66443>>>>>>> function iSelect returns integer
66445>>>>>>> function_return (iEvaluate(oSelectionCriteriaArray(self)))
66446>>>>>>> end_function
66447>>>>>>> function iJump_Out returns integer
66449>>>>>>> function_return (iJumpOut.i(oSelectionCriteriaArray(self),pMainFile(self)))
66450>>>>>>> end_function
66451>>>>>>> procedure reset_crit
66453>>>>>>> send reset to (oSelectionCriteriaArray(self))
66454>>>>>>> end_procedure
66455>>>>>>> procedure reset
66457>>>>>>> forward send reset
66459>>>>>>> send reset_crit
66460>>>>>>> end_procedure
66461>>>>>>> procedure add_criteria_boolean_expr string str#
66463>>>>>>> send add_criteria_boolean_expr to (oSelectionCriteriaArray(self)) str#
66464>>>>>>> end_procedure
66465>>>>>>> procedure add_criteria_function integer msg# integer obj#
66467>>>>>>> send add_criteria_function to (oSelectionCriteriaArray(self)) msg# obj#
66468>>>>>>> end_procedure
66469>>>>>>> procedure add_criteria_simple integer file# integer fld# integer comp# string val1# string val2#
66471>>>>>>> send add_criteria_simple to (oSelectionCriteriaArray(self)) file# fld# comp# val1# val2#
66472>>>>>>> end_procedure
66473>>>>>>> // or-list
66473>>>>>>> procedure add_criteria_orlist integer file# integer fld# string lsValues
66475>>>>>>> send add_criteria_orlist to (oSelectionCriteriaArray(self)) file# fld# lsValues
66476>>>>>>> end_procedure
66477>>>>>>> procedure run
66479>>>>>>> send AnalyzeJumpInOutValues to (oSelectionCriteriaArray(self)) (pMainFile(self)) (pOrdering(self))
66480>>>>>>> send show_JumpInValues to (oSelectionCriteriaArray(self))
66481>>>>>>> send show_JumpOutValues to (oSelectionCriteriaArray(self))
66482>>>>>>> forward send run
66484>>>>>>> end_procedure
66485>>>>>>>end_class // cDataScanner
66486>>>>>>>
66486>>>>>>>class cBreakHandler is a cArray
66487>>>>>>> procedure construct_object
66489>>>>>>> forward send construct_object
66491>>>>>>> property integer prv.piFirstRec public DFTRUE
66492>>>>>>> end_procedure
66493>>>>>>> item_property_list
66493>>>>>>> item_property integer piFile.i // What file? (always main file)
66493>>>>>>> item_property integer piField.i // What field? (If file is 0 then Break field is a function ID)
66493>>>>>>> item_property integer phExprArr.i
66493>>>>>>> item_property integer piExprRow.i
66493>>>>>>> item_property integer piLevel.i // A change in value triggers a break in what level?
66493>>>>>>> item_property string psPreviousValue.i
66493>>>>>>> end_item_property_list cBreakHandler
#REM 66537 DEFINE FUNCTION PSPREVIOUSVALUE.I INTEGER LIROW RETURNS STRING
#REM 66541 DEFINE PROCEDURE SET PSPREVIOUSVALUE.I INTEGER LIROW STRING VALUE
#REM 66545 DEFINE FUNCTION PILEVEL.I INTEGER LIROW RETURNS INTEGER
#REM 66549 DEFINE PROCEDURE SET PILEVEL.I INTEGER LIROW INTEGER VALUE
#REM 66553 DEFINE FUNCTION PIEXPRROW.I INTEGER LIROW RETURNS INTEGER
#REM 66557 DEFINE PROCEDURE SET PIEXPRROW.I INTEGER LIROW INTEGER VALUE
#REM 66561 DEFINE FUNCTION PHEXPRARR.I INTEGER LIROW RETURNS INTEGER
#REM 66565 DEFINE PROCEDURE SET PHEXPRARR.I INTEGER LIROW INTEGER VALUE
#REM 66569 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 66573 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 66577 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 66581 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
66586>>>>>>> procedure add_break_field integer liFile integer liField integer liExprRow integer lhExprArr
66588>>>>>>> integer liRow
66588>>>>>>> get row_count to liRow
66589>>>>>>> set piFile.i liRow to liFile
66590>>>>>>> set piField.i liRow to liField
66591>>>>>>> set phExprArr.i liRow to lhExprArr
66592>>>>>>> set piExprRow.i liRow to liExprRow
66593>>>>>>> set psPreviousValue.i item liRow to ""
66594>>>>>>> end_procedure
66595>>>>>>> function break_level returns integer
66597>>>>>>> integer liMax liRow liLevel liFile lhExprArr liExprRow
66597>>>>>>> string lsValue
66597>>>>>>> move 0 to liLevel
66598>>>>>>> get row_count to liMax
66599>>>>>>> decrement liMax
66600>>>>>>> if (prv.piFirstRec(self)) begin
66602>>>>>>> set prv.piFirstRec to DFFALSE
66603>>>>>>> if (Row_Count(self)) move BRK_BEGIN to liLevel
66606>>>>>>> else move 0 to liLevel
66608>>>>>>> end
66608>>>>>>>>
66608>>>>>>> else begin
66609>>>>>>> for liRow from 0 to liMax
66615>>>>>>>>
66615>>>>>>> get piFile.i liRow to liFile
66616>>>>>>> if liFile get FieldInf_FieldValue liFile (piField.i(self,liRow)) to lsValue
66619>>>>>>> else begin
66620>>>>>>> get phExprArr.i liRow to lhExprArr
66621>>>>>>> get piExprRow.i liRow to liExprRow
66622>>>>>>> get sEvalExpression of (Query_ExprEvaluator(self)) (piExprId.i(lhExprArr,liExprRow)) to lsValue
66623>>>>>>> end
66623>>>>>>>>
66623>>>>>>> if lsValue ne (psPreviousValue.i(self,liRow)) begin
66625>>>>>>> move (liRow+1) to liLevel
66626>>>>>>> move liMax to liRow // Break the loop!
66627>>>>>>> end
66627>>>>>>>>
66627>>>>>>> loop
66628>>>>>>>>
66628>>>>>>> end
66628>>>>>>>>
66628>>>>>>> if liLevel begin // If a break was detected we update our 'previous' values
66630>>>>>>> for liRow from 0 to liMax
66636>>>>>>>>
66636>>>>>>> get piFile.i liRow to liFile
66637>>>>>>> if liFile get FieldInf_FieldValue liFile (piField.i(self,liRow)) to lsValue
66640>>>>>>> else begin
66641>>>>>>> get phExprArr.i liRow to lhExprArr
66642>>>>>>> get piExprRow.i liRow to liExprRow
66643>>>>>>> get sEvalExpression of (Query_ExprEvaluator(self)) (piExprId.i(lhExprArr,liExprRow)) to lsValue
66644>>>>>>> end
66644>>>>>>>>
66644>>>>>>> set psPreviousValue.i item liRow to lsValue
66645>>>>>>> loop
66646>>>>>>>>
66646>>>>>>> end
66646>>>>>>>>
66646>>>>>>> function_return liLevel // 0=No break
66647>>>>>>> end_function
66648>>>>>>> procedure reset
66650>>>>>>> send delete_data
66651>>>>>>> set prv.piFirstRec to DFTRUE
66652>>>>>>> end_procedure
66653>>>>>>>end_class // cBreakHandler
66654>>>>>>>
66654>>>>>>>class cReportTotals is a cArray
66655>>>>>>> procedure construct_object
66657>>>>>>> forward send construct_object
66659>>>>>>> property integer piNumberOfColumns public 0
66660>>>>>>> property integer piCurrentLevel public 0
66661>>>>>>> end_procedure
66662>>>>>>> procedure reset
66664>>>>>>> send delete_data
66665>>>>>>> set piCurrentLevel to 0
66666>>>>>>> end_procedure
66667>>>>>>> function nRcl_Data.i integer liColumn returns number
66669>>>>>>> function_return (value(self,piNumberOfColumns(self)*piCurrentLevel(self)+liColumn))
66670>>>>>>> end_function
66671>>>>>>> procedure Sum_Data.in integer liColumn number lnValue
66673>>>>>>> integer liItem lhSelf
66673>>>>>>> move self to lhSelf
66674>>>>>>> move (piNumberOfColumns(lhSelf)*piCurrentLevel(lhSelf)+liColumn) to liItem
66675>>>>>>> //showln lnValue " " (number(value(lhSelf,liItem)))
66675>>>>>>> set value item liItem to (lnValue+number(value(lhSelf,liItem)))
66676>>>>>>> end_procedure
66677>>>>>>> procedure Sto_Data.in integer liColumn number lnValue
66679>>>>>>> set value item (piNumberOfColumns(self)*piCurrentLevel(self)+liColumn) to lnValue
66680>>>>>>> end_procedure
66681>>>>>>> procedure New_Level
66683>>>>>>> integer liNumberOfColumns liCurrentLevel liBase liItem
66683>>>>>>> get piNumberOfColumns to liNumberOfColumns
66684>>>>>>> get piCurrentLevel to liCurrentLevel
66685>>>>>>> increment liCurrentLevel
66686>>>>>>> move (liCurrentLevel*liNumberOfColumns) to liBase
66687>>>>>>> for liItem from liBase to (liBase+liNumberOfColumns-1)
66693>>>>>>>>
66693>>>>>>> set value item liItem to 0
66694>>>>>>> loop
66695>>>>>>>>
66695>>>>>>> set piCurrentLevel to liCurrentLevel
66696>>>>>>> end_procedure
66697>>>>>>> procedure Drop_Level
66699>>>>>>> integer liNumberOfColumns liCurrentLevel liBase liItem
66699>>>>>>> get piNumberOfColumns to liNumberOfColumns
66700>>>>>>> get piCurrentLevel to liCurrentLevel
66701>>>>>>> decrement liCurrentLevel
66702>>>>>>> move (liCurrentLevel*liNumberOfColumns) to liBase
66703>>>>>>> for liItem from liBase to (liBase+liNumberOfColumns-1)
66709>>>>>>>>
66709>>>>>>> set value item liItem to (number(value(self,liItem))+number(value(self,liItem+liNumberOfColumns)))
66710>>>>>>> loop
66711>>>>>>>>
66711>>>>>>> set piCurrentLevel to liCurrentLevel
66712>>>>>>> end_procedure
66713>>>>>>>end_class // cReportTotals
66714>>>>>>>
66714>>>>>>>class cReport_Info is a cDataScanner
66715>>>>>>> procedure construct_object
66717>>>>>>> forward send construct_object
66719>>>>>>> property string pReportTitle public "Un-titled"
66720>>>>>>> property string pBottomText public ""
66721>>>>>>> property integer pOnlyMostSignificantBreakLevel public false
66722>>>>>>> object oBreaks is a cBreakHandler NO_IMAGE
66724>>>>>>> end_object
66725>>>>>>> end_procedure
66726>>>>>>>
66726>>>>>>> item_property_list
66726>>>>>>> item_property integer rpt_field_file
66726>>>>>>> item_property integer rpt_field_field
66726>>>>>>> item_property string rpt_field_name
66726>>>>>>> item_property integer rpt_field_cr
66726>>>>>>> item_property number rpt_field_start
66726>>>>>>> item_property number rpt_field_width
66726>>>>>>> item_property string rpt_field_font
66726>>>>>>> item_property integer rpt_field_fontsize
66726>>>>>>> item_property integer rpt_field_sum
66726>>>>>>> item_property integer rpt_field_fontstyle
66726>>>>>>> item_property integer rpt_field_type
66726>>>>>>> item_property integer rpt_field_decpoints
66726>>>>>>> item_property integer rpt_field_expr_array
66726>>>>>>> item_property integer rpt_field_expr_row
66726>>>>>>> end_item_property_list cReport_info
#REM 66794 DEFINE FUNCTION RPT_FIELD_EXPR_ROW INTEGER LIROW RETURNS INTEGER
#REM 66798 DEFINE PROCEDURE SET RPT_FIELD_EXPR_ROW INTEGER LIROW INTEGER VALUE
#REM 66802 DEFINE FUNCTION RPT_FIELD_EXPR_ARRAY INTEGER LIROW RETURNS INTEGER
#REM 66806 DEFINE PROCEDURE SET RPT_FIELD_EXPR_ARRAY INTEGER LIROW INTEGER VALUE
#REM 66810 DEFINE FUNCTION RPT_FIELD_DECPOINTS INTEGER LIROW RETURNS INTEGER
#REM 66814 DEFINE PROCEDURE SET RPT_FIELD_DECPOINTS INTEGER LIROW INTEGER VALUE
#REM 66818 DEFINE FUNCTION RPT_FIELD_TYPE INTEGER LIROW RETURNS INTEGER
#REM 66822 DEFINE PROCEDURE SET RPT_FIELD_TYPE INTEGER LIROW INTEGER VALUE
#REM 66826 DEFINE FUNCTION RPT_FIELD_FONTSTYLE INTEGER LIROW RETURNS INTEGER
#REM 66830 DEFINE PROCEDURE SET RPT_FIELD_FONTSTYLE INTEGER LIROW INTEGER VALUE
#REM 66834 DEFINE FUNCTION RPT_FIELD_SUM INTEGER LIROW RETURNS INTEGER
#REM 66838 DEFINE PROCEDURE SET RPT_FIELD_SUM INTEGER LIROW INTEGER VALUE
#REM 66842 DEFINE FUNCTION RPT_FIELD_FONTSIZE INTEGER LIROW RETURNS INTEGER
#REM 66846 DEFINE PROCEDURE SET RPT_FIELD_FONTSIZE INTEGER LIROW INTEGER VALUE
#REM 66850 DEFINE FUNCTION RPT_FIELD_FONT INTEGER LIROW RETURNS STRING
#REM 66854 DEFINE PROCEDURE SET RPT_FIELD_FONT INTEGER LIROW STRING VALUE
#REM 66858 DEFINE FUNCTION RPT_FIELD_WIDTH INTEGER LIROW RETURNS NUMBER
#REM 66862 DEFINE PROCEDURE SET RPT_FIELD_WIDTH INTEGER LIROW NUMBER VALUE
#REM 66866 DEFINE FUNCTION RPT_FIELD_START INTEGER LIROW RETURNS NUMBER
#REM 66870 DEFINE PROCEDURE SET RPT_FIELD_START INTEGER LIROW NUMBER VALUE
#REM 66874 DEFINE FUNCTION RPT_FIELD_CR INTEGER LIROW RETURNS INTEGER
#REM 66878 DEFINE PROCEDURE SET RPT_FIELD_CR INTEGER LIROW INTEGER VALUE
#REM 66882 DEFINE FUNCTION RPT_FIELD_NAME INTEGER LIROW RETURNS STRING
#REM 66886 DEFINE PROCEDURE SET RPT_FIELD_NAME INTEGER LIROW STRING VALUE
#REM 66890 DEFINE FUNCTION RPT_FIELD_FIELD INTEGER LIROW RETURNS INTEGER
#REM 66894 DEFINE PROCEDURE SET RPT_FIELD_FIELD INTEGER LIROW INTEGER VALUE
#REM 66898 DEFINE FUNCTION RPT_FIELD_FILE INTEGER LIROW RETURNS INTEGER
#REM 66902 DEFINE PROCEDURE SET RPT_FIELD_FILE INTEGER LIROW INTEGER VALUE
66907>>>>>>>
66907>>>>>>> procedure check_break
66909>>>>>>> integer brk#
66909>>>>>>> get break_level of (oBreaks(self)) to brk#
66910>>>>>>> if brk# send handle_break brk#
66913>>>>>>> end_procedure
66914>>>>>>>
66914>>>>>>> procedure subheader integer level#
66916>>>>>>> DATASCAN$SHOWLN ("Subheader level: "+string(level#))
66916>>>>>>> end_procedure
66917>>>>>>>
66917>>>>>>> procedure subtotal integer level#
66919>>>>>>> DATASCAN$SHOWLN ("SubTotal level: "+string(level#))
66919>>>>>>> end_procedure
66920>>>>>>>
66920>>>>>>> procedure handle_break integer brk#
66922>>>>>>> integer oBreaks# levels# level#
66922>>>>>>> move (oBreaks(self)) to oBreaks#
66923>>>>>>> if brk# begin
66925>>>>>>> if (pOnlyMostSignificantBreakLevel(self)) begin
66927>>>>>>> if brk# eq BRK_BEGIN send subheader 1
66930>>>>>>> if brk# eq BRK_END send subtotal 1
66933>>>>>>> if brk# gt 0 begin
66935>>>>>>> send subtotal brk#
66936>>>>>>> send subheader brk#
66937>>>>>>> end
66937>>>>>>>>
66937>>>>>>> end
66937>>>>>>>>
66937>>>>>>> else begin
66938>>>>>>> get row_count of oBreaks# to levels#
66939>>>>>>> if (brk#>0 or brk#=BRK_END) begin
66941>>>>>>> for_ex level# from levels# down_to 1
66948>>>>>>> send subtotal level#
66949>>>>>>> loop
66950>>>>>>>>
66950>>>>>>> end
66950>>>>>>>>
66950>>>>>>> if (brk#>0 or brk#=BRK_BEGIN) begin
66952>>>>>>> for level# from 1 to levels#
66958>>>>>>>>
66958>>>>>>> send subheader level#
66959>>>>>>> loop
66960>>>>>>>>
66960>>>>>>> end
66960>>>>>>>>
66960>>>>>>> end
66960>>>>>>>>
66960>>>>>>> end
66960>>>>>>>>
66960>>>>>>> end_procedure
66961>>>>>>>
66961>>>>>>> procedure add_break_field integer file# integer field# integer liExprRow integer lhExprArr
66963>>>>>>> send add_break_field to (oBreaks(self)) file# field# liExprRow lhExprArr
66964>>>>>>> end_procedure
66965>>>>>>>
66965>>>>>>> procedure reset_breaks
66967>>>>>>> send reset to (oBreaks(self))
66968>>>>>>> end_procedure
66969>>>>>>>
66969>>>>>>> procedure reset
66971>>>>>>> forward send reset
66973>>>>>>> send reset_crit
66974>>>>>>> send reset_breaks
66975>>>>>>> end_procedure
66976>>>>>>>
66976>>>>>>> procedure DoReset
66978>>>>>>> send reset
66979>>>>>>> send delete_data
66980>>>>>>> end_procedure
66981>>>>>>>
66981>>>>>>> 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
66983>>>>>>> integer row#
66983>>>>>>> get row_count to row#
66984>>>>>>> set rpt_field_file row# to file#
66985>>>>>>> set rpt_field_field row# to field#
66986>>>>>>> set rpt_field_name row# to name#
66987>>>>>>> set rpt_field_cr row# to cr#
66988>>>>>>> set rpt_field_start row# to start#
66989>>>>>>> set rpt_field_width row# to width#
66990>>>>>>> set rpt_field_font row# to font#
66991>>>>>>> set rpt_field_fontsize row# to fontsize#
66992>>>>>>> set rpt_field_sum row# to sum#
66993>>>>>>> set rpt_field_fontstyle row# to fontstyle#
66994>>>>>>> set rpt_field_expr_array row# to lhExprArr
66995>>>>>>> set rpt_field_expr_row row# to liExprRow
66996>>>>>>> if file# begin
66998>>>>>>> set rpt_field_type row# to (FieldInf_FieldType(file#,field#))
66999>>>>>>> set rpt_field_decpoints row# to (FieldInf_DecPoints(file#,field#))
67000>>>>>>> end
67000>>>>>>>>
67000>>>>>>> else begin
67001>>>>>>> set rpt_field_type row# to (piType.i(lhExprArr,liExprRow))
67002>>>>>>> set rpt_field_decpoints row# to (piDecimals.i(lhExprArr,liExprRow))
67003>>>>>>> end
67003>>>>>>>>
67003>>>>>>> end_procedure
67004>>>>>>>
67004>>>>>>> function rpt_field_count returns integer
67006>>>>>>> function_return (row_count(self))
67007>>>>>>> end_function
67008>>>>>>> procedure record_not_selected
67010>>>>>>>// showln ("NOT SELECT: "+idx_field_value(oIndexAnalyzer#,pOrdering(self),1,1))
67010>>>>>>> end_procedure
67011>>>>>>> procedure Record_Selected
67013>>>>>>> send check_break
67014>>>>>>>// showln (idx_field_value(oIndexAnalyzer#,pOrdering(self),1,1))
67014>>>>>>> end_procedure
67015>>>>>>> procedure scan_starts // Sent unconditionally at the beginning of a scan
67017>>>>>>>// send handle_break BRK_BEGIN
67017>>>>>>> end_procedure
67018>>>>>>> procedure scan_ended // Sent unconditionally at the end of a scan
67020>>>>>>> send handle_break BRK_END
67021>>>>>>> end_procedure
67022>>>>>>>end_class // cReport_Info
67023>>>>>Use Files.utl // Utilities for handling file related stuff
67023>>>>>Use Strings.utl // String manipulation for VDF
67023>>>>>Use Dates.utl // Date manipulation for VDF
67023>>>>>Use Wait.utl //
67023>>>>>Use MsgBox.utl // obs procedure
67023>>>>>Use HTML.utl // HTML functions
Including file: html.utl (C:\Apps\VDFQuery\AppSrc\html.utl)
67023>>>>>>>//**********************************************************************
67023>>>>>>>// Use HTML.utl // HTML functions
67023>>>>>>>//
67023>>>>>>>//
67023>>>>>>>// Create: Fri 04-09-1998
67023>>>>>>>// Update: Wed 16-09-1998 - Un-commented setting of pHtmlConversionTable
67023>>>>>>>//
67023>>>>>>>//
67023>>>>>>>//**********************************************************************
67023>>>>>>>
67023>>>>>>>Use Strings.nui // String manipulation for VDF
67023>>>>>>>Use Files.nui // Utilities for handling file related stuff
67023>>>>>>>Use URL.nui // URL manipulation
Including file: url.nui (C:\Apps\VDFQuery\AppSrc\url.nui)
67023>>>>>>>>>// Use URL.nui // URL manipulation
67023>>>>>>>>>
67023>>>>>>>>>//> From the point of view of the URL string manipulation functions an URL
67023>>>>>>>>>//> is composed of the following items:
67023>>>>>>>>>//>
67023>>>>>>>>>//> * Protocol "http:"
67023>>>>>>>>>//> * User ID "sture"
67023>>>>>>>>>//> * Password "headset"
67023>>>>>>>>>//> * Host "www.sture.dk"
67023>>>>>>>>>//> * Port 80
67023>>>>>>>>>//> * Path "/Images/EDUC2001"
67023>>>>>>>>>//> * Type "type=xml"
67023>>>>>>>>>//>
67023>>>>>>>>>//> function URL_ParseURL global string lsURL returns integer
67023>>>>>>>>>//>
67023>>>>>>>>>//> To have a URL decomposed into the items above use the URL_ParseURL
67023>>>>>>>>>//> function. The function returns TRUE if a host could be identidfied
67023>>>>>>>>>//> as part of the lsURL string and FALSE if not.
67023>>>>>>>>>//>
67023>>>>>>>>>//>
67023>>>>>>>>>//> function URL_Value global integer liSegment returns string
67023>>>>>>>>>//>
67023>>>>>>>>>//> After having used the URL_ParseURL to decompose an URL you should use
67023>>>>>>>>>//> the URL_Value function to obtain the value of each component in the
67023>>>>>>>>>//> URL. For example, to obtain the 'Path' part of the URL you would write
67023>>>>>>>>>//>
67023>>>>>>>>>//> get URL_Value URL_SEGMENT_PATH to lsPath
67023>>>>>>>>>//>
67023>>>>>>>>>//> The URL_SEGMENT_PATH symbol is a constant defined by the URL.nui package.
67023>>>>>>>>>//> You may pass the following segment identifiers to the function:
67023>>>>>>>>>//>
67023>>>>>>>>>//> URL_SEGMENT_PROTOCOL, URL_SEGMENT_USER, URL_SEGMENT_PASSWORD,
67023>>>>>>>>>//> URL_SEGMENT_HOST, URL_SEGMENT_PORT, URL_SEGMENT_PATH and
67023>>>>>>>>>//> URL_SEGMENT_TYPE
67023>>>>>>>>>//>
67023>>>>>>>>>//> These symbols may also be used as arguments to a the 'set URL_Value'
67023>>>>>>>>>//> procedure anabling you to set the value of each individual before
67023>>>>>>>>>//> calling this function:
67023>>>>>>>>>//>
67023>>>>>>>>>//> function URL_Compose global returns string
67023>>>>>>>>>//>
67023>>>>>>>>>//> This function combines all the segments setup via the 'set URL_Value'
67023>>>>>>>>>//> procedure (and possebly leftovers from the most recent call to
67023>>>>>>>>>//> URL_ParseURL) and returns a URL.
67023>>>>>>>>>//>
67023>>>>>>>>>//>
67023>>>>>>>>>//> Note that the URL functions decribed here are merely string manipulations.
67023>>>>>>>>>//> They do not interact with any internet componenents locally on the machine
67023>>>>>>>>>//> or on the internet itself.
67023>>>>>>>>>//>
67023>>>>>>>>>
67023>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
67023>>>>>>>>>Use Strings.nui // String manipulation for VDF
67023>>>>>>>>>
67023>>>>>>>>>enumeration_list
67023>>>>>>>>> define URL_SEGMENT_PROTOCOL
67023>>>>>>>>> define URL_SEGMENT_USER
67023>>>>>>>>> define URL_SEGMENT_PASSWORD
67023>>>>>>>>> define URL_SEGMENT_HOST
67023>>>>>>>>> define URL_SEGMENT_PORT
67023>>>>>>>>> define URL_SEGMENT_PATH
67023>>>>>>>>> define URL_SEGMENT_TYPE
67023>>>>>>>>>end_enumeration_list
67023>>>>>>>>>
67023>>>>>>>>>
67023>>>>>>>>>desktop_section
67028>>>>>>>>> object oUrlParser is a cArray NO_IMAGE
67030>>>>>>>>> function iFindToken string lsToken string lsValue returns integer
67033>>>>>>>>> integer liPos liLen liTokenLen
67033>>>>>>>>> string lsString
67033>>>>>>>>> move (length(lsToken)) to liTokenLen
67034>>>>>>>>> move (length(lsValue)) to liLen
67035>>>>>>>>> for liPos from 1 to liLen
67041>>>>>>>>>>
67041>>>>>>>>> move (left(lsValue,liPos)) to lsString
67042>>>>>>>>> if (right(lsString,liTokenLen)=lsToken) function_return liPos
67045>>>>>>>>> loop
67046>>>>>>>>>>
67046>>>>>>>>> function_return 0
67047>>>>>>>>> end_function
67048>>>>>>>>>
67048>>>>>>>>> // ftp://<user>:<password>@<host>:<port>/<url-path>;type=<typecode>
67048>>>>>>>>>
67048>>>>>>>>> function sParseUrl string lsUrl returns integer
67051>>>>>>>>> integer liPos lbRval
67051>>>>>>>>> string lsValue lsValue2 lsHost
67051>>>>>>>>> send delete_data
67052>>>>>>>>> move DFTRUE to lbRval
67053>>>>>>>>> get iFindToken ("/"+"/") lsUrl to liPos // Protokol?
67054>>>>>>>>> if liPos begin // Protokol
67056>>>>>>>>> move (left(lsUrl,liPos)) to lsValue
67057>>>>>>>>> move (replace(lsValue,lsUrl,"")) to lsUrl
67058>>>>>>>>> set value item URL_SEGMENT_PROTOCOL to (StringLeftBut(lsValue,2))
67059>>>>>>>>> end
67059>>>>>>>>>>
67059>>>>>>>>>
67059>>>>>>>>> get iFindToken "@" lsUrl to liPos // User ?
67060>>>>>>>>> if liPos begin // User
67062>>>>>>>>> move (left(lsUrl,liPos)) to lsValue
67063>>>>>>>>> move (replace(lsValue,lsUrl,"")) to lsUrl
67064>>>>>>>>> get iFindToken ":" lsValue to liPos
67065>>>>>>>>> if liPos begin // User and Password
67067>>>>>>>>> move (left(lsValue,liPos)) to lsValue2
67068>>>>>>>>> set value item URL_SEGMENT_USER to (StringLeftBut(lsValue2,1))
67069>>>>>>>>> move (replace(lsValue2,lsValue,"")) to lsValue
67070>>>>>>>>> set value item URL_SEGMENT_PASSWORD to (StringLeftBut(lsValue,1))
67071>>>>>>>>> end
67071>>>>>>>>>>
67071>>>>>>>>> else begin // User without password
67072>>>>>>>>> set value item URL_SEGMENT_USER to (StringLeftBut(lsValue,1))
67073>>>>>>>>> end
67073>>>>>>>>>>
67073>>>>>>>>> end
67073>>>>>>>>>>
67073>>>>>>>>>
67073>>>>>>>>> // ftp://<user>:<password>@<host>:<port>/<url-path>;type=<typecode>
67073>>>>>>>>>
67073>>>>>>>>> get iFindToken ";" lsUrl to liPos // Type ?
67074>>>>>>>>> if liPos begin // Type!
67076>>>>>>>>> move (left(lsUrl,liPos)) to lsValue
67077>>>>>>>>> move (replace(lsValue,lsUrl,"")) to lsUrl
67078>>>>>>>>> set value item URL_SEGMENT_TYPE to lsUrl
67079>>>>>>>>> move (StringLeftBut(lsValue,1)) to lsValue
67080>>>>>>>>> get iFindToken "/" lsValue to liPos // Path ?
67081>>>>>>>>> if liPos begin // Path! www.dataaccess.dk:80/magicpath/Images
67083>>>>>>>>> move (left(lsValue,liPos-1)) to lsValue2
67084>>>>>>>>> set value item URL_SEGMENT_PATH to (replace(lsValue2,lsValue,""))
67085>>>>>>>>> move lsValue2 to lsValue
67086>>>>>>>>> end
67086>>>>>>>>>>
67086>>>>>>>>> get iFindToken ":" lsValue to liPos // Port ?
67087>>>>>>>>> if liPos begin // Port ! Dataaccess.kn:80
67089>>>>>>>>> move (left(lsValue,liPos)) to lsHost
67090>>>>>>>>> set value item URL_SEGMENT_HOST to (StringLeftBut(lsHost,1))
67091>>>>>>>>> set value item URL_SEGMENT_PORT to (replace(lsHost,lsValue,""))
67092>>>>>>>>> end
67092>>>>>>>>>>
67092>>>>>>>>> else set value item URL_SEGMENT_HOST to lsValue
67094>>>>>>>>> end
67094>>>>>>>>>>
67094>>>>>>>>> else begin
67095>>>>>>>>> get iFindToken "/" lsUrl to liPos // Path ?
67096>>>>>>>>> if liPos begin
67098>>>>>>>>> move lsUrl to lsValue
67099>>>>>>>>>
67099>>>>>>>>> if liPos begin // Path! www.dataaccess.dk:80/magicpath/Images
67101>>>>>>>>> move (left(lsValue,liPos-1)) to lsValue2
67102>>>>>>>>> set value item URL_SEGMENT_PATH to (replace(lsValue2,lsValue,""))
67103>>>>>>>>> move lsValue2 to lsValue
67104>>>>>>>>> end
67104>>>>>>>>>>
67104>>>>>>>>> get iFindToken ":" lsValue to liPos // Port ?
67105>>>>>>>>> if liPos begin // Port! Dataaccess.kn:80
67107>>>>>>>>> move (left(lsValue,liPos)) to lsHost
67108>>>>>>>>> set value item URL_SEGMENT_HOST to (StringLeftBut(lsHost,1))
67109>>>>>>>>> set value item URL_SEGMENT_PORT to (replace(lsHost,lsValue,""))
67110>>>>>>>>> end
67110>>>>>>>>>>
67110>>>>>>>>> else set value item URL_SEGMENT_HOST to lsValue
67112>>>>>>>>> end
67112>>>>>>>>>>
67112>>>>>>>>> else begin
67113>>>>>>>>> get iFindToken ":" lsUrl to liPos // Port?
67114>>>>>>>>> if liPos begin
67116>>>>>>>>> move (left(lsUrl,liPos)) to lsValue
67117>>>>>>>>> move (replace(lsValue,lsUrl,"")) to lsUrl
67118>>>>>>>>> set value item URL_SEGMENT_HOST to (StringLeftBut(lsValue,1))
67119>>>>>>>>> set value item URL_SEGMENT_PORT to lsUrl
67120>>>>>>>>> end
67120>>>>>>>>>>
67120>>>>>>>>> else begin
67121>>>>>>>>> set value item URL_SEGMENT_HOST to lsUrl
67122>>>>>>>>> end
67122>>>>>>>>>>
67122>>>>>>>>> end
67122>>>>>>>>>>
67122>>>>>>>>> end
67122>>>>>>>>>>
67122>>>>>>>>> if (value(self,URL_SEGMENT_HOST)="") move DFFALSE to lbRval
67125>>>>>>>>> function_return lbRval
67126>>>>>>>>> end_function
67127>>>>>>>>> end_object
67128>>>>>>>>>end_desktop_section
67133>>>>>>>>>
67133>>>>>>>>>// Public interface:
67133>>>>>>>>>
67133>>>>>>>>>function URL_ParseURL global string lsValue returns integer
67135>>>>>>>>> function_return (sParseUrl(oUrlParser(self),lsValue))
67136>>>>>>>>>end_function
67137>>>>>>>>>
67137>>>>>>>>>function URL_Value global integer liSegment returns string
67139>>>>>>>>> function_return (value(oUrlParser(self),liSegment))
67140>>>>>>>>>end_function
67141>>>>>>>>>
67141>>>>>>>>>procedure set URL_Value global integer liSegment string lsValue
67143>>>>>>>>> set value of (oUrlParser(self)) item liSegment to lsValue
67144>>>>>>>>>end_procedure
67145>>>>>>>>>
67145>>>>>>>>>procedure URL_Reset
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
67147>>>>>>>>> send delete_data to (oUrlParser(self))
67148>>>>>>>>>end_procedure
67149>>>>>>>>>
67149>>>>>>>>>function URL_Compose global returns string
67151>>>>>>>>> integer liPort
67151>>>>>>>>> string lsUser lsPassword lsHost lsPath lsType lsProtocol
67151>>>>>>>>> string lsRval
67151>>>>>>>>>
67151>>>>>>>>> // ftp://<user>:<password>@<host>:<port>/<url-path>;type=<typecode>
67151>>>>>>>>>
67151>>>>>>>>> get URL_Value URL_SEGMENT_PROTOCOL to lsProtocol
67152>>>>>>>>> get URL_Value URL_SEGMENT_USER to lsUser
67153>>>>>>>>> get URL_Value URL_SEGMENT_PASSWORD to lsPassword
67154>>>>>>>>> get URL_Value URL_SEGMENT_HOST to lsHost
67155>>>>>>>>> get URL_Value URL_SEGMENT_PORT to liPort
67156>>>>>>>>> get URL_Value URL_SEGMENT_PATH to lsPath
67157>>>>>>>>> get URL_Value URL_SEGMENT_TYPE to lsType
67158>>>>>>>>>
67158>>>>>>>>> if (lsProtocol<>"") move (lsProtocol+"/"+"/") to lsRval
67161>>>>>>>>>
67161>>>>>>>>> if (lsUser<>"") begin
67163>>>>>>>>> move (lsRval+lsUser) to lsRval
67164>>>>>>>>> if (lsPassword<>"") move (lsRval+":"+lsPassword) to lsRval
67167>>>>>>>>> move (lsRval+"@") to lsRval
67168>>>>>>>>> end
67168>>>>>>>>>>
67168>>>>>>>>> move (lsRval+lsHost) to lsRval
67169>>>>>>>>> if (liPort<>0) move (lsRval+":"+string(liPort)) to lsRval
67172>>>>>>>>> if (lsPath<>"") begin
67174>>>>>>>>> if (left(lsPath,1)="/") move (lsRval+lsPath) to lsRval
67177>>>>>>>>> else move (lsRval+"/"+lsPath) to lsRval
67179>>>>>>>>> end
67179>>>>>>>>>>
67179>>>>>>>>> if (lsType<>"") move (lsRval+";"+lsType) to lsRval
67182>>>>>>>>> function_return lsRval
67183>>>>>>>>>end_function
67184>>>>>>>>>
67184>>>>>>>>>// The URL_InsertLinks is meant to be used to insert links into a string
67184>>>>>>>>>// of text as a preparation for writing it to a html page.
67184>>>>>>>>>//
67184>>>>>>>>>// If an URL occurs in the text the function will insert link tags
67184>>>>>>>>>// around the URL in order to make it a clickable.
67184>>>>>>>>>//
67184>>>>>>>>>// If you have an 'ugly' link like this:
67184>>>>>>>>>//
67184>>>>>>>>>// ftp://jakob:magic@ftp.kruse-net.dk:8000/magic/data;type=xml
67184>>>>>>>>>//
67184>>>>>>>>>// and you want the browser to simply display
67184>>>>>>>>>//
67184>>>>>>>>>// Click [here] to download some magic data
67184>>>>>>>>>//
67184>>>>>>>>>// where [] denotes the scope of the link, just pass this text to the
67184>>>>>>>>>// function:
67184>>>>>>>>>//
67184>>>>>>>>>// Click ftp://jakob:magic@ftp.kruse-net.dk:8000/magic/data;type=xml[here]
67184>>>>>>>>>// to download some magic data
67184>>>>>>>>>//
67184>>>>>>>>>//
67184>>>>>>>>>//
67184>>>>>>>>>//
67184>>>>>>>>>function URL_InsertLinks global string lsValue returns string
67186>>>>>>>>> integer liPos liLen lbInLink lbFin
67186>>>>>>>>> string lsRval lsChar lsLeadIn lsLink lsLinkText lsDblSlash
67186>>>>>>>>> move (length(lsValue)) to liLen
67187>>>>>>>>> move "" to lsRval
67188>>>>>>>>> move 1 to liPos
67189>>>>>>>>> move ("/"+"/") to lsDblSlash
67190>>>>>>>>> repeat
67190>>>>>>>>>>
67190>>>>>>>>> move "" to lsLeadIn
67191>>>>>>>>> if (lowercase(mid(lsValue,4,liPos))="www.") begin
67193>>>>>>>>> //move "http://www." to lsLeadIn
67193>>>>>>>>> move ("http:"+lsDblSlash+"www.") to lsLeadIn
67194>>>>>>>>> move (liPos+4) to liPos
67195>>>>>>>>> end
67195>>>>>>>>>>
67195>>>>>>>>> if (lowercase(mid(lsValue,4,liPos))="ftp.") begin
67197>>>>>>>>> //move "ftp://ftp." to lsLeadIn
67197>>>>>>>>> move ("ftp:"+lsDblSlash+"ftp.") to lsLeadIn
67198>>>>>>>>> move (liPos+4) to liPos
67199>>>>>>>>> end
67199>>>>>>>>>>
67199>>>>>>>>> if (lowercase(mid(lsValue,6,liPos))="ftp:"+lsDblSlash) begin
67201>>>>>>>>> move ("ftp:"+lsDblSlash) to lsLeadIn
67202>>>>>>>>> move (liPos+6) to liPos
67203>>>>>>>>> end
67203>>>>>>>>>>
67203>>>>>>>>> if (lowercase(mid(lsValue,7,liPos))="http:"+lsDblSlash) begin
67205>>>>>>>>> move ("http:"+lsDblSlash) to lsLeadIn
67206>>>>>>>>> move (liPos+7) to liPos
67207>>>>>>>>> end
67207>>>>>>>>>>
67207>>>>>>>>> if (lowercase(mid(lsValue,8,liPos))="https:"+lsDblSlash) begin
67209>>>>>>>>> move ("https:"+lsDblSlash) to lsLeadIn
67210>>>>>>>>> move (liPos+8) to liPos
67211>>>>>>>>> end
67211>>>>>>>>>>
67211>>>>>>>>> if (lsLeadIn<>"") begin
67213>>>>>>>>> move lsLeadIn to lsLink
67214>>>>>>>>> repeat
67214>>>>>>>>>>
67214>>>>>>>>> move (mid(lsValue,1,liPos)) to lsChar
67215>>>>>>>>> move (not(("abcdefghijklmnopqrstuvwxyz:;=?@/.-+%*_01234567890#&~'"+'"') contains lowercase(lsChar))) to lbFin
67216>>>>>>>>> ifnot lbFin begin
67218>>>>>>>>> move (lsLink+lsChar) to lsLink
67219>>>>>>>>> increment liPos
67220>>>>>>>>> end
67220>>>>>>>>>>
67220>>>>>>>>> until (lbFin or (liPos>liLen))
67222>>>>>>>>> if (".:@;=" contains right(lsLink,1)) begin
67224>>>>>>>>> get StringLeftBut lsLink 1 to lsLink
67225>>>>>>>>> decrement liPos
67226>>>>>>>>> end
67226>>>>>>>>>>
67226>>>>>>>>> move lsLink to lsLinkText
67227>>>>>>>>> // Insert:
67227>>>>>>>>> if (mid(lsValue,1,liPos)="[") begin
67229>>>>>>>>> increment liPos // Beyond the "[" sign
67230>>>>>>>>> move "" to lsLinkText
67231>>>>>>>>> repeat
67231>>>>>>>>>>
67231>>>>>>>>> move (mid(lsValue,1,liPos)) to lsChar
67232>>>>>>>>> move (lsChar="]") to lbFin
67233>>>>>>>>> increment liPos
67234>>>>>>>>> ifnot lbFin begin
67236>>>>>>>>> move (lsLinkText+lsChar) to lsLinkText
67237>>>>>>>>> end
67237>>>>>>>>>>
67237>>>>>>>>> until (lbFin or (liPos>liLen))
67239>>>>>>>>> end
67239>>>>>>>>>>
67239>>>>>>>>> // End insert
67239>>>>>>>>> move ('<A href="'+lsLink+'" target="_self">'+lsLinkText+'</A>') to lsLink
67240>>>>>>>>> move (lsRval+lsLink) to lsRval
67241>>>>>>>>> end
67241>>>>>>>>>>
67241>>>>>>>>> else begin
67242>>>>>>>>> move (mid(lsValue,1,liPos)) to lsChar
67243>>>>>>>>> move (lsRval+lsChar) to lsRval
67244>>>>>>>>> increment liPos
67245>>>>>>>>> end
67245>>>>>>>>>>
67245>>>>>>>>> until (liPos>liLen)
67247>>>>>>>>> function_return lsRval
67248>>>>>>>>>end_function
67249>>>>>>>>>
67249>>>>>>>>>
67249>>>>>>>
67249>>>>>>>integer oGlobalHtmlAttributes#
67249>>>>>>>object oGlobalHtmlAttributes is an array
67251>>>>>>> property integer pHtmlConversionTable public 0
67253>>>>>>> property integer pHtmlTrimCrState public 1 // Exclamation mark
67255>>>>>>> property string pHtmlDocType public ('<'+character(33)+'DOCTYPE HTML PUBLIC "-/'+'/IETF/'+'/DTD HTML/'+'/EN">')
67257>>>>>>> property string pHtmlMT_Generator public "Visual DataFlex"
67259>>>>>>> property string pHtmlMT_Formatter public "Visual DataFlex"
67261>>>>>>> move self to oGlobalHtmlAttributes#
67262>>>>>>>end_object
67263>>>>>>>
67263>>>>>>>class cAnsiToHtml_ConversionTable is an array
67264>>>>>>> procedure construct_object integer img#
67266>>>>>>> forward send construct_object img#
67268>>>>>>> property string pCharacterSetName public "Un-named"
67269>>>>>>> property string pCharacterSetID public ""
67270>>>>>>> end_procedure
67271>>>>>>> function Is_cAnsiToHtml_ConversionTable returns integer
67273>>>>>>> function_return 1
67274>>>>>>> end_function
67275>>>>>>> procedure set CharacterConversion integer char# string html#
67277>>>>>>> // By setting the item value to character(char#) we avoid having
67277>>>>>>> // to call that function during the character translation:
67277>>>>>>> set value item (item_count(self)) to (character(char#))
67278>>>>>>> set value item (item_count(self)) to html#
67279>>>>>>> end_procedure
67280>>>>>>> function ConvertAnsiToHtml string str# returns string
67282>>>>>>> integer max# itm#
67282>>>>>>> string html# char#
67282>>>>>>> get item_count to max#
67283>>>>>>> move 0 to itm#
67284>>>>>>> while itm# lt max#
67288>>>>>>> get value item itm# to char#
67289>>>>>>> increment itm#
67290>>>>>>> get value item itm# to html#
67291>>>>>>> increment itm#
67292>>>>>>> move (replaces(char#,str#,html#)) to str#
67293>>>>>>> end
67294>>>>>>>>
67294>>>>>>> function_return str#
67295>>>>>>> end_function
67296>>>>>>>end_class
67297>>>>>>>
67297>>>>>>>function html_TextToHTML global string lsValue returns string
67299>>>>>>> get Text_Trim lsValue to lsValue
67300>>>>>>> move (replaces(character(10),lsValue,"<br>")) to lsValue
67301>>>>>>> get RemoveDblBlanks lsValue to lsValue
67302>>>>>>> get url_InsertLinks lsValue to lsValue
67303>>>>>>> function_return lsValue
67304>>>>>>>end_function
67305>>>>>>>
67305>>>>>>>function html_TextToHTML_LeaveSpaces global string lsValue returns string
67307>>>>>>> get Text_Trim lsValue to lsValue
67308>>>>>>> move (replaces(character(10),lsValue,"<br>")) to lsValue
67309>>>>>>> get url_InsertLinks lsValue to lsValue
67310>>>>>>> function_return lsValue
67311>>>>>>>end_function
67312>>>>>>>
67312>>>>>>>desktop_section
67317>>>>>>>object oAnsiToHtml_Latin_1 is a cAnsiToHtml_ConversionTable
67319>>>>>>> set pCharacterSetName to "Latin 1"
67320>>>>>>> set pCharacterSetID to "iso-8859-1"
67321>>>>>>> set CharacterConversion 160 to " " //
67322>>>>>>> set CharacterConversion 161 to "¡" //
67323>>>>>>> set CharacterConversion 162 to "¢" // ›
67324>>>>>>> set CharacterConversion 163 to "£" // œ
67325>>>>>>> set CharacterConversion 164 to "¤" // general currency
67326>>>>>>> set CharacterConversion 165 to "¥" //
67327>>>>>>> set CharacterConversion 166 to "¦" // |
67328>>>>>>> set CharacterConversion 167 to "§" // õ
67329>>>>>>> set CharacterConversion 168 to "¨" // ù
67330>>>>>>> set CharacterConversion 169 to "©" // (c)
67331>>>>>>> set CharacterConversion 170 to "ª" //
67332>>>>>>> set CharacterConversion 171 to "«" //
67333>>>>>>> set CharacterConversion 172 to "¬" // ª
67334>>>>>>> set CharacterConversion 173 to "­" //
67335>>>>>>> set CharacterConversion 174 to "®" // (r) ©
67336>>>>>>> set CharacterConversion 175 to "¯" //
67337>>>>>>> set CharacterConversion 176 to "°" // ø
67338>>>>>>> set CharacterConversion 177 to "±" // ñ
67339>>>>>>> set CharacterConversion 178 to "²" // exp(2)
67340>>>>>>> set CharacterConversion 179 to "³" // exp(3)
67341>>>>>>> set CharacterConversion 180 to "´" //
67342>>>>>>> set CharacterConversion 181 to "µ" //
67343>>>>>>> set CharacterConversion 182 to "¶" //
67344>>>>>>> set CharacterConversion 183 to "·" //
67345>>>>>>> set CharacterConversion 184 to "¸" //
67346>>>>>>> set CharacterConversion 185 to "¹" //
67347>>>>>>> set CharacterConversion 186 to "º" //
67348>>>>>>> set CharacterConversion 187 to "»" //
67349>>>>>>> set CharacterConversion 188 to "¼" // 1/4
67350>>>>>>> set CharacterConversion 189 to "½" // 1/2
67351>>>>>>> set CharacterConversion 190 to "¾" // 3/4
67352>>>>>>> set CharacterConversion 191 to "¿" // ¨
67353>>>>>>> set CharacterConversion 192 to "À" // ·
67354>>>>>>> set CharacterConversion 193 to "Á" // µ
67355>>>>>>> set CharacterConversion 194 to "Â" // ¶
67356>>>>>>> set CharacterConversion 195 to "Ã" // Ç
67357>>>>>>> set CharacterConversion 196 to "Ä" // Ž
67358>>>>>>> set CharacterConversion 197 to "Å" //
67359>>>>>>> set CharacterConversion 198 to "&Aelig;" // ’
67360>>>>>>> set CharacterConversion 199 to "Ç" // €
67361>>>>>>> set CharacterConversion 200 to "È" // Ô
67362>>>>>>> set CharacterConversion 201 to "É" //
67363>>>>>>> set CharacterConversion 202 to "Ê" // Ò
67364>>>>>>> set CharacterConversion 203 to "Ë" // Ó
67365>>>>>>> set CharacterConversion 204 to "Ì" // Þ
67366>>>>>>> set CharacterConversion 205 to "Í" // Ö
67367>>>>>>> set CharacterConversion 206 to "Î" // ×
67368>>>>>>> set CharacterConversion 207 to "Ï" // Ø
67369>>>>>>> set CharacterConversion 208 to "Ð" // Ñ
67370>>>>>>> set CharacterConversion 209 to "Ñ" // ¥
67371>>>>>>> set CharacterConversion 210 to "Ò" // ã
67372>>>>>>> set CharacterConversion 211 to "Ó" // à
67373>>>>>>> set CharacterConversion 212 to "Ô" // â
67374>>>>>>> set CharacterConversion 213 to "Õ" // å
67375>>>>>>> set CharacterConversion 214 to "Ö" // ™
67376>>>>>>> set CharacterConversion 216 to "Ø" //
67377>>>>>>> set CharacterConversion 217 to "Ù" // ë
67378>>>>>>> set CharacterConversion 218 to "Ú" // é
67379>>>>>>> set CharacterConversion 219 to "Û" // ê
67380>>>>>>> set CharacterConversion 220 to "Ü" // š
67381>>>>>>> set CharacterConversion 221 to "Ý" // í
67382>>>>>>> set CharacterConversion 222 to "Þ" // è
67383>>>>>>> set CharacterConversion 223 to "ß" // á
67384>>>>>>> set CharacterConversion 224 to "à" // …
67385>>>>>>> set CharacterConversion 225 to "á" //
67386>>>>>>> set CharacterConversion 226 to "â" // ƒ
67387>>>>>>> set CharacterConversion 227 to "ã" // Æ
67388>>>>>>> set CharacterConversion 228 to "ä" // „
67389>>>>>>> set CharacterConversion 229 to "å" // †
67390>>>>>>> set CharacterConversion 230 to "æ" // ‘
67391>>>>>>> set CharacterConversion 231 to "ç" // ‡
67392>>>>>>> set CharacterConversion 232 to "è" // Š
67393>>>>>>> set CharacterConversion 233 to "é" // ‚
67394>>>>>>> set CharacterConversion 234 to "ê" // ˆ
67395>>>>>>> set CharacterConversion 235 to "ë" // ‰
67396>>>>>>> set CharacterConversion 236 to "ì" //
67397>>>>>>> set CharacterConversion 237 to "í" // ¡
67398>>>>>>> set CharacterConversion 238 to "î" // Œ
67399>>>>>>> set CharacterConversion 239 to "ï" // ‹
67400>>>>>>> set CharacterConversion 240 to "ð" // Ð
67401>>>>>>> set CharacterConversion 241 to "ñ" // ¤
67402>>>>>>> set CharacterConversion 242 to "ò" // •
67403>>>>>>> set CharacterConversion 243 to "ó" // ¢
67404>>>>>>> set CharacterConversion 244 to "ô" // “
67405>>>>>>> set CharacterConversion 245 to "õ" // ä
67406>>>>>>> set CharacterConversion 246 to "ö" // ”
67407>>>>>>> set CharacterConversion 248 to "ø" // ›
67408>>>>>>> set CharacterConversion 249 to "ù" // —
67409>>>>>>> set CharacterConversion 250 to "ú" // £
67410>>>>>>> set CharacterConversion 251 to "û" // –
67411>>>>>>> set CharacterConversion 252 to "ü" //
67412>>>>>>> set CharacterConversion 253 to "ý" // ì
67413>>>>>>> set CharacterConversion 254 to "þ" // ç
67414>>>>>>> set CharacterConversion 255 to "ÿ" // ˜
67415>>>>>>>end_object // oAnsiToHtml_Latin_1
67416>>>>>>>end_desktop_section
67421>>>>>>>
67421>>>>>>>// Uncomment the following line in order to have the function convert ANSI
67421>>>>>>>// characters to native html characters.
67421>>>>>>>//set pHtmlConversionTable of oGlobalHtmlAttributes# to (oAnsiToHtml_Latin_1(self))
67421>>>>>>>
67421>>>>>>>// Make the html_AnsiToHtml function cut away superflous trailing cr/lf
67421>>>>>>>// characters when printing text.
67421>>>>>>>set pHtmlTrimCrState of oGlobalHtmlAttributes# to true
67422>>>>>>>
67422>>>>>>>// If function ConvertChar is not already defined we define it here:
67422>>>>>>>
67422>>>>>>>// This function assumes that string parameter contains ANSI characters
67422>>>>>>>function html_AnsiToHtml global string str# returns string
67424>>>>>>> move (replaces("&",str#,"&")) to str#
67425>>>>>>> move (replaces('"',str#,""")) to str#
67426>>>>>>> move (replaces("<",str#,"<")) to str#
67427>>>>>>> move (replaces(">",str#,">")) to str#
67428>>>>>>> if (pHtmlTrimCrState(oGlobalHtmlAttributes#)) ; move (Text_RemoveTrailingCr(str#)) to str#
67431>>>>>>> move (replaces(character(10),str#,"<br>")) to str#
67432>>>>>>> move (replaces(character(13),str#,"")) to str#
67433>>>>>>> move (RemoveDblBlanks(str#)) to str#
67434>>>>>>> if (pHtmlConversionTable(oGlobalHtmlAttributes#)) ; get ConvertAnsiToHtml of (pHtmlConversionTable(oGlobalHtmlAttributes#)) str# to str#
67437>>>>>>> function_return str#
67438>>>>>>>end_function
67439>>>>>>>
67439>>>>>>>// This function is identical to html_AnsiToHtml except that it
67439>>>>>>>// assumes the parameter to be OEM characters.
67439>>>>>>>function html_DfToHtml global string str# returns string
67441>>>>>>> function_return (html_AnsiToHtml(ConvertChar(1,str#)))
67442>>>>>>>end_function
67443>>>>>>>
67443>>>>>>>// This is identical to the html_DfToHtml function except that it will
67443>>>>>>>// never return the empty string. Where html_DfToHtml would return the
67443>>>>>>>// empty string this function will return a 'non breaking space'. You
67443>>>>>>>// may want to use this function when writing table data since it will
67443>>>>>>>// ensure that the cells are appearing even if their content is empty.
67443>>>>>>>function html_DfToHtmlTable global string str# returns string
67445>>>>>>> string rval#
67445>>>>>>> move (html_AnsiToHtml(ConvertChar(1,str#))) to rval#
67446>>>>>>> if rval# eq "" move " " to rval#
67449>>>>>>> function_return rval#
67450>>>>>>>end_function
67451>>>>>>>
67451>>>>>>>External_Function32 HtmlShellExecute "ShellExecuteA" SHELL32.DLL ; handle hwnd# String lpszOp# String lpszFile# String lpszParams# ; String lpszDir# integer FsShowCmd# returns integer
67452>>>>>>>
67452>>>>>>>// This may be used to start any kind of document. Not just html docs.
67452>>>>>>>procedure html_StartDoc global string doc#
67454>>>>>>> integer grb#
67454>>>>>>> handle scrhDC#
67454>>>>>>> string dir#
67454>>>>>>> move (GetDesktopWindow()) to scrhDC# // Defined in WinUser.pkg
67455>>>>>>> // We assume that the document is in a directory along DFPATH or that
67455>>>>>>> // the directory path is part of the doc name:
67455>>>>>>> get SEQ_ExtractPathFromFileName doc# to dir# // Is a path specified?
67456>>>>>>> if dir# eq "" get SEQ_FindFileAlongDFPath doc# to dir#
67459>>>>>>> else move "" to dir#
67461>>>>>>> // Parameters Directory
67461>>>>>>> move (HtmlShellExecute(scrhDC#,"Open",doc#,"",dir#,1)) to grb#
67462>>>>>>>end_procedure
67463>>>>>>>
67463>>>>>>>procedure html_WriteHeader global integer channel# string title#
67465>>>>>>> writeln channel channel# (pHtmlDocType(oGlobalHtmlAttributes#))
67468>>>>>>> writeln '<html>'
67470>>>>>>> writeln '<head>'
67472>>>>>>> writeln (' <title>'+html_DfToHtmlTable(title#)+'</title>')
67474>>>>>>> //writeln ' <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">'
67474>>>>>>> writeln (' <meta name="GENERATOR" content="'+pHtmlMT_Generator(oGlobalHtmlAttributes#)+'">')
67476>>>>>>> writeln '</head>'
67478>>>>>>>end_procedure
67479>>>>>>>
67479>>>>>Use Macros.utl // Various macros (Desktop_Section)
67479>>>>>Use RGB.utl // Some color functions
67479>>>>>Use Array.nui // Item_Property command
67479>>>>>Use FdxSelct.utl // Functions iFdxSelectOneFile and iFdxSelectOneField
Including file: fdxselct.utl (C:\Apps\VDFQuery\AppSrc\fdxselct.utl)
67479>>>>>>>// Use FdxSelct.utl // Functions iFdxSelectOneFile and iFdxSelectOneField
67479>>>>>>>Use Fdx_Attr.utl // FDX compatible attribute functions
Including file: fdx_attr.utl (C:\Apps\VDFQuery\AppSrc\fdx_attr.utl)
67479>>>>>>>>>Use FDX_Attr.nui
67479>>>>>>>Use FdxField.nui // FDX Field things
67479>>>>>>>Use FdxIndex.nui // Index analysing functions
67479>>>>>>>Use GridUtil.utl // Grid and List utilities
67479>>>>>>>Use SetOfFld.utl // cSetOfFields class
Including file: setoffld.utl (C:\Apps\VDFQuery\AppSrc\setoffld.utl)
67479>>>>>>>>>// Use SetOfFld.utl // cSetOfFields class
67479>>>>>>>>>Use Base.utl // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
Including file: base.utl (C:\Apps\VDFQuery\AppSrc\base.utl)
67479>>>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
67479>>>>>>>>>Use Strings.nui // String manipulation for VDF
67479>>>>>>>>>
67479>>>>>>>>>class cSetOfFields is a cArray
67480>>>>>>>>> item_property_list
67480>>>>>>>>> item_property integer piFile.i
67480>>>>>>>>> item_property integer piField.i
67480>>>>>>>>> end_item_property_list cSetOfFields
#REM 67512 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 67516 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 67520 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 67524 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
67529>>>>>>>>> procedure add_field integer file# integer field#
67531>>>>>>>>> integer row#
67531>>>>>>>>> get row_count to row#
67532>>>>>>>>> set piFile.i row# to file#
67533>>>>>>>>> set piField.i row# to field#
67534>>>>>>>>> end_procedure
67535>>>>>>>>> function iFindField.ii integer file# integer field# returns integer
67537>>>>>>>>> integer row# max#
67537>>>>>>>>> get row_count to max#
67538>>>>>>>>> for row# from 0 to (max#-1)
67544>>>>>>>>>>
67544>>>>>>>>> if (file#=piFile.i(self,row#) and field#=piField.i(self,row#)) function_return row#
67547>>>>>>>>> loop
67548>>>>>>>>>>
67548>>>>>>>>> function_return -1
67549>>>>>>>>> end_function
67550>>>>>>>>> procedure reset
67552>>>>>>>>> send delete_data
67553>>>>>>>>> end_procedure
67554>>>>>>>>> procedure CallBack_Files integer msg# integer obj#
67556>>>>>>>>> integer row# max# file# itm#
67556>>>>>>>>> string files#
67556>>>>>>>>> move "" to files#
67557>>>>>>>>> get row_count to max#
67558>>>>>>>>> for row# from 0 to (max#-1)
67564>>>>>>>>>>
67564>>>>>>>>> get piFile.i row# to file#
67565>>>>>>>>> ifnot (IsIntegerPresent(files#,file#)) move (AddIntegerToString(files#,file#)) to files#
67568>>>>>>>>> loop
67569>>>>>>>>>>
67569>>>>>>>>> move (HowManyIntegers(files#)) to max#
67570>>>>>>>>> for itm# from 1 to max#
67576>>>>>>>>>>
67576>>>>>>>>> send msg# to obj# (ExtractInteger(files#,itm#))
67577>>>>>>>>> loop
67578>>>>>>>>>>
67578>>>>>>>>> end_procedure
67579>>>>>>>>>end_class
67580>>>>>>>Use DBMS.utl // Basic DBMS functions
67580>>>>>>>
67580>>>>>>>Use APS // Auto Positioning and Sizing classes for VDF
67580>>>>>>>class cFdxSelectOneFileList is a aps.Grid
67581>>>>>>> procedure construct_object integer img#
67583>>>>>>> forward send construct_object img#
67585>>>>>>> set line_width to 4 0
67586>>>>>>> set header_label item 0 to "#"
67587>>>>>>> set header_label item 1 to "Display name"
67588>>>>>>> set header_label item 2 to "DF name"
67589>>>>>>> set header_label item 3 to "Root name"
67590>>>>>>> set form_margin item 0 to 4 //
67591>>>>>>> set form_margin item 1 to 40 //
67592>>>>>>> set form_margin item 2 to 10 //
67593>>>>>>> set form_margin item 3 to 32 //
67594>>>>>>> set highlight_row_state to true
67595>>>>>>> set CurrentCellColor to clHighlight
67596>>>>>>> set CurrentCellTextColor to clHighlightText
67597>>>>>>> set CurrentRowColor to clHighlight
67598>>>>>>> set CurrentRowTextColor to clHighlightText
67599>>>>>>>// set highlight_row_color to (rgb(0,255,255))
67599>>>>>>>// set current_item_color to (rgb(0,255,255))
67599>>>>>>> set select_mode to no_select
67600>>>>>>> on_key knext_item send switch
67601>>>>>>> on_key kprevious_item send switch_back
67602>>>>>>> on_key key_ctrl+key_r send sort_data
67603>>>>>>> property integer piValidateFunction public 0
67604>>>>>>> property integer piValidateObject public 0
67605>>>>>>> end_procedure
67606>>>>>>>
67606>>>>>>> procedure mouse_click integer liItem integer liGrb
67608>>>>>>> if ((liItem-1)<item_count(self)) send close_panel_ok
67611>>>>>>> end_procedure
67612>>>>>>>
67612>>>>>>> function sSortValue.ii integer column# integer itm# returns string
67614>>>>>>> if column# eq 0 function_return (IntToStrR(value(self,itm#),4))
67617>>>>>>> end_function
67618>>>>>>> function iSpecialSortValueOnColumn.i integer column# returns integer
67620>>>>>>> if column# eq 0 function_return 1
67623>>>>>>> function_return 0 // Otherwise no special anything
67624>>>>>>> end_function
67625>>>>>>>
67625>>>>>>> procedure sort_data.i integer column#
67627>>>>>>> send Grid_SortByColumn self column#
67628>>>>>>> end_procedure
67629>>>>>>> procedure sort_data
67631>>>>>>> integer cc#
67631>>>>>>> get Grid_CurrentColumn self to cc#
67632>>>>>>> send sort_data.i cc#
67633>>>>>>> end_procedure
67634>>>>>>> procedure header_mouse_click integer itm#
67636>>>>>>> send sort_data.i itm#
67637>>>>>>> forward send header_mouse_click itm#
67639>>>>>>> end_procedure
67640>>>>>>> procedure fill_list.ii integer oFDX# integer suggest_file#
67642>>>>>>> integer file# suggest_itm# fnc# obj# ok#
67642>>>>>>> send delete_data
67643>>>>>>> get piValidateFunction to fnc#
67644>>>>>>> get piValidateObject to obj#
67645>>>>>>> move 0 to file#
67646>>>>>>> move -1 to suggest_itm#
67647>>>>>>> send cursor_wait to (cursor_control(self))
67648>>>>>>> repeat
67648>>>>>>>>
67648>>>>>>> move (FDX_AttrValue_FLSTNAV(oFDX#,DF_FILE_NEXT_USED,file#)) to file#
67649>>>>>>> if file# begin
67651>>>>>>>// if (iCanOpen.i(oFDX#,file#)) begin
67651>>>>>>> if (FDX_CanOpenFile(oFDX#,file#)) begin
67653>>>>>>> if obj# ne 0 get fnc# of obj# file# to ok#
67656>>>>>>> else move 1 to ok#
67658>>>>>>> if ok# begin
67660>>>>>>> if file# eq suggest_file# move (item_count(self)) to suggest_itm#
67663>>>>>>> send add_item msg_none (string(file#))
67664>>>>>>> send add_item msg_none (rtrim(FDX_AttrValue_FILELIST(oFDX#,DF_FILE_DISPLAY_NAME,file#)))
67665>>>>>>> send add_item msg_none (FDX_AttrValue_FILELIST(oFDX#,DF_FILE_LOGICAL_NAME,file#))
67666>>>>>>> send add_item msg_none (FDX_AttrValue_FILELIST(oFDX#,DF_FILE_ROOT_NAME,file#))
67667>>>>>>> end
67667>>>>>>>>
67667>>>>>>> end
67667>>>>>>>>
67667>>>>>>> end
67667>>>>>>>>
67667>>>>>>> until file# eq 0
67669>>>>>>> send cursor_ready to (cursor_control(self))
67670>>>>>>> set dynamic_update_state to dfTrue
67671>>>>>>> if suggest_itm# ne -1 set current_item to suggest_itm#
67674>>>>>>> send Grid_SetEntryState self 0
67675>>>>>>> end_procedure
67676>>>>>>> function iCurrentFile returns integer
67678>>>>>>> integer itm#
67678>>>>>>> ifnot (item_count(self)) function_return 0
67681>>>>>>> get current_item to itm#
67682>>>>>>> move ((itm#/4)*4) to itm#
67683>>>>>>> function_return (value(self,itm#))
67684>>>>>>> end_function
67685>>>>>>>end_class // cFdxSelectOneFileList
67686>>>>>>>
67686>>>>>>>class cFdxSelectOneFieldList is a aps.Grid
67687>>>>>>> procedure construct_object integer img#
67689>>>>>>> forward send construct_object img#
67691>>>>>>> set line_width to 7 0
67692>>>>>>> set header_label item 0 to "#"
67693>>>>>>> set header_label item 1 to "Name"
67694>>>>>>> set header_label item 2 to "Type"
67695>>>>>>> set header_label item 3 to "Len"
67696>>>>>>> set header_label item 4 to "Offset"
67697>>>>>>> set header_label item 5 to "Idx"
67698>>>>>>> set header_label item 6 to "Relation"
67699>>>>>>> set form_margin item 0 to 2 // #
67700>>>>>>> set form_margin item 1 to 15 // Name
67701>>>>>>> set form_margin item 2 to 4 // Type
67702>>>>>>> set form_margin item 3 to 5 // Len
67703>>>>>>> set form_margin item 4 to 5 // Offset
67704>>>>>>> set form_margin item 5 to 3 // Idx
67705>>>>>>> set form_margin item 6 to 30 // Relation
67706>>>>>>> set highlight_row_state to true
67707>>>>>>> set CurrentCellColor to clHighlight
67708>>>>>>> set CurrentCellTextColor to clHighlightText
67709>>>>>>> set CurrentRowColor to clHighlight
67710>>>>>>> set CurrentRowTextColor to clHighlightText
67711>>>>>>>// set highlight_row_color to (rgb(0,255,255))
67711>>>>>>>// set current_item_color to (rgb(0,255,255))
67711>>>>>>> set select_mode to no_select
67712>>>>>>> on_key knext_item send switch
67713>>>>>>> on_key kprevious_item send switch_back
67714>>>>>>> end_procedure
67715>>>>>>> function sRelFieldName.iii integer oFDX# integer file# integer field# returns string
67717>>>>>>> function_return (FDX_FieldName(oFDX#,file#,field#,1))
67718>>>>>>> end_function
67719>>>>>>> procedure fill_list.iiii integer oFDX# integer file# integer suggest_file# integer suggest_field#
67721>>>>>>> integer field# max_field# suggest_itm# type# len# dec# idx#
67721>>>>>>> send delete_data
67722>>>>>>> ifnot file# get FDX_NextFileThatCanOpen oFDX# 0 to file#
67725>>>>>>> if file# ne suggest_file# move 0 to suggest_field#
67728>>>>>>> move -1 to suggest_itm#
67729>>>>>>> if (FDX_CanOpenFile(oFDX#,file#)) begin
67731>>>>>>> move (FDX_AttrValue_FILE(oFDX#,DF_FILE_NUMBER_FIELDS,file#)) to max_field#
67732>>>>>>> for field# from 1 to max_field#
67738>>>>>>>>
67738>>>>>>> if field# eq suggest_field# move (item_count(self)) to suggest_itm#
67741>>>>>>> send add_item msg_none (string(field#))
67742>>>>>>> send add_item msg_none (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_NAME,file#,field#))
67743>>>>>>> move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_TYPE,file#,field#)) to type#
67744>>>>>>> send add_item msg_none (API_ShortFieldTypeName(type#))
67745>>>>>>> move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_LENGTH,file#,field#)) to len#
67746>>>>>>> if type# eq DF_BCD begin
67748>>>>>>> move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_PRECISION,file#,field#)) to dec#
67749>>>>>>> send add_item msg_none (string(len#-dec#)+"."+string(dec#))
67750>>>>>>> end
67750>>>>>>>>
67750>>>>>>> else send add_item msg_none (string(len#))
67752>>>>>>> send add_item msg_none (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_OFFSET,file#,field#))
67753>>>>>>> move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_INDEX,file#,field#)) to idx#
67754>>>>>>> if idx# send add_item msg_none (string(idx#))
67757>>>>>>> else send add_item msg_none ""
67759>>>>>>> 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#)))
67760>>>>>>> loop
67761>>>>>>>>
67761>>>>>>> end
67761>>>>>>>>
67761>>>>>>> set dynamic_update_state to true
67762>>>>>>> if suggest_itm# ne -1 set current_item to suggest_itm#
67765>>>>>>> send Grid_SetEntryState self 0
67766>>>>>>> end_procedure
67767>>>>>>> function iCurrentField returns integer
67769>>>>>>> integer itm#
67769>>>>>>> ifnot (item_count(self)) function_return 0
67772>>>>>>> get current_item to itm#
67773>>>>>>> move ((itm#/7)*7) to itm#
67774>>>>>>> function_return (value(self,itm#))
67775>>>>>>> end_function
67776>>>>>>>end_class // cFdxSelectOneFieldList
67777>>>>>>>
67777>>>>>>>desktop_section
67782>>>>>>>object oFdxSelectOneFile is a aps.ModalPanel label "Select table"
67785>>>>>>> set locate_mode to CENTER_ON_SCREEN
67786>>>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
67787>>>>>>> property integer piResult public 0
67789>>>>>>> on_key ksave_record send close_panel_ok
67790>>>>>>> on_key kcancel send close_panel
67791>>>>>>> object oLst is a cFdxSelectOneFileList
67793>>>>>>> set size to 200 0
67794>>>>>>> on_key kenter send close_panel_ok
67795>>>>>>> end_object
67796>>>>>>> object oBtn1 is a aps.Multi_Button
67798>>>>>>> on_item t.btn.ok send close_panel_ok
67799>>>>>>> end_object
67800>>>>>>> object oBtn2 is a aps.Multi_Button
67802>>>>>>> on_item t.btn.cancel send close_panel
67803>>>>>>> end_object
67804>>>>>>> send aps_locate_multi_buttons
67805>>>>>>> procedure close_panel_ok
67808>>>>>>> set piResult to 1
67809>>>>>>> send close_panel
67810>>>>>>> end_procedure
67811>>>>>>> function iPopup.iiii integer oFDX# integer suggest# integer fnc# integer obj# returns integer
67814>>>>>>> integer rval#
67814>>>>>>> set piValidateFunction of (oLst(self)) to fnc#
67815>>>>>>> set piValidateObject of (oLst(self)) to obj#
67816>>>>>>> send fill_list.ii to (oLst(self)) oFDX# suggest#
67817>>>>>>> set piResult to 0
67818>>>>>>> send popup
67819>>>>>>> if (piResult(self)) move (iCurrentFile(oLst(self))) to rval#
67822>>>>>>> else move 0 to rval#
67824>>>>>>> function_return rval#
67825>>>>>>> end_function
67826>>>>>>> procedure aps_onResize integer delta_rw# integer delta_cl#
67829>>>>>>> send aps_resize (oLst(self)) delta_rw# 0
67830>>>>>>> send aps_register_multi_button (oBtn1(self))
67831>>>>>>> send aps_register_multi_button (oBtn2(self))
67832>>>>>>> send aps_locate_multi_buttons
67833>>>>>>> send aps_auto_size_container
67834>>>>>>> end_procedure
67835>>>>>>>end_object // oFdxSelectOneFile
67836>>>>>>>
67836>>>>>>>//>This function is defined in a package called "fdxselct.utl". This
67836>>>>>>>//>function calls an object defined just before the function (note that two
67836>>>>>>>//>versions of this object is defined, one for VDF and one for DF3.2). The
67836>>>>>>>//>Function returns the number of the selected file or 0 if the user
67836>>>>>>>//>cancelled the dialog.
67836>>>>>>>//>
67836>>>>>>>//>lhFDX: Object ID that holds a set of table definitions. VDFQuery passes
67836>>>>>>>//>zero in order not to use such an object and instead let the user select
67836>>>>>>>//>a table that is actually there (physically present).
67836>>>>>>>//>
67836>>>>>>>//>liDefaultFile: If this parameter is not zero, the cursor will locate
67836>>>>>>>//>itself on the corresponding file as the the dialog pops up. VDFQuery
67836>>>>>>>//>passes the number of the currently selected file.
67836>>>>>>>//>
67836>>>>>>>//>liValidFnc, liValidObj: Identifies a booelan function (liValidFnc) in an
67836>>>>>>>//>object (liValidObj) that may be used to validate each file, before it is
67836>>>>>>>//>added to the selection list (1 makes the file go in the list, 0 excludes
67836>>>>>>>//>the file). VDFQuery passes a function that checks that "@" is not part
67836>>>>>>>//>of the display name, and the the file has not been excluded by the
67836>>>>>>>//>programmer (this is what Dan Walsh describes with the
67836>>>>>>>//>VdfQuery_ExcludeFile message).
67836>>>>>>>//>
67836>>>>>>>//>Check the code calling this function in VDFQuery.utl to get the full
67836>>>>>>>//>picture
67836>>>>>>>function iFdxSelectOneFileValidate global integer lhFDX integer liDefaultFile integer liValidFnc integer liValidObj returns integer
67838>>>>>>> function_return (iPopup.iiii(oFdxSelectOneFile(self),lhFDX,liDefaultFile,liValidFnc,liValidObj))
67839>>>>>>>end_function
67840>>>>>>>
67840>>>>>>>//> Function iFdxSelectOneFile returns number of selected file or 0
67840>>>>>>>//> if the user cancelled the dialog. If the liDefaultFile parameter is the number
67840>>>>>>>//> of an existing table, the cursor will locate itself on that as the
67840>>>>>>>//> the dialog pops up.
67840>>>>>>>function iFdxSelectOneFile global integer lhFDX integer liDefaultFile returns integer
67842>>>>>>> function_return (iFdxSelectOneFileValidate(lhFDX,liDefaultFile,0,0))
67843>>>>>>>end_function
67844>>>>>>>
67844>>>>>>>object oFdxSelectOneField is a aps.ModalPanel label "Select field"
67847>>>>>>> set locate_mode to CENTER_ON_SCREEN
67848>>>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
67849>>>>>>> property integer piResult public 0
67851>>>>>>> property integer piFDX_Server public 0
67853>>>>>>> property integer piCurrentFile public 0
67855>>>>>>> property integer piLockFile public 0
67857>>>>>>> on_key ksave_record send close_panel_ok
67858>>>>>>> on_key kcancel send close_panel
67859>>>>>>> on_key kprompt send Table_Select
67860>>>>>>> send aps_make_row_space 10
67861>>>>>>> object oFrm1 is a aps.Form label "Table" abstract AFT_NUMERIC4.0
67865>>>>>>> set label_justification_mode to JMODE_TOP
67866>>>>>>> set object_shadow_state to true
67867>>>>>>> end_object
67868>>>>>>> object oFrm2 is a aps.Form label "Display name" abstract AFT_ASCII40 snap SL_RIGHT
67873>>>>>>> set label_justification_mode to JMODE_TOP
67874>>>>>>> set object_shadow_state to true
67875>>>>>>> end_object
67876>>>>>>> object oFrm3 is a aps.Form label "DF name" abstract AFT_ASCII10 snap SL_RIGHT
67881>>>>>>> set label_justification_mode to JMODE_TOP
67882>>>>>>> set object_shadow_state to true
67883>>>>>>> end_object
67884>>>>>>> object oFrm4 is a aps.Form label "Root name" abstract AFT_ASCII35 snap SL_RIGHT
67889>>>>>>> set label_justification_mode to JMODE_TOP
67890>>>>>>> set object_shadow_state to true
67891>>>>>>> end_object
67892>>>>>>> procedure DoUpdateDisplay
67895>>>>>>> integer oFDX# file#
67895>>>>>>> get piFDX_Server to oFDX#
67896>>>>>>> get piCurrentFile to file#
67897>>>>>>> set value of (oFrm1(self)) item 0 to file#
67898>>>>>>> set value of (oFrm2(self)) item 0 to (rtrim(FDX_AttrValue_FILELIST(oFDX#,DF_FILE_DISPLAY_NAME,file#)))
67899>>>>>>> set value of (oFrm3(self)) item 0 to (FDX_AttrValue_FILELIST(oFDX#,DF_FILE_LOGICAL_NAME,file#))
67900>>>>>>> set value of (oFrm4(self)) item 0 to (FDX_AttrValue_FILELIST(oFDX#,DF_FILE_ROOT_NAME,file#))
67901>>>>>>> end_procedure
67902>>>>>>> object oLst is a cFdxSelectOneFieldList snap SL_DOWN relative_to (oFrm1(self))
67910>>>>>>> on_key kenter send close_panel_ok
67911>>>>>>> end_object
67912>>>>>>> procedure close_panel_ok
67915>>>>>>> set piResult to 1
67916>>>>>>> send close_panel
67917>>>>>>> end_procedure
67918>>>>>>> object oBtn1 is a aps.Multi_Button
67920>>>>>>> on_item t.btn.ok send close_panel_ok
67921>>>>>>> end_object
67922>>>>>>> object oBtn2 is a aps.Multi_Button
67924>>>>>>> on_item "Change table" send Table_Select
67925>>>>>>> end_object
67926>>>>>>> object oBtn3 is a aps.Multi_Button
67928>>>>>>> on_item t.btn.cancel send close_panel
67929>>>>>>> end_object
67930>>>>>>> send aps_locate_multi_buttons
67931>>>>>>>
67931>>>>>>> procedure Table_Select
67934>>>>>>> integer file# oFDX#
67934>>>>>>> get piFDX_Server to oFDX#
67935>>>>>>> ifnot (piLockFile(self)) begin
67937>>>>>>> move (iFdxSelectOneFile(oFDX#,piCurrentFile(self))) to file#
67938>>>>>>> if file# begin
67940>>>>>>> send fill_list.iiii to (oLst(self)) oFDX# file# 0 0
67941>>>>>>> set piCurrentFile to file#
67942>>>>>>> send DoUpdateDisplay
67943>>>>>>> end
67943>>>>>>>>
67943>>>>>>> end
67943>>>>>>>>
67943>>>>>>> end_procedure
67944>>>>>>>
67944>>>>>>> function iPopup.iii integer oFDX# integer lock_file# integer suggest# returns integer
67947>>>>>>> integer rval# suggest_file# suggest_field# file# field#
67947>>>>>>> move (hi(suggest#)) to suggest_file#
67948>>>>>>> move (low(suggest#)) to suggest_field#
67949>>>>>>> set piResult to 0
67950>>>>>>>
67950>>>>>>> if (lock_file# and suggest_file#) if lock_file# ne suggest_file# move 0 to suggest_file#
67955>>>>>>> ifnot suggest_file# move 0 to suggest_field#
67958>>>>>>>
67958>>>>>>> set piFDX_Server to oFDX#
67959>>>>>>> set piLockFile to lock_file#
67960>>>>>>>
67960>>>>>>> if lock_file# move lock_file# to file#
67963>>>>>>> else begin
67964>>>>>>> if suggest_file# move suggest_file# to file#
67967>>>>>>> else get FDX_NextFileThatCanOpen oFDX# 0 to file# // Find first#
67969>>>>>>> end
67969>>>>>>>>
67969>>>>>>>
67969>>>>>>> if file# begin
67971>>>>>>> send fill_list.iiii to (oLst(self)) oFDX# file# suggest_file# suggest_field#
67972>>>>>>> set piCurrentFile to file#
67973>>>>>>> send DoUpdateDisplay
67974>>>>>>> send popup
67975>>>>>>> if (piResult(self)) begin
67977>>>>>>> get piCurrentFile to file#
67978>>>>>>> move (iCurrentField(oLst(self))) to field#
67979>>>>>>> move (file#*65536+field#) to rval#
67980>>>>>>> end
67980>>>>>>>>
67980>>>>>>> else move 0 to rval#
67982>>>>>>> end
67982>>>>>>>>
67982>>>>>>> else begin
67983>>>>>>> send obs "Sorry, no tables to select"
67984>>>>>>> move 0 to rval#
67985>>>>>>> end
67985>>>>>>>>
67985>>>>>>> function_return rval#
67986>>>>>>> end_function
67987>>>>>>> procedure aps_onResize integer delta_rw# integer delta_cl#
67990>>>>>>> send aps_resize (oLst(self)) delta_rw# 0
67991>>>>>>> send aps_register_multi_button (oBtn1(self))
67992>>>>>>> send aps_register_multi_button (oBtn2(self))
67993>>>>>>> send aps_register_multi_button (oBtn3(self))
67994>>>>>>> send aps_register_max_rc (oFrm4(self))
67995>>>>>>> send aps_locate_multi_buttons
67996>>>>>>> send aps_auto_size_container
67997>>>>>>> end_procedure
67998>>>>>>> procedure aps_beautify
68001>>>>>>> send aps_align_by_moving (oFrm2(self)) (oFrm1(self)) SL_ALIGN_BOTTOM
68002>>>>>>> send aps_align_by_moving (oFrm3(self)) (oFrm2(self)) SL_ALIGN_BOTTOM
68003>>>>>>> send aps_align_by_moving (oFrm4(self)) (oFrm3(self)) SL_ALIGN_BOTTOM
68004>>>>>>> send aps_align_inside_container_by_moving (oLst(self)) SL_ALIGN_CENTER
68005>>>>>>> end_procedure
68006>>>>>>>end_object // oFdxSelectOneField
68007>>>>>>>
68007>>>>>>>//> Function iFdxSelectOneField returns selected file multiplied by 65536
68007>>>>>>>//> plus the number of the selected field. If the user cancels the dialog
68007>>>>>>>//> 0 will be returned. If a file# is passed as the first parameter the
68007>>>>>>>//> dialog will be locked to that file.
68007>>>>>>>function iFdxSelectOneField global integer oFDX# integer file# integer suggest# returns integer
68009>>>>>>> function_return (iPopup.iii(oFdxSelectOneField(self),oFDX#,file#,suggest#))
68010>>>>>>>end_function
68011>>>>>>>
68011>>>>>>>Use APS // Auto Positioning and Sizing classes for VDF
68011>>>>>>>class cFdxSelectFieldsList is a aps.Grid
68012>>>>>>> procedure construct_object integer img#
68014>>>>>>> forward send construct_object img#
68016>>>>>>> send GridPrepare_AddColumn "" AFT_ASCII3
68017>>>>>>> send GridPrepare_AddColumn "Name" AFT_ASCII25
68018>>>>>>> send GridPrepare_AddColumn "Type" AFT_ASCII6
68019>>>>>>> send GridPrepare_AddColumn "Length" AFT_ASCII8
68020>>>>>>> send GridPrepare_AddColumn "Relates to" AFT_ASCII12
68021>>>>>>> send GridPrepare_Apply self
68022>>>>>>> set select_mode to MULTI_SELECT
68023>>>>>>> on_key kswitch send switch
68024>>>>>>> on_key kswitch_back send switch_back
68025>>>>>>> end_procedure
68026>>>>>>> procedure select_toggling integer itm# integer i#
68028>>>>>>> forward send select_toggling (Grid_BaseItem(self)) i# // Redirect to first column
68030>>>>>>> end_procedure
68031>>>>>>> procedure fill_list.iii integer oFDX# integer file# integer set#
68033>>>>>>> integer field# max_field# base# rel_file#
68033>>>>>>> set dynamic_update_state to DFFALSE
68034>>>>>>> send delete_data
68035>>>>>>> move (FDX_AttrValue_FILE(oFDX#,DF_FILE_NUMBER_FIELDS,file#)) to max_field#
68036>>>>>>> for field# from 0 to max_field#
68042>>>>>>>>
68042>>>>>>> get item_count to base#
68043>>>>>>> send add_item msg_none ""
68044>>>>>>> set checkbox_item_state item base# to true
68045>>>>>>> if (iFindField.ii(set#,file#,field#)<>-1) set select_state item base# to true
68048>>>>>>> send add_item msg_none (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_NAME,file#,field#))
68049>>>>>>> send add_item msg_none (StringFieldType(FDX_AttrValue_FIELD(oFDX#,DF_FIELD_TYPE,file#,field#)))
68050>>>>>>> send add_item msg_none (FDX_FieldLength(oFDX#,file#,field#))
68051>>>>>>> move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_RELATED_FILE,file#,field#)) to rel_file#
68052>>>>>>> if rel_file# send add_item msg_none (FDX_AttrValue_FILELIST(oFDX#,DF_FILE_LOGICAL_NAME,rel_file#))
68055>>>>>>> else send add_item msg_none ""
68057>>>>>>> loop
68058>>>>>>>>
68058>>>>>>> send Grid_SetEntryState self 0
68059>>>>>>> set dynamic_update_state to DFTRUE
68060>>>>>>> end_procedure
68061>>>>>>> procedure rebuild_set integer set# integer file#
68063>>>>>>> integer row# max# fld# base# columns#
68063>>>>>>> send reset to set#
68064>>>>>>> get Grid_Columns self to columns#
68065>>>>>>> get Grid_RowCount self to max#
68066>>>>>>> for row# from 0 to (max#-1)
68072>>>>>>>>
68072>>>>>>> move (row#*columns#) to base#
68073>>>>>>> if (select_state(self,base#)) send add_field to set# file# row#
68076>>>>>>> loop
68077>>>>>>>>
68077>>>>>>> end_procedure
68078>>>>>>> procedure select_help integer st#
68080>>>>>>> integer row# max# base# columns#
68080>>>>>>> get Grid_Columns self to columns#
68081>>>>>>> get Grid_RowCount self to max#
68082>>>>>>> for row# from 0 to (max#-1)
68088>>>>>>>>
68088>>>>>>> move (row#*columns#) to base#
68089>>>>>>> set select_state item base# to st#
68090>>>>>>> loop
68091>>>>>>>>
68091>>>>>>> set dynamic_update_state to true
68092>>>>>>> end_procedure
68093>>>>>>> procedure select_all
68095>>>>>>> send select_help 1
68096>>>>>>> end_procedure
68097>>>>>>> procedure select_none
68099>>>>>>> send select_help 0
68100>>>>>>> end_procedure
68101>>>>>>>end_class // cFdxSelectFieldsList
68102>>>>>>>
68102>>>>>>>object oFdxSelectFields is a aps.ModalPanel
68104>>>>>>> set locate_mode to CENTER_ON_SCREEN
68105>>>>>>> on_key ksave_record send close_panel_ok
68106>>>>>>> on_key kcancel send close_panel
68107>>>>>>> property integer piResult public 0
68109>>>>>>> set pMinimumSize to 150 0
68110>>>>>>> object oLst is a cFdxSelectFieldsList
68112>>>>>>> on_key kenter send next
68113>>>>>>> set size to 200 0
68114>>>>>>> end_object
68115>>>>>>> object oBtn1 is a aps.Multi_Button
68117>>>>>>> on_item "Select all" send select_all to (oLst(self))
68118>>>>>>> end_object
68119>>>>>>> object oBtn2 is a aps.Multi_Button
68121>>>>>>> on_item "Deselect all" send select_none to (oLst(self))
68122>>>>>>> end_object
68123>>>>>>> object oBtn3 is a aps.Multi_Button
68125>>>>>>> on_item t.btn.ok send close_panel_ok
68126>>>>>>> end_object
68127>>>>>>> object oBtn4 is a aps.Multi_Button
68129>>>>>>> on_item t.btn.cancel send close_panel
68130>>>>>>> end_object
68131>>>>>>> send aps_locate_multi_buttons sl_vertical
68132>>>>>>> procedure close_panel_ok
68135>>>>>>> set piResult to 1
68136>>>>>>> send close_panel
68137>>>>>>> end_procedure
68138>>>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
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_register_multi_button (oBtn3(self))
68146>>>>>>> send aps_register_multi_button (oBtn4(self))
68147>>>>>>> send aps_locate_multi_buttons sl_vertical
68148>>>>>>> send aps_auto_size_container
68149>>>>>>> end_procedure
68150>>>>>>> function iPopup.iii integer oFDX# integer file# integer set# returns integer
68153>>>>>>> set piResult to 0
68154>>>>>>> send fill_list.iii to (oLst(self)) oFDX# file# set#
68155>>>>>>> set label to ("Select fields: "+FDX_AttrValue_FILELIST(oFDX#,DF_FILE_LOGICAL_NAME,file#))
68156>>>>>>> send popup
68157>>>>>>> if (piResult(self)) begin
68159>>>>>>> send rebuild_set to (oLst(self)) set# file#
68160>>>>>>> end
68160>>>>>>>>
68160>>>>>>> function_return (piResult(self))
68161>>>>>>> end_function
68162>>>>>>>end_object // oFdxSelectFields
68163>>>>>>>
68163>>>>>>>//> Function iFdxSelectFields returns 1 if the the user did indeed select a
68163>>>>>>>//> set of fields and 0 if the user cancelled the selection. If 1 is returned
68163>>>>>>>//> the function will modify the set of fields passed to it in parameter
68163>>>>>>>//> set#.
68163>>>>>>>function iFdxSelectFields global integer oFDX# integer file# integer set# returns integer
68165>>>>>>> integer close# open# rval#
68165>>>>>>> ifnot oFDX# begin
68167>>>>>>> if (DBMS_IsOpenFile(file#)) begin
68169>>>>>>> move 0 to close#
68170>>>>>>> move 1 to open#
68171>>>>>>> end
68171>>>>>>>>
68171>>>>>>> else begin
68172>>>>>>> if (DBMS_OpenFile(file#,DF_SHARE,0)) begin
68174>>>>>>> move 1 to close#
68175>>>>>>> move 1 to open#
68176>>>>>>> end
68176>>>>>>>>
68176>>>>>>> else begin
68177>>>>>>> move 0 to close#
68178>>>>>>> move 0 to open#
68179>>>>>>> end
68179>>>>>>>>
68179>>>>>>> end
68179>>>>>>>>
68179>>>>>>> end
68179>>>>>>>>
68179>>>>>>> else begin
68180>>>>>>> move 0 to close#
68181>>>>>>> move 1 to open#
68182>>>>>>> end
68182>>>>>>>>
68182>>>>>>> move (iPopup.iii(oFdxSelectFields(self),oFDX#,file#,set#)) to rval#
68183>>>>>>> if close# close file#
68186>>>>>>> function_return rval#
68187>>>>>>>end_function
68188>>>>>>>
68188>>>>>>>Use APS // Auto Positioning and Sizing classes for VDF
68188>>>>>>>class cFdxSelectIndexList is a aps.List
68189>>>>>>> procedure construct_object integer img#
68191>>>>>>> forward send construct_object img#
68193>>>>>>> on_key kswitch send switch
68194>>>>>>> on_key kswitch_back send switch_back
68195>>>>>>> property integer phFDX public 0
68196>>>>>>> property integer piFile public 0
68197>>>>>>> end_procedure
68198>>>>>>> procedure mouse_click integer liItem integer liGrb
68200>>>>>>> if ((liItem-1)<item_count(self)) send close_panel_ok
68203>>>>>>> end_procedure
68204>>>>>>> procedure AddIndex integer liFile integer liIndex string lsFields integer liType
68206>>>>>>> send add_item MSG_NONE (string(liIndex)+": "+FDX_IndexAsFieldNames(phFDX(self),piFile(self),liIndex,0))
68207>>>>>>> set aux_value item (item_count(self)-1) to liIndex
68208>>>>>>> end_procedure
68209>>>>>>> procedure fill_list.ii integer oFDX# integer file#
68211>>>>>>> integer field# max_field# base# rel_file#
68211>>>>>>> set phFDX to oFDX#
68212>>>>>>> set piFile to file#
68213>>>>>>> set dynamic_update_state to DFFALSE
68214>>>>>>> send delete_data
68215>>>>>>> send FDX_IndexCallback oFDX# file# DF_INDEX_TYPE_ONLINE MSG_AddIndex self
68216>>>>>>> send FDX_IndexCallback oFDX# file# DF_INDEX_TYPE_BATCH MSG_AddIndex self
68217>>>>>>> set dynamic_update_state to DFTRUE
68218>>>>>>> end_procedure
68219>>>>>>>end_class // cFdxSelectIndexList
68220>>>>>>>
68220>>>>>>>object oFdxSelectIndex is a aps.ModalPanel
68222>>>>>>> set locate_mode to CENTER_ON_SCREEN
68223>>>>>>> on_key ksave_record send close_panel_ok
68224>>>>>>> on_key kcancel send close_panel
68225>>>>>>> property integer piResult public 0
68227>>>>>>> set pMinimumSize to 150 0
68228>>>>>>> object oLst is a cFdxSelectIndexList
68230>>>>>>> on_key kenter send close_panel_ok
68231>>>>>>> set size to 100 300
68232>>>>>>> end_object
68233>>>>>>> object oBtn1 is a aps.Multi_Button
68235>>>>>>> on_item t.btn.ok send close_panel_ok
68236>>>>>>> end_object
68237>>>>>>> object oBtn2 is a aps.Multi_Button
68239>>>>>>> on_item t.btn.cancel send close_panel
68240>>>>>>> end_object
68241>>>>>>> send aps_locate_multi_buttons
68242>>>>>>> procedure close_panel_ok
68245>>>>>>> set piResult to (aux_value(oLst(self),CURRENT))
68246>>>>>>> send close_panel
68247>>>>>>> end_procedure
68248>>>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
68249>>>>>>> procedure aps_onResize integer delta_rw# integer delta_cl#
68252>>>>>>> send aps_resize (oLst(self)) delta_rw# 0
68253>>>>>>> send aps_register_multi_button (oBtn1(self))
68254>>>>>>> send aps_register_multi_button (oBtn2(self))
68255>>>>>>> send aps_locate_multi_buttons
68256>>>>>>> send aps_auto_size_container
68257>>>>>>> end_procedure
68258>>>>>>> function iPopup.ii integer oFDX# integer file# returns integer
68261>>>>>>> set piResult to 0
68262>>>>>>> send fill_list.ii to (oLst(self)) oFDX# file#
68263>>>>>>> set label to ("Select index: "+FDX_AttrValue_FILELIST(oFDX#,DF_FILE_LOGICAL_NAME,file#))
68264>>>>>>> send popup
68265>>>>>>> function_return (piResult(self))
68266>>>>>>> end_function
68267>>>>>>>end_object // oFdxSelectIndex
68268>>>>>>>end_desktop_section
68273>>>>>>>
68273>>>>>>>function iFdxSelectIndex global integer oFDX# integer file# returns integer
68275>>>>>>> integer close# open# rval#
68275>>>>>>> ifnot oFDX# begin
68277>>>>>>> if (DBMS_IsOpenFile(file#)) begin
68279>>>>>>> move 0 to close#
68280>>>>>>> move 1 to open#
68281>>>>>>> end
68281>>>>>>>>
68281>>>>>>> else begin
68282>>>>>>> if (DBMS_OpenFile(file#,DF_SHARE,0)) begin
68284>>>>>>> move 1 to close#
68285>>>>>>> move 1 to open#
68286>>>>>>> end
68286>>>>>>>>
68286>>>>>>> else begin
68287>>>>>>> move 0 to close#
68288>>>>>>> move 0 to open#
68289>>>>>>> end
68289>>>>>>>>
68289>>>>>>> end
68289>>>>>>>>
68289>>>>>>> end
68289>>>>>>>>
68289>>>>>>> else begin
68290>>>>>>> move 0 to close#
68291>>>>>>> move 1 to open#
68292>>>>>>> end
68292>>>>>>>>
68292>>>>>>> move (iPopup.ii(oFdxSelectIndex(self),oFDX#,file#)) to rval#
68293>>>>>>> if close# close file#
68296>>>>>>> function_return rval#
68297>>>>>>>end_function
68298>>>>>Use AutoPrmt.utl // Automatic prompt lists for VDF, (DefaultPromptList(self))
Including file: autoprmt.utl (C:\Apps\VDFQuery\AppSrc\autoprmt.utl)
68298>>>>>>>// **********************************************************************
68298>>>>>>>// Use AutoPrmt.utl // Automatic prompt lists for VDF, (DefaultPromptList(self))
68298>>>>>>>//
68298>>>>>>>// by Sture Andersen
68298>>>>>>>//
68298>>>>>>>// Try to send popup to (DefaultPromptList(self)) and see what happens
68298>>>>>>>//
68298>>>>>>>// Create: Thu 14-04-1997
68298>>>>>>>// Update: Sat 10-05-1997 - Restructure
68298>>>>>>>// Wed 16-07-1997 - Object index_analyzer is now private
68298>>>>>>>// Thu 30-10-1997 - Now runs from dbForms with no server
68298>>>>>>>// Mon 15-12-1997 - Procedure DefaultPromptList added
68298>>>>>>>// Sat 05-12-1998 - When PL's are constructed (not auto_server)
68298>>>>>>>// in VDF5, the server of the dbList has to be
68298>>>>>>>// set.
68298>>>>>>>// Wed 10-02-1999 - Prompt lists are now re-sizable.
68298>>>>>>>// Tue 30-11-1999 - Changing function call from expressional to
68298>>>>>>>// non-expressional fixed "illegal message"
68298>>>>>>>// problem (shouldn't have happened in the
68298>>>>>>>// first place because delegation_mode was set
68298>>>>>>>// to no_delegate_or_error).
68298>>>>>>>// Mon 30+06-2003 - Changed height of selection list (double height)
68298>>>>>>>// ***********************************************************************
68298>>>>>>>
68298>>>>>>>Use APS // Auto Positioning and Sizing classes for VDF
68298>>>>>>>Use Dynamo.utl // Dynamic creation of objects for VDF
Including file: dynamo.utl (C:\Apps\VDFQuery\AppSrc\dynamo.utl)
68298>>>>>>>>>// **********************************************************************
68298>>>>>>>>>// Use Dynamo.utl // Dynamic creation of objects for VDF
68298>>>>>>>>>//
68298>>>>>>>>>// Version: 1.0
68298>>>>>>>>>// By Sture Andersen
68298>>>>>>>>>//
68298>>>>>>>>>// Create: Thu 03-04-1997 -
68298>>>>>>>>>// Update: Sat 10-05-1997 - Procedure push_data_fields added
68298>>>>>>>>>// Thu 08-09-2005 - Maximum columns handled by dbGrid & dbList increased from 10 to 20
68298>>>>>>>>>// Wed 14-09-2005 - Now also handles virtual fields (in dbGrids and dbLists, dbForms soon to come)
68298>>>>>>>>>// ***********************************************************************
68298>>>>>>>>>
68298>>>>>>>>>Use APS // Auto Positioning and Sizing classes for VDF
68298>>>>>>>>>Use Set.utl // cArray, cSet and cStack classes
68298>>>>>>>>>Use Classes.nui // Class characteristics
Including file: classes.nui (C:\Apps\VDFQuery\AppSrc\classes.nui)
68298>>>>>>>>>>>// Use Classes.nui // Class characteristics
68298>>>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
68298>>>>>>>>>>>Use cDbRichEdit.pkg
68298>>>>>>>>>>>
68298>>>>>>>>>>>// Start off by enumerating all kinds of object classes that can be
68298>>>>>>>>>>>// thought of. These are just symbols that will be used for indexing
68298>>>>>>>>>>>// within arrays:
68298>>>>>>>>>>>
68298>>>>>>>>>>>Enumeration_List
68298>>>>>>>>>>> Define class.View
68298>>>>>>>>>>> Define class.dbView
68298>>>>>>>>>>> Define class.ModalPanel
68298>>>>>>>>>>> Define class.dbModalPanel
68298>>>>>>>>>>> Define class.Group
68298>>>>>>>>>>> Define class.dbGroup
68298>>>>>>>>>>> Define class.Container3d
68298>>>>>>>>>>> Define class.dbContainer3d
68298>>>>>>>>>>> Define class.TabDialog
68298>>>>>>>>>>> Define class.dbTabDialog
68298>>>>>>>>>>> Define class.TabPage
68298>>>>>>>>>>> Define class.dbTabPage
68298>>>>>>>>>>> Define class.RadioGroup
68298>>>>>>>>>>> Define class.Form
68298>>>>>>>>>>> Define class.dbForm
68298>>>>>>>>>>> Define class.ComboForm
68298>>>>>>>>>>> Define class.dbComboForm
68298>>>>>>>>>>> Define class.SpinForm
68298>>>>>>>>>>> Define class.dbSpinForm
68298>>>>>>>>>>> Define class.CheckBox
68298>>>>>>>>>>> Define class.dbCheckBox
68298>>>>>>>>>>> Define class.Edit
68298>>>>>>>>>>> Define class.dbEdit
68298>>>>>>>>>>> Define class.TextBox
68298>>>>>>>>>>> Define class.Button
68298>>>>>>>>>>> Define class.Radio
68298>>>>>>>>>>> Define class.List
68298>>>>>>>>>>> Define class.dbList
68298>>>>>>>>>>> Define class.Grid
68298>>>>>>>>>>> Define class.dbGrid
68298>>>>>>>>>>> Define class.Multi_Button
68298>>>>>>>>>>> Define class.BitmapContainer
68298>>>>>>>>>>> Define class.ToolButton
68298>>>>>>>>>>> Define class.DataDictionary
68298>>>>>>>>>>> Define class.ImageViewer // This one I have completely forgotten about
68298>>>>>>>>>>> Define class.GraphArea
68298>>>>>>>>>>> Define class.RichEdit
68298>>>>>>>>>>> Define class.dbRichEdit
68298>>>>>>>>>>> Define class.TextEdit
68298>>>>>>>>>>> Define class.dbTextEdit
68298>>>>>>>>>>> Define class.User // This one just marks the end
68298>>>>>>>>>>>End_Enumeration_List
68298>>>>>>>>>>>
68298>>>>>>>>>>>
68298>>>>>>>>>>>ClassReveal BaseClass -1
68302>>>>>>>>>>>ClassReveal View class.View
68306>>>>>>>>>>>ClassReveal dbView class.dbView
68310>>>>>>>>>>>ClassReveal ModalPanel class.ModalPanel
68314>>>>>>>>>>>ClassReveal dbModalPanel class.dbModalPanel
68318>>>>>>>>>>>ClassReveal Group class.Group
68322>>>>>>>>>>>ClassReveal dbGroup class.dbGroup
68326>>>>>>>>>>>ClassReveal Container3d class.Container3d
68330>>>>>>>>>>>ClassReveal dbContainer3d class.dbContainer3d
68334>>>>>>>>>>>ClassReveal TabDialog class.TabDialog
68338>>>>>>>>>>>ClassReveal dbTabDialog class.dbTabDialog
68342>>>>>>>>>>>ClassReveal TabPage class.TabPage
68346>>>>>>>>>>>ClassReveal dbTabPage class.dbTabPage
68350>>>>>>>>>>>ClassReveal RadioGroup class.RadioGroup
68354>>>>>>>>>>>ClassReveal Form class.Form
68358>>>>>>>>>>>ClassReveal dbForm class.dbForm
68362>>>>>>>>>>>ClassReveal ComboForm class.ComboForm
68366>>>>>>>>>>>ClassReveal dbComboForm class.dbComboForm
68370>>>>>>>>>>>ClassReveal SpinForm class.SpinForm
68374>>>>>>>>>>>ClassReveal dbSpinForm class.dbSpinForm
68378>>>>>>>>>>>ClassReveal CheckBox class.CheckBox
68382>>>>>>>>>>>ClassReveal dbCheckBox class.dbCheckBox
68386>>>>>>>>>>>ClassReveal Edit class.Edit
68390>>>>>>>>>>>ClassReveal dbEdit class.dbEdit
68394>>>>>>>>>>>ClassReveal TextBox class.TextBox
68398>>>>>>>>>>>ClassReveal Button class.Button
68402>>>>>>>>>>>ClassReveal Radio class.Radio
68406>>>>>>>>>>>ClassReveal List class.List
68410>>>>>>>>>>>ClassReveal dbList class.dbList
68414>>>>>>>>>>>ClassReveal Grid class.Grid
68418>>>>>>>>>>>ClassReveal dbGrid class.dbGrid
68422>>>>>>>>>>>ClassReveal BitmapContainer class.BitmapContainer
68426>>>>>>>>>>>ClassReveal DataDictionary class.DataDictionary
68430>>>>>>>>>>>ClassReveal cRichEdit class.RichEdit
68434>>>>>>>>>>>ClassReveal cdbRichEdit class.dbRichEdit
68438>>>>>>>>>>>ClassReveal cTextEdit class.TextEdit
68442>>>>>>>>>>>ClassReveal cdbTextEdit class.dbTextEdit
68446>>>>>>>>>>>
68446>>>>>>>>>>>
68446>>>>>>>>>>>
68446>>>>>>>>>>>desktop_section
68451>>>>>>>>>>>object oVdfClasses is a cArray
68453>>>>>>>>>>> item_property_list
68453>>>>>>>>>>> item_property string psName.i
68453>>>>>>>>>>> item_property integer pbDbAware.i
68453>>>>>>>>>>> item_property integer pbContainer.i
68453>>>>>>>>>>> item_property integer pbVisible.i
68453>>>>>>>>>>> item_property integer pbMultiItem.i
68453>>>>>>>>>>> end_item_property_list
#REM 68499 DEFINE FUNCTION PBMULTIITEM.I INTEGER LIROW RETURNS INTEGER
#REM 68504 DEFINE PROCEDURE SET PBMULTIITEM.I INTEGER LIROW INTEGER VALUE
#REM 68509 DEFINE FUNCTION PBVISIBLE.I INTEGER LIROW RETURNS INTEGER
#REM 68514 DEFINE PROCEDURE SET PBVISIBLE.I INTEGER LIROW INTEGER VALUE
#REM 68519 DEFINE FUNCTION PBCONTAINER.I INTEGER LIROW RETURNS INTEGER
#REM 68524 DEFINE PROCEDURE SET PBCONTAINER.I INTEGER LIROW INTEGER VALUE
#REM 68529 DEFINE FUNCTION PBDBAWARE.I INTEGER LIROW RETURNS INTEGER
#REM 68534 DEFINE PROCEDURE SET PBDBAWARE.I INTEGER LIROW INTEGER VALUE
#REM 68539 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 68544 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
68550>>>>>>>>>>> procedure AddClass integer liClass string lsName integer lbDBAware integer lbContainer integer lbVisible integer lbMultiItem
68553>>>>>>>>>>> set psName.i liClass to lsName
68554>>>>>>>>>>> set pbDbAware.i liClass to lbDBAware
68555>>>>>>>>>>> set pbContainer.i liClass to lbContainer
68556>>>>>>>>>>> set pbVisible.i liClass to lbVisible
68557>>>>>>>>>>> set pbMultiItem.i liClass to lbMultiItem
68558>>>>>>>>>>> end_procedure
68559>>>>>>>>>>> send AddClass class.View "View" 0 1 1 0
68560>>>>>>>>>>> send AddClass class.dbView "dbView" 1 1 1 0
68561>>>>>>>>>>> send AddClass class.ModalPanel "ModalPanel" 0 1 1 0
68562>>>>>>>>>>> send AddClass class.dbModalPanel "dbModalPanel" 1 1 1 0
68563>>>>>>>>>>> send AddClass class.Group "Group" 0 1 1 0
68564>>>>>>>>>>> send AddClass class.dbGroup "dbGroup" 1 1 1 0
68565>>>>>>>>>>> send AddClass class.Container3d "Container3d" 0 1 1 0
68566>>>>>>>>>>> send AddClass class.dbContainer3d "dbContainer3d" 1 1 1 0
68567>>>>>>>>>>> send AddClass class.TabDialog "TabDialog" 0 1 1 0
68568>>>>>>>>>>> send AddClass class.dbTabDialog "dbTabDialog" 1 1 1 0
68569>>>>>>>>>>> send AddClass class.TabPage "TabPage" 0 1 1 0
68570>>>>>>>>>>> send AddClass class.dbTabPage "dbTabPage" 1 1 1 0
68571>>>>>>>>>>> send AddClass class.RadioGroup "RadioGroup" 0 1 1 0
68572>>>>>>>>>>> send AddClass class.Form "Form" 0 0 1 0
68573>>>>>>>>>>> send AddClass class.dbForm "dbForm" 1 0 1 0
68574>>>>>>>>>>> send AddClass class.ComboForm "ComboForm" 0 0 1 0
68575>>>>>>>>>>> send AddClass class.dbComboForm "dbComboForm" 1 0 1 0
68576>>>>>>>>>>> send AddClass class.SpinForm "SpinForm" 0 0 1 0
68577>>>>>>>>>>> send AddClass class.dbSpinForm "dbSpinForm" 1 0 1 0
68578>>>>>>>>>>> send AddClass class.CheckBox "CheckBox" 0 0 1 0
68579>>>>>>>>>>> send AddClass class.dbCheckBox "dbCheckBox" 1 0 1 0
68580>>>>>>>>>>> send AddClass class.Edit "Edit" 0 0 1 0
68581>>>>>>>>>>> send AddClass class.dbEdit "dbEdit" 1 0 1 0
68582>>>>>>>>>>> send AddClass class.TextBox "TextBox" 0 0 1 0
68583>>>>>>>>>>> send AddClass class.Button "Button" 0 0 1 0
68584>>>>>>>>>>> send AddClass class.Radio "Radio" 0 0 1 0
68585>>>>>>>>>>> send AddClass class.List "List" 0 0 1 0
68586>>>>>>>>>>> send AddClass class.dbList "dbList" 1 0 1 1
68587>>>>>>>>>>> send AddClass class.Grid "Grid" 0 0 1 1
68588>>>>>>>>>>> send AddClass class.dbGrid "dbGrid" 1 0 1 1
68589>>>>>>>>>>> send AddClass class.Multi_Button "Multi_Button" 0 0 1 0
68590>>>>>>>>>>> send AddClass class.BitmapContainer "BitmapContainer"0 0 1 0
68591>>>>>>>>>>> send AddClass class.ToolButton "ToolButton" 0 0 1 0
68592>>>>>>>>>>> send AddClass class.DataDictionary "DataDictionary" 1 0 0 0
68593>>>>>>>>>>> send AddClass class.ImageViewer "ImageViewer" 0 0 1 0
68594>>>>>>>>>>> send AddClass class.GraphArea "GraphArea" 0 0 1 0
68595>>>>>>>>>>> send AddClass class.RichEdit "RichEdit " 0 0 1 0
68596>>>>>>>>>>> send AddClass class.dbRichEdit "dbRichEdit" 1 0 1 0
68597>>>>>>>>>>> send AddClass class.TextEdit "TextEdit " 0 0 1 0
68598>>>>>>>>>>> send AddClass class.dbTextEdit "dbTextEdit" 1 0 1 0
68599>>>>>>>>>>> send AddClass class.User "User" 0 0 0 0
68600>>>>>>>>>>>end_object
68601>>>>>>>>>>>end_desktop_section
68606>>>>>>>>>>>
68606>>>>>>>>>>>function Cls_ClassName global integer liClass returns string
68608>>>>>>>>>>> function_return (psName.i(oVdfClasses(self),liClass))
68609>>>>>>>>>>>end_function
68610>>>>>>>>>>>function Cls_ClassIsDbAware global integer liClass returns integer
68612>>>>>>>>>>> function_return (pbDbAware.i(oVdfClasses(self),liClass))
68613>>>>>>>>>>>end_function
68614>>>>>>>>>>>function Cls_ClassIsContainer global integer liClass returns integer
68616>>>>>>>>>>> function_return (pbContainer.i(oVdfClasses(self),liClass))
68617>>>>>>>>>>>end_function
68618>>>>>>>>>>>function Cls_ClassIsVisible global integer liClass returns integer
68620>>>>>>>>>>> function_return (pbVisible.i(oVdfClasses(self),liClass))
68621>>>>>>>>>>>end_function
68622>>>>>>>>>>>function Cls_ClassIsMultiItem global integer liClass returns integer
68624>>>>>>>>>>> function_return (pbMultiItem.i(oVdfClasses(self),liClass))
68625>>>>>>>>>>>end_function
68626>>>>>>>>>>>
68626>>>>>>>>>>>
68626>>>>>>>>>>>
68626>>>>>>>>>Use Createobj.nui // Function create_object_within_parent
Including file: createobj.nui (C:\Apps\VDFQuery\AppSrc\createobj.nui)
68626>>>>>>>>>>>// Use Createobj.nui // Function create_object_within_parent
68626>>>>>>>>>>>//
68626>>>>>>>>>>>// This function will create an object of class liClass as if it was nested
68626>>>>>>>>>>>// inside object with object_id lhParent.
68626>>>>>>>>>>>
68626>>>>>>>>>>>function create_object_within_parent global integer liClass integer lhParent returns integer
68628>>>>>>>>>>> integer lhRval lhSelf
68628>>>>>>>>>>> name liClass U_rizla_class
68628>>>>>>>>>>> move self to lhSelf
68629>>>>>>>>>>> move lhParent to self
68630>>>>>>>>>>> object rizla_object is a rizla_class
68632>>>>>>>>>>> move self to lhRval
68633>>>>>>>>>>> end_object
68634>>>>>>>>>>> move lhSelf to self
68635>>>>>>>>>>> function_return lhRval
68636>>>>>>>>>>>end_function
68637>>>>>>>>>
68637>>>>>>>>>class dnm.Button is a aps.Button
68638>>>>>>>>> procedure construct_object
68640>>>>>>>>> forward send construct_object
68642>>>>>>>>> property integer p_message public 0
68643>>>>>>>>> end_procedure
68644>>>>>>>>> procedure OnClick
68646>>>>>>>>> integer lhObj lhMsg
68646>>>>>>>>> get p_message to lhMsg
68647>>>>>>>>> get aux_value item 0 to lhObj
68648>>>>>>>>> if lhObj send lhMsg to lhObj
68651>>>>>>>>> else send lhMsg
68653>>>>>>>>> end_procedure
68654>>>>>>>>>end_class
68655>>>>>>>>>class dnm.Multi_Button is a aps.Multi_Button
68656>>>>>>>>> procedure construct_object
68658>>>>>>>>> forward send construct_object
68660>>>>>>>>> property integer p_message public 0
68661>>>>>>>>> end_procedure
68662>>>>>>>>> procedure OnClick
68664>>>>>>>>> integer lhObj lhMsg
68664>>>>>>>>> get p_message to lhMsg
68665>>>>>>>>> get aux_value item 0 to lhObj
68666>>>>>>>>> if lhObj send lhMsg to lhObj
68669>>>>>>>>> else send lhMsg
68671>>>>>>>>> end_procedure
68672>>>>>>>>>end_class
68673>>>>>>>>>
68673>>>>>>>>>class dnm.virtual_field_columns is a cArray
68674>>>>>>>>> item_property_list
68674>>>>>>>>> item_property integer piFile.i
68674>>>>>>>>> item_property integer piField.i
68674>>>>>>>>> end_item_property_list dnm.virtual_field_columns
#REM 68706 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 68710 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 68714 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 68718 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
68723>>>>>>>>>end_class
68724>>>>>>>>>
68724>>>>>>>>>class dnm.dbForm is a aps.dbForm
68725>>>>>>>>> procedure construct_object
68727>>>>>>>>> forward send construct_object
68729>>>>>>>>> object oVirtualFieldsColumns is a dnm.virtual_field_columns
68731>>>>>>>>> end_object
68732>>>>>>>>> end_procedure
68733>>>>>>>>> procedure set_virtual_field_id integer liColumn integer liFile integer liField
68735>>>>>>>>> set piFile.i of oVirtualFieldsColumns liColumn to liFile
68736>>>>>>>>> set piField.i of oVirtualFieldsColumns liColumn to liField
68737>>>>>>>>> end_procedure
68738>>>>>>>>> function virtual_field_value integer liColumn returns string
68740>>>>>>>>> integer liFile liField
68740>>>>>>>>> get piFile.i of oVirtualFieldsColumns liColumn to liFile
68741>>>>>>>>> get piField.i of oVirtualFieldsColumns liColumn to liField
68742>>>>>>>>> function_return (FieldInf_FieldValue(liFile,liField))
68743>>>>>>>>> end_function
68744>>>>>>>>>end_class
68745>>>>>>>>>
68745>>>>>>>>>class dnm.dbGrid is a aps.dbGrid
68746>>>>>>>>> procedure construct_object
68748>>>>>>>>> forward send construct_object
68750>>>>>>>>> object oVirtualFieldsColumns is a dnm.virtual_field_columns
68752>>>>>>>>> end_object
68753>>>>>>>>> end_procedure
68754>>>>>>>>> procedure set_virtual_field_id integer liColumn integer liFile integer liField
68756>>>>>>>>> set piFile.i of oVirtualFieldsColumns liColumn to liFile
68757>>>>>>>>> set piField.i of oVirtualFieldsColumns liColumn to liField
68758>>>>>>>>> end_procedure
68759>>>>>>>>> function virtual_field_value integer liColumn returns string
68761>>>>>>>>> integer liFile liField
68761>>>>>>>>> get piFile.i of oVirtualFieldsColumns liColumn to liFile
68762>>>>>>>>> get piField.i of oVirtualFieldsColumns liColumn to liField
68763>>>>>>>>> function_return (FieldInf_FieldValue(liFile,liField))
68764>>>>>>>>> end_function
68765>>>>>>>>>end_class
68766>>>>>>>>>
68766>>>>>>>>>class dnm.dbList is a aps.dbList
68767>>>>>>>>> procedure construct_object
68769>>>>>>>>> forward send construct_object
68771>>>>>>>>> object oVirtualFieldsColumns is a dnm.virtual_field_columns
68773>>>>>>>>> end_object
68774>>>>>>>>> end_procedure
68775>>>>>>>>> procedure set_virtual_field_id integer liColumn integer liFile integer liField
68777>>>>>>>>> set piFile.i of oVirtualFieldsColumns liColumn to liFile
68778>>>>>>>>> set piField.i of oVirtualFieldsColumns liColumn to liField
68779>>>>>>>>> end_procedure
68780>>>>>>>>> function virtual_field_value integer liColumn returns string
68782>>>>>>>>> integer liFile liField
68782>>>>>>>>> get piFile.i of oVirtualFieldsColumns liColumn to liFile
68783>>>>>>>>> get piField.i of oVirtualFieldsColumns liColumn to liField
68784>>>>>>>>> function_return (FieldInf_FieldValue(liFile,liField))
68785>>>>>>>>> end_function
68786>>>>>>>>>end_class
68787>>>>>>>>>
68787>>>>>>>>>class dynamo_message_dealer is a cStack
68788>>>>>>>>> procedure deal_messages integer lhObj
68790>>>>>>>>> integer liNumArg lhMsg liItem liBase liMax
68790>>>>>>>>> string lsArg1 lsArg2 lsArg3 lsArg4 lsArg5
68790>>>>>>>>> get item_count to liMax
68791>>>>>>>>> move 0 to liBase
68792>>>>>>>>> while liBase lt liMax
68796>>>>>>>>> get value item liBase to lhMsg
68797>>>>>>>>> get value item (liBase+1) to liNumArg
68798>>>>>>>>>
68798>>>>>>>>> if liNumArg gt 1 get value item (liBase+2) to lsArg1
68801>>>>>>>>> if liNumArg gt 2 get value item (liBase+3) to lsArg2
68804>>>>>>>>> if liNumArg gt 3 get value item (liBase+4) to lsArg3
68807>>>>>>>>> if liNumArg gt 4 get value item (liBase+5) to lsArg4
68810>>>>>>>>> if liNumArg gt 5 get value item (liBase+6) to lsArg5
68813>>>>>>>>>
68813>>>>>>>>> if liNumArg eq 6 send lhMsg to lhObj lsArg1 lsArg2 lsArg3 lsArg4 lsArg5
68816>>>>>>>>> if liNumArg eq 5 send lhMsg to lhObj lsArg1 lsArg2 lsArg3 lsArg4
68819>>>>>>>>> if liNumArg eq 4 send lhMsg to lhObj lsArg1 lsArg2 lsArg3
68822>>>>>>>>> if liNumArg eq 3 send lhMsg to lhObj lsArg1 lsArg2
68825>>>>>>>>> if liNumArg eq 2 send lhMsg to lhObj lsArg1
68828>>>>>>>>> if liNumArg eq 1 send lhMsg to lhObj
68831>>>>>>>>>
68831>>>>>>>>> move (liBase+liNumArg+1) to liBase
68832>>>>>>>>> end
68833>>>>>>>>>>
68833>>>>>>>>> send delete_data
68834>>>>>>>>> end_procedure
68835>>>>>>>>>end_class
68836>>>>>>>>>
68836>>>>>>>>>class dynamo_data_connect_settings is a cArray
68837>>>>>>>>> item_property_list
68837>>>>>>>>> item_property integer piFile.i
68837>>>>>>>>> item_property integer piField.i
68837>>>>>>>>> item_property string psForcedLabel.i
68837>>>>>>>>> item_property integer piForcedWidth.i
68837>>>>>>>>> end_item_property_list dynamo_data_connect_settings
#REM 68875 DEFINE FUNCTION PIFORCEDWIDTH.I INTEGER LIROW RETURNS INTEGER
#REM 68879 DEFINE PROCEDURE SET PIFORCEDWIDTH.I INTEGER LIROW INTEGER VALUE
#REM 68883 DEFINE FUNCTION PSFORCEDLABEL.I INTEGER LIROW RETURNS STRING
#REM 68887 DEFINE PROCEDURE SET PSFORCEDLABEL.I INTEGER LIROW STRING VALUE
#REM 68891 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 68895 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 68899 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 68903 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
68908>>>>>>>>> procedure add_data_connect_values integer liFile integer liField string lsLabel integer liWidth
68910>>>>>>>>> integer liRow
68910>>>>>>>>> get row_count to liRow
68911>>>>>>>>> set piFile.i liRow to liFile
68912>>>>>>>>> set piField.i liRow to liField
68913>>>>>>>>> set psForcedLabel.i liRow to lsLabel
68914>>>>>>>>> set piForcedWidth.i liRow to liWidth
68915>>>>>>>>> end_procedure
68916>>>>>>>>>end_class // dynamo_data_connect_settings
68917>>>>>>>>>
68917>>>>>>>>>// Here comes the main actor for tonight: The aps_ObjectDynamo class.
68917>>>>>>>>>class aps_ObjectDynamo is a cStack
68918>>>>>>>>> procedure construct_object
68920>>>>>>>>> forward send construct_object
68922>>>>>>>>> set value item class.View to U_aps.View
68923>>>>>>>>> set value item class.dbView to U_aps.dbView
68924>>>>>>>>> set value item class.ModalPanel to U_aps.ModalPanel
68925>>>>>>>>> set value item class.dbModalPanel to U_aps.dbModalPanel
68926>>>>>>>>> set value item class.Group to U_aps.Group
68927>>>>>>>>> set value item class.dbGroup to U_aps.dbGroup
68928>>>>>>>>> set value item class.Container3d to U_aps.Container3d
68929>>>>>>>>> set value item class.dbContainer3d to U_aps.dbContainer3d
68930>>>>>>>>> set value item class.TabDialog to U_aps.TabDialog
68931>>>>>>>>> set value item class.dbTabDialog to U_aps.dbTabDialog
68932>>>>>>>>> set value item class.TabPage to U_aps.TabPage
68933>>>>>>>>> set value item class.dbTabPage to U_aps.dbTabPage
68934>>>>>>>>> set value item class.RadioGroup to U_aps.RadioGroup
68935>>>>>>>>> set value item class.Form to U_aps.Form
68936>>>>>>>>> set value item class.dbForm to U_dnm.dbForm
68937>>>>>>>>> set value item class.ComboForm to U_aps.ComboForm
68938>>>>>>>>> set value item class.dbComboForm to U_aps.dbComboForm
68939>>>>>>>>> set value item class.SpinForm to U_aps.dbSpinForm
68940>>>>>>>>> set value item class.dbSpinForm to U_aps.dbSpinForm
68941>>>>>>>>> set value item class.CheckBox to U_aps.CheckBox
68942>>>>>>>>> set value item class.dbCheckBox to U_aps.dbCheckBox
68943>>>>>>>>> set value item class.Edit to U_aps.Edit
68944>>>>>>>>> set value item class.dbEdit to U_aps.dbEdit
68945>>>>>>>>> set value item class.TextBox to U_aps.TextBox
68946>>>>>>>>> set value item class.Button to U_dnm.Button
68947>>>>>>>>> set value item class.Radio to U_aps.Radio
68948>>>>>>>>> set value item class.List to U_aps.List
68949>>>>>>>>> set value item class.dbList to U_dnm.dbList
68950>>>>>>>>> set value item class.Grid to U_aps.Grid
68951>>>>>>>>> set value item class.dbGrid to U_dnm.dbGrid
68952>>>>>>>>> set value item class.Multi_Button to U_dnm.Multi_Button
68953>>>>>>>>> set value item class.BitmapContainer to U_aps.BitmapContainer
68954>>>>>>>>> set value item class.ToolButton to U_aps.ToolButton
68955>>>>>>>>> set value item class.DataDictionary to U_aps.DataDictionary
68956>>>>>>>>>
68956>>>>>>>>> // When creating object structures we have to distinguish between
68956>>>>>>>>> // containers and controls. Containers are pushed upon this stack
68956>>>>>>>>> // to let the objects after it be created with the container as
68956>>>>>>>>> // the parent. The property holds the value of the outmost parent:
68956>>>>>>>>> property integer p_dynamo_desktop private (parent(self))
68957>>>>>>>>> object container_stack is a cStack
68959>>>>>>>>> send push.i (aps_ObjectDynamo.p_dynamo_desktop(self))
68960>>>>>>>>> end_object
68961>>>>>>>>>
68961>>>>>>>>> // This object marks the data aware classes that contains
68961>>>>>>>>> // prototype entry objects:
68961>>>>>>>>> object prototype_entry_based_array is a cArray
68963>>>>>>>>> set value item class.dbList to DFTRUE
68964>>>>>>>>> set value item class.dbGrid to DFTRUE
68965>>>>>>>>> end_object
68966>>>>>>>>>
68966>>>>>>>>> // If values are pushed upon this array they will be set as
68966>>>>>>>>> // data_file and data_field on the item(s) of the object
68966>>>>>>>>> object data_connect_array is a cStack
68968>>>>>>>>> end_object
68969>>>>>>>>>
68969>>>>>>>>> // The two objects
68969>>>>>>>>> object top_code_messages is a dynamo_message_dealer
68971>>>>>>>>> end_object
68972>>>>>>>>> object bottom_code_messages is a dynamo_message_dealer
68974>>>>>>>>> end_object
68975>>>>>>>>> end_procedure
68976>>>>>>>>>
68976>>>>>>>>> procedure set p_dynamo_desktop integer obj#
68978>>>>>>>>> integer container_stack#
68978>>>>>>>>> move (container_stack(self)) to container_stack#
68979>>>>>>>>> send delete_data to container_stack# // Clean up previous desktop
68980>>>>>>>>> send push.i to container_stack# obj#
68981>>>>>>>>> set !$.p_dynamo_desktop to obj#
68982>>>>>>>>> end_procedure
68983>>>>>>>>>
68983>>>>>>>>> function p_dynamo_desktop returns integer
68985>>>>>>>>> function_return (!$.p_dynamo_desktop(self))
68986>>>>>>>>> end_function
68987>>>>>>>>>
68987>>>>>>>>> function should_be_pushed integer class# returns integer
68989>>>>>>>>> function_return (Cls_ClassIsContainer(class#))
68990>>>>>>>>> end_function
68991>>>>>>>>>
68991>>>>>>>>> function prototype_entry_based integer class# returns integer
68993>>>>>>>>> function_return (value(prototype_entry_based_array(self),class#))
68994>>>>>>>>> end_function
68995>>>>>>>>>
68995>>>>>>>>> procedure push_object integer obj#
68997>>>>>>>>> send push.i to (container_stack(self)) obj#
68998>>>>>>>>> end_procedure
68999>>>>>>>>>
68999>>>>>>>>> procedure pop_object
69001>>>>>>>>> integer grb#
69001>>>>>>>>> get ipop of (container_stack(self)) to grb#
69002>>>>>>>>> // Make it size and locate:
69002>>>>>>>>> send end_construct_object to grb# // Hold your breath!
69003>>>>>>>>> end_procedure
69004>>>>>>>>>
69004>>>>>>>>> procedure push_data_field integer liFile integer liField string lsForcedLabel integer liForcedWidth
69006>>>>>>>>> integer lhDataConnect liItem liTmp
69006>>>>>>>>> move (data_connect_array(self)) to lhDataConnect // procedure push_data_field
69007>>>>>>>>> move (item_count(lhDataConnect)/2) to liItem
69008>>>>>>>>> send push.i to lhDataConnect liFile
69009>>>>>>>>> send push.i to lhDataConnect liField
69010>>>>>>>>> if (num_arguments>2 and lsForcedLabel<>"") send add_bottom_message SET_Header_Label liItem lsForcedLabel
69013>>>>>>>>>
69013>>>>>>>>> if (num_arguments>3) move liForcedWidth to liTmp
69016>>>>>>>>> else move 0 to liTmp
69018>>>>>>>>>
69018>>>>>>>>> if (liField>=256 and liTmp=0) begin
69020>>>>>>>>> // If it's a virtual field, we have to calculate the default width of
69020>>>>>>>>> // that field since APS is not capable of doing that:
69020>>>>>>>>> move (FieldWidthMDU(liFile,liField)) to liTmp
69021>>>>>>>>> end
69021>>>>>>>>>>
69021>>>>>>>>>
69021>>>>>>>>> if (liTmp<>0) send add_bottom_message SET_aps_fixed_column_width liItem liTmp
69024>>>>>>>>> end_procedure
69025>>>>>>>>>
69025>>>>>>>>> procedure push_data_fields string fields#
69027>>>>>>>>> integer fld# max#
69027>>>>>>>>> string str#
69027>>>>>>>>> move (length(fields#)/8) to max#
69028>>>>>>>>> for fld# from 0 to (max#-1)
69034>>>>>>>>>>
69034>>>>>>>>> move (mid(fields#,8,fld#*8+1)) to str#
69035>>>>>>>>> send push_data_field (left(str#,4)) (right(str#,4))
69036>>>>>>>>> loop
69037>>>>>>>>>>
69037>>>>>>>>> end_procedure
69038>>>>>>>>>
69038>>>>>>>>> procedure creating_object_top_code integer object# integer class#
69040>>>>>>>>> // This may be augmentet by descending classes
69040>>>>>>>>> end_procedure
69041>>>>>>>>> procedure creating_object_bottom_code integer object# integer class#
69043>>>>>>>>> // This may be augmentet by descending classes
69043>>>>>>>>> end_procedure
69044>>>>>>>>>
69044>>>>>>>>> procedure load_filenumber_and_fieldindex integer lhDataConnect integer itm#
69046>>>>>>>>> get value of lhDataConnect item (itm#*2) to filenumber
69047>>>>>>>>> get value of lhDataConnect item (itm#*2+1) to fieldindex
69048>>>>>>>>> end_procedure
69049>>>>>>>>>
69049>>>>>>>>>
69049>>>>>>>>>
69049>>>>>>>>> // This procedure is rather complicated. I really could not create a
69049>>>>>>>>> // dynamic number of columns. The procedure CASE's out.
69049>>>>>>>>> procedure creating_object_data_connect integer object# integer class#
69051>>>>>>>>> integer itm# max# lhDataConnect data_file# data_field#
69051>>>>>>>>> integer prototype_entry_based# self#
69051>>>>>>>>> move (data_connect_array(self)) to lhDataConnect // procedure creating_object_data_connect
69052>>>>>>>>> get prototype_entry_based class# to prototype_entry_based#
69053>>>>>>>>>
69053>>>>>>>>> get item_count of lhDataConnect to max#
69054>>>>>>>>> if max# gt 40 move 40 to max# // Maximum 20 columns!
69057>>>>>>>>> move 0 to itm#
69058>>>>>>>>> if prototype_entry_based# begin // If dbList or dbGrid
69060>>>>>>>>> move self to self#
69061>>>>>>>>> move object# to self
69062>>>>>>>>>// object element is a prototype_entry no_image
69062>>>>>>>>> object element is a CM_EntryList no_image
69064>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 1 // If object contains 1 column
69075>>>>>>>>>>
69075>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 2 // If object contains 2 columns
69093>>>>>>>>>>
69093>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 3 // If object contains 3 columns
69118>>>>>>>>>>
69118>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 4 // etc...
69150>>>>>>>>>>
69150>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 5
69189>>>>>>>>>>
69189>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 6
69235>>>>>>>>>>
69235>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 7
69288>>>>>>>>>>
69288>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 8
69348>>>>>>>>>>
69348>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 9
69415>>>>>>>>>>
69415>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 10
69489>>>>>>>>>>
69489>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 11
69570>>>>>>>>>>
69570>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 12
69658>>>>>>>>>>
69658>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 13
69753>>>>>>>>>>
69753>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 14
69855>>>>>>>>>>
69855>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 15
69964>>>>>>>>>>
69964>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 16
70080>>>>>>>>>>
70080>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 17
70203>>>>>>>>>>
70203>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 18
70333>>>>>>>>>>
70333>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 19
70470>>>>>>>>>>
70470>>>>>>>>> DYNAMO$CREATE_ENTRY_ITEMS 20 // If more than 20, they are ignored.
70614>>>>>>>>>>
70614>>>>>>>>>
70614>>>>>>>>> // "DYNAMO$CREATE_ENTRY_ITEMS 2" will expand like this:
70614>>>>>>>>> // if max# eq (2*2) begin // 4 means 2!
70614>>>>>>>>> // item_list
70614>>>>>>>>> // get value of lhDataConnect item 0 to filenumber
70614>>>>>>>>> // get value of lhDataConnect item 1 to fieldindex
70614>>>>>>>>> // entry_item indirect_file.recnum
70614>>>>>>>>> // get value of lhDataConnect item 2 to filenumber
70614>>>>>>>>> // get value of lhDataConnect item 3 to fieldindex
70614>>>>>>>>> // entry_item indirect_file.recnum
70614>>>>>>>>> // end_item_list
70614>>>>>>>>> // end
70614>>>>>>>>>
70614>>>>>>>>> end_object
70615>>>>>>>>> set item_limit to (item_count(element(self)))
70616>>>>>>>>> set line_width to (item_count(element(self))) (displayable_rows(self))
70617>>>>>>>>> set matrix_size to (item_count(element(self))) (displayable_rows(self))
70618>>>>>>>>> move self# to self
70619>>>>>>>>>
70619>>>>>>>>> end
70619>>>>>>>>>>
70619>>>>>>>>> else begin // Not prototype_entry:
70620>>>>>>>>> while (itm#*2) lt max#
70624>>>>>>>>> get value of lhDataConnect item (itm#*2) to data_file#
70625>>>>>>>>> get value of lhDataConnect item (itm#*2+1) to data_field#
70626>>>>>>>>> if max# eq 0 send bind_data to object# data_file# data_field#
70629>>>>>>>>> else begin // This branch probably never gets called!
70630>>>>>>>>> set data_file of object# item itm# to data_file#
70631>>>>>>>>> set data_field of object# item itm# to data_field#
70632>>>>>>>>> end
70632>>>>>>>>>>
70632>>>>>>>>> increment itm#
70633>>>>>>>>> end
70634>>>>>>>>>>
70634>>>>>>>>> end
70634>>>>>>>>>>
70634>>>>>>>>> send delete_data to lhDataConnect
70635>>>>>>>>> end_procedure
70636>>>>>>>>>
70636>>>>>>>>> // This procedure creates an object nested inside the object currently
70636>>>>>>>>> // on top of the container_stack.
70636>>>>>>>>> function icreate_dynamo_object integer class_idx# returns integer
70638>>>>>>>>> integer parent# // Object_Id of nesting parent
70638>>>>>>>>> integer container_stack# // Stack identifier
70638>>>>>>>>> integer self# // Temporary holder of self
70638>>>>>>>>> integer object# // Object ID of the object that is created
70638>>>>>>>>> integer class# // Class ID of the object that is created
70638>>>>>>>>> integer should_be_pushed# // Is the object a visual container?
70638>>>>>>>>> integer p_auto_size_container_state# // For pushing
70638>>>>>>>>> integer p_auto_locate_control_state# // For pushing
70638>>>>>>>>> integer dm# // For pushing
70638>>>>>>>>>
70638>>>>>>>>> move (container_stack(self)) to container_stack#
70639>>>>>>>>>
70639>>>>>>>>> move (should_be_pushed(self,class_idx#)) to should_be_pushed#
70640>>>>>>>>>
70640>>>>>>>>> // Class# is passed to this function as a pointer to the class array.
70640>>>>>>>>> // Translate it to the actual class identifier:
70640>>>>>>>>> get value item class_idx# to class#
70641>>>>>>>>>
70641>>>>>>>>> get icopy of container_stack# to parent# // Get parent from stack.
70642>>>>>>>>> name class# U_aps_class // Dig it again!
70642>>>>>>>>>
70642>>>>>>>>> move self to self#
70643>>>>>>>>> move parent# to self
70644>>>>>>>>> object dynamo_object is an aps_class
70646>>>>>>>>> move self to object#
70647>>>>>>>>> send creating_object_top_code to self# object# class_idx#
70648>>>>>>>>> send deal_messages to (top_code_messages(self#)) object#
70649>>>>>>>>> send creating_object_data_connect to self# object# class_idx#
70650>>>>>>>>> send deal_messages to (bottom_code_messages(self#)) object#
70651>>>>>>>>> send creating_object_bottom_code to self# object# class_idx#
70652>>>>>>>>> // If visual container: postpone auto sizing and locating:
70652>>>>>>>>> if should_be_pushed# begin
70654>>>>>>>>> // If (db)View or (db)ModalPanel it does not understand the
70654>>>>>>>>> // p_auto_locate_control_state. Therefore we make it quiet:
70654>>>>>>>>> get delegation_mode to dm#
70655>>>>>>>>> set delegation_mode to no_delegate_or_error
70656>>>>>>>>> get p_auto_size_container_state to p_auto_size_container_state#
70657>>>>>>>>> set p_auto_size_container_state to false
70658>>>>>>>>> get p_auto_locate_control_state to p_auto_locate_control_state#
70659>>>>>>>>> set p_auto_locate_control_state to false
70660>>>>>>>>> set delegation_mode to dm#
70661>>>>>>>>> end
70661>>>>>>>>>>
70661>>>>>>>>> end_object
70662>>>>>>>>>
70662>>>>>>>>> move self# to self
70663>>>>>>>>> if should_be_pushed# begin
70665>>>>>>>>> send aps_init to object# // Undo the effect of a premature end_construct
70666>>>>>>>>> get delegation_mode of object# to dm#
70667>>>>>>>>> set delegation_mode of object# to no_delegate_or_error
70668>>>>>>>>> set p_auto_size_container_state of object# to p_auto_size_container_state#
70669>>>>>>>>> set p_auto_locate_control_state of object# to p_auto_locate_control_state#
70670>>>>>>>>> set delegation_mode of object# to dm#
70671>>>>>>>>> send push_object object#
70672>>>>>>>>> end
70672>>>>>>>>>>
70672>>>>>>>>> function_return object#
70673>>>>>>>>> end_function
70674>>>>>>>>>
70674>>>>>>>>> // This procedure duplicates the function icreate_dynamo_object. Use it
70674>>>>>>>>> // when the ID of the created object isn't needed.
70674>>>>>>>>> procedure create_dynamo_object integer class#
70676>>>>>>>>> integer grb#
70676>>>>>>>>> get icreate_dynamo_object class# to grb#
70677>>>>>>>>> end_procedure
70678>>>>>>>>>
70678>>>>>>>>> // -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
70678>>>>>>>>> // Add top/bottom code messages
70678>>>>>>>>> // -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
70678>>>>>>>>>
70678>>>>>>>>> procedure add_top_message integer msg# string arg1# string arg2# string arg3# string arg4# string arg5#
70680>>>>>>>>> integer top_code_messages#
70680>>>>>>>>> move (top_code_messages(self)) to top_code_messages#
70681>>>>>>>>> send push.i to top_code_messages# msg#
70682>>>>>>>>> send push.i to top_code_messages# num_arguments
70683>>>>>>>>> if num_arguments gt 1 send push.s to top_code_messages# arg1#
70686>>>>>>>>> if num_arguments gt 2 send push.s to top_code_messages# arg2#
70689>>>>>>>>> if num_arguments gt 3 send push.s to top_code_messages# arg3#
70692>>>>>>>>> if num_arguments gt 4 send push.s to top_code_messages# arg4#
70695>>>>>>>>> if num_arguments gt 5 send push.s to top_code_messages# arg5#
70698>>>>>>>>> end_procedure
70699>>>>>>>>>
70699>>>>>>>>> procedure add_bottom_message integer msg# string arg1# string arg2# string arg3# string arg4# string arg5#
70701>>>>>>>>> integer bottom_code_messages#
70701>>>>>>>>> move (bottom_code_messages(self)) to bottom_code_messages#
70702>>>>>>>>> send push.i to bottom_code_messages# msg#
70703>>>>>>>>> send push.i to bottom_code_messages# num_arguments
70704>>>>>>>>> if num_arguments gt 1 send push.s to bottom_code_messages# arg1#
70707>>>>>>>>> if num_arguments gt 2 send push.s to bottom_code_messages# arg2#
70710>>>>>>>>> if num_arguments gt 3 send push.s to bottom_code_messages# arg3#
70713>>>>>>>>> if num_arguments gt 4 send push.s to bottom_code_messages# arg4#
70716>>>>>>>>> if num_arguments gt 5 send push.s to bottom_code_messages# arg5#
70719>>>>>>>>> end_procedure
70720>>>>>>>>>
70720>>>>>>>>> // -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
70720>>>>>>>>> // Create customized DD-objects
70720>>>>>>>>> // -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
70720>>>>>>>>>
70720>>>>>>>>> // This function creates a DSO for the file passed as an argument. If a
70720>>>>>>>>> // specialized class has been registered for this file (fieldinf.pkg),
70720>>>>>>>>> // that class will be instantiated, otherwise it creates a normal
70720>>>>>>>>> // DataDictionary and set the main_file of that.
70720>>>>>>>>> function icreate_dynamo_dso integer file# returns integer
70722>>>>>>>>> integer parent# class# rval#
70722>>>>>>>>> get DataDictionary_Class file# to Class#
70723>>>>>>>>> if Class# begin // A class exists. We use it:
70725>>>>>>>>> get icopy of (container_stack(self)) to parent# // Get parent from stack.
70726>>>>>>>>> get create_object_within_parent class# parent# to rval#
70727>>>>>>>>> end
70727>>>>>>>>>>
70727>>>>>>>>> else begin // A class did not exist. We create a DD and set main_file:
70728>>>>>>>>> get icreate_dynamo_object class.DataDictionary to rval#
70729>>>>>>>>> set main_file of rval# to file#
70730>>>>>>>>> end
70730>>>>>>>>>>
70730>>>>>>>>> function_return rval#
70731>>>>>>>>> end_function
70732>>>>>>>>>
70732>>>>>>>>>//// In order to create DSO-structures, where one DSO is constrained by another,
70732>>>>>>>>>//// I have to nest the DSO's involved. This is absolutely not DAF compliant,
70732>>>>>>>>>//// but I can find no other way, AND I STILL HAVE NOT TESTED THIS. This
70732>>>>>>>>>//// function will create a DSO for file# nested inside DSO#.
70732>>>>>>>>>//// 19/4-1997: Maybe "set/get constraint_file to ??"
70732>>>>>>>>>//function icreate_dynamo_constrained_dso integer file# integer dso# returns integer
70732>>>>>>>>>// integer rval#
70732>>>>>>>>>// send push_object dso#
70732>>>>>>>>>// get icreate_dynamo_dso file# to rval#
70732>>>>>>>>>// send pop_object
70732>>>>>>>>>// function_return rval#
70732>>>>>>>>>//end_function
70732>>>>>>>>>end_class
70733>>>>>>>>>
70733>>>>>>>>>// // The aps_ObjectDynamo class defined above knows a lot of low level
70733>>>>>>>>>// // details (compared to its descenders) of how to create objects in a
70733>>>>>>>>>// // structure. However, to become really useful rules and more techniques
70733>>>>>>>>>// // must be added. The first level of this is implemented in this class:
70733>>>>>>>>>//
70733>>>>>>>>>// class aps_DialogDynamo is a aps_ObjectDynamo
70733>>>>>>>>>// procedure construct_object
70733>>>>>>>>>// forward send construct_object
70733>>>>>>>>>// property integer pCallBackObject public 0
70733>>>>>>>>>// end_procedure
70733>>>>>>>>>// end_class
70733>>>>>>>>>//
70733>>>>>>>>>// class aps_DialogStructure is a cStack
70733>>>>>>>>>// procedure construct_object
70733>>>>>>>>>// forward send construct_object
70733>>>>>>>>>// end_procedure
70733>>>>>>>>>// function iCreate integer class returns integer
70733>>>>>>>>>// end_function
70733>>>>>>>>>// end_class
70733>>>>>>>Use DataView.utl // Classes for analyzing index definitions
70733>>>>>>>Use Buttons.utl // Button texts
70733>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
70733>>>>>>>
70733>>>>>>>// define AUTOPRMT$DEBUG
70733>>>>>>>
70733>>>>>>>class apl.DataDictionary is a aps.DataDictionary
70734>>>>>>> procedure construct_object
70736>>>>>>> property string pPromptList_Fields public ""
70737>>>>>>> property integer pPromptList_Auto_Server_State public 1
70738>>>>>>> forward send construct_object
70740>>>>>>> end_procedure
70741>>>>>>> procedure PromptListAddField integer file# integer fld#
70743>>>>>>> set pPromptList_Fields to (pPromptList_Fields(self)+pad(string(file#),4)+pad(string(fld#),4))
70744>>>>>>> end_procedure
70745>>>>>>> function is_apl.DataDictionary returns integer
70747>>>>>>> function_return 1
70748>>>>>>> end_function
70749>>>>>>>end_class
70750>>>>>>>
70750>>>>>>>class apl.dbList is a aps.dbList
70751>>>>>>> procedure construct_object
70753>>>>>>> forward send construct_object
70755>>>>>>> // Mysteriously this isn't called
70755>>>>>>> set CurrentCellColor to (rgb(255,128,128))
70756>>>>>>> set size to 200 0
70757>>>>>>> end_procedure
70758>>>>>>> procedure end_construct_object
70760>>>>>>> forward send end_construct_object
70762>>>>>>> ifnot (move_value_out_state(self)) begin
70764>>>>>>> on_key kenter send close_panel_ok
70765>>>>>>> end
70765>>>>>>>>
70765>>>>>>> end_procedure
70766>>>>>>>end_class
70767>>>>>>>
70767>>>>>>>
70767>>>>>>>class apl.dbModalPanel is a aps.dbModalPanel
70768>>>>>>> procedure construct_object
70770>>>>>>> forward send construct_object
70772>>>>>>> property integer pListObj public 0
70773>>>>>>> property integer pButton1 public 0
70774>>>>>>> property integer pButton2 public 0
70775>>>>>>> property integer piResult public 0
70776>>>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
70777>>>>>>> set pMinimumSize to 100 150
70778>>>>>>> on_key kCancel send close_panel
70779>>>>>>> end_procedure
70780>>>>>>> procedure close_panel_ok
70782>>>>>>> set piResult to 1
70783>>>>>>> send close_panel
70784>>>>>>> end_procedure
70785>>>>>>> procedure aps_onResize integer delta_rw# integer delta_cl#
70787>>>>>>> set p_max_column to 150 // Minimum width of container
70788>>>>>>> send aps_resize (pListObj(self)) delta_rw# 0
70789>>>>>>> send aps_register_multi_button (pButton1(self))
70790>>>>>>> send aps_register_multi_button (pButton2(self))
70791>>>>>>> send aps_locate_multi_buttons
70792>>>>>>> send aps_auto_size_container
70793>>>>>>> end_procedure
70794>>>>>>> procedure popup
70796>>>>>>> set piResult to 0
70797>>>>>>> forward send popup
70799>>>>>>> end_procedure
70800>>>>>>>end_class // apl.dbModalPanel
70801>>>>>>>
70801>>>>>>>class aps_PromptListDynamo is a aps_ObjectDynamo
70802>>>>>>> procedure construct_object
70804>>>>>>> forward send construct_object
70806>>>>>>> object private.oIndexAnalyzer is a cIndexAnalyzer
70808>>>>>>> end_object
70809>>>>>>> set value item class.dbModalPanel to U_apl.dbModalPanel
70810>>>>>>> set value item class.dbList to U_apl.dbList
70811>>>>>>> end_procedure
70812>>>>>>>
70812>>>>>>> function iCreatePromptList integer file# string fields# integer auto_server_state# integer move_value_out_state# returns integer
70814>>>>>>> integer ModalPanel# lst# data_file# data_field# dd#
70814>>>>>>> integer idx# element# itm# max# btn#
70814>>>>>>>
70814>>>>>>> ifnot file# function_return 0
70817>>>>>>>
70817>>>>>>> // If no fields were passed, we find some ourselves:
70817>>>>>>> if fields# eq "" get prompt_list_fields of (private.oIndexAnalyzer(self)) file# to fields#
70820>>>>>>>
70820>>>>>>> if fields# ne "" begin // If we have any fields to display:
70822>>>>>>> send add_top_message set_label (File_Display_Name(file#))
70823>>>>>>> get icreate_dynamo_object class.dbModalPanel to ModalPanel#
70824>>>>>>> // Indentation indicates that the object was pushed on the
70824>>>>>>> // container stack
70824>>>>>>>
70824>>>>>>> set p_max_column of ModalPanel# to 150 // Minimum width of container
70825>>>>>>>
70825>>>>>>> if auto_server_state# begin
70827>>>>>>> send add_top_message set_auto_server_state 1
70828>>>>>>> send add_top_message set_deferred_state 1
70829>>>>>>> send add_top_message set_main_file file#
70830>>>>>>> end
70830>>>>>>>>
70830>>>>>>> else begin
70831>>>>>>> get icreate_dynamo_dso file# to dd#
70832>>>>>>> set server of ModalPanel# to dd#
70833>>>>>>> // In VDF5 we have to set the server of the dbList:
70833>>>>>>> send add_top_message set_server dd#
70834>>>>>>> end
70834>>>>>>>>
70834>>>>>>>
70834>>>>>>> send push_data_fields fields#
70835>>>>>>>
70835>>>>>>> // No single column wider than 150:
70835>>>>>>> send add_top_message set_p_max_column_width 150
70836>>>>>>> send add_top_message set_move_value_out_state move_value_out_state#
70837>>>>>>> send add_top_message set_CurrentCellColor (rgb(255,128,128))
70838>>>>>>> get icreate_dynamo_object class.dbList to lst#
70839>>>>>>>
70839>>>>>>> set list_object of ModalPanel# to lst#
70840>>>>>>> set pListObj of ModalPanel# to lst#
70841>>>>>>> // Shade the columns that do not have a main index:
70841>>>>>>> move (element(lst#)) to element#
70842>>>>>>> get item_count of element# to max#
70843>>>>>>> for itm# from 0 to (max#-1)
70849>>>>>>>>
70849>>>>>>> get data_file of element# item itm# to data_file#
70850>>>>>>> if file# eq data_file# begin
70852>>>>>>> get data_field of element# item itm# to data_field#
70853>>>>>>> if data_field# begin // If recnum we allow search
70855>>>>>>> get_attribute df_field_index of data_file# data_field# to idx# // Have an index?
70858>>>>>>> ifnot idx# set item_option of element# item itm# to noenter true // (not(idx#))
70861>>>>>>> //else set item_option of element# item itm# to noenter false
70861>>>>>>> end
70861>>>>>>>>
70861>>>>>>> end
70861>>>>>>>>
70861>>>>>>> else set item_option of element# item itm# to noenter true
70863>>>>>>> loop
70864>>>>>>>>
70864>>>>>>>
70864>>>>>>> send add_top_message set_value 0 t.btn.ok
70865>>>>>>> if move_value_out_state# send add_top_message set_p_message msg_ok
70868>>>>>>> else send add_top_message set_p_message msg_close_panel_ok
70870>>>>>>> send add_top_message set_aux_value 0 lst#
70871>>>>>>> send add_top_message set_psExtraLabel t.key.return
70872>>>>>>>
70872>>>>>>> get icreate_dynamo_object class.Multi_Button to btn#
70873>>>>>>> set pButton1 of ModalPanel# to btn#
70874>>>>>>>
70874>>>>>>> send add_top_message set_value 0 t.btn.cancel
70875>>>>>>> send add_top_message set_p_message msg_cancel
70876>>>>>>> send add_top_message set_aux_value 0 lst#
70877>>>>>>> send add_top_message set_psExtraLabel t.key.esc
70878>>>>>>> get icreate_dynamo_object class.Multi_Button to btn#
70879>>>>>>> set pButton2 of ModalPanel# to btn#
70880>>>>>>>
70880>>>>>>> send aps_locate_multi_buttons to ModalPanel#
70881>>>>>>>
70881>>>>>>> send pop_object // dbModalPanel
70882>>>>>>> end
70882>>>>>>>>
70882>>>>>>> else move 0 to ModalPanel#
70884>>>>>>> function_return ModalPanel#
70885>>>>>>> end_function
70886>>>>>>>end_class // aps_PromptListDynamo
70887>>>>>>>
70887>>>>>>>object PromptListDynamo is a aps_PromptListDynamo
70889>>>>>>>end_object
70890>>>>>>>
70890>>>>>>>class cDefaultPromptList is a cArray
70891>>>>>>> procedure construct_object
70893>>>>>>> forward send construct_object
70895>>>>>>> property integer pPrevObj public 0
70896>>>>>>> property integer pDynamoObj public (PromptListDynamo(self))
70897>>>>>>>
70897>>>>>>> property integer pDataFile private 0
70898>>>>>>> property integer pDataField private 0
70899>>>>>>> property string pFields private ""
70900>>>>>>> property integer pAuto_Server_State private 0
70901>>>>>>> property integer pMoveValueOutState private 0
70902>>>>>>> end_procedure
70903>>>>>>>
70903>>>>>>> procedure Initialize_From_File integer file# string fields#
70905>>>>>>> set !$.pDataFile to 0
70906>>>>>>> set !$.pDataField to 0
70907>>>>>>> set !$.pFields to ""
70908>>>>>>> set !$.pAuto_Server_State to 0
70909>>>>>>> set !$.pDataFile to file#
70910>>>>>>> set !$.pMoveValueOutState to 1
70911>>>>>>> if num_arguments ge 1 set !$.pFields to fields#
70914>>>>>>> end_procedure
70915>>>>>>>
70915>>>>>>> procedure Initialize_From_Deo integer focus#
70917>>>>>>> integer file# field# auto_server_state# dm# svr# is_apl_DD#
70917>>>>>>> string fields#
70917>>>>>>> set !$.pDataFile to 0
70918>>>>>>> set !$.pDataField to 0
70919>>>>>>> set !$.pFields to ""
70920>>>>>>> set !$.pAuto_Server_State to 1
70921>>>>>>> set !$.pMoveValueOutState to 1
70922>>>>>>>
70922>>>>>>> if focus# gt desktop begin
70924>>>>>>> get delegation_mode of focus# to dm#
70925>>>>>>> set delegation_mode of focus# to no_delegate_or_error
70926>>>>>>> get data_file of focus# item current to file#
70927>>>>>>> get data_field of focus# item current to field#
70928>>>>>>> get server of focus# to svr#
70929>>>>>>> set delegation_mode of focus# to dm#
70930>>>>>>>
70930>>>>>>> if file# begin
70932>>>>>>> if svr# get which_data_set of svr# file# to svr#
70935>>>>>>> if (svr# and file# eq main_file(svr#) and Extended_DSO_State(svr#)) begin
70937>>>>>>> get delegation_mode of svr# to dm#
70938>>>>>>> set delegation_mode of svr# to no_delegate_or_error
70939>>>>>>> get is_apl.DataDictionary of svr# to is_apl_DD#
70940>>>>>>> if is_apl_DD# begin
70942>>>>>>> get pPromptList_Fields of svr# to fields#
70943>>>>>>> get pPromptList_Auto_Server_State of svr# to auto_server_state#
70944>>>>>>> end
70944>>>>>>>>
70944>>>>>>> else move 1 to auto_server_state#
70946>>>>>>> set delegation_mode of svr# to dm#
70947>>>>>>> end
70947>>>>>>>>
70947>>>>>>>
70947>>>>>>> set !$.pDataFile to file#
70948>>>>>>> set !$.pDataField to field#
70949>>>>>>> set !$.pFields to fields#
70950>>>>>>> set !$.pAuto_Server_State to auto_server_state#
70951>>>>>>> end
70951>>>>>>>>
70951>>>>>>> end
70951>>>>>>>>
70951>>>>>>> end_procedure
70952>>>>>>>
70952>>>>>>> procedure exec_popup
70954>>>>>>> integer PromptList# DataFile# Auto_Server_State# MoveValueOutState#
70954>>>>>>> string Fields#
70954>>>>>>> get !$.pDataFile to DataFile#
70955>>>>>>> get !$.pFields to Fields#
70956>>>>>>> get !$.pAuto_Server_State to Auto_Server_State#
70957>>>>>>> get !$.pMoveValueOutState to MoveValueOutState#
70958>>>>>>> if (pPrevObj(self)) begin
70960>>>>>>> send request_destroy_object to (pPrevObj(self))
70961>>>>>>> end
70961>>>>>>>>
70961>>>>>>> get iCreatePromptList of (pDynamoObj(self)) DataFile# Fields# Auto_Server_State# MoveValueOutState# to PromptList#
70962>>>>>>> set pPrevObj to PromptList#
70963>>>>>>> if PromptList# send popup to PromptList#
70966>>>>>>> end_procedure
70967>>>>>>>
70967>>>>>>> procedure request_popup
70969>>>>>>> integer file# field# idx#
70969>>>>>>> send Initialize_From_Deo (focus(desktop))
70970>>>>>>> get !$.pDataFile to file#
70971>>>>>>> get !$.pDataField to field#
70972>>>>>>> if (file# and field#) begin // If activated from a db control.
70974>>>>>>> get_attribute df_field_index of file# field# to idx# // Have an index?
70977>>>>>>> // If the field is indexed, the user could find anyway:
70977>>>>>>> if idx# send exec_popup
70980>>>>>>> end
70980>>>>>>>>
70980>>>>>>> end_procedure
70981>>>>>>>
70981>>>>>>> procedure popup
70983>>>>>>> send Initialize_From_Deo (focus(desktop))
70984>>>>>>> send exec_popup
70985>>>>>>> end_procedure
70986>>>>>>>
70986>>>>>>> function iPopup.is integer file# string fields# returns integer
70988>>>>>>> set !$.pDataFile to file#
70989>>>>>>> set !$.pDataField to 0
70990>>>>>>> set !$.pFields to fields#
70991>>>>>>> set !$.pAuto_Server_State to 0
70992>>>>>>> set !$.pMoveValueOutState to 0
70993>>>>>>> send exec_popup
70994>>>>>>> function_return (piResult(pPrevObj(self)))
70995>>>>>>> end_procedure
70996>>>>>>>end_class // cDefaultPromptList
70997>>>>>>>
70997>>>>>>>object DefaultPromptList is a cDefaultPromptList
70999>>>>>>>end_object
71000>>>>>>>
71000>>>>>>>class cDefaultPromptList_File is an array
71001>>>>>>> procedure construct_object
71003>>>>>>> forward send construct_object
71005>>>>>>> property integer main_file public 0
71006>>>>>>> end_procedure
71007>>>>>>> procedure popup
71009>>>>>>> send PromptListPopupFile (main_file(self))
71010>>>>>>> end_procedure
71011>>>>>>>end_class
71012>>>>>>>
71012>>>>>>>object oDefPLs is an array
71014>>>>>>>end_object
71015>>>>>>>
71015>>>>>>>//> Function PromptList_File may be used for setting up prompt list
71015>>>>>>>//> objects for files in DD classes (on non related fields).
71015>>>>>>>function PromptList_File integer file# returns integer
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
71017>>>>>>> integer obj#
71017>>>>>>> get value of (oDefPLs(self)) item file# to obj#
71018>>>>>>> ifnot obj# begin
71020>>>>>>> object oDefaultPromptList_File is a cDefaultPromptList_File
71022>>>>>>> set main_file to file#
71023>>>>>>> move self to obj#
71024>>>>>>> end_object
71025>>>>>>> set value of (oDefPLs(self)) item file# to obj#
71026>>>>>>> end
71026>>>>>>>>
71026>>>>>>> function_return obj#
71027>>>>>>>end_function
71028>>>>>>>
71028>>>>>>>procedure request_popup_DefaultPromptList for BaseClass
71030>>>>>>> send request_popup to (DefaultPromptList(self))
71031>>>>>>>end_procedure
71032>>>>>>>
71032>>>>>>>procedure PromptListPopupFile integer file#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
71034>>>>>>> send Initialize_From_File to (DefaultPromptList(self)) file# ""
71035>>>>>>> send exec_popup to (DefaultPromptList(self))
71036>>>>>>>end_procedure
71037>>>>>>>
71037>>>>>>>//> Function PromptListSelectRecord returns TRUE if a record was selected,
71037>>>>>>>//> otherwise FALSE. If a record is selected the record will be present
71037>>>>>>>//> in its record buffer.
71037>>>>>>>function PromptListSelectRecord global integer file# string fields# returns integer
71039>>>>>>> function_return (iPopup.is(DefaultPromptList(self),file#,fields#))
71040>>>>>>>end_function
71041>>>>>Use API_Attr.nui // Functions for querying API attributes (No User Interface)
71041>>>>>Use Flexml.Pkg // FlexML classes
Including file: Flexml.pkg (c:\VDF12\Pkg\Flexml.pkg)
71041>>>>>>>//****************************************************************************************
71041>>>>>>>// *
71041>>>>>>>// FLEXML.PKG *
71041>>>>>>>// *
71041>>>>>>>// Interface package for FLEXML.DLL - extension system for Extensible Markup Language. *
71041>>>>>>>// *
71041>>>>>>>// Written by Michael Gouker, 7/31/99 *
71041>>>>>>>// 12/19/2000 JJT - Major revision changes for VDF7/SP2. *
71041>>>>>>>// *
71041>>>>>>>//****************************************************************************************
71041>>>>>>>Use LanguageText.pkg
71041>>>>>>>Use Windows.pkg
71041>>>>>>>Use GlobalFunctionsProcedures.pkg
71041>>>>>>>
71041>>>>>>>
71041>>>>>>>// Used to designate that a handle is a handle to an Xml Dom object. This
71041>>>>>>>// is used/required by server web-services but could be used elsewhere .
71041>>>>>>>
71041>>>>>>>
71041>>>>>>>// Types of Nodes
71041>>>>>>>
71041>>>>>>>
71041>>>>>>>// classes and methods defined in fmac
71041>>>>>>>
71041>>>>>>>
71041>>>>>>>register_function transformNode integer infcXSLNode returns string
71041>>>>>>>
71041>>>>>>>
71041>>>>>>>
71041>>>>>>>
71041>>>>>>>
71041>>>>>>>
71041>>>>>>>
71041>>>>>>>
71041>>>>>>>
71041>>>>>>>// XML function & procedure registration
71041>>>>>>>
71041>>>>>>>register_procedure set XmlInterface integer iHandle
71041>>>>>>>register_function XmlInterface returns integer
71041>>>>>>>
71041>>>>>>>// NODE Properties
71041>>>>>>>register_function phAttributes returns integer
71041>>>>>>>register_function psBaseName returns String
71041>>>>>>>register_function phChildNodes returns integer
71041>>>>>>>register_function phDefinition returns integer
71041>>>>>>>register_function phFirstChild returns integer
71041>>>>>>>register_function phLastChild returns integer
71041>>>>>>>register_function phNextSibling returns integer
71041>>>>>>>register_function psNameSpaceURI returns String
71041>>>>>>>register_function psNodeName returns String
71041>>>>>>>register_function piNodeType returns integer
71041>>>>>>>register_function psNodeTypeString returns string
71041>>>>>>>register_function phOwnerDocument returns integer
71041>>>>>>>register_function phParentNode returns integer
71041>>>>>>>register_function pbParsed returns integer
71041>>>>>>>register_function psPrefix returns string
71041>>>>>>>register_function phPreviousSibling returns integer
71041>>>>>>>register_function pbSpecified returns integer
71041>>>>>>>register_function psText returns string
71041>>>>>>>register_procedure set psText string sText
71041>>>>>>>register_function psXML returns string
71041>>>>>>>
71041>>>>>>>// Node Read write properties
71041>>>>>>>
71041>>>>>>>register_procedure set psDataType string sTypeName
71041>>>>>>>register_function psDataType returns String
71041>>>>>>>register_procedure set pvNodeTypedValue integer iType integer iAddress
71041>>>>>>>register_function pvNodeTypedValue integer iType returns integer // address of data
71041>>>>>>>register_procedure set psNodeValue string sValue
71041>>>>>>>register_function psNodeValue returns string
71041>>>>>>>
71041>>>>>>>// Node Methods
71041>>>>>>>
71041>>>>>>>register_function AppendChild integer iChildInfc returns integer
71041>>>>>>>register_function CloneInfcNode integer bRecurse returns integer
71041>>>>>>>register_function HasChildNodes returns integer
71041>>>>>>>register_function InsertBefore integer infcNodeToInsert Integer iWhere returns Integer
71041>>>>>>>register_function RemoveChild integer iChildToRemove returns integer
71041>>>>>>>register_function ReplaceChild integer iNewChild integer iChildToReplace returns integer
71041>>>>>>>register_function SelectNodes string selectstring returns integer
71041>>>>>>>register_function SelectSingleNode string selectstring returns integer
71041>>>>>>>
71041>>>>>>>// Node Collections
71041>>>>>>>// READONLY PROPERTIES
71041>>>>>>>
71041>>>>>>>register_function phItem integer iItem returns integer
71041>>>>>>>register_function phElementItem integer iItem returns integer
71041>>>>>>>
71041>>>>>>>register_function piLength returns integer
71041>>>>>>>
71041>>>>>>>//* GET_ENUMNODELIST */ typ_p1_int | qt_int | out_two,
71041>>>>>>>//* GET_RESET */ qt_int | out_one,
71041>>>>>>>
71041>>>>>>>// Named Node Map
71041>>>>>>>
71041>>>>>>>//* GET_NAMEDITEM */ typ_p1_str | qt_int | out_two,
71041>>>>>>>
71041>>>>>>>register_function NamedItem string sName returns integer
71041>>>>>>>register_function QualifiedItem string sBaseName string sNameSpace returns integer
71041>>>>>>>register_function RemoveNamedItem string sName returns integer
71041>>>>>>>register_function RemoveQualifiedItem string sBaseName string sNameSpace returns integer
71041>>>>>>>register_function SetNamedItem integer iInterface returns integer
71041>>>>>>>
71041>>>>>>>// XML DOM Document
71041>>>>>>>// Read only properties
71041>>>>>>>
71041>>>>>>>register_function phDocType returns integer
71041>>>>>>>register_function phImplementation returns integer
71041>>>>>>>register_function phParseError returns integer
71041>>>>>>>register_function piReadyState returns integer
71041>>>>>>>register_function psURL returns string
71041>>>>>>>
71041>>>>>>>// Read Write Properties
71041>>>>>>>
71041>>>>>>>register_procedure set pbAsync integer bValue
71041>>>>>>>register_function pbAsync returns integer
71041>>>>>>>register_procedure set phDocumentElement integer iElement
71041>>>>>>>register_function phDocumentElement returns Integer
71041>>>>>>>register_procedure set pbPreserveWhiteSpace integer bValue
71041>>>>>>>register_function pbPreserveWhiteSpace returns integer
71041>>>>>>>register_procedure set pbResolveExternals integer bValue
71041>>>>>>>register_function pbResolveExternals returns integer
71041>>>>>>>register_procedure set pbValidateOnParse integer bValue
71041>>>>>>>register_function pbValidateOnParse returns integer
71041>>>>>>>
71041>>>>>>>// Events
71041>>>>>>>
71041>>>>>>>// Methods
71041>>>>>>>
71041>>>>>>>register_function abort returns integer
71041>>>>>>>register_function ElementsByTagName string sTagName returns integer
71041>>>>>>>register_function LoadDocument string sURLName returns integer
71041>>>>>>>register_function LoadXML string sXMLText returns integer
71041>>>>>>>register_function NodeFromID string sNodeName returns integer
71041>>>>>>>register_function SaveDocument string sURLName returns integer
71041>>>>>>>
71041>>>>>>>// Parse Error
71041>>>>>>>// Read Only Properties
71041>>>>>>>
71041>>>>>>>register_function piErrorCode returns integer
71041>>>>>>>register_function piFilePos returns integer
71041>>>>>>>register_function piLine returns integer
71041>>>>>>>register_function piLinePos returns integer
71041>>>>>>>register_function psReason returns string
71041>>>>>>>register_function psSrcText returns string
71041>>>>>>>register_function psURL returns string
71041>>>>>>>
71041>>>>>>>// DOM Implementation
71041>>>>>>>// Method
71041>>>>>>>
71041>>>>>>>register_function HasFeature string sSystem string sFeature returns integer
71041>>>>>>>
71041>>>>>>>// Methods
71041>>>>>>>
71041>>>>>>>register_function substringData integer iOffset integer iCount returns String
71041>>>>>>>register_function appendData string sData returns integer
71041>>>>>>>register_function insertData integer iOffset string sData returns integer
71041>>>>>>>register_function deleteData integer iOffset integer iCount returns integer
71041>>>>>>>register_function replaceData integer iOffset integer iCount string sData returns Integer
71041>>>>>>>
71041>>>>>>>// Attributes
71041>>>>>>>
71041>>>>>>>register_function psName returns String
71041>>>>>>>
71041>>>>>>>// Elements
71041>>>>>>>// Read Only properties
71041>>>>>>>
71041>>>>>>>register_function psTagName returns String
71041>>>>>>>
71041>>>>>>>// Methods
71041>>>>>>>
71041>>>>>>>register_procedure set attributeValue string sName string sValue
71041>>>>>>>register_function attributeValue string sName returns string
71041>>>>>>>register_function removeAttribute string sName returns integer
71041>>>>>>>register_function attributeNode string sName returns integer
71041>>>>>>>register_procedure set attributeNode integer iNode returns integer
71041>>>>>>>register_function removeAttributeNode integer iNode returns integer
71041>>>>>>>
71041>>>>>>>// DOM Text
71041>>>>>>>// Methods
71041>>>>>>>
71041>>>>>>>register_function splitText integer iOffset returns integer
71041>>>>>>>
71041>>>>>>>// DOM Processing Instruction
71041>>>>>>>// Read Only Properties
71041>>>>>>>register_function psTarget returns String
71041>>>>>>>
71041>>>>>>>// DOM Document Type
71041>>>>>>>
71041>>>>>>>register_function phEntities returns integer
71041>>>>>>>register_function phNotations returns integer
71041>>>>>>>
71041>>>>>>>// DOM Notations
71041>>>>>>>
71041>>>>>>>register_function psPublicID returns string
71041>>>>>>>register_function psSystemID returns string
71041>>>>>>>register_function psNotationName returns string
71041>>>>>>>
71041>>>>>>>// create nodes
71041>>>>>>>
71041>>>>>>>register_function createAttribute string sName returns integer
71041>>>>>>>register_function createCDataSection string sValue returns integer
71041>>>>>>>register_function createComment string sValue returns integer
71041>>>>>>>register_function createDocumentFragment returns integer
71041>>>>>>>register_function createElement string sTagName returns integer
71041>>>>>>>register_function createEntityReference string sEntityName returns integer
71041>>>>>>>register_function createNode integer iNodeType string sName string sNameSpace returns integer
71041>>>>>>>register_function createProcessingInstruction string sTarget string sData returns Integer
71041>>>>>>>register_function createTextNode string sData returns integer
71041>>>>>>>
71041>>>>>>>register_function ChangeNodeType integer iTypeOfNode integer bSetInterface returns integer
71041>>>>>>>
71041>>>>>>>
71041>>>>>>>// ******************************************************************************
71041>>>>>>>//
71041>>>>>>>// Part 1: Base Document Logic Specialized For Templates
71041>>>>>>>//
71041>>>>>>>// ******************************************************************************
71041>>>>>>>
71041>>>>>>>//
71041>>>>>>>// XML Collections
71041>>>>>>>//
71041>>>>>>>// Collection mixin has common functions to both node lists and named node maps
71041>>>>>>>//
71041>>>>>>>
71041>>>>>>>// This provides functions required of all XMLDOM objects.
71041>>>>>>>//
71041>>>>>>>Class cXMLDOMMixin is a Mixin
71042>>>>>>>
71042>>>>>>> // Create an XML object of passed class Id and bind passed interface. returns
71042>>>>>>> // the object handle. All dynamic XML object can be created using this syntax
71042>>>>>>>
71042>>>>>>> Function CreateXMLObject integer iClassId integer hinfXMLInterface returns Handle
71044>>>>>>> Handle hoId hoDocument
71044>>>>>>> // We will always create objects at the DOMDocument level.
71044>>>>>>> Get DocumentObject to hoDocument
71045>>>>>>> If (hoDocument=0) Begin // this should never happen.
71047>>>>>>> error DFERR_XML_INTERNAL_ERROR C_$XmlFailedNoDocObject
71048>>>>>>>>
71048>>>>>>> Function_return 0
71049>>>>>>> End
71049>>>>>>>>
71049>>>>>>> If hinfXMLInterface Begin
71051>>>>>>> Get Create of hoDocument iClassId to hoID
71052>>>>>>> Set XMLInterface of hoID to hinfXMLInterface
71053>>>>>>> End
71053>>>>>>>>
71053>>>>>>> Function_return hoID
71054>>>>>>> End_function
71055>>>>>>>
71055>>>>>>> // create an XML Node object based on the interface type.
71055>>>>>>> // this will convert the interface to the proper type and will create
71055>>>>>>> // an appropriate DF object.
71055>>>>>>> // This requires that a DocumentObject exists
71055>>>>>>>
71055>>>>>>> Function CreateXMLNode handle hinfc returns handle
71057>>>>>>> integer hoNode iType iClassId
71057>>>>>>> Handle hoDocument
71057>>>>>>> // Get the node type of the infc handle w/o creating a DF object
71057>>>>>>> Move (invokexml(DF_IXMLDOMNODE, GET_piNodeType, hinfc, 0, 0, 0, 0)) to iType
71058>>>>>>> Move (invokexml(DF_IXMLDOMNODE, GET_ChangeNodeType, hinfc, iType, 1, 0, 0)) to hInfc
71059>>>>>>> if (hinfc=0) Begin
71061>>>>>>> // this should not happen and we would need to know about this.
71061>>>>>>> Error DFERR_XML_INTERNAL_ERROR (C_$XmlFailedNoDocObject + string(iType))
71062>>>>>>>>
71062>>>>>>> function_return 0
71063>>>>>>> end
71063>>>>>>>>
71063>>>>>>> Get DocumentObject to hoDocument
71064>>>>>>> // you can augment your class IDs in a single place.
71064>>>>>>> Get NodeClassId of hoDocument iType to iClassId
71065>>>>>>> // MG: 12/6/00 Changed to create nodes inside of the document object.
71065>>>>>>> Get CreateXMLObject of hoDocument iClassId hinfc to hoNode
71066>>>>>>>
71066>>>>>>> Function_return hoNode
71067>>>>>>> End_function
71068>>>>>>>
71068>>>>>>> // Change object's class. This let's you change the class id of an object
71068>>>>>>> // on an object by object basis. This would let you create nodes (e.g. elements)
71068>>>>>>> // that have a custom interface for each node type. Normally, this would be sent
71068>>>>>>> // after a node has been created using one of the default classes
71068>>>>>>> Function ChangeNodeClass integer hoNode integer iClassID returns handle
71070>>>>>>> integer iType
71070>>>>>>> Handle hinfcNew
71070>>>>>>> Get piNodeType of hoNode to iType
71071>>>>>>> Get ChangeNodeType of hoNode iType False to hInfcNew
71072>>>>>>> Send Destroy to hoNode // destroy object and old infc handle.
71073>>>>>>> Get CreateXMLObject iClassId hinfcNew to hoNode
71074>>>>>>> Function_return hoNode
71075>>>>>>> End_function
71076>>>>>>>
71076>>>>>>>End_Class
71077>>>>>>>
71077>>>>>>>
71077>>>>>>>Class cXMLDOMCollectionMixin Is A Mixin
71078>>>>>>>
71078>>>>>>> Import_Class_Protocol cXMLDOMMixin
71079>>>>>>>
71079>>>>>>> // Returns number of items in the collection
71079>>>>>>> //
71079>>>>>>> Function NodeListLength Returns Integer
71081>>>>>>> Integer iLength
71081>>>>>>> Get piLength To iLength
71082>>>>>>> Function_Return iLength
71083>>>>>>> End_Function
71084>>>>>>>
71084>>>>>>> // Returns an XML node object for pass item
71084>>>>>>> //
71084>>>>>>> Function CollectionNode Integer I Returns Handle
71086>>>>>>> Integer hoNewNode
71086>>>>>>> Integer infcItem
71086>>>>>>> Get phItem i To infcItem
71087>>>>>>> If (infcItem) ; Get CreateXMLNode infcItem to hoNewNode
71090>>>>>>> Function_Return hoNewNode
71091>>>>>>> End_Function
71092>>>>>>>
71092>>>>>>>
71092>>>>>>>End_Class
71093>>>>>>>
71093>>>>>>>// Simple declarations of collections.
71093>>>>>>>
71093>>>>>>>Class cXMLDOMNodeList Is A BaseXmlDomNodeList
71094>>>>>>> Import_Class_Protocol cXMLDOMCollectionMixin
71095>>>>>>>End_Class
71096>>>>>>>
71096>>>>>>>Class cXMLDOMNamedNodeMap Is A BaseXmlDomNamedNodeMap
71097>>>>>>>
71097>>>>>>> Import_Class_Protocol cXMLDOMCollectionMixin
71098>>>>>>>
71098>>>>>>> // returns a node attribute that matches passed name, zero if none
71098>>>>>>> Function NamedNode string sName Returns Handle
71100>>>>>>> Integer hoNewNode
71100>>>>>>> Integer infcItem
71100>>>>>>> Get NamedItem sName To infcItem
71101>>>>>>> If infcItem ; Get CreateXMLNode infcItem to hoNewNode
71104>>>>>>> Function_Return hoNewNode
71105>>>>>>> End_Function
71106>>>>>>>
71106>>>>>>> // Adds or changes a node attribute
71106>>>>>>> // This should return the passed object Id which is now bound to the attribute. If an error, returns 0
71106>>>>>>> Function SetNamedNode Handle hoNode Returns Handle
71108>>>>>>> Integer hinfcNode hinfcItem
71108>>>>>>> Get XMLInterface of hoNode to hinfcNode // node of passed attribute
71109>>>>>>> Get SetNamedItem hinfcNode To hinfcItem
71110>>>>>>> If hinfcItem ; Set XMLInterface of hoNode to hinfcItem
71113>>>>>>> else ; Move 0 to hoNode // zero indicates error
71115>>>>>>> Function_Return hoNode
71116>>>>>>> End_Function
71117>>>>>>>
71117>>>>>>> // removes named attribute, Returns handle of removed node or zero if not found.
71117>>>>>>> // Note that returned object must be disposed of or moved somewhere else.
71117>>>>>>> Function RemoveNamedNode string sName Returns Handle
71119>>>>>>> Integer hoNewNode
71119>>>>>>> Integer infcItem
71119>>>>>>> Get RemoveNamedItem sName To infcItem
71120>>>>>>> If infcItem ; Get CreateXMLNode infcItem to hoNewNode
71123>>>>>>> Function_Return hoNewNode
71124>>>>>>> End_Function
71125>>>>>>>
71125>>>>>>> //(new)
71125>>>>>>> function QualifiedNode string sNameSpace string sBaseName returns handle
71127>>>>>>> Integer hoNewNode
71127>>>>>>> Integer infcItem
71127>>>>>>> Get QualifiedItem sBaseName sNameSpace To infcItem
71128>>>>>>> If infcItem ; Get CreateXMLNode infcItem to hoNewNode
71131>>>>>>> Function_Return hoNewNode
71132>>>>>>> End_function
71133>>>>>>>
71133>>>>>>> //(new)
71133>>>>>>> function RemoveQualifiedNode string sNameSpace string sBaseName returns handle
71135>>>>>>> Integer hoNewNode
71135>>>>>>> Integer infcItem
71135>>>>>>> Get RemoveQualifiedItem sBaseName sNameSpace To infcItem
71136>>>>>>> If infcItem ; Get CreateXMLNode infcItem to hoNewNode
71139>>>>>>> Function_Return hoNewNode
71140>>>>>>> End_Function
71141>>>>>>>
71141>>>>>>>End_Class
71142>>>>>>>
71142>>>>>>>
71142>>>>>>>
71142>>>>>>>// Mixin for nodes.
71142>>>>>>>//
71142>>>>>>>// First the declaration of functions that have no object references.
71142>>>>>>>//
71142>>>>>>>
71142>>>>>>>
71142>>>>>>>Class cXMLDOMNodeMixin Is A Mixin
71143>>>>>>>
71143>>>>>>> Import_Class_Protocol cXMLDOMMixin
71144>>>>>>>
71144>>>>>>> // Append Node to the end of list. Returns passed Object handle if Ok, 0 if error
71144>>>>>>>
71144>>>>>>> Function AppendNode handle hoNode Returns Handle
71146>>>>>>> Integer hoNewTextNode
71146>>>>>>> Integer hinfcNode
71146>>>>>>> Integer infcReturned
71146>>>>>>> // Get COM Interface to call Append child.
71146>>>>>>> Get XMLInterface Of hoNode To hinfcNode
71147>>>>>>> If (hinfcNode=0) Function_return 0
71150>>>>>>> Get AppendChild hinfcNode To infcReturned
71151>>>>>>> // Interface returned is stored in DataFlex object.
71151>>>>>>> If (infcReturned=0) Function_return 0
71154>>>>>>> Set XMLInterface Of hoNode To infcReturned
71155>>>>>>> Function_Return hoNode
71156>>>>>>> End_Function
71157>>>>>>>
71157>>>>>>> // Insert NewNode before Node. Returns passed newnode Object handle if Ok, 0 if error
71157>>>>>>>
71157>>>>>>> Function InsertBeforeNode Integer hoNewNode Integer hoNode Returns Handle
71159>>>>>>> Integer hinfcNewNode hinfcNode iType hoRefNode
71159>>>>>>> Integer infcReturned
71159>>>>>>> // DOM says if no refnode argument passed or it is 0, append to end
71159>>>>>>> If (Num_Arguments=1) ; Move 0 to hoRefNode
71162>>>>>>> else ; Move hoNode to hoRefNode
71164>>>>>>> Get XMLInterface Of hoNewNode To hinfcNewNode
71165>>>>>>> If (hinfcNewNode=0) Function_return 0
71168>>>>>>> if hoRefNode begin
71170>>>>>>> Get XMLInterface Of hoRefNode To hinfcNode
71171>>>>>>> If (hinfcNode=0) function_return 0
71174>>>>>>> End
71174>>>>>>>>
71174>>>>>>> Get InsertBefore hinfcNewNode hinfcNode To infcReturned
71175>>>>>>> If (infcReturned=0) Function_return 0
71178>>>>>>> // Interface returned is stored in DataFlex object.
71178>>>>>>> Set XMLInterface Of hoNewNode To infcReturned
71179>>>>>>> Function_Return hoNewNode
71180>>>>>>> End_Function
71181>>>>>>>
71181>>>>>>> // Remove Node. Returns object Id of removed node, zero if error
71181>>>>>>> // Important: The node is not destroyed! This lets you move it elsewhere if you want
71181>>>>>>>
71181>>>>>>> Function RemoveNode integer hoNode Returns Handle
71183>>>>>>> Integer hInfcNode
71183>>>>>>> Get XMLInterface of hoNode to hInfcNode
71184>>>>>>> If (hinfcNode=0) Function_return 0
71187>>>>>>> Get RemoveChild hInfcNode To hinfcNode
71188>>>>>>> If (hinfcNode=0) Function_return 0
71191>>>>>>> Set XMLInterface of hoNode to hinfcNode
71192>>>>>>> Function_Return hoNode
71193>>>>>>> End_Function
71194>>>>>>>
71194>>>>>>> // Replace Node. Returns object Id of replaced node, zero if error
71194>>>>>>> // Important: The replaced node is not destroyed! This lets you move it elsewhere if you want
71194>>>>>>>
71194>>>>>>> Function ReplaceNode integer hoNewNode integer hoNodeToReplace Returns Handle
71196>>>>>>> Integer hInfcNewNode hinfcNodetoReplace hinfcNode
71196>>>>>>> Get XMLInterface of hoNewNode to hInfcNewNode
71197>>>>>>> Get XMLInterface of hoNodetoReplace to hInfcNodetoreplace
71198>>>>>>> If (hinfcNewNode=0 or hInfcNodeToReplace=0) Function_return 0
71201>>>>>>> Get ReplaceChild hInfcNewNode hinfcNodeToReplace To hinfcNode
71202>>>>>>> If (hinfcNode=0) Function_return 0
71205>>>>>>> Set XMLInterface of hoNodetoReplace to hinfcNode
71206>>>>>>> Function_Return hoNodetoReplace
71207>>>>>>> End_Function
71208>>>>>>>
71208>>>>>>> // Remove the named node. Returns handle to removed node. You must destroy
71208>>>>>>> // or move this removed object as needed
71208>>>>>>>
71208>>>>>>> Function RemoveNamedNode String sQueryString Returns Handle
71210>>>>>>> Integer hoNode
71210>>>>>>> Integer hInfcTemplate hinfcNode
71210>>>>>>> Get SelectSingleNode sQueryString To hinfcTemplate
71211>>>>>>> If (hinfcTemplate) Begin
71213>>>>>>> // Remove child returns an interface to the disassociated node.
71213>>>>>>> // It should be disposed by setting it to an object and then calling destroy
71213>>>>>>> Get RemoveChild hInfcTemplate To hInfcNode
71214>>>>>>> If hInfcNode Get CreateXMLNode hinfcNode to hoNode
71217>>>>>>> End
71217>>>>>>>>
71217>>>>>>> Function_Return hoNode
71218>>>>>>> End_Function
71219>>>>>>>
71219>>>>>>> // This function creates a clone of the passed Node. if bRecurse all child nodes are also
71219>>>>>>> // cloned. The object Id of the new clone object is returned.
71219>>>>>>> // The interface of the object returned can be used in AppendChild to add
71219>>>>>>> // the node to the XML Document.
71219>>>>>>>
71219>>>>>>> Function CloneNode integer bRecurse Returns Handle
71221>>>>>>> Handle hoNewNode
71221>>>>>>> Handle hinfcNewNode
71221>>>>>>> Get CloneInfcNode (if(bRecurse,-1,0)) To hinfcNewNode
71222>>>>>>> If hinfcNewNode ; Get CreateXMLNode hinfcNewNode to hoNewNode
71225>>>>>>> Function_Return hoNewNode
71226>>>>>>> End_Function
71227>>>>>>>
71227>>>>>>> // Create a collection of all nodes. returns handle of a cXMLDomNodeList
71227>>>>>>>
71227>>>>>>> Function ChildNodes Returns Handle
71229>>>>>>> Integer infcNodeList
71229>>>>>>> Integer hoNodeList
71229>>>>>>> Get phChildNodes To infcNodeList
71230>>>>>>> If (infcNodeList) ; Get CreateXMLObject U_cXMLDOMNodeList infcNodeList to hoNodeList
71233>>>>>>> Function_Return hoNodeList
71234>>>>>>> End_Function
71235>>>>>>>
71235>>>>>>> // Create a collection of all attributes. returns handle of a cXMLDomNodeMapList
71235>>>>>>>
71235>>>>>>> Function AttributeNodes Returns Handle
71237>>>>>>> Integer hoCollectionId // Object to hold collection
71237>>>>>>> Integer hinfcAttributes // XML Interface for collection
71237>>>>>>> Get phAttributes To hinfcAttributes
71238>>>>>>> If (hinfcAttributes) ; Get CreateXMLObject U_cXMLDOMNamedNodeMap hinfcAttributes to hoCollectionId
71241>>>>>>> Function_Return hoCollectionId
71242>>>>>>> End_Function
71243>>>>>>>
71243>>>>>>> // Returns a collection of just elements
71243>>>>>>>
71243>>>>>>> Function ElementNodes String sQueryString Returns Handle
71245>>>>>>> Integer hoNodeList
71245>>>>>>> Integer hinfcNodeList
71245>>>>>>> Get ElementsByTagName sQueryString To hinfcNodeList
71246>>>>>>> If (hinfcNodeList <> 0) ; Get CreateXMLObject U_cXMLDOMNodeList hinfcNodeList to hoNodeList
71249>>>>>>> Function_Return hoNodeList
71250>>>>>>> End_Function
71251>>>>>>>
71251>>>>>>>
71251>>>>>>>
71251>>>>>>> // Return object handle for query.
71251>>>>>>>
71251>>>>>>> Function FindNode String sQueryString Returns Handle
71253>>>>>>> Integer hoNode
71253>>>>>>> Integer hinfcNode
71253>>>>>>> Get SelectSingleNode sQueryString To hinfcNode
71254>>>>>>> //inkey windowindex
71254>>>>>>> If (hinfcNode <> 0) ; Get CreateXMLNode hInfcNode to hoNode
71257>>>>>>> Function_Return hoNode
71258>>>>>>> End_Function
71259>>>>>>>
71259>>>>>>> // Return object handle for a collection node.
71259>>>>>>>
71259>>>>>>>
71259>>>>>>> Function FindNodeList String sQueryString Returns Handle
71261>>>>>>> Integer hoNodeList
71261>>>>>>> Integer hinfcNodeList
71261>>>>>>> Get SelectNodes sQueryString To hinfcNodeList
71262>>>>>>> If (hinfcNodeList <> 0) ; Get CreateXMLObject U_cXMLDOMNodeList hinfcNodeList to hoNodeList
71265>>>>>>> Function_Return hoNodeList
71266>>>>>>> End_Function
71267>>>>>>>
71267>>>>>>> // The CreatexxxxxNode messages creates an node object for the type specified. Both
71267>>>>>>> // the interface and the object or of the correct type (i.e. element, comment)
71267>>>>>>> // These all return an object handle which can be used to place the object via
71267>>>>>>> // appendNode or InsertBeforeNode
71267>>>>>>>
71267>>>>>>> // This function creates a child element, returning a dataflex object.
71267>>>>>>> // The interface of the object returned can be used in AppendChild to add
71267>>>>>>> // the element to the XML Document.
71267>>>>>>>
71267>>>>>>> Function CreateElementNode String sTagName String sValue Returns Handle
71269>>>>>>> Integer hoNewElement
71269>>>>>>> Integer hoDocumentObject
71269>>>>>>> Integer infcNewElement
71269>>>>>>> Integer iClassId
71269>>>>>>> // The DataFlex objects are created inside the nodes (elements).
71269>>>>>>> // Create an element in the document and assign its interface to the new DF object.
71269>>>>>>> Get DocumentObject to hoDocumentObject
71270>>>>>>> Get createElement of hoDocumentObject sTagName To infcNewElement
71271>>>>>>> If infcNewElement Begin // if there was an error, no infc handle would be returned
71273>>>>>>> Get NodeClassId of hoDocumentObject NODE_ELEMENT to iClassId
71274>>>>>>> Get CreateXMLObject iClassId infcNewElement to hoNewElement
71275>>>>>>> If hoNewElement ; // very unlikely this will be zero Set psText Of hoNewElement To sValue
71278>>>>>>> End
71278>>>>>>>>
71278>>>>>>> Function_Return hoNewElement
71279>>>>>>> End_Function
71280>>>>>>>
71280>>>>>>> // This function creates an attribute in a document. Attributes are _NOT_ children of an element.
71280>>>>>>> // A DataFlex object is returned. An attribute can be added to an xml document using
71280>>>>>>> // get AddAttributeNode.
71280>>>>>>>
71280>>>>>>> Function CreateAttributeNode String sName String sValue Returns Handle
71282>>>>>>> Integer hoNewAttribute
71282>>>>>>> Integer hoDocumentObject
71282>>>>>>> Integer infcNewAttribute
71282>>>>>>> Integer iClassId
71282>>>>>>> Get DocumentObject to hoDocumentObject
71283>>>>>>> // Create an Attribute in the document and assign its interface to the new DF object.
71283>>>>>>> Get createAttribute of hoDocumentObject sName To infcNewAttribute
71284>>>>>>> If infcNewAttribute Begin // if there was an error, no infc handle would be returned
71286>>>>>>> Get NodeClassId of hoDocumentObject NODE_ATTRIBUTE to iClassId
71287>>>>>>> Get CreateXMLObject iClassId infcNewAttribute to hoNewAttribute
71288>>>>>>> // Set the value of the attribute.
71288>>>>>>> If hoNewAttribute ; // very unlikely this will be 0 Set psText Of hoNewAttribute To sValue
71291>>>>>>> End
71291>>>>>>>>
71291>>>>>>> Function_Return hoNewAttribute
71292>>>>>>> End_Function
71293>>>>>>>
71293>>>>>>> // This function creates a child comment, returning a dataflex object.
71293>>>>>>> // The interface of the object returned can be used in AppendChild to add
71293>>>>>>> // the comment to the XML Document.
71293>>>>>>>
71293>>>>>>> Function CreateChildComment String sValue Returns Handle
71295>>>>>>> Integer hoNewComment
71295>>>>>>> Integer hoDocumentObject
71295>>>>>>> Integer infcNewComment
71295>>>>>>> integer iClassID
71295>>>>>>> Get DocumentObject to hoDocumentObject
71296>>>>>>> // Create an Comment in the document and assign its interface to the new DF object.
71296>>>>>>> Get createComment of hoDocumentObject sValue To infcNewComment
71297>>>>>>> If infcNewComment Begin // if there was an error, no infc handle would be returned
71299>>>>>>> Get NodeClassId of hoDocumentObject NODE_COMMENT to iClassId
71300>>>>>>> Get CreateXMLObject iClassId infcNewComment to hoNewComment
71301>>>>>>> If hoNewComment ; // very unlikely this will be 0 Set psText Of hoNewComment To sValue
71304>>>>>>> End
71304>>>>>>>>
71304>>>>>>> Function_Return hoNewComment
71305>>>>>>> End_Function
71306>>>>>>>
71306>>>>>>> // This function creates a child processing instruction, returning a dataflex object.
71306>>>>>>> // The interface of the object returned can be used in AppendChild to add
71306>>>>>>> // the processing instruction to the XML Document.
71306>>>>>>>
71306>>>>>>> Function CreateChildProcessingInstruction String sTarget String sValue Returns Handle
71308>>>>>>> Integer hoNewProcessingInstruction
71308>>>>>>> Integer hoDocumentObject
71308>>>>>>> Integer infcNewProcessingInstruction
71308>>>>>>> integer iClassID
71308>>>>>>> Get DocumentObject to hoDocumentObject
71309>>>>>>> // Create an ProcessingInstruction in the document and assign its interface to the new DF object.
71309>>>>>>> Get createProcessingInstruction of hoDocumentObject sTarget sValue To infcNewProcessingInstruction
71310>>>>>>> If infcNewProcessingInstruction Begin // if there was an error, no infc handle would be returned
71312>>>>>>> Get NodeClassId of hoDocumentObject NODE_PROCESSING_INSTRUCTION to iClassId
71313>>>>>>> Get CreateXMLObject iClassID infcNewProcessingInstruction to hoNewProcessingInstruction
71314>>>>>>> End
71314>>>>>>>>
71314>>>>>>> Function_Return hoNewProcessingInstruction
71315>>>>>>> End_Function
71316>>>>>>>
71316>>>>>>> // This function creates a child text node, returning a dataflex object.
71316>>>>>>> // The interface of the object returned can be used in AppendChild to add
71316>>>>>>> // the text node to the XML Document.
71316>>>>>>>
71316>>>>>>> Function CreateChildTextNode String sValue Returns Handle
71318>>>>>>> Integer hoNewTextNode
71318>>>>>>> Integer hoDocumentObject
71318>>>>>>> Integer infcNewTextNode
71318>>>>>>> integer iClassID
71318>>>>>>> Get DocumentObject to hoDocumentObject
71319>>>>>>> // Create an TextNode in the document and assign its interface to the new DF object.
71319>>>>>>> Get createTextNode of hoDocumentObject sValue To infcNewTextNode
71320>>>>>>> If infcNewTextNode Begin // if there was an error, no infc handle would be returned
71322>>>>>>> Get NodeClassId of hoDocumentObject NODE_TEXT to iClassId
71323>>>>>>> Get CreateXMLObject iClassId infcNewTextNode to hoNewTextNode
71324>>>>>>> End
71324>>>>>>>>
71324>>>>>>> Function_Return hoNewTextNode
71325>>>>>>> End_Function
71326>>>>>>>
71326>>>>>>> // This function creates a cdata text node, returning a dataflex object.
71326>>>>>>> // The interface of the object returned can be used in AppendChild to add
71326>>>>>>> // the cdata node to the XML Document.
71326>>>>>>>
71326>>>>>>> Function CreateCDATASectionNode String sValue Returns Handle
71328>>>>>>> Integer hoNewNode
71328>>>>>>> Integer hoDocumentObject
71328>>>>>>> Integer infcNewNode
71328>>>>>>> Integer iClassId
71328>>>>>>> // The DataFlex objects are created inside the nodes (elements).
71328>>>>>>> // Create an element in the document and assign its interface to the new DF object.
71328>>>>>>> Get DocumentObject to hoDocumentObject
71329>>>>>>> Get createCDATASection of hoDocumentObject sValue To infcNewNode
71330>>>>>>> If infcNewNode Begin
71332>>>>>>> Get NodeClassId of hoDocumentObject NODE_CDATA_SECTION to iClassId
71333>>>>>>> Get CreateXMLObject iClassId infcNewNode to hoNewNode
71334>>>>>>> End
71334>>>>>>>>
71334>>>>>>> Function_Return hoNewNode
71335>>>>>>> End_Function
71336>>>>>>>
71336>>>>>>> // Create a document fragment. Document fragments can be used to house nodes temporarily. When
71336>>>>>>> // You append or insert a document fragment (appendNode InsertBeforeNode) child nodes are appended
71336>>>>>>> // to the destination object and not the fragment node itself. This is useful!
71336>>>>>>>
71336>>>>>>> Function CreateDocumentFragmentNode Returns Handle
71338>>>>>>> Integer hoNew
71338>>>>>>> Integer hoDocumentObject
71338>>>>>>> Integer infcNew
71338>>>>>>> integer iClassID
71338>>>>>>> Get DocumentObject to hoDocumentObject
71339>>>>>>> // Create an Comment in the document and assign its interface to the new DF object.
71339>>>>>>> Get createDocumentFragment of hoDocumentObject To infcNew
71340>>>>>>> If infcNew Begin // if there was an error, no infc handle would be returned
71342>>>>>>> Get NodeClassId of hoDocumentObject NODE_DOCUMENT_FRAGMENT to iClassId
71343>>>>>>> Get CreateXMLObject iClassId infcNew to hoNew
71344>>>>>>> End
71344>>>>>>>>
71344>>>>>>> Function_Return hoNew
71345>>>>>>> End_Function
71346>>>>>>>
71346>>>>>>> // Create a Node of any passed Type (e.g. Node_element). Normally you don't need this as there are
71346>>>>>>> // specific messages to do this for each node type. Node that this lets you pass namespaces as a separate
71346>>>>>>> // parameter. With all of the other messages (e.g. createElementNode) you pass namespaces as prefixed to
71346>>>>>>> // the tagname (e.g. Get CreateElementNode "MyNameSpace:MyTag" "MyValue" to hoEle)
71346>>>>>>>
71346>>>>>>> Function CreateChildNode Integer iNodeType String sTagName String sNameSpace Returns Handle
71348>>>>>>> Integer hoNewNode hoDocumentObject
71348>>>>>>> Integer infcNewNode
71348>>>>>>> Integer iClassid iType
71348>>>>>>> Get DocumentObject to hoDocumentObject
71349>>>>>>> Get NodeClassId iNodeType to iClassId
71350>>>>>>> If (iClassId<>0) Begin
71352>>>>>>> // Create a node in the document and assign its interface to the new DF object.
71352>>>>>>> Get createNode of hoDocumentObject iNodeType sTagName sNameSpace To infcNewNode
71353>>>>>>> // this is required to force the interface type to be correct.
71353>>>>>>> Move (invokexml(DF_IXMLDOMNODE, GET_piNodeType, infcNewNode, 0, 0, 0, 0)) to iType
71354>>>>>>> Move (invokexml(DF_IXMLDOMNODE, GET_ChangeNodeType, infcNewNode, iType, 1, 0, 0)) to infcNewNode
71355>>>>>>>
71355>>>>>>> If infcNewNode ; Get CreateXMLObject iClassId infcNewNode to hoNewNode
71358>>>>>>> End
71358>>>>>>>>
71358>>>>>>> Function_Return hoNewNode
71359>>>>>>> End_Function
71360>>>>>>>
71360>>>>>>>
71360>>>>>>>
71360>>>>>>> // The Addxxxxx messages create a new node and appends it to the list. When used as a function,
71360>>>>>>> // the object handle is returned and must be disposed of later by the programmer.
71360>>>>>>> // When used as a procedure, the object is destroyed--it just does it and is done.
71360>>>>>>>
71360>>>>>>> Function AddElement String sTagName String sValue Returns Handle
71362>>>>>>> Integer hoNewElement
71362>>>>>>> Get CreateElementNode sTagName sValue To hoNewElement
71363>>>>>>> If hoNewElement Get AppendNode hoNewElement to hoNewElement
71366>>>>>>> Function_return hoNewElement
71367>>>>>>> End_Function
71368>>>>>>>
71368>>>>>>> Procedure AddElement String sTagName String sValue
71370>>>>>>> Integer hoNewElement
71370>>>>>>> Get AddElement sTagName sValue To hoNewElement
71371>>>>>>> If hoNewElement ; Send Destroy To hoNewElement
71374>>>>>>> Else ; Error DFERR_XML_INTERNAL_ERROR (SFormat(C_$XmlMethodFailure, "msg_AddElement"))
71376>>>>>>> End_procedure
71377>>>>>>>
71377>>>>>>> // this returns the object, This is often needed
71377>>>>>>>
71377>>>>>>>
71377>>>>>>>
71377>>>>>>> //(new)
71377>>>>>>> Function CreateElementNodeNS String sNameSpace String sTagName String sValue returns Handle
71379>>>>>>> Integer hoNewElement
71379>>>>>>> Get CreateChildNode NODE_ELEMENT sTagName sNameSpace to hoNewElement
71380>>>>>>> If (hoNewElement and sValue<>"") ; Set psText Of hoNewElement To sValue
71383>>>>>>> Function_Return hoNewElement
71384>>>>>>> End_procedure
71385>>>>>>>
71385>>>>>>>
71385>>>>>>> // this returns the object, This is often needed
71385>>>>>>>
71385>>>>>>> //(new)
71385>>>>>>> Function AddElementNS string sNameSpace String sTagName String sValue Returns Handle
71387>>>>>>> Integer hoNewElement
71387>>>>>>> Get CreateElementNodeNS sNameSpace sTagName sValue To hoNewElement
71388>>>>>>> If hoNewElement Begin
71390>>>>>>> Get AppendNode hoNewElement to hoNewElement
71391>>>>>>> end
71391>>>>>>>>
71391>>>>>>> Function_return hoNewElement
71392>>>>>>> End_Function
71393>>>>>>>
71393>>>>>>> //(new)
71393>>>>>>> Procedure AddElementNS String sNameSpace String sTagName String sValue
71395>>>>>>> Integer hoNewElement
71395>>>>>>> Get AddElementNS sNameSpace sTagName sValue to hoNewElement
71396>>>>>>> If hoNewElement ; Send Destroy To hoNewElement
71399>>>>>>> Else ; Error DFERR_XML_INTERNAL_ERROR (SFormat(C_$XmlMethodFailure, "msg_AddElementNS"))
71401>>>>>>> End_procedure
71402>>>>>>>
71402>>>>>>> //(new)
71402>>>>>>> Function AddAttributeNode handle hoNode returns Handle
71404>>>>>>> handle hInfc
71404>>>>>>> get Set_AttributeNode (XmlInterface(hoNode)) to hInfc
71405>>>>>>> if hInfc ; // if ret value we have a replacement set XmlInterface of hoNode to hInfc
71408>>>>>>> function_return hoNode
71409>>>>>>> End_Function
71410>>>>>>>
71410>>>>>>>// // is this needed
71410>>>>>>>// Function AddAttributeNodeNS handle hoNode returns Handle
71410>>>>>>>// Get AddAttributeNode hoNode to hoNode
71410>>>>>>>// function_return hoNode
71410>>>>>>>// End_Function
71410>>>>>>>
71410>>>>>>> //(new)
71410>>>>>>> Function AttributeValueNode string sName returns Handle
71412>>>>>>> handle hInfc
71412>>>>>>> handle hoNode
71412>>>>>>> get AttributeNode sName to hInfc
71413>>>>>>> if hInfc ; // if ret value we have a replacement Get CreateXMLNode hInfc to hoNode
71416>>>>>>> function_return hoNode
71417>>>>>>> End_Function
71418>>>>>>>
71418>>>>>>> //(new)
71418>>>>>>> Function AttributeValueNodeNS string sNameSpace string sBaseName returns Handle
71420>>>>>>> handle hoAttrs hoAttr
71420>>>>>>> string sValue
71420>>>>>>> Get AttributeNodes to hoAttrs
71421>>>>>>> If hoAttrs begin
71423>>>>>>> Get QualifiedNode of hoAttrs sNamespace sBaseName to hoAttr
71424>>>>>>> send destroy of hoAttrs
71425>>>>>>> end
71425>>>>>>>>
71425>>>>>>> function_return hoAttr
71426>>>>>>> End_Function
71427>>>>>>>
71427>>>>>>>
71427>>>>>>> //(new)
71427>>>>>>> Function CreateAttributeNodeNS string sNameSpace string sName String sValue Returns Handle
71429>>>>>>> Integer hoNewAttribute
71429>>>>>>> Get CreateChildNode NODE_ATTRIBUTE sName sNameSpace To hoNewAttribute
71430>>>>>>> If hoNewAttribute ; Set psText Of hoNewAttribute To sValue
71433>>>>>>> Function_Return hoNewAttribute
71434>>>>>>> End_Function
71435>>>>>>>
71435>>>>>>> //(new)
71435>>>>>>> Procedure AddAttributeNS String sNameSpace String sName String sValue
71437>>>>>>> handle hoNode
71437>>>>>>> Get CreateAttributeNodeNS sNameSpace sName sValue to hoNode
71438>>>>>>> If hoNode Begin
71440>>>>>>> Get AddAttributeNode hoNode to hoNode
71441>>>>>>> If hoNode Send Destroy of hoNode
71444>>>>>>> end
71444>>>>>>>>
71444>>>>>>> Else ; Error DFERR_XML_INTERNAL_ERROR (SFormat(C_$XmlMethodFailure, "msg_AddAttributeNS"))
71446>>>>>>> End_Procedure
71447>>>>>>>
71447>>>>>>>
71447>>>>>>> // This function encapsulates creation and addition of attributes to a node.
71447>>>>>>> // should only work with element class
71447>>>>>>> Procedure AddAttribute String sName String sValue
71449>>>>>>> Set AttributeValue sName to sValue
71450>>>>>>> End_Procedure
71451>>>>>>>
71451>>>>>>> // This function encapsulates creation and addition of comments to a node.
71451>>>>>>> // The return value is a Boolean that is currently unused.
71451>>>>>>>
71451>>>>>>> Procedure AddChildComment String sValue
71453>>>>>>> Integer hoNewNode
71453>>>>>>> Get createChildComment sValue To hoNewNode
71454>>>>>>> If not hoNewNode ; Error DFERR_XML_INTERNAL_ERROR (SFormat(C_$XmlMethodFailure, "msg_AddChildComment"))
71457>>>>>>> Else Begin
71458>>>>>>> Get AppendNode hoNewNode to hoNewNode
71459>>>>>>> Send Destroy To hoNewNode
71460>>>>>>> End
71460>>>>>>>>
71460>>>>>>> End_Procedure
71461>>>>>>>
71461>>>>>>> // This function encapsulates creation and addition of processing instructions to a node.
71461>>>>>>> // The return value is a Boolean that is currently unused.
71461>>>>>>>
71461>>>>>>> Procedure AddChildProcessingInstruction String sTarget String sValue
71463>>>>>>> Integer hoNewNode
71463>>>>>>> Get createChildProcessingInstruction sTarget sValue To hoNewNode
71464>>>>>>> If not hoNewNode ; Error DFERR_XML_INTERNAL_ERROR (SFormat(C_$XmlMethodFailure, "msg_AddChildProcessingInstruction"))
71467>>>>>>> Else Begin
71468>>>>>>> Get AppendNode hoNewNode to hoNewNode
71469>>>>>>> Send Destroy To hoNewNode
71470>>>>>>> end
71470>>>>>>>>
71470>>>>>>> End_Procedure
71471>>>>>>>
71471>>>>>>>
71471>>>>>>> // This function encapsulates creation and addition of text nodes to a node.
71471>>>>>>> // The return value is a Boolean that is currently unused.
71471>>>>>>>
71471>>>>>>> Procedure AddChildTextNode String sValue
71473>>>>>>> Integer hoNewNode
71473>>>>>>> Get createChildTextNode sValue To hoNewNode
71474>>>>>>> If not hoNewNode ; Error DFERR_XML_INTERNAL_ERROR (SFormat(C_$XmlMethodFailure, "msg_AddChildTextNode"))
71477>>>>>>> Else Begin
71478>>>>>>> Get AppendNode hoNewNode to hoNewNode
71479>>>>>>> Send Destroy To hoNewNode
71480>>>>>>> End
71480>>>>>>>>
71480>>>>>>> End_Procedure
71481>>>>>>>
71481>>>>>>> // This procedure encapsulates creation and addition of cdata text nodes to a node.
71481>>>>>>> Procedure AddCDataSection String sValue
71483>>>>>>> handle hoNewNode
71483>>>>>>> Get CreateCDATASectionNode sValue To hoNewNode
71484>>>>>>> If not hoNewNode ; Error DFERR_XML_INTERNAL_ERROR (SFormat(C_$XmlMethodFailure, "msg_AddCDataSection"))
71487>>>>>>> Else Begin
71488>>>>>>> Get AppendNode hoNewNode to hoNewNode
71489>>>>>>> Send Destroy To hoNewNode
71490>>>>>>> end
71490>>>>>>>>
71490>>>>>>> End_procedure
71491>>>>>>>
71491>>>>>>>
71491>>>>>>> Function AddChildNode Integer iNodeType String sTagName String sNameSpace Returns Handle
71493>>>>>>> Integer hoNewNode
71493>>>>>>> Integer hoDocumentObject
71493>>>>>>> Get DocumentObject to hoDocumentObject
71494>>>>>>> Get createChildNode of hoDocumentObject iNodeType sTagName sNamespace To hoNewNode
71495>>>>>>> If hoNewNode ; Get AppendNode hoNewNode to hoNewNode
71498>>>>>>> Function_Return hoNewNode
71499>>>>>>> End_Function
71500>>>>>>>
71500>>>>>>> // ChildNodeValue is used to get the "value" of an element. This is useful when the element
71500>>>>>>> // only has a single value (similar to an attribute).
71500>>>>>>>
71500>>>>>>> Function ChildNodeValue String sTagName Returns String
71502>>>>>>> Integer hoTempNode
71502>>>>>>> Integer hinfcTempNode
71502>>>>>>> String sRetVal
71502>>>>>>> Get SelectSingleNode sTagName To hinfcTempNode
71503>>>>>>> //showln "...." hinfctempNode ' ' stagName ' ' (psNodeName(self))
71503>>>>>>> If (hinfcTempNode <> 0) Begin
71505>>>>>>> Get CreateXMLObject U_BaseXMLDOMNode hinfcTempNode to hoTempNode
71506>>>>>>> If hoTempNode Begin
71508>>>>>>> Get psText Of hoTempNode To sRetVal
71509>>>>>>> Send Destroy of hoTempNode
71510>>>>>>> end
71510>>>>>>>>
71510>>>>>>> End
71510>>>>>>>>
71510>>>>>>> Function_Return sRetVal
71511>>>>>>> End_Function
71512>>>>>>>
71512>>>>>>> // This simple function allows a parent to change the text of one of its elements.
71512>>>>>>> // This actually occurs quite a bit, because (as stated above) lowest level
71512>>>>>>> // elements are frequently used as properties.
71512>>>>>>> //
71512>>>>>>> Procedure SetChildNodeValue String sTagName String sValue
71514>>>>>>> Integer hoTempNode
71514>>>>>>> Integer hinfcTempNode
71514>>>>>>> // Search for the node that matches.
71514>>>>>>> Get SelectSingleNode sTagName To hinfcTempNode
71515>>>>>>> // If no match is found, add a new element with the tag.
71515>>>>>>> If (hinfcTempNode = 0) ; Send AddElement sTagName sValue
71518>>>>>>> Else Begin
71519>>>>>>> Get CreateXMLObject U_BaseXMLDOMNode hinfcTempNode to hoTempNode
71520>>>>>>> If hoTempNode Begin
71522>>>>>>> // Set the text of the element.
71522>>>>>>> Set psText Of hoTempNode To sValue
71523>>>>>>> Send Destroy To hoTempNode
71524>>>>>>> end
71524>>>>>>>>
71524>>>>>>> Else ; error DFERR_XML_INTERNAL_ERROR (SFormat(C_$XmlMethodFailure, "msg_SetChildNodeValue"))
71526>>>>>>> end
71526>>>>>>>>
71526>>>>>>> End_Procedure
71527>>>>>>>
71527>>>>>>> // These messages are used to allow you to travese through a nodes.
71527>>>>>>>
71527>>>>>>> Function FirstChild Returns Handle
71529>>>>>>> handle hoChild
71529>>>>>>> integer hinfcChild
71529>>>>>>> Get phFirstChild to hinfcChild
71530>>>>>>> If (hinfcChild) ; Get CreateXMLNode hinfcChild to hoChild
71533>>>>>>> Function_return hoChild
71534>>>>>>> end_function
71535>>>>>>>
71535>>>>>>> Function NextSibling Returns Handle
71537>>>>>>> handle hoChild
71537>>>>>>> integer hinfcChild
71537>>>>>>> Get phNextSibling to hinfcChild
71538>>>>>>> If (hinfcChild) ; Get CreateXMLNode hinfcChild to hoChild
71541>>>>>>> Function_return hoChild
71542>>>>>>> end_function
71543>>>>>>>
71543>>>>>>> Function PreviousSibling Returns Handle
71545>>>>>>> handle hoChild
71545>>>>>>> integer hinfcChild
71545>>>>>>> Get phPreviousSibling to hinfcChild
71546>>>>>>> If (hinfcChild) ; Get CreateXMLNode hinfcChild to hoChild
71549>>>>>>> Function_return hoChild
71550>>>>>>> end_function
71551>>>>>>>
71551>>>>>>> Function LastChild Returns Handle
71553>>>>>>> handle hoChild
71553>>>>>>> integer hinfcChild
71553>>>>>>> Get phLastChild to hinfcChild
71554>>>>>>> If (hinfcChild) ; Get CreateXMLNode hinfcChild to hoChild
71557>>>>>>> Function_return hoChild
71558>>>>>>> end_function
71559>>>>>>>
71559>>>>>>> // Enumerate through all nodes.
71559>>>>>>>
71559>>>>>>> Procedure EnumerateNodes Integer iMsg Integer hoReceiver String sVal1 String sVal2
71561>>>>>>> Integer i iLen
71561>>>>>>> Integer hoNode
71561>>>>>>> Integer hoNodeCollection
71561>>>>>>> Get ChildNodes To hoNodeCollection
71562>>>>>>> If (hoNodeCollection <> 0) Begin
71564>>>>>>> Get NodeListLength of hoNodeCollection to iLen
71565>>>>>>> Decrement iLen
71566>>>>>>> For i From 0 To iLen
71572>>>>>>>>
71572>>>>>>> // For each record, process its fields.
71572>>>>>>> Get CollectionNode Of hoNodeCollection i To hoNode
71573>>>>>>> Send iMsg Of hoReceiver hoNode sVal1 sVal2
71574>>>>>>> Send Destroy Of hoNode
71575>>>>>>> Loop
71576>>>>>>>>
71576>>>>>>> Send Destroy of hoNodeCollection
71577>>>>>>> End
71577>>>>>>>>
71577>>>>>>> End_Procedure
71578>>>>>>>
71578>>>>>>> // Enumerate through all elements.
71578>>>>>>>
71578>>>>>>> Procedure EnumerateElements Integer iMsg Integer hoReceiver String sVal1 String sVal2
71580>>>>>>> Integer i iLen
71580>>>>>>> Integer hoNode
71580>>>>>>> Integer hoNodeCollection
71580>>>>>>> Get ChildNodes To hoNodeCollection
71581>>>>>>> If (hoNodeCollection <> 0) Begin
71583>>>>>>> Get NodeListLength of hoNodeCollection to iLen
71584>>>>>>> Decrement iLen
71585>>>>>>> For i From 0 To iLen
71591>>>>>>>>
71591>>>>>>> // For each record, process its fields.
71591>>>>>>> Get CollectionNode Of hoNodeCollection i To hoNode
71592>>>>>>> If (piNodeType(hoNode)=NODE_ELEMENT) ; Send iMsg Of hoReceiver hoNode sVal1 sVal2
71595>>>>>>> Send Destroy Of hoNode
71596>>>>>>> Loop
71597>>>>>>>>
71597>>>>>>> Send Destroy of hoNodeCollection
71598>>>>>>> End
71598>>>>>>>>
71598>>>>>>> End_Procedure
71599>>>>>>>
71599>>>>>>>
71599>>>>>>> // enumerate through all attributes. There is no recurse here because attributes will not
71599>>>>>>> // contain attributes.
71599>>>>>>>
71599>>>>>>> Procedure EnumerateAttributes Integer iMsg Integer hoReceiver String sSomeValue
71601>>>>>>> Integer i iLen
71601>>>>>>> Integer hoNode
71601>>>>>>> Integer hoNodeMapCollection
71601>>>>>>> Get AttributeNodes To hoNodeMapCollection
71602>>>>>>> If (hoNodeMapCollection <> 0) Begin
71604>>>>>>> Get NodeListLength of hoNodeMapCollection to iLen
71605>>>>>>> Decrement iLen
71606>>>>>>> For i From 0 To iLen
71612>>>>>>>>
71612>>>>>>> // For each record, process its fields.
71612>>>>>>> Get CollectionNode Of hoNodeMapCollection i To hoNode
71613>>>>>>> Send iMsg Of hoReceiver hoNode sSomeValue
71614>>>>>>> Send Destroy Of hoNode
71615>>>>>>> Loop
71616>>>>>>>>
71616>>>>>>> Send Destroy of hoNodeMapCollection
71617>>>>>>> End
71617>>>>>>>>
71617>>>>>>> End_Procedure
71618>>>>>>>
71618>>>>>>>
71618>>>>>>> Function XSLTransformation Integer hoXSLDocument Returns String
71620>>>>>>> integer infcXSLStartAt
71620>>>>>>> String sBuffer
71620>>>>>>> // Transformation is of current object using passed XSLDocument.
71620>>>>>>> Get XMLInterface Of hoXSLDocument to infcXSLStartAt
71621>>>>>>> Get TransformNode infcXSLStartAt to sBuffer
71622>>>>>>> Function_Return sBuffer
71623>>>>>>> End_Function
71624>>>>>>>
71624>>>>>>> // This allows for transformations not limited to the size of the string buffer
71624>>>>>>> //
71624>>>>>>> // Note that it is up to the programmer to dispose of the memory allocated at pBuffer
71624>>>>>>> // by using the free(pBuffer) function
71624>>>>>>> //
71624>>>>>>> Function XSLTransformationToAddress Integer hoXSLDocument Returns Address
71626>>>>>>> integer infcXSLStartAt
71626>>>>>>> Address pBuffer
71626>>>>>>> // Transformation is of current object using passed XSLDocument.
71626>>>>>>> Get XMLInterface Of hoXSLDocument to infcXSLStartAt
71627>>>>>>> Get TransformNodeToAddress infcXSLStartAt to pBuffer
71628>>>>>>> Function_Return pBuffer
71629>>>>>>> End_Function
71630>>>>>>>
71630>>>>>>>
71630>>>>>>> // return an object that is the parent of the current node
71630>>>>>>> Function ParentNode returns handle
71632>>>>>>> Handle hoId
71632>>>>>>> Handle hinfcXMLInterface
71632>>>>>>> get phParentNode to hinfcXMLInterface
71633>>>>>>> If (hinfcXMLInterface) ; Get CreateXmlNode hinfcXMLInterface to hoID
71636>>>>>>> Function_return hoID
71637>>>>>>> End_function
71638>>>>>>>
71638>>>>>>> // extract base name from string. e.g.: ns:name --> name
71638>>>>>>> //
71638>>>>>>> Function BaseNameFromQName string sName returns string
71640>>>>>>> integer iPos
71640>>>>>>> Move (Pos(":",sName)) to iPos
71641>>>>>>> If iPos Begin
71643>>>>>>> Move (remove(sName,1,iPos)) to sName
71644>>>>>>> end
71644>>>>>>>>
71644>>>>>>> function_return sName
71645>>>>>>> end_function
71646>>>>>>>
71646>>>>>>> // extract prefix name from string. e.g.: ns:name --> ns
71646>>>>>>> //
71646>>>>>>> Function PrefixNameFromQName string sName returns string
71648>>>>>>> integer iPos
71648>>>>>>> Move (Pos(":",sName)) to iPos
71649>>>>>>> If iPos Begin
71651>>>>>>> Move (left(sName,iPos-1)) to sName
71652>>>>>>> end
71652>>>>>>>>
71652>>>>>>> function_return sName
71653>>>>>>> end_function
71654>>>>>>>
71654>>>>>>> // Same as NextSibling except it destroys the current node
71654>>>>>>> //
71654>>>>>>> Function NextNode Returns Handle
71656>>>>>>> handle hoNode
71656>>>>>>> Get NextSibling to hoNode
71657>>>>>>> Send Destroy
71658>>>>>>> Function_return hoNode
71659>>>>>>> end_function
71660>>>>>>>
71660>>>>>>>
71660>>>>>>> // Returns true if node is element and namespace and base name match
71660>>>>>>> //
71660>>>>>>> Function IsElementNS string sNamespaceURI string sBaseName returns boolean
71662>>>>>>> Function_return (piNodeType(self)=NODE_ELEMENT and ; psNameSpaceURI(self)=sNamespaceURI and ; psBaseName(self)=sBaseName )
71663>>>>>>> end_function
71664>>>>>>>
71664>>>>>>> // Returns node of first occurence of child node matching namespace and base name
71664>>>>>>> //
71664>>>>>>> Function ChildElementNS string sNameSpaceURI string sBaseName returns handle
71666>>>>>>> handle hoNode
71666>>>>>>> Get FirstChild to hoNode
71667>>>>>>> While (hoNode and not(IsElementNS(hoNode, sNameSpaceURI, sBaseName)))
71671>>>>>>> Get NextNode of hoNode to hoNode
71672>>>>>>> end
71673>>>>>>>>
71673>>>>>>> function_return hoNode
71674>>>>>>> end_function
71675>>>>>>>
71675>>>>>>> // Returns node of next occurence of sibling node matching namespace and base name
71675>>>>>>> //
71675>>>>>>> Function NextElementNS string sNameSpaceURI string sBaseName returns handle
71677>>>>>>> handle hoNode
71677>>>>>>> Get NextSibling to hoNode
71678>>>>>>> While (hoNode and not(IsElementNS(hoNode, sNameSpaceURI, sBaseName)))
71682>>>>>>> Get NextNode of hoNode to hoNode
71683>>>>>>> end
71684>>>>>>>>
71684>>>>>>> Send Destroy
71685>>>>>>> function_return hoNode
71686>>>>>>> end_function
71687>>>>>>>
71687>>>>>>>
71687>>>>>>> // Returns value (string) first occurence of child node matching namespace and base name
71687>>>>>>> //
71687>>>>>>> Function ChildElementValueNS string sNameSpaceURI string sBaseName returns string
71689>>>>>>> handle hoNext
71689>>>>>>> string sText
71689>>>>>>> Get ChildElementNS sNameSpaceURI sBaseName to hoNext
71690>>>>>>> If hoNext begin
71692>>>>>>> Get psText of hoNext to sText
71693>>>>>>> send destroy of hoNext
71694>>>>>>> end
71694>>>>>>>>
71694>>>>>>> Function_return sText
71695>>>>>>> end_function
71696>>>>>>>
71696>>>>>>> Procedure SetChildElementValueNS string sNameSpaceURI string sBaseName String sValue
71698>>>>>>> Integer hoNode
71698>>>>>>> Integer hinfcTempNode
71698>>>>>>> Get ChildElementNS sNameSpaceURI sBaseName to hoNode
71699>>>>>>> If (hoNode=0) begin
71701>>>>>>> Send AddElementNS sNameSpaceURI sBaseName sValue
71702>>>>>>> end
71702>>>>>>>>
71702>>>>>>> Else Begin
71703>>>>>>> Set psText Of hoNode To sValue
71704>>>>>>> send destroy of hoNode
71705>>>>>>> end
71705>>>>>>>>
71705>>>>>>> End_Procedure
71706>>>>>>>
71706>>>>>>>
71706>>>>>>>// // Returns node of first occurence of child node matching namespace and base name
71706>>>>>>>// // that has an attrib value that contains a specified value
71706>>>>>>>// //
71706>>>>>>>// //Doc/ Visibility=Public
71706>>>>>>>// Function FindElementNodeWithAttribNS string sNamespace string sBaseName string sAttribName string sAttribValue returns handle
71706>>>>>>>// handle hoNext hoNode
71706>>>>>>>// string sName
71706>>>>>>>// Get FirstChild to hoNode
71706>>>>>>>// While (hoNode)
71706>>>>>>>// If (IsElementNS(hoNode, sNameSpace, sBaseName)) begin
71706>>>>>>>// Get AttributeValue of hoNode sAttribName to sName
71706>>>>>>>// If (sName=sAttribValue) Begin
71706>>>>>>>// Function_return hoNode
71706>>>>>>>// end
71706>>>>>>>// end
71706>>>>>>>// Get NextSibling of hoNode to hoNext
71706>>>>>>>// Send Destroy of hoNode
71706>>>>>>>// Move hoNext to hoNode
71706>>>>>>>// end
71706>>>>>>>// function_return 0
71706>>>>>>>// end_function
71706>>>>>>>
71706>>>>>>> // pass a prefix and try to finds its NameSpaceURI. Start at current node and work up to parent.
71706>>>>>>> // This can be useful when a qualified name is found in an attribute value
71706>>>>>>> //
71706>>>>>>> Function PrefixToNamespaceURI string sPrefix returns string
71708>>>>>>> handle hoNode
71708>>>>>>> Integer i iNodes
71708>>>>>>> Integer hoNodes hoParentNode hoAttNode
71708>>>>>>> Boolean bDone bParent
71708>>>>>>> string sAttPrefix sName sNameSpace
71708>>>>>>>
71708>>>>>>> Move self to hoNode
71709>>>>>>> While Not bDone
71713>>>>>>> Get AttributeNodes of hoNode To hoNodes
71714>>>>>>> If (hoNodes <> 0) Begin
71716>>>>>>> Get NodeListLength of hoNodes to iNodes
71717>>>>>>> For i From 0 To (iNodes-1)
71723>>>>>>>>
71723>>>>>>> // For each record, process its fields.
71723>>>>>>> Get CollectionNode Of hoNodes i To hoAttNode
71724>>>>>>> Get psPrefix of hoAttNode to sAttPrefix
71725>>>>>>> If (sAttPrefix="xmlns") Begin
71727>>>>>>> Get psBaseName of hoAttNode to sName
71728>>>>>>> If (sName=sPrefix) Begin
71730>>>>>>> Get Value of hoAttNode to sNameSpace
71731>>>>>>> Move true to bDone
71732>>>>>>> Move (iNodes-1) to i
71733>>>>>>> end
71733>>>>>>>>
71733>>>>>>> end
71733>>>>>>>>
71733>>>>>>> Send Destroy Of hoAttNode
71734>>>>>>> Loop
71735>>>>>>>>
71735>>>>>>> Send Destroy of hoNodes
71736>>>>>>> End
71736>>>>>>>>
71736>>>>>>> Get ParentNode of hoNode to hoParentNode
71737>>>>>>> If bParent send destroy of hoNode
71740>>>>>>> If not bDone begin
71742>>>>>>> If not hoParentNode move true to bDone
71745>>>>>>> Else begin
71746>>>>>>> Move True to bParent
71747>>>>>>> Move hoParentNode to hoNode
71748>>>>>>> end
71748>>>>>>>>
71748>>>>>>> end
71748>>>>>>>>
71748>>>>>>> end
71749>>>>>>>>
71749>>>>>>> Function_return sNameSpace
71750>>>>>>> end_function
71751>>>>>>>
71751>>>>>>>
71751>>>>>>>
71751>>>>>>>End_Class
71752>>>>>>>
71752>>>>>>>// Set up basic inheritance for specialized forms of XML classes.
71752>>>>>>>// This needs to be done so we can make objects of these types.
71752>>>>>>>
71752>>>>>>>Class cXMLDOMElement Is A BaseXmlDomElement
71753>>>>>>> Import_Class_protocol cXMLDOMNodeMixin
71754>>>>>>>
71754>>>>>>>// Send AddAttribute
71754>>>>>>>// Get AddAttributeNode
71754>>>>>>>// Send RemoveAttribute
71754>>>>>>>// Get AttributeValue
71754>>>>>>>// Get AttributeValueNode
71754>>>>>>>
71754>>>>>>>// Send AddAttributeNS
71754>>>>>>>// Get AddAttributeNodeNS
71754>>>>>>>// Send RemoveAttributeNs
71754>>>>>>>// Get AttributeValueNS
71754>>>>>>>// Get AttributeValueNodeNS
71754>>>>>>>
71754>>>>>>> // Should use AddAttributeValue...does same thing
71754>>>>>>> Procedure SetAttributeValue String sName String sValue
71756>>>>>>> Send AddAttribute sName sValue
71757>>>>>>> End_Procedure
71758>>>>>>>
71758>>>>>>> // Note: Get_AttributeValue already there
71758>>>>>>>
71758>>>>>>> Procedure RemoveAttribute string sName
71760>>>>>>> integer iVal
71760>>>>>>> Get RemoveAttribute sName to iVal
71761>>>>>>> End_procedure
71762>>>>>>>
71762>>>>>>> //(new)
71762>>>>>>> Function AttributeValueNS string sNameSpace string sBaseName returns string
71764>>>>>>> handle hoAttr
71764>>>>>>> string sValue
71764>>>>>>> Get AttributeValueNodeNS sNameSpace sBaseName to hoAttr
71765>>>>>>> If hoAttr Begin
71767>>>>>>> Get Value of hoAttr to sValue
71768>>>>>>> send destroy of hoAttr
71769>>>>>>> end
71769>>>>>>>>
71769>>>>>>> function_return sValue
71770>>>>>>> end_function
71771>>>>>>>
71771>>>>>>> //(new)
71771>>>>>>> Procedure RemoveAttributeNS string sNameSpace string sBaseName
71773>>>>>>> handle hoAttrs hoAttr
71773>>>>>>> string sValue
71773>>>>>>> Get AttributeNodes to hoAttrs
71774>>>>>>> If hoAttrs begin
71776>>>>>>> Get RemoveQualifiedNode of hoAttrs sNamespace sBaseName to hoAttr
71777>>>>>>> If hoAttr ; send destroy of hoAttr
71780>>>>>>> end
71780>>>>>>>>
71780>>>>>>> send destroy of hoAttrs
71781>>>>>>> end_procedure
71782>>>>>>>
71782>>>>>>>End_Class
71783>>>>>>>
71783>>>>>>>Class cXMLDOMNode Is A BaseXmlDomNode
71784>>>>>>> Import_Class_protocol cXMLDOMNodeMixin
71785>>>>>>>End_Class
71786>>>>>>>
71786>>>>>>>Class cXMLDOMAttribute Is A BaseXmlDomAttribute
71787>>>>>>> Import_Class_protocol cXMLDOMNodeMixin
71788>>>>>>>End_Class
71789>>>>>>>
71789>>>>>>>Class cXMLDOMComment Is A BaseXmlDomComment
71790>>>>>>> Import_Class_protocol cXMLDOMNodeMixin
71791>>>>>>>End_Class
71792>>>>>>>
71792>>>>>>>Class cXMLDOMProcessingInstruction Is A BaseXmlDomProcessingInstruction
71793>>>>>>> Import_Class_protocol cXMLDOMNodeMixin
71794>>>>>>>End_Class
71795>>>>>>>
71795>>>>>>>Class cXMLDOMTextNode Is A BaseXmlDomTextNode
71796>>>>>>> Import_Class_protocol cXMLDOMNodeMixin
71797>>>>>>>End_Class
71798>>>>>>>
71798>>>>>>>Class cXMLDOMCDATASection Is A BaseXmlDomCDATASection
71799>>>>>>> Import_Class_protocol cXMLDOMNodeMixin
71800>>>>>>>End_Class
71801>>>>>>>
71801>>>>>>>Class cXMLDOMDocumentType Is A BaseXmlDomDocumentType
71802>>>>>>> Import_Class_protocol cXMLDOMNodeMixin
71803>>>>>>>
71803>>>>>>>// Function EnumerateEntities Integer iMsg Integer hoReceiver Integer bEnumerate Integer iSomeValue Returns Handle
71803>>>>>>>// Integer i
71803>>>>>>>// Integer hoNode
71803>>>>>>>// Integer hoNamedNodeMap
71803>>>>>>>// Integer hinfcNamedNodeMap
71803>>>>>>>// Integer iLength
71803>>>>>>>
71803>>>>>>>// Get phEntities To hinfcNamedNodeMap
71803>>>>>>>
71803>>>>>>>// showln "The interface of the named node map is " hinfcNamedNodeMap
71803>>>>>>>
71803>>>>>>>// If (hinfcNamedNodeMap <> 0) Begin
71803>>>>>>>// Get CreateXMLObject U_cXMLDOMNamedNodeMap hinfcNamedNodeMap to hoNamedNodeMap
71803>>>>>>>// Get piLength Of hoNamedNodeMap To iLength
71803>>>>>>>// Showln "There are " iLength " items in map"
71803>>>>>>>
71803>>>>>>>// /// For i From 0 To (NodeListLength(hoNamedNodeMap)-1)
71803>>>>>>>// /// // For each record, process its fields.
71803>>>>>>>// // Get CollectionNode Of hoNamedNodeMap i To hoNode
71803>>>>>>>// // Send iMsg Of hoReceiver hoNode bEnumerate iSomeValue
71803>>>>>>>// // Send Destroy_Object Of hoNode
71803>>>>>>>// // Loop
71803>>>>>>>// End
71803>>>>>>>// Send Destroy To hoNamedNodeMap
71803>>>>>>>// Function_Return 0
71803>>>>>>>// End_Function
71803>>>>>>>
71803>>>>>>>// Function EnumerateNotations Integer iMsg Integer hoReceiver Integer bEnumerate Integer iSomeValue Returns Handle
71803>>>>>>>// Integer i
71803>>>>>>>// Integer hoNode
71803>>>>>>>// Integer hoNamedNodeMap
71803>>>>>>>// Integer hinfcNamedNodeMap
71803>>>>>>>// Integer iLength
71803>>>>>>>
71803>>>>>>>// Object oNamedNodeMap Is A cXMLDOMNamedNodeMap
71803>>>>>>>// Move Self To hoNamedNodeMap
71803>>>>>>>// End_Object
71803>>>>>>>
71803>>>>>>>// Get phNotations To hinfcNamedNodeMap
71803>>>>>>>
71803>>>>>>>// showln "The interface of the named node map is " hinfcNamedNodeMap
71803>>>>>>>
71803>>>>>>>// If (hinfcNamedNodeMap <> 0) Begin
71803>>>>>>>// Set XMLInterface Of hoNamedNodeMap To hinfcNamedNodeMap
71803>>>>>>>// Get piLength Of hoNamedNodeMap To iLength
71803>>>>>>>// Showln "There are " iLength " items in map"
71803>>>>>>>
71803>>>>>>>///// For i From 0 To (NodeListLength(hoNamedNodeMap)-1)
71803>>>>>>>///// // For each record, process its fields.
71803>>>>>>>//// Get CollectionNode Of hoNamedNodeMap i To hoNode
71803>>>>>>>//// Send iMsg Of hoReceiver hoNode bEnumerate iSomeValue
71803>>>>>>>//// Send Destroy_Object Of hoNode
71803>>>>>>>//// Loop
71803>>>>>>>// End
71803>>>>>>>// Send Destroy_Object To hoNamedNodeMap
71803>>>>>>>// Function_Return 0
71803>>>>>>>// End_Function
71803>>>>>>>
71803>>>>>>>End_Class
71804>>>>>>>
71804>>>>>>>Class cXMLDOMNotation Is A BaseXmlDomNotation
71805>>>>>>> Import_Class_protocol cXMLDOMNodeMixin
71806>>>>>>>End_Class
71807>>>>>>>
71807>>>>>>>Class cXMLDOMEntity Is A BaseXmlDomEntity
71808>>>>>>> Import_Class_protocol cXMLDOMNodeMixin
71809>>>>>>>End_Class
71810>>>>>>>
71810>>>>>>>Class cXMLDOMEntityReference Is A BaseXmlDomEntityReference
71811>>>>>>> Import_Class_protocol cXMLDOMNodeMixin
71812>>>>>>>End_Class
71813>>>>>>>
71813>>>>>>>Class cXMLDOMDocumentFragment Is A BaseXmlDomDocumentFragment
71814>>>>>>> Import_Class_protocol cXMLDOMNodeMixin
71815>>>>>>>End_Class
71816>>>>>>>
71816>>>>>>>
71816>>>>>>>
71816>>>>>>>// Base document class with Base functions.
71816>>>>>>>
71816>>>>>>>Class cXMLDOMDocument is An BaseXmlDomDocument
71817>>>>>>>
71817>>>>>>> Import_Class_protocol cXMLDOMNodeMixin
71818>>>>>>>
71818>>>>>>> Procedure Construct_Object
71820>>>>>>> Forward Send Construct_Object
71822>>>>>>> Property String psDocumentName ""
71823>>>>>>> Property integer phPrivateDocumentElement 0
71824>>>>>>> End_Procedure
71825>>>>>>>
71825>>>>>>> // returns the classId for the passed NodeType. This is a good augmentation point. All nodes
71825>>>>>>> // within an xml document come here to get a class. So, if you want to augment and return a
71825>>>>>>> // different class, just check the node type and return whatever -- else forward
71825>>>>>>>
71825>>>>>>> Function NodeClassId integer iType returns integer
71827>>>>>>> integer iClassId
71827>>>>>>> Case Begin
71827>>>>>>> Case (iType=NODE_ELEMENT) Move U_cXMLDOMElement to iClassId
71830>>>>>>> Case (iType=NODE_ATTRIBUTE) Move U_cXMLDOMAttribute to iClassId
71834>>>>>>> Case (iType=NODE_TEXT) Move U_cXMLDOMTextNode to iClassId
71838>>>>>>> Case (iType=NODE_CDATA_SECTION) Move U_cXMLDOMCDATASection to iClassId
71842>>>>>>> Case (iType=NODE_ENTITY_REFERENCE) Move U_cXMLDOMEntityReference to iClassId
71846>>>>>>> Case (iType=NODE_ENTITY) Move U_cXMLDOMEntity to iClassId
71850>>>>>>> Case (iType=NODE_PROCESSING_INSTRUCTION) Move U_cXMLDOMProcessingInstruction to iClassId
71854>>>>>>> Case (iType=NODE_COMMENT) Move U_cXMLDOMComment to iClassId
71858>>>>>>> Case (iType=NODE_DOCUMENT) Move U_cXMLDOMDocument to iClassId
71862>>>>>>> Case (iType=NODE_DOCUMENT_TYPE) Move U_cXMLDOMDocumentType to iClassId
71866>>>>>>> Case (iType=NODE_DOCUMENT_FRAGMENT) Move U_cXMLDOMDocumentFragment to iClassId
71870>>>>>>> Case (iType=NODE_NOTATION) Move U_cXMLDOMNotation to iClassId
71874>>>>>>> Case (iType=0) Move 0 to iClassId // this is an error!!
71878>>>>>>> Case Else Move U_cXMLDOMNode to iClassId
71880>>>>>>> Case End
71880>>>>>>> Function_return iClassId
71881>>>>>>> end_function
71882>>>>>>>
71882>>>>>>> // Load an XML Document. The name of the document is stored in a property
71882>>>>>>> // that must be set for this function to work correctly.
71882>>>>>>>
71882>>>>>>> Function LoadXMLDocument Returns Integer
71884>>>>>>> String sDocumentName
71884>>>>>>> Integer bRetVal
71884>>>>>>> Get psDocumentName To sDocumentName
71885>>>>>>> Get LoadDocument sDocumentName To bRetVal
71886>>>>>>> If (bRetVal = 0); Function_Return TRUE
71889>>>>>>> Else; Function_Return FALSE
71891>>>>>>> End_Function
71892>>>>>>>
71892>>>>>>> Function SaveXMLDocument Returns Integer
71894>>>>>>> String sDocumentName
71894>>>>>>> Integer bRetVal
71894>>>>>>> Get psDocumentName To sDocumentName
71895>>>>>>> Get SaveDocument sDocumentName To bRetVal
71896>>>>>>> Function_Return bRetVal
71897>>>>>>> End_Function
71898>>>>>>>
71898>>>>>>> // Load an XML from a string. This aguments the C message to ret 1 if Ok and 0 if error.
71898>>>>>>> //
71898>>>>>>> Function LoadXML string sXML Returns Integer
71900>>>>>>> Integer bRetVal
71900>>>>>>> // for some reason the parser will not work properly with embedded double quotes.
71900>>>>>>> // Change all " to ' in document.
71900>>>>>>> //Move (replaces('"',sXML,"'")) to sXML // removed this. Bad Idea.
71900>>>>>>> Forward Get LoadXml sXML To bRetVal
71902>>>>>>> If (bRetVal = 0) ; Function_Return TRUE
71905>>>>>>> Else; Function_Return FALSE
71907>>>>>>> End_Function
71908>>>>>>>
71908>>>>>>> // Load an XML string from an address. This aguments the C message to ret 1 if Ok and 0 if error.
71908>>>>>>> //
71908>>>>>>> Function LoadXMLFromAddress address pXML Returns Integer
71910>>>>>>> Integer bRetVal
71910>>>>>>> Forward Get LoadXmlFromAddress pXML To bRetVal
71912>>>>>>> If (bRetVal = 0) ; Function_Return TRUE
71915>>>>>>> Else; Function_Return FALSE
71917>>>>>>> End_Function
71918>>>>>>>
71918>>>>>>>
71918>>>>>>> // Allow Nodes and Node node lists to get the parent document.
71918>>>>>>>
71918>>>>>>> Function DocumentObject Returns Handle
71920>>>>>>> Function_Return self
71921>>>>>>> End_Function
71922>>>>>>>
71922>>>>>>> // Access to the root node allows for searches and iterations.
71922>>>>>>> // The root node is a cNode.
71922>>>>>>>
71922>>>>>>> Function DocumentElement Returns Handle
71924>>>>>>> Integer hNewNode // Object ID of Root Node
71924>>>>>>> Integer infcNode // XML Element Interface
71924>>>>>>>// we used to buffer this so we'd always return the same object. This is dangerous. If the devloper
71924>>>>>>>// deletes the root and then creates some other object with this name, we will have problems. Now we
71924>>>>>>>// always create a new root now - which means you can create multiple roots (which is probably ok).
71924>>>>>>>
71924>>>>>>>// Get phPrivateDocumentElement to hNewNode
71924>>>>>>>// // if for some reason the developer sends destroy to the root element then
71924>>>>>>>// // we must check that acutally exists. If not, create the root all over again
71924>>>>>>>// Get Object_Id of hNewNode to hNewNode // if Object no longer exists, 0 is returned
71924>>>>>>>// If not (hNewNode) Begin
71924>>>>>>>// // Call XML to get the document root element.
71924>>>>>>>// Get phDocumentElement To infcNode
71924>>>>>>>// If infcNode Begin
71924>>>>>>>// Get CreateXMLObject U_cXMLDOMElement infcNode to hNewNode
71924>>>>>>>// Set phPrivateDocumentElement to hNewNode
71924>>>>>>>// end
71924>>>>>>>// End
71924>>>>>>>
71924>>>>>>> Get phDocumentElement To infcNode
71925>>>>>>> If infcNode Begin
71927>>>>>>> Get CreateXMLObject U_cXMLDOMElement infcNode to hNewNode
71928>>>>>>> Set phPrivateDocumentElement to hNewNode // we no longer use this at all
71929>>>>>>> end
71929>>>>>>>>
71929>>>>>>> Function_Return hNewNode
71930>>>>>>> End_Function
71931>>>>>>>
71931>>>>>>> // CreateRootNode is used to set up the first element in a document.
71931>>>>>>> // It should only be used when creating new files.
71931>>>>>>>
71931>>>>>>> Function CreateDocumentElement String sTagName Returns Handle
71933>>>>>>> Integer hNewNode // Object ID of Root Node
71933>>>>>>> Integer infcNode // XML Element Interface
71933>>>>>>> // Call XML to create an element in the document.
71933>>>>>>> Get CreateElement sTagName To infcNode
71934>>>>>>> // Tie the element interface to the DataFlex object.
71934>>>>>>> If infcNode ; Get CreateXMLObject U_cXMLDOMElement infcNode to hNewNode
71937>>>>>>> // Call XML to set the root element of the document.
71937>>>>>>> Set phDocumentElement To infcNode
71938>>>>>>> Set phPrivateDocumentElement to hNewNode
71939>>>>>>> Function_Return hNewNode
71940>>>>>>> End_Function
71941>>>>>>>
71941>>>>>>> //(new)
71941>>>>>>> Function CreateDocumentElementNS string sNamespace String sTagName Returns Handle
71943>>>>>>> Integer hNewNode // Object ID of Root Node
71943>>>>>>> Integer infcNode iType // XML Element Interface
71943>>>>>>> Get CreateElementNodeNS sNameSpace sTagName "" to hNewNode
71944>>>>>>> Get XmlInterface of hNewNode to infcNode
71945>>>>>>> Set phDocumentElement To infcNode
71946>>>>>>> Set phPrivateDocumentElement to hNewNode
71947>>>>>>> Function_Return hNewNode
71948>>>>>>> End_Function
71949>>>>>>>
71949>>>>>>>
71949>>>>>>>
71949>>>>>>> // return the DocType as a document-type object. Returns 0 if no dtd
71949>>>>>>> // Access to information from the doc type object is limited. Use get psXML
71949>>>>>>> Function DocTypeNode returns handle
71951>>>>>>> handle hinfcDocType hoDocType
71951>>>>>>> get phDocType to hinfcDocType
71952>>>>>>> If hinfcDocType ; Get CreateXMLObject U_cXMLDOMDocumentType hinfcDocType to hoDocType
71955>>>>>>> Function_return hoDocType
71956>>>>>>> End_function
71957>>>>>>>
71957>>>>>>> Function phXMLErrorObject Returns Handle
71959>>>>>>> Integer hoParseErrorObject
71959>>>>>>> Integer hInfcParseError
71959>>>>>>> Get phParseError To hInfcParseError
71960>>>>>>> If hInfcParseError ; Get CreateXMLObject U_BaseXMLDOMParseError hinfcParseError to hoParseErrorObject
71963>>>>>>> Function_Return hoParseErrorObject
71964>>>>>>> End_Function
71965>>>>>>>
71965>>>>>>> // The following procedure is meant to be overridden by one provided by the developer.
71965>>>>>>>
71965>>>>>>> Procedure BasicParseErrorReport
71967>>>>>>> String sProblem
71967>>>>>>> String sLinePosition
71967>>>>>>> String sDescr
71967>>>>>>> String sReason
71967>>>>>>> String sSource
71967>>>>>>> Integer hoParseErrorObject
71967>>>>>>> Get phXMLErrorObject To hoParseErrorObject
71968>>>>>>> If hoParseErrorObject Begin
71970>>>>>>> Move (SFormat(C_$CannotLoad, psDocumentName(Self)) + "."+character(13)+character(10)) To sProblem
71971>>>>>>> Move (SFormat(C_$ParsingError, piLine(hoParseErrorObject), piLinePos(hoParseErrorObject))) To sLinePosition
71972>>>>>>> Move (sLinePosition +character(13)+character(10)) To sLinePosition
71973>>>>>>>
71973>>>>>>> Move (C_$Reason + ":" * (psReason(hoParseErrorObject)) +character(13)+character(10)) To sReason
71974>>>>>>> Move (C_$Source + ":" * (psSrcText(hoParseErrorObject))) To sSource
71975>>>>>>> Move (sProblem + sLinePosition + sReason + sSource) To sDescr
71976>>>>>>> Error DFERR_XML_INTERNAL_ERROR sDescr
71977>>>>>>>>
71977>>>>>>> Send Destroy of hoParseErrorObject
71978>>>>>>> End
71978>>>>>>>>
71978>>>>>>> else ; Error DFERR_XML_INTERNAL_ERROR C_$NotCreatedParseObject
71980>>>>>>> End_Procedure
71981>>>>>>>
71981>>>>>>>End_Class
71982>>>>>Use Spec0011.utl // Floating menues on the fly
Including file: spec0011.utl (C:\Apps\VDFQuery\AppSrc\spec0011.utl)
71982>>>>>>>// Use Spec0011.utl // Floating menues on the fly
71982>>>>>>>
71982>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
71982>>>>>>>
71982>>>>>>>desktop_section
71987>>>>>>> object oSpec0011Arr is a cArray
71989>>>>>>> item_property_list
71989>>>>>>> item_property integer piMsg.i
71989>>>>>>> item_property string psText.i
71989>>>>>>> end_item_property_list
#REM 72026 DEFINE FUNCTION PSTEXT.I INTEGER LIROW RETURNS STRING
#REM 72031 DEFINE PROCEDURE SET PSTEXT.I INTEGER LIROW STRING VALUE
#REM 72036 DEFINE FUNCTION PIMSG.I INTEGER LIROW RETURNS INTEGER
#REM 72041 DEFINE PROCEDURE SET PIMSG.I INTEGER LIROW INTEGER VALUE
72047>>>>>>> procedure add_item integer iMsg string sVal
72050>>>>>>> integer iRow
72050>>>>>>> get row_count to iRow
72051>>>>>>> set piMsg.i iRow to iMsg
72052>>>>>>> set psText.i iRow to sVal
72053>>>>>>> end_procedure
72054>>>>>>> end_object
72055>>>>>>>end_desktop_section
72060>>>>>>>
72060>>>>>>>procedure FLOATMENU_PrepareAddItem global integer iMsg string sVal
72062>>>>>>> send add_item to (oSpec0011Arr(self)) iMsg sVal
72063>>>>>>>end_procedure
72064>>>>>>>
72064>>>>>>>class cSpec0011FloatingPopupMenu is a FloatingPopupMenu
72065>>>>>>> procedure popup
72067>>>>>>> forward send popup
72069>>>>>>> send request_destroy_object
72070>>>>>>> end_procedure
72071>>>>>>>end_class
72072>>>>>>>
72072>>>>>>>function FLOATMENU_Apply global integer iObj returns integer
72074>>>>>>> integer iSelf iArr iRow iMax iObjFM
72074>>>>>>> move self to iSelf
72075>>>>>>> move (oSpec0011Arr(self)) to iArr
72076>>>>>>> get row_count of iArr to iMax
72077>>>>>>> move desktop to self
72078>>>>>>> object oSpec0011_FM is a cSpec0011FloatingPopupMenu
72080>>>>>>> for iRow from 0 to (iMax-1)
72086>>>>>>>>
72086>>>>>>> send add_item (piMsg.i(iArr,iRow)) (psText.i(iArr,iRow))
72087>>>>>>> set aux_value item iRow to iObj
72088>>>>>>> loop
72089>>>>>>>>
72089>>>>>>> move self to iObjFM
72090>>>>>>> end_object
72091>>>>>>> move iSelf to self
72092>>>>>>> send delete_data to iArr
72093>>>>>>> function_return iObjFM
72094>>>>>>>end_function
72095>>>>>Use GridUtil.utl // Grid and List utilities (not for dbGrid's or Table's)
72095>>>>>Use QryOrder.utl // cQueryOrderExpression class
Including file: qryorder.utl (C:\Apps\VDFQuery\AppSrc\qryorder.utl)
72095>>>>>>>// **********************************************************************
72095>>>>>>>// Use QryOrder.utl // Ad-hoc index thing for query classes
72095>>>>>>>//
72095>>>>>>>// By Sture Andersen
72095>>>>>>>//
72095>>>>>>>// Update: Wed 24-09-2003 - Lower limit of for loop fixed in function sReverseValue.s
72095>>>>>>>//
72095>>>>>>>// **********************************************************************
72095>>>>>>>
72095>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
72095>>>>>>>Use FieldInf // Global field info objects and abstract field types
72095>>>>>>>Use Collate.nui // A little collating thing
Including file: collate.nui (C:\Apps\VDFQuery\AppSrc\collate.nui)
72095>>>>>>>>>// Use Collate.nui // A little collating thing
72095>>>>>>>>>
72095>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
72095>>>>>>>>>Use Strings.nui // String manipulation for VDF (No User Interface)
72095>>>>>>>>>
72095>>>>>>>>>class cCollateArray is a cArray
72096>>>>>>>>> procedure fill_current_sort_order
72098>>>>>>>>> integer liCharacter
72098>>>>>>>>> for liCharacter from 32 to 255
72104>>>>>>>>>>
72104>>>>>>>>> set value item (liCharacter-32) to (character(liCharacter))
72105>>>>>>>>> loop
72106>>>>>>>>>>
72106>>>>>>>>> send sort_items
72107>>>>>>>>> end_procedure
72108>>>>>>>>> function sStringValue returns string
72110>>>>>>>>> integer liMax liItem
72110>>>>>>>>> string lsRval
72110>>>>>>>>> get item_count to liMax
72111>>>>>>>>> decrement liMax
72112>>>>>>>>> move "" to lsRval
72113>>>>>>>>> for liItem from 0 to liMax
72119>>>>>>>>>>
72119>>>>>>>>> move (lsRval+value(self,liItem)) to lsRval
72120>>>>>>>>> loop
72121>>>>>>>>>>
72121>>>>>>>>> function_return lsRval
72122>>>>>>>>> end_function
72123>>>>>>>>>end_class // cCollateArray
72124>>>>>>>>>
72124>>>>>>>>>desktop_section
72129>>>>>>>>> object oCollateArray is a cCollateArray NO_IMAGE
72131>>>>>>>>> property string psCollateString public ""
72133>>>>>>>>> property string psCollateStringReversed public ""
72135>>>>>>>>> procedure Init
72138>>>>>>>>> string lsValue
72138>>>>>>>>> get sStringValue to lsValue
72139>>>>>>>>> set psCollateString to lsValue
72140>>>>>>>>> set psCollateStringReversed to (StringReverse(lsValue))
72141>>>>>>>>> end_procedure
72142>>>>>>>>> send fill_current_sort_order
72143>>>>>>>>> send Init
72144>>>>>>>>> end_object
72145>>>>>>>>>end_desktop_section
72150>>>>>>>>>
72150>>>>>>>>>function Collate_String global returns string
72152>>>>>>>>> function_return (psCollateString(oCollateArray(self)))
72153>>>>>>>>>end_function
72154>>>>>>>>>function Collate_ReversedString global returns string
72156>>>>>>>>> function_return (psCollateStringReversed(oCollateArray(self)))
72157>>>>>>>>>end_function
72158>>>>>>>>>
72158>>>>>>>>>string gs$ReversedCollateString 255
72158>>>>>>>>>move (repeat(" ",31)+Collate_ReversedString()) to gs$ReversedCollateString
72159>>>>>>>>>
72159>>>>>>>Use QryExpr.utl // Expression handling for queries
72159>>>>>>>Use Query.nui // Basic things needed for a query tool
Including file: query.nui (C:\Apps\VDFQuery\AppSrc\query.nui)
72159>>>>>>>>>// Use Query.nui // Basic things needed for a query tool
72159>>>>>>>>>
72159>>>>>>>>>Use DataScan.utl // Data scan classes
72159>>>>>>>>>use QueryLng.pkg // Language dependant constants
Including file: querylng.pkg (C:\Apps\VDFQuery\AppSrc\querylng.pkg)
72159>>>>>>>>>>> define t.DfQuery.DFQuery for "Database query"
72159>>>>>>>>>>> define t.DfQuery.EQ for "Equal to"
72159>>>>>>>>>>> define t.DfQuery.LT for "Less than"
72159>>>>>>>>>>> define t.DfQuery.LE for "Less than or equal"
72159>>>>>>>>>>> define t.DfQuery.GE for "Greater than or equal"
72159>>>>>>>>>>> define t.DfQuery.GT for "Greater than"
72159>>>>>>>>>>> define t.DfQuery.NE for "Not equal to"
72159>>>>>>>>>>> define t.DfQuery.IN for "String includes"
72159>>>>>>>>>>> define t.DfQuery.CIN for "String does not include"
72159>>>>>>>>>>> define t.DfQuery.BT for "Between"
72159>>>>>>>>>>> define t.DfQuery.CBT for "Outside interval"
72159>>>>>>>>>>> define t.DfQuery.NB for "Not blank"
72159>>>>>>>>>>> define t.DfQuery.B for "Blank"
72159>>>>>>>>>>> define t.DfQuery.OrL for "In list" // or-list
72159>>>>>>>>>>> define t.DfQuery.SetDefaultValue for "Set Default Value"
72159>>>>>>>>>>> define t.DfQuery.QueryDefinition for "Query Definition"
72159>>>>>>>>>>> define t.DfQuery.None for "None"
72159>>>>>>>>>>> define t.DfQuery.Run for "&Run"
72159>>>>>>>>>>> define t.DfQuery.LblIncludeCrit for "Include selection criteria in printed report"
72159>>>>>>>>>>> define t.DfQuery.LblDisplayLocked for "Display locked selections"
72159>>>>>>>>>>> define t.DfQuery.LblPrintTotals for "Print totals only"
72159>>>>>>>>>>> define t.DfQuery.LblLandscape for "Landscape"
72159>>>>>>>>>>> define t.DfQuery.LblTab1 for "Fields"
72159>>>>>>>>>>> define t.DfQuery.LblTab2 for "Selection"
72159>>>>>>>>>>> define t.DfQuery.LblTab3 for "Ordering"
72159>>>>>>>>>>> define t.DfQuery.LblTab5 for "Output"
72159>>>>>>>>>>> define t.DfQuery.LblFont for "Font:"
72159>>>>>>>>>>> define t.DfQuery.LblPrintOrder for "Ordering:"
72159>>>>>>>>>>> define t.DfQuery.LblSearchOrder for "Search order:"
72159>>>>>>>>>>> define t.DfQuery.LblInsertField for "Insert"
72159>>>>>>>>>>> define t.DfQuery.LblAddField for "Add"
72159>>>>>>>>>>> define t.DfQuery.LblDeleteField for "Delete"
72159>>>>>>>>>>> define t.DfQuery.LblDefaultValue for "Default value"
72159>>>>>>>>>>> define t.DfQuery.LblAdjustBelow for "Ad&just below"
72159>>>>>>>>>>> define t.DfQuery.LblGrpPrnt for "Printed fields"
72159>>>>>>>>>>> define t.DfQuery.LblGrdPrnt0 for "Field name"
72159>>>>>>>>>>> define t.DfQuery.LblGrdPrnt1 for "Sum"
72159>>>>>>>>>>> define t.DfQuery.LblGrdPrnt2 for "Cr"
72159>>>>>>>>>>> define t.DfQuery.LblGrdPrnt3 for "Start"
72159>>>>>>>>>>> define t.DfQuery.LblGrdPrnt4 for "Width"
72159>>>>>>>>>>> define t.DfQuery.SthGrdPrnt0 for "Name of the field as it will appear in the printed report"
72159>>>>>>>>>>> define t.DfQuery.SthGrdPrnt1 for "Check this if you want a total for this column"
72159>>>>>>>>>>> define t.DfQuery.SthGrdPrnt2 for "Check this if report should start a new line before printing this field"
72159>>>>>>>>>>> define t.DfQuery.SthGrdPrnt3 for "Printing position for the current field (column) in centimeters"
72159>>>>>>>>>>> define t.DfQuery.SthGrdPrnt4 for "Width of the current field (column) in centimeters"
72159>>>>>>>>>>> define t.DfQuery.LblGrpCrit for "Selections"
72159>>>>>>>>>>> define t.DfQuery.LblGrdCrit0 for "Field name"
72159>>>>>>>>>>> define t.DfQuery.LblGrdCrit1 for "Type"
72159>>>>>>>>>>> define t.DfQuery.LblGrdCrit2 for "Value"
72159>>>>>>>>>>> define t.DfQuery.SthGrdCrit0 for "Name of the field as it will appear in the selection form"
72159>>>>>>>>>>> define t.DfQuery.SthGrdCrit1 for "Specifies the type of selection (press F4 to change)"
72159>>>>>>>>>>> define t.DfQuery.SthGrdCrit2 for "Current value of the criteria. Press F4 to change"
72159>>>>>>>>>>> define t.DfQuery.DBMSfiles for "Table"
72159>>>>>>>>>>> define t.DfQuery.DBMSfields for "Fields"
72159>>>>>>>>>>> define t.DfQuery.QueryTitle for "Query Title:"
72159>>>>>>>>>>> define t.DfQuery.MainFile for "Main File:"
72159>>>>>>>>>>> define t.DfQuery.Operators for "Selection Operators"
72159>>>>>>>>>>> define t.DfQuery.gt_or_eq for "Greater than or equal: "
72159>>>>>>>>>>> define t.DfQuery.lt_or_eq for "Less than or equal: "
72159>>>>>>>>>>> define t.DfQuery.no_limit for "No limitation"
72159>>>>>>>>>>> define t.DfQuery.illegal_interval for "Illegal interval"
72159>>>>>>>>>>> define t.DfQuery.before for "before: "
72159>>>>>>>>>>> define t.DfQuery.after for "after: "
72159>>>>>>>>>>> define t.DfQuery.both_incl for "(both incl)"
72159>>>>>>>>>>> define t.DfQuery.to for "to"
72159>>>>>>>>>>> define t.DfQuery.ReportCancelled for "*** The report was interrupted before completion ***"
72159>>>>>>>>>>> define t.DfQuery.Dest_Printer for "Printer"
72159>>>>>>>>>>> define t.DfQuery.Dest_Preview for "Preview"
72159>>>>>>>>>>> define t.DfQuery.Dest_File for "File"
72159>>>>>>>>>>> define t.DfQuery.ReportDest for "Report destination"
72159>>>>>>>>>>> define t.DfQuery.FileNameNotSpec for "File name not specified"
72159>>>>>>>>>>> define t.DfQuery.SelectionCrit for "Selection criteria:"
72159>>>>>>>>>>> define t.DfQuery.NoSelectionCrit for "No selection criteria applied"
72159>>>>>>>>>>> define t.DfQuery.Filter1 for "Text files|*.txt|XML files|*.xml|All files|*.*"
72159>>>>>>>>>>> define t.DfQuery.Caption1 for "Print to file"
72159>>>>>>>>>>> define t.DfQuery.RightHeader for "<D>, <T>, Page <P> of <MP>"
72159>>>>>>>>>>> define t.DfQuery.Page for "Page:"
72159>>>>>>>>>>> define t.DfQuery.GenerationTime for "Generated on:"
72159>>>>>>>>>>> define t.DfQuery.OpenFileCaption for "Open query definition"
72159>>>>>>>>>>> define t.DfQuery.SaveFileCaption for "Save query definition"
72159>>>>>>>>>>> define t.DfQuery.FileFilter for "Query definition file (*.qdf)|*.qdf"
72159>>>>>>>>>>> define t.DfQuery.IncompDefFile for "Incompatible report definition file."
72159>>>>>>>>>>> define t.DfQuery.FileFormatCD for "Comma delimited"
72159>>>>>>>>>>> define t.DfQuery.FileFormatLD for "Line delimited"
72159>>>>>>>>>>> define t.DfQuery.FileFormatPR for "Formatted"
72159>>>>>>>>>>> define t.DfQuery.LblRecords for "Records:"
72159>>>>>>>>>>> define t.DfQuery.tt.Open for "Open query definition"
72159>>>>>>>>>>> define t.DfQuery.tt.AdvTableOpen for "Table selector"
72159>>>>>>>>>>> define t.DfQuery.tt.Save for "Save query definition"
72159>>>>>>>>>>> define t.DfQuery.tt.New for "New query"
72159>>>>>>>>>>> define t.DfQuery.ReadingRecords for "Reading records (#/#)"
72159>>>>>>>>>>> define t.DfQuery.LblGrdBreak1 for "Break"
72159>>>>>>>>>>> define t.DfQuery.LblGrdBreak2 for "Field name"
72159>>>>>>>>>>> define t.DfQuery.SthGrdBreak0 for "Should the report break on this field?"
72159>>>>>>>>>>> define t.DfQuery.SthGrdBreak1 for "The field will print under this name"
72159>>>>>>>>>>> define t.DfQuery.FileCompleted for "File completed"
72159>>>>>>>>>>> define t.DfQuery.LogicalNames for "Logical names"
72159>>>>>>>>>>> define t.DfQuery.UserNames for "User names"
72159>>>>>>>>>>> define t.DfQuery.UseAnsi for "Use ANSI characters"
72159>>>>>>>>>>> define t.DfQuery.InclNames for "Include column names"
72159>>>>>>>>>>> define t.DfQuery.Semicolon for "Semicolon as delimiter"
72159>>>>>>>>>>> define t.DfQuery.Texts for "Texts"
72159>>>>>>>>>>> define t.DfQuery.TextBefore for "Before report"
72159>>>>>>>>>>> define t.DfQuery.TextAfter for "After report"
72159>>>>>>>>>>> define t.DfQuery.Expression for "Expression"
72159>>>>>>>>>>> define t.DfQuery.ExprCritAdded for "Expressional selection criteria added"
72159>>>>>>>>>>> define t.DfQuery.DisplayTblDef for "Display table definition"
72159>>>>>>>>>>> define t.DfQuery.AddAllFields for "Add all fields"
72159>>>>>>>>>>> define t.DfQuery.AddIndexFields for "Add fields in index"
72159>>>>>>>>>>> define t.DfQuery.SelCritExpr for "Selection criteria (expression)"
72159>>>>>>>>>>>
72159>>>>>>>>>Use FieldInf // Global field info objects and abstract field types
72159>>>>>>>>>
72159>>>>>>>>>define DFQ.FORMAT.CD for 1 // Comma delimited
72159>>>>>>>>>define DFQ.FORMAT.LD for 2 // Line delimited
72159>>>>>>>>>define DFQ.FORMAT.PRINT for 3 // Printable
72159>>>>>>>>>define DFQ.FORMAT.HTML for 4 // HTML
72159>>>>>>>>>define DFQ.FORMAT.XML for 5 // XML
72159>>>>>>>>>
72159>>>>>>>>>define DFQ.DEST.PRINTER for 0 // The order of these are dictated by the
72159>>>>>>>>>define DFQ.DEST.SCREEN for 1 // order of radio buttons in the destination
72159>>>>>>>>>define DFQ.DEST.FILE for 2 // selector
72159>>>>>>>>>define DFQ.DEST.EMAIL for 3 // selector
72159>>>>>>>>>
72159>>>>>>>>>integer Query$ExcludeAllRecnums
72159>>>>>>>>>move 0 to Query$ExcludeAllRecnums
72160>>>>>>>>>
72160>>>>>>>>>desktop_section // Place object on desktop no matter where declared
72165>>>>>>>>> object oDfQuery_ExcludeFields is a cFieldInfoStuff NO_IMAGE
72167>>>>>>>>> end_object
72168>>>>>>>>>end_desktop_section
72173>>>>>>>>>
72173>>>>>>>>>function DfQuery_ExcludeField global integer file# integer field# returns integer
72175>>>>>>>>> if (not(field#) and Query$ExcludeAllRecnums) function_return 1
72178>>>>>>>>> if file# if field# begin
72182>>>>>>>>> end
72182>>>>>>>>>>
72182>>>>>>>>> function_return (integer_value.ii(oDfQuery_ExcludeFields(self),file#,field#))
72183>>>>>>>>>end_function
72184>>>>>>>>>procedure set DfQuery_ExcludeField global integer file# integer field# integer value#
72186>>>>>>>>> ifnot (file# or field#) move value# to Query$ExcludeAllRecnums
72189>>>>>>>>> else set integer_value.ii of (oDfQuery_ExcludeFields(self)) file# field# to value#
72191>>>>>>>>>end_procedure
72192>>>>>>>>>
72192>>>>>>>>>desktop_section // Place object on desktop no matter where declared
72197>>>>>>>>> object oDfQuery_ExcludeFiles is a cArray NO_IMAGE
72199>>>>>>>>> end_object
72200>>>>>>>>>end_desktop_section
72205>>>>>>>>>
72205>>>>>>>>>enumeration_list
72205>>>>>>>>> define DFQ_FALSE
72205>>>>>>>>> define DFQ_TRUE
72205>>>>>>>>> define DFQ_ALWAYS
72205>>>>>>>>>end_enumeration_list
72205>>>>>>>>>
72205>>>>>>>>>define VDFQ_FALSE for DFQ_FALSE // For backwards compatibility
72205>>>>>>>>>define VDFQ_TRUE for DFQ_TRUE //
72205>>>>>>>>>define VDFQ_ALWAYS for DFQ_ALWAYS //
72205>>>>>>>>>
72205>>>>>>>>>function DfQuery_ExcludeFile global integer file# returns integer
72207>>>>>>>>> function_return (value(oDfQuery_ExcludeFiles(self),file#))
72208>>>>>>>>>end_function
72209>>>>>>>>>procedure set DfQuery_ExcludeFile global integer file# integer value#
72211>>>>>>>>> set value of (oDfQuery_ExcludeFiles(self)) item file# to value#
72212>>>>>>>>>end_procedure
72213>>>>>>>>>
72213>>>>>>>>>function DfQuery_CompModeTxt_Short global integer comp# returns string
72215>>>>>>>>> if comp# eq SC_COMP_EQ function_return "=" //"EQ"
72218>>>>>>>>> if comp# eq SC_COMP_LT function_return "<" //"LT"
72221>>>>>>>>> if comp# eq SC_COMP_LE function_return "<=" //"LE"
72224>>>>>>>>> if comp# eq SC_COMP_GE function_return ">=" //"GE"
72227>>>>>>>>> if comp# eq SC_COMP_GT function_return ">" //"GT"
72230>>>>>>>>> if comp# eq SC_COMP_NE function_return "<>" //"NE"
72233>>>>>>>>> if comp# eq SC_COMP_IN function_return "IN"
72236>>>>>>>>> if comp# eq SC_COMP_CIN function_return "CIN"
72239>>>>>>>>> if comp# eq SC_COMP_BETWEEN function_return "x-y" //"BT"
72242>>>>>>>>> if comp# eq SC_COMP_CBETWEEN function_return "CBT"
72245>>>>>>>>> if comp# eq SC_COMP_NOT_BLANK function_return '<>""'
72248>>>>>>>>> if comp# eq SC_COMP_BLANK function_return '=""'
72251>>>>>>>>> if comp# eq SC_COMP_OR_LIST function_return "in list"
72254>>>>>>>>>end_function
72255>>>>>>>>>
72255>>>>>>>>>function DfQuery_CompModeTxt_Long global integer comp# returns string
72257>>>>>>>>> if comp# eq SC_COMP_EQ function_return t.DfQuery.EQ
72260>>>>>>>>> if comp# eq SC_COMP_LT function_return t.DfQuery.LT
72263>>>>>>>>> if comp# eq SC_COMP_LE function_return t.DfQuery.LE
72266>>>>>>>>> if comp# eq SC_COMP_GE function_return t.DfQuery.GE
72269>>>>>>>>> if comp# eq SC_COMP_GT function_return t.DfQuery.GT
72272>>>>>>>>> if comp# eq SC_COMP_NE function_return t.DfQuery.NE
72275>>>>>>>>> if comp# eq SC_COMP_IN function_return t.DfQuery.IN
72278>>>>>>>>> if comp# eq SC_COMP_CIN function_return t.DfQuery.CIN
72281>>>>>>>>> if comp# eq SC_COMP_BETWEEN function_return t.DfQuery.BT
72284>>>>>>>>> if comp# eq SC_COMP_CBETWEEN function_return t.DfQuery.CBT
72287>>>>>>>>> if comp# eq SC_COMP_NOT_BLANK function_return t.DfQuery.NB
72290>>>>>>>>> if comp# eq SC_COMP_BLANK function_return t.DfQuery.B
72293>>>>>>>>> if comp# eq SC_COMP_OR_LIST function_return t.DfQuery.OrL
72296>>>>>>>>>end_function
72297>>>>>>>>>
72297>>>>>>>>>function DfQuery_CritText integer type# integer comp# string str1# string str2# returns string
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
72299>>>>>>>>> date date1# date2#
72299>>>>>>>>> number num1# num2#
72299>>>>>>>>> string rval#
72299>>>>>>>>> if type# eq ASCII_WINDOW move SC_TYPE_ASCII to type#
72302>>>>>>>>> else begin
72303>>>>>>>>> if type# eq DATE_WINDOW move SC_TYPE_DATE to type#
72306>>>>>>>>> else move SC_TYPE_NUMERIC to type#
72308>>>>>>>>> end
72308>>>>>>>>>>
72308>>>>>>>>>
72308>>>>>>>>> if comp# eq SC_COMP_OR_LIST function_return (replaces("|",str1#,"; ")) // or-list
72311>>>>>>>>>
72311>>>>>>>>> if type# eq SC_TYPE_ASCII begin
72313>>>>>>>>> if (comp#=SC_COMP_BETWEEN or comp#=SC_COMP_CBETWEEN) begin
72315>>>>>>>>> if (str1#+str2#) ne "" begin
72317>>>>>>>>> if str1# eq "" move (t.DfQuery.lt_or_eq+str2#) to rval#
72320>>>>>>>>> else begin
72321>>>>>>>>> if str2# eq "" move (t.DfQuery.gt_or_eq+str1#) to rval#
72324>>>>>>>>> else begin
72325>>>>>>>>> if str1# gt str2# move t.DfQuery.illegal_interval to rval#
72328>>>>>>>>> else move ('"'+str1#+'"'+" - "+'"'+str2#+'"'+" "+t.DfQuery.both_incl) to rval#
72330>>>>>>>>> end
72330>>>>>>>>>>
72330>>>>>>>>> end
72330>>>>>>>>>>
72330>>>>>>>>> end
72330>>>>>>>>>>
72330>>>>>>>>> else move t.DfQuery.no_limit to rval#
72332>>>>>>>>> end
72332>>>>>>>>>>
72332>>>>>>>>> else move ('"'+str1#+'"') to rval# // EQ LT LE GE GT or NE
72334>>>>>>>>> end
72334>>>>>>>>>>
72334>>>>>>>>> if type# eq SC_TYPE_DATE begin
72336>>>>>>>>> move str1# to date1#
72337>>>>>>>>> if (comp#=SC_COMP_BETWEEN or comp#=SC_COMP_CBETWEEN) begin
72339>>>>>>>>> move str2# to date2#
72340>>>>>>>>> if (date1#+date2#) begin
72342>>>>>>>>> ifnot date1# move (t.DfQuery.before+string(date2#)) to rval#
72345>>>>>>>>> else begin
72346>>>>>>>>> ifnot date2# move (t.DfQuery.after+string(date1#)) to rval#
72349>>>>>>>>> else begin
72350>>>>>>>>> if date1# gt date2# move t.DfQuery.illegal_interval to rval#
72353>>>>>>>>> else move (string(date1#)+" - "+string(date2#)+" "+t.DfQuery.both_incl) to rval#
72355>>>>>>>>> end
72355>>>>>>>>>>
72355>>>>>>>>> end
72355>>>>>>>>>>
72355>>>>>>>>> end
72355>>>>>>>>>>
72355>>>>>>>>> else move t.DfQuery.no_limit to rval#
72357>>>>>>>>> end
72357>>>>>>>>>>
72357>>>>>>>>> else begin // EQ LT LE GE GT or NE
72358>>>>>>>>> if date1# ne 0 move date1# to rval#
72361>>>>>>>>> else move t.DfQuery.no_limit to rval#
72363>>>>>>>>> end
72363>>>>>>>>>>
72363>>>>>>>>> end
72363>>>>>>>>>>
72363>>>>>>>>> if type# eq SC_TYPE_NUMERIC begin
72365>>>>>>>>> move str1# to num1#
72366>>>>>>>>> if (comp#=SC_COMP_BETWEEN or comp#=SC_COMP_CBETWEEN) begin
72368>>>>>>>>> move str2# to num2#
72369>>>>>>>>> if (num1#<>0 or num2#<>0) begin
72371>>>>>>>>> if (num1#=0) move (t.DfQuery.lt_or_eq+string(num2#)) to rval#
72374>>>>>>>>> else begin
72375>>>>>>>>> if (num2#=0) move (t.DfQuery.gt_or_eq+string(num1#)) to rval#
72378>>>>>>>>> else begin
72379>>>>>>>>> if num1# gt num2# move t.DfQuery.illegal_interval to rval#
72382>>>>>>>>> else move (string(num1#)+" - "+string(num2#)+" "+t.DfQuery.both_incl) to rval#
72384>>>>>>>>> end
72384>>>>>>>>>>
72384>>>>>>>>> end
72384>>>>>>>>>>
72384>>>>>>>>> end
72384>>>>>>>>>>
72384>>>>>>>>> else move t.DfQuery.no_limit to rval#
72386>>>>>>>>> end
72386>>>>>>>>>>
72386>>>>>>>>> else move num1# to rval#
72388>>>>>>>>> end
72388>>>>>>>>>>
72388>>>>>>>>> function_return rval#
72389>>>>>>>>>end_function
72390>>>>>>>>>
72390>>>>>>>>>// Also For backwards compatibility
72390>>>>>>>>>function VDFQuery_ExcludeFile global integer file# returns integer
72392>>>>>>>>> function_return (VDFQuery_ExcludeFile(file#))
72393>>>>>>>>>end_function
72394>>>>>>>>>procedure set VDfQuery_ExcludeFile global integer file# integer value#
72396>>>>>>>>> set DfQuery_ExcludeFile file# to value#
72397>>>>>>>>>end_procedure
72398>>>>>>>>>function VDFQuery_ExcludeField global integer file# integer field# returns integer
72400>>>>>>>>> function_return (VDFQuery_ExcludeField(file#,field#))
72401>>>>>>>>>end_function
72402>>>>>>>>>procedure set VDfQuery_ExcludeField global integer file# integer field# integer value#
72404>>>>>>>>> set DfQuery_ExcludeField file# field# to value#
72405>>>>>>>>>end_procedure
72406>>>>>>>>>
72406>>>>>>>>>
72406>>>>>>>Use FdxIndex.utl // Index analysing functions
72406>>>>>>>
72406>>>>>>> define t.QryOrder.Break for "Break"
72406>>>>>>> define t.QryOrder.Segment for "Segment"
72406>>>>>>> define t.QryOrder.Fields for "Fields"
72406>>>>>>> define t.QryOrder.Caps for "Caps"
72406>>>>>>> define t.QryOrder.Reverse for "Reverse"
72406>>>>>>> define t.QryOrder.Specify for "Specify ad hoc index"
72406>>>>>>>
72406>>>>>>>
72406>>>>>>>
72406>>>>>>>class cQueryOrderExpression is a cArray
72407>>>>>>> procedure construct_object integer liImage
72409>>>>>>> forward send construct_object liImage
72411>>>>>>> property integer phExprArr public 0
72412>>>>>>> end_procedure
72413>>>>>>>
72413>>>>>>> item_property_list
72413>>>>>>> item_property integer piFile.i
72413>>>>>>> item_property integer piField.i
72413>>>>>>> item_property integer piExprRow.i
72413>>>>>>> item_property integer pbCapsLock.i
72413>>>>>>> item_property integer pbReverse.i
72413>>>>>>> item_property string psValue.i
72413>>>>>>>
72413>>>>>>> item_property integer pbBreak.i
72413>>>>>>> item_property string psLabel.i
72413>>>>>>> end_item_property_list_extended cQueryOrderExpression
#REM 72537 DEFINE FUNCTION PSLABEL.I INTEGER LIROW RETURNS STRING
#REM 72541 DEFINE PROCEDURE SET PSLABEL.I INTEGER LIROW STRING VALUE
#REM 72545 DEFINE FUNCTION PBBREAK.I INTEGER LIROW RETURNS INTEGER
#REM 72549 DEFINE PROCEDURE SET PBBREAK.I INTEGER LIROW INTEGER VALUE
#REM 72553 DEFINE FUNCTION PSVALUE.I INTEGER LIROW RETURNS STRING
#REM 72557 DEFINE PROCEDURE SET PSVALUE.I INTEGER LIROW STRING VALUE
#REM 72561 DEFINE FUNCTION PBREVERSE.I INTEGER LIROW RETURNS INTEGER
#REM 72565 DEFINE PROCEDURE SET PBREVERSE.I INTEGER LIROW INTEGER VALUE
#REM 72569 DEFINE FUNCTION PBCAPSLOCK.I INTEGER LIROW RETURNS INTEGER
#REM 72573 DEFINE PROCEDURE SET PBCAPSLOCK.I INTEGER LIROW INTEGER VALUE
#REM 72577 DEFINE FUNCTION PIEXPRROW.I INTEGER LIROW RETURNS INTEGER
#REM 72581 DEFINE PROCEDURE SET PIEXPRROW.I INTEGER LIROW INTEGER VALUE
#REM 72585 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 72589 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 72593 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 72597 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
72602>>>>>>>
72602>>>>>>> procedure DoCopyFromOtherObject integer lhObj
72604>>>>>>> set phExprArr to (phExprArr(lhObj))
72605>>>>>>> send Clone_Array lhObj self
72606>>>>>>> end_procedure
72607>>>>>>>
72607>>>>>>> procedure Add_Field integer liFile integer liField
72609>>>>>>> integer liRow
72609>>>>>>> get row_count to liRow
72610>>>>>>> set piFile.i liRow to liFile
72611>>>>>>> set piField.i liRow to liField
72612>>>>>>> end_procedure
72613>>>>>>> procedure Add_Expr integer liExprRow
72615>>>>>>> integer liRow
72615>>>>>>> get row_count to liRow
72616>>>>>>> set piExprRow.i liRow to liExprRow
72617>>>>>>> end_procedure
72618>>>>>>> procedure ReadValues // Of the record buffer
72620>>>>>>> integer liRow liMax liFile liField liType liDec
72620>>>>>>> integer lhExprArr liExprRow lbNegative
72620>>>>>>> number lnValue
72620>>>>>>> string lsRval lsValue
72620>>>>>>> move "" to lsRval
72621>>>>>>> get row_count to liMax
72622>>>>>>> for liRow from 0 to (liMax-1)
72628>>>>>>>>
72628>>>>>>> get piFile.i liRow to liFile
72629>>>>>>> if liFile begin
72631>>>>>>> get piField.i liRow to liField
72632>>>>>>> get FieldInf_FieldValue liFile liField to lsValue
72633>>>>>>> get FieldInf_FieldType liFile liField to liType
72634>>>>>>> if liType eq DF_DATE begin
72636>>>>>>> move (integer(date(lsValue))) to lsValue
72637>>>>>>> move (NumToStrR(lsValue,0,6)) to lsValue
72638>>>>>>> end
72638>>>>>>>>
72638>>>>>>> if liType eq DF_BCD begin
72640>>>>>>> get FieldInf_DecPoints liFile liField to liDec
72641>>>>>>> move lsValue to lnValue
72642>>>>>>> move (lnValue<0) to lbNegative
72643>>>>>>> if lbNegative move (abs(lnValue)) to lnValue
72646>>>>>>> move (NumToStrR(lnValue,liDec,14)) to lsValue
72647>>>>>>> ifnot lbNegative move ("+"+lsValue) to lsValue
72650>>>>>>> else move (" "+lsValue) to lsValue
72652>>>>>>> end
72652>>>>>>>>
72652>>>>>>> end
72652>>>>>>>>
72652>>>>>>> else begin // Aha! Expression:
72653>>>>>>> get phExprArr to lhExprArr
72654>>>>>>> get piExprRow.i liRow to liExprRow
72655>>>>>>> get sEvalExpression of (Query_ExprEvaluator(self)) (piExprId.i(lhExprArr,liExprRow)) to lsValue
72656>>>>>>> get piType.i of lhExprArr liExprRow to liType
72657>>>>>>>
72657>>>>>>> if liType eq DF_DATE begin
72659>>>>>>> move (integer(date(lsValue))) to lsValue
72660>>>>>>> move (NumToStrR(lsValue,0,6)) to lsValue
72661>>>>>>> end
72661>>>>>>>>
72661>>>>>>> if liType eq DF_BCD begin
72663>>>>>>> get piWidth.i of lhExprArr liExprRow to liDec
72664>>>>>>>// move (NumToStrR(lsValue,liDec,14)) to lsValue
72664>>>>>>> move lsValue to lnValue
72665>>>>>>> move (lnValue<0) to lbNegative
72666>>>>>>> if lbNegative move (abs(lnValue)) to lnValue
72669>>>>>>> move (NumToStrR(lnValue,liDec,14)) to lsValue
72670>>>>>>> ifnot lbNegative move ("+"+lsValue) to lsValue
72673>>>>>>> else move (" "+lsValue) to lsValue
72675>>>>>>> end
72675>>>>>>>>
72675>>>>>>> end
72675>>>>>>>>
72675>>>>>>> set psValue.i liRow to lsValue
72676>>>>>>> loop
72677>>>>>>>>
72677>>>>>>> end_procedure
72678>>>>>>> function sReverseValue.s string lsValue returns string
72680>>>>>>> integer liPos liLen
72680>>>>>>> string lsRval lsChar
72680>>>>>>> move (length(lsValue)) to liLen
72681>>>>>>> move "" to lsRval
72682>>>>>>> for liPos from 1 to liLen
72688>>>>>>>>
72688>>>>>>> move (mid(lsValue,1,liPos)) to lsChar
72689>>>>>>> move (lsRval+mid(gs$ReversedCollateString,1,ascii(lsChar))) to lsRval
72690>>>>>>> loop
72691>>>>>>>>
72691>>>>>>> function_return lsRval
72692>>>>>>> end_function
72693>>>>>>> function sIndexValue returns string
72695>>>>>>> integer liRow liMax liLen liPos liChar
72695>>>>>>> string lsValue lsSegmentValue lsgr
72695>>>>>>> move "" to lsValue
72696>>>>>>> get row_count to liMax
72697>>>>>>> decrement liMax
72698>>>>>>> for liRow from 0 to liMax
72704>>>>>>>>
72704>>>>>>> get psValue.i liRow to lsSegmentValue
72705>>>>>>> if (pbCapsLock.i(self,liRow)) move (uppercase(lsSegmentValue)) to lsSegmentValue
72708>>>>>>> if (pbReverse.i(self,liRow)) get sReverseValue.s lsSegmentValue to lsSegmentValue
72711>>>>>>> move (lsValue+lsSegmentValue) to lsValue
72712>>>>>>> if liRow ne liMax move (lsValue+" ") to lsValue
72715>>>>>>> loop
72716>>>>>>>>
72716>>>>>>> function_return lsValue
72717>>>>>>> end_function
72718>>>>>>> function sSegmentName integer liRow returns string
72720>>>>>>> integer liFile liField lhExprArr liExprRow
72720>>>>>>> string lsRval
72720>>>>>>>
72720>>>>>>> get piFile.i liRow to liFile
72721>>>>>>> if liFile begin
72723>>>>>>> get piField.i liRow to liField
72724>>>>>>> get FieldInf_FieldLabel_Long liFile liField to lsRval
72725>>>>>>> end
72725>>>>>>>>
72725>>>>>>> else begin
72726>>>>>>> get phExprArr to lhExprArr
72727>>>>>>> get piExprRow.i liRow to liExprRow
72728>>>>>>> get psLabel.i of lhExprArr liExprRow to lsRval
72729>>>>>>> end
72729>>>>>>>>
72729>>>>>>> function_return lsRval
72730>>>>>>> end_function
72731>>>>>>> function sIndexNames returns string
72733>>>>>>> integer liRow liMax
72733>>>>>>> string lsRval
72733>>>>>>> move "" to lsRval
72734>>>>>>> get row_count to liMax
72735>>>>>>> decrement liMax
72736>>>>>>> for liRow from 0 to liMax
72742>>>>>>>>
72742>>>>>>> move (lsRval*sSegmentName(self,liRow)) to lsRval
72743>>>>>>> if liRow ne liMax move (lsRval+",") to lsRval
72746>>>>>>> loop
72747>>>>>>>>
72747>>>>>>> function_return lsRval
72748>>>>>>> end_procedure
72749>>>>>>>
72749>>>>>>> procedure SEQ_Read integer liChannel
72751>>>>>>> integer liMax liRow
72751>>>>>>> readln channel liChannel liMax
72753>>>>>>> for liRow from 0 to liMax
72759>>>>>>>>
72759>>>>>>> set piFile.i liRow to (SEQ_ReadLn(liChannel))
72760>>>>>>> set piField.i liRow to (SEQ_ReadLn(liChannel))
72761>>>>>>> set piExprRow.i liRow to (SEQ_ReadLn(liChannel))
72762>>>>>>> set pbCapsLock.i liRow to (SEQ_ReadLn(liChannel))
72763>>>>>>> set pbReverse.i liRow to (SEQ_ReadLn(liChannel))
72764>>>>>>> loop
72765>>>>>>>>
72765>>>>>>> end_procedure
72766>>>>>>>
72766>>>>>>> procedure SEQ_Write integer liChannel
72768>>>>>>> integer liMax liRow
72768>>>>>>> get row_count to liMax
72769>>>>>>> decrement liMax
72770>>>>>>> writeln channel liChannel liMax
72773>>>>>>> for liRow from 0 to liMax
72779>>>>>>>>
72779>>>>>>> writeln (piFile.i(self,liRow))
72781>>>>>>> writeln (piField.i(self,liRow))
72783>>>>>>> writeln (piExprRow.i(self,liRow))
72785>>>>>>> writeln (pbCapsLock.i(self,liRow))
72787>>>>>>> writeln (pbReverse.i(self,liRow))
72789>>>>>>> loop
72790>>>>>>>>
72790>>>>>>> end_procedure
72791>>>>>>> procedure MarkUsedExpressions
72793>>>>>>> integer liRow liMax lhExprArr
72793>>>>>>> get phExprArr to lhExprArr
72794>>>>>>> get row_count to liMax
72795>>>>>>> decrement liMax
72796>>>>>>> for liRow from 0 to liMax
72802>>>>>>>>
72802>>>>>>> ifnot (piFile.i(self,liRow)) send CleanUp_MarkAsUsed to lhExprArr (piExprRow.i(self,liRow))
72805>>>>>>> loop
72806>>>>>>>>
72806>>>>>>> end_procedure
72807>>>>>>>
72807>>>>>>> procedure GetNewExpressionIDs
72809>>>>>>> integer liRow liMax lhExprArr liExprRow
72809>>>>>>> get phExprArr to lhExprArr
72810>>>>>>> get row_count to liMax
72811>>>>>>> decrement liMax
72812>>>>>>> for liRow from 0 to liMax
72818>>>>>>>>
72818>>>>>>> ifnot (piFile.i(self,liRow)) begin
72820>>>>>>> get piExprRow.i liRow to liExprRow
72821>>>>>>> get pbCleanupNewRow.i of lhExprArr liExprRow to liExprRow
72822>>>>>>> set piExprRow.i liRow to liExprRow
72823>>>>>>> end
72823>>>>>>>>
72823>>>>>>> loop
72824>>>>>>>>
72824>>>>>>> end_procedure
72825>>>>>>>end_class // cQueryOrderExpression
72826>>>>>>>
72826>>>>>>>
72826>>>>>>>use aps
72826>>>>>>>class cFieldInf.IndexBreakList is a aps.list
72827>>>>>>> procedure construct_object integer liImage
72829>>>>>>> forward send construct_object liImage
72831>>>>>>> property integer pbDisplayFileNamesUser public DFTRUE
72832>>>>>>> send GridPrepare_AddColumn t.QryOrder.Break AFT_ASCII4
72833>>>>>>> send GridPrepare_AddColumn t.QryOrder.Segment AFT_ASCII25
72834>>>>>>> send GridPrepare_Apply self
72835>>>>>>> set select_mode to NO_SELECT
72836>>>>>>> on_key KNEXT_ITEM send switch
72837>>>>>>> on_key KPREVIOUS_ITEM send switch_back
72838>>>>>>> property integer phServer public 0 // of class cQueryOrderExpression
72839>>>>>>> set select_mode to MULTI_SELECT
72840>>>>>>> end_procedure
72841>>>>>>>
72841>>>>>>> procedure select_toggling integer liItem integer i#
72843>>>>>>> integer liColumn
72843>>>>>>> get Grid_ItemColumn self liItem to liColumn
72844>>>>>>> if (liColumn=0) forward send select_toggling liItem i#
72848>>>>>>> end_procedure
72849>>>>>>>
72849>>>>>>> procedure fill_list.iii integer liFile integer liIndex integer lhOrderExpression
72851>>>>>>> integer liMax liSegment liField liBase lhObj liRow
72851>>>>>>> set dynamic_update_state to DFFALSE
72852>>>>>>> send delete_data
72853>>>>>>> if liFile begin
72855>>>>>>> if (liIndex<256) begin // Normal index
72857>>>>>>> get FDX_AttrValue_INDEX 0 DF_INDEX_NUMBER_SEGMENTS liFile liIndex to liMax
72858>>>>>>> if liMax begin
72860>>>>>>> for liSegment from 1 to (liMax-1) // Exclude the least significant segment
72866>>>>>>>>
72866>>>>>>> get FDX_AttrValue_IDXSEG 0 DF_INDEX_SEGMENT_FIELD liFile liIndex liSegment to liField
72867>>>>>>> get item_count to liBase
72868>>>>>>> send add_item MSG_NONE ""
72869>>>>>>> set aux_value item liBase to (liFile*65536+liField)
72870>>>>>>> set checkbox_item_state item liBase to DFTRUE
72871>>>>>>> send add_item MSG_NONE (FieldInf_FieldLabel_Long(liFile,liField)+": ")
72872>>>>>>> set entry_state item (liBase+1) to DFTRUE
72873>>>>>>> loop
72874>>>>>>>>
72874>>>>>>> end
72874>>>>>>>>
72874>>>>>>> end
72874>>>>>>>>
72874>>>>>>> else begin
72875>>>>>>> if (liIndex=1023) begin // Ad hoc
72877>>>>>>> move lhOrderExpression to lhObj
72878>>>>>>> get row_count of lhObj to liMax
72879>>>>>>> for liSegment from 0 to (liMax-1) // Exclude the least significant segment
72885>>>>>>>>
72885>>>>>>> get piFile.i of lhObj liSegment to liFile
72886>>>>>>> get piField.i of lhObj liSegment to liField
72887>>>>>>> get item_count to liBase
72888>>>>>>> send add_item MSG_NONE ""
72889>>>>>>> set aux_value item liBase to (liFile*65536+liField)
72890>>>>>>> set checkbox_item_state item liBase to DFTRUE
72891>>>>>>> send add_item MSG_NONE (sSegmentName(lhObj,liSegment)+": ")
72892>>>>>>> set aux_value item (liBase+1) to (piExprRow.i(lhObj,liSegment))
72893>>>>>>> set entry_state item (liBase+1) to DFTRUE
72894>>>>>>> loop
72895>>>>>>>>
72895>>>>>>> end
72895>>>>>>>>
72895>>>>>>> else begin // Virtual Index
72896>>>>>>> move (liIndex-256) to liIndex
72897>>>>>>> get FieldInf_VirtualIndex_Object liFile liIndex to lhObj
72898>>>>>>> if lhObj begin
72900>>>>>>> get row_count of lhObj to liMax
72901>>>>>>> for liSegment from 0 to (liMax-2) // Exclude the least significant segment
72907>>>>>>>>
72907>>>>>>> get piField.i of lhObj liSegment to liField
72908>>>>>>> get item_count to liBase
72909>>>>>>> send add_item MSG_NONE ""
72910>>>>>>> set aux_value item liBase to (liFile*65536+liField)
72911>>>>>>> set checkbox_item_state item liBase to DFTRUE
72912>>>>>>> send add_item MSG_NONE (sSegmentName(lhObj,liSegment)+": ")
72913>>>>>>> set entry_state item (liBase+1) to DFTRUE
72914>>>>>>> loop
72915>>>>>>>>
72915>>>>>>> end
72915>>>>>>>>
72915>>>>>>> end
72915>>>>>>>>
72915>>>>>>> end
72915>>>>>>>>
72915>>>>>>> end
72915>>>>>>>>
72915>>>>>>> set dynamic_update_state to DFTRUE
72916>>>>>>> end_procedure
72917>>>>>>>
72917>>>>>>>end_class // cFieldInf.IndexBreak_List
72918>>>>>>>
72918>>>>>>>Use Buttons.utl // Button texts
72918>>>>>>>Use GridUtil.utl
72918>>>>>>>
72918>>>>>>>use APS // Auto Positioning and Sizing classes for VDF
72918>>>>>>>class cQueryOrderingGrid is a aps.Grid
72919>>>>>>> procedure construct_object integer liImage
72921>>>>>>> forward send construct_object liImage
72923>>>>>>> send GridPrepare_AddColumn "#" AFT_ASCII2
72924>>>>>>> send GridPrepare_AddColumn t.QryOrder.Fields AFT_ASCII20
72925>>>>>>> send GridPrepare_AddColumn t.QryOrder.Caps AFT_ASCII3
72926>>>>>>> send GridPrepare_AddColumn t.QryOrder.Reverse AFT_ASCII3
72927>>>>>>> send GridPrepare_Apply self
72928>>>>>>> on_key KNEXT_ITEM send switch
72929>>>>>>> on_key KPREVIOUS_ITEM send switch_back
72930>>>>>>> property integer phServer public 0 // of class cQueryOrderExpression
72931>>>>>>> set select_mode to MULTI_SELECT
72932>>>>>>> on_key key_ctrl+key_up_arrow send MoveRowUp
72933>>>>>>> on_key key_ctrl+key_down_arrow send MoveRowDown
72934>>>>>>> on_key kDelete_Record send DeleteRow
72935>>>>>>> end_procedure
72936>>>>>>> procedure select_toggling integer liItem integer i#
72938>>>>>>> integer liColumn
72938>>>>>>> get Grid_ItemColumn self liItem to liColumn
72939>>>>>>> if (liColumn=2 or liColumn=3) forward send select_toggling liItem i#
72943>>>>>>> end_procedure
72944>>>>>>> procedure fill_list
72946>>>>>>> integer lhServer liRow liMax liBase
72946>>>>>>> get phServer to lhServer
72947>>>>>>> set dynamic_update_state to DFFALSE
72948>>>>>>> send delete_data
72949>>>>>>> get row_count of lhServer to liMax
72950>>>>>>> decrement liMax
72951>>>>>>> for liRow from 0 to liMax
72957>>>>>>>>
72957>>>>>>> get item_count to liBase
72958>>>>>>> send add_item MSG_NONE (liRow+1)
72959>>>>>>> send add_item MSG_NONE (sSegmentName(lhServer,liRow))
72960>>>>>>> send add_item MSG_NONE ""
72961>>>>>>> set checkbox_item_state item (liBase+2) to DFTRUE
72962>>>>>>> set select_state item (liBase+2) to (pbCapsLock.i(lhServer,liRow))
72963>>>>>>> send add_item MSG_NONE ""
72964>>>>>>> set checkbox_item_state item (liBase+3) to DFTRUE
72965>>>>>>> set select_state item (liBase+3) to (pbReverse.i(lhServer,liRow))
72966>>>>>>> loop
72967>>>>>>>>
72967>>>>>>> send Grid_SetEntryState self DFFALSE
72968>>>>>>> set dynamic_update_state to DFTRUE
72969>>>>>>> end_procedure
72970>>>>>>> procedure RowFromGridToArray integer liRow integer liBase
72972>>>>>>> integer lhServer
72972>>>>>>> get phServer to lhServer
72973>>>>>>> set pbCapsLock.i of lhServer liRow to (select_state(self,liBase+2))
72974>>>>>>> set pbReverse.i of lhServer liRow to (select_state(self,liBase+3))
72975>>>>>>> end_procedure
72976>>>>>>> procedure DoAddField integer liFile integer liField
72978>>>>>>> integer liRow
72978>>>>>>> get Grid_CurrentRow self to liRow
72979>>>>>>> send MoveGridToArray
72980>>>>>>> send Add_Field to (phServer(self)) liFile liField
72981>>>>>>> send fill_list
72982>>>>>>> set Grid_CurrentRow self to liRow
72983>>>>>>> end_procedure
72984>>>>>>> procedure MoveGridToArray
72986>>>>>>> integer liMax liRow lhServer liBase
72986>>>>>>> get phServer to lhServer
72987>>>>>>> get row_count of lhServer to liMax
72988>>>>>>> decrement liMax
72989>>>>>>> for liRow from 0 to liMax
72995>>>>>>>>
72995>>>>>>> get Grid_RowBaseItem self liRow to liBase
72996>>>>>>> send RowFromGridToArray liRow liBase
72997>>>>>>> loop
72998>>>>>>>>
72998>>>>>>> end_procedure
72999>>>>>>> procedure DeleteRow
73001>>>>>>> integer liRow lhServer liMax
73001>>>>>>> get phServer to lhServer
73002>>>>>>> if (item_count(self)) begin
73004>>>>>>> get Grid_CurrentRow self to liRow
73005>>>>>>> send MoveGridToArray
73006>>>>>>> send delete_row to lhServer liRow
73007>>>>>>> send fill_list
73008>>>>>>> get row_count of lhServer to liMax
73009>>>>>>> if liMax begin
73011>>>>>>> if (liRow<liMax) set Grid_CurrentRow self to liRow
73014>>>>>>> else set Grid_CurrentRow self to (liRow-1)
73016>>>>>>> end
73016>>>>>>>>
73016>>>>>>> end
73016>>>>>>>>
73016>>>>>>> end_procedure
73017>>>>>>> procedure MoveRowUp
73019>>>>>>> integer liRow lhServer
73019>>>>>>> get phServer to lhServer
73020>>>>>>> if (item_count(self)) begin
73022>>>>>>> get Grid_CurrentRow self to liRow
73023>>>>>>> if (liRow>0) begin
73025>>>>>>> send MoveGridToArray
73026>>>>>>> send swap_rows to lhServer liRow (liRow-1)
73027>>>>>>> send fill_list
73028>>>>>>> set Grid_CurrentRow self to (liRow-1)
73029>>>>>>> end
73029>>>>>>>>
73029>>>>>>> end
73029>>>>>>>>
73029>>>>>>> end_procedure
73030>>>>>>>
73030>>>>>>> procedure MoveRowDown
73032>>>>>>> integer liRow lhServer
73032>>>>>>> get phServer to lhServer
73033>>>>>>> if (item_count(self)) begin
73035>>>>>>> get Grid_CurrentRow self to liRow
73036>>>>>>> if (liRow<(row_count(lhServer)-1)) begin
73038>>>>>>> send MoveGridToArray
73039>>>>>>> send swap_rows to lhServer liRow (liRow+1)
73040>>>>>>> send fill_list
73041>>>>>>> set Grid_CurrentRow self to (liRow+1)
73042>>>>>>> end
73042>>>>>>>>
73042>>>>>>> end
73042>>>>>>>>
73042>>>>>>> end_procedure
73043>>>>>>>end_class // cQueryOrderingGrid
73044>>>>>>>
73044>>>>>>>
73044>>>>>>>use aps
73044>>>>>>>class cFieldInf.IndexSelectList is a aps.list
73045>>>>>>> procedure construct_object integer liImage
73047>>>>>>> forward send construct_object liImage
73049>>>>>>> set highlight_row_state to DFTRUE
73050>>>>>>> property integer piFile public 0
73051>>>>>>> end_procedure
73052>>>>>>> procedure AddIndex integer liFile integer liIndex string lsIndexDef integer liType
73054>>>>>>> send add_item MSG_NONE (string(liIndex)+": "+FDX_IndexAsFieldNames(0,liFile,liIndex,0))
73055>>>>>>> set aux_value item (item_count(self)-1) to liIndex
73056>>>>>>> end_procedure
73057>>>>>>> procedure AddBatchIndex integer liFile integer liIndex string lsIndexDef integer liType
73059>>>>>>> send add_item MSG_NONE (string(liIndex)+": "+FDX_IndexAsFieldNames(0,liFile,liIndex,0))
73060>>>>>>> set aux_value item (item_count(self)-1) to liIndex
73061>>>>>>> end_procedure
73062>>>>>>> procedure SetSelectedIndex integer liIndex
73064>>>>>>> integer liMax liItem
73064>>>>>>> get item_count to liMax
73065>>>>>>> decrement liMax
73066>>>>>>> for liItem from 0 to liMax
73072>>>>>>>>
73072>>>>>>> if (liIndex=aux_value(self,liItem)) set current_item to liItem
73075>>>>>>> loop
73076>>>>>>>>
73076>>>>>>> end_procedure
73077>>>>>>> procedure fill_list.iii integer liFile integer liIndex integer lbGenericIndicesOnly
73079>>>>>>> integer lhObj liMax
73079>>>>>>> set dynamic_update_state to DFFALSE
73080>>>>>>> send delete_data
73081>>>>>>> set piFile to liFile
73082>>>>>>> if liFile begin
73084>>>>>>> send add_item MSG_NONE "0: Recnum"
73085>>>>>>> send FDX_IndexCallback 0 liFile DF_INDEX_TYPE_ONLINE MSG_AddIndex self
73086>>>>>>> send FDX_IndexCallback 0 liFile DF_INDEX_TYPE_BATCH MSG_AddBatchIndex self
73087>>>>>>> ifnot lbGenericIndicesOnly begin
73089>>>>>>> send add_item MSG_NONE "Ad hoc"
73090>>>>>>> set aux_value item (item_count(self)-1) to 1023
73091>>>>>>>
73091>>>>>>> get FieldInf_VirtualIndices_Object liFile to lhObj
73092>>>>>>> if lhObj begin
73094>>>>>>> get row_count of lhObj to liMax
73095>>>>>>> decrement liMax
73096>>>>>>> for liIndex from 0 to liMax
73102>>>>>>>>
73102>>>>>>> send add_item MSG_NONE (psIndexName.i(lhObj,liIndex))
73103>>>>>>> set aux_value item (item_count(self)-1) to (liIndex+256)
73104>>>>>>> loop
73105>>>>>>>>
73105>>>>>>> end
73105>>>>>>>>
73105>>>>>>>
73105>>>>>>> end
73105>>>>>>>>
73105>>>>>>> send SetSelectedIndex liIndex
73106>>>>>>> end
73106>>>>>>>>
73106>>>>>>> set dynamic_update_state to DFTRUE
73107>>>>>>> end_procedure
73108>>>>>>>end_class // cFieldInf.IndexSelectList
73109>>>>>>>
73109>>>>>>>///////////////////////////////////////////////////////////////////////////
73109>>>>>>>
73109>>>>>>>
73109>>>>>>>Use QryFldSl.pkg // cFieldInf.Table_List and cFieldInf.Field_List classes
Including file: qryfldsl.pkg (C:\Apps\VDFQuery\AppSrc\qryfldsl.pkg)
73109>>>>>>>>>// Use QryFldSl.pkg // cFieldInf.Table_List and cFieldInf.Field_List classes
73109>>>>>>>>>
73109>>>>>>>>>Use FieldInf // Global field info objects and abstract field types
73109>>>>>>>>>Use Fdx2.utl // FDX aware object for displaying a table definition
73109>>>>>>>>>
73109>>>>>>>>>use aps
73109>>>>>>>>>class cFieldInf.Table_List is a aps.List
73110>>>>>>>>> procedure construct_object integer liImage
73112>>>>>>>>> forward send construct_object liImage
73114>>>>>>>>> property integer pbDisplayFileNamesUser public DFTRUE
73115>>>>>>>>> on_key KEY_CTRL+KEY_D send DisplayDefinition
73116>>>>>>>>> on_key kuser send toggle_display
73117>>>>>>>>> on_key kenter send Next
73118>>>>>>>>> on_key KSWITCH send switch
73119>>>>>>>>> on_key KSWITCH_BACK send switch_back
73120>>>>>>>>> object oSet is a set NO_IMAGE
73122>>>>>>>>> end_object
73123>>>>>>>>> end_procedure
73124>>>>>>>>>
73124>>>>>>>>> procedure GoToFile integer liFile
73126>>>>>>>>> integer liMax liItm
73126>>>>>>>>> get item_count to liMax
73127>>>>>>>>> decrement liMax
73128>>>>>>>>> for liItm from 0 to liMax
73134>>>>>>>>>>
73134>>>>>>>>> if (aux_value(self,liItm)=liFile) set current_item to liItm
73137>>>>>>>>> loop
73138>>>>>>>>>>
73138>>>>>>>>> end_procedure
73139>>>>>>>>> procedure DisplayDefinition
73141>>>>>>>>> integer liFile
73141>>>>>>>>> if (item_count(self)) begin
73143>>>>>>>>> get aux_value item CURRENT to liFile
73144>>>>>>>>> send FDX_ModalDisplayFileAttributes 0 liFile
73145>>>>>>>>> end
73145>>>>>>>>>>
73145>>>>>>>>> end_procedure
73146>>>>>>>>> procedure toggle_display
73148>>>>>>>>> set pbDisplayFileNamesUser to (not(pbDisplayFileNamesUser(self)))
73149>>>>>>>>> send InsertFileNames
73150>>>>>>>>> end_procedure
73151>>>>>>>>> procedure InsertFileNames
73153>>>>>>>>> integer liType
73153>>>>>>>>> integer liItem liMax liFile
73153>>>>>>>>> string lsValue
73153>>>>>>>>> get pbDisplayFileNamesUser to liType
73154>>>>>>>>> get item_count to liMax
73155>>>>>>>>> for liItem from 0 to (liMax-1)
73161>>>>>>>>>>
73161>>>>>>>>> get aux_value item liItem to liFile
73162>>>>>>>>> if liType get File_Display_Name liFile to lsValue
73165>>>>>>>>> else get_attribute DF_FILE_LOGICAL_NAME of liFile to lsValue
73169>>>>>>>>> set value item liItem to lsValue
73170>>>>>>>>> loop
73171>>>>>>>>>>
73171>>>>>>>>> set dynamic_update_state to DFTRUE
73172>>>>>>>>> end_procedure
73173>>>>>>>>> procedure FileNamesLogical
73175>>>>>>>>> set pbDisplayFileNamesUser to DFFALSE
73176>>>>>>>>> send InsertFileNames
73177>>>>>>>>> end_procedure
73178>>>>>>>>> procedure FileNamesUser
73180>>>>>>>>> set pbDisplayFileNamesUser to DFTRUE
73181>>>>>>>>> send InsertFileNames
73182>>>>>>>>> end_procedure
73183>>>>>>>>>
73183>>>>>>>>> function bIncludeFile integer liFile returns integer
73185>>>>>>>>> // function_return (DfQuery_ExcludeFile(liFile)<>DFQ_ALWAYS)
73185>>>>>>>>> function_return DFTRUE
73186>>>>>>>>> end_function
73187>>>>>>>>>
73187>>>>>>>>> procedure add_file integer liFile
73189>>>>>>>>> integer liField liMax liRelFile
73189>>>>>>>>>
73189>>>>>>>>> if (DBMS_OpenFile(liFile,DF_SHARE,0)) begin
73191>>>>>>>>> get_attribute DF_FILE_NUMBER_FIELDS of liFile to liMax
73194>>>>>>>>>
73194>>>>>>>>> if (find_element(oSet(self),liFile)=-1) begin
73196>>>>>>>>> send add_element to (oSet(self)) liFile
73197>>>>>>>>> send add_item msg_none ""
73198>>>>>>>>> set aux_value item (item_count(self)-1) to liFile
73199>>>>>>>>>
73199>>>>>>>>> for liField from 1 to liMax
73205>>>>>>>>>>
73205>>>>>>>>> get_attribute DF_FIELD_RELATED_FILE of liFile liField to liRelFile
73208>>>>>>>>> if (liRelFile and bIncludeFile(self,liFile)) send add_file liRelFile
73211>>>>>>>>> loop
73212>>>>>>>>>>
73212>>>>>>>>> end
73212>>>>>>>>>>
73212>>>>>>>>> end
73212>>>>>>>>>>
73212>>>>>>>>> else error 200 ("Related file could not be opened (entry: "+string(liFile)+")")
73214>>>>>>>>> end_procedure
73215>>>>>>>>>
73215>>>>>>>>> procedure fill_list.i integer liFile
73217>>>>>>>>> send delete_data
73218>>>>>>>>> send delete_data to (oSet(self))
73219>>>>>>>>>
73219>>>>>>>>> if liFile send add_file liFile
73222>>>>>>>>> send InsertFileNames
73223>>>>>>>>> send OnNewFile liFile
73224>>>>>>>>> end_procedure
73225>>>>>>>>>
73225>>>>>>>>> procedure OnNewFile integer liFile
73227>>>>>>>>> //send notify_filechange liFile
73227>>>>>>>>> end_procedure
73228>>>>>>>>>
73228>>>>>>>>> procedure OnChange
73230>>>>>>>>> integer liFile
73230>>>>>>>>> if (item_count(self)) begin
73232>>>>>>>>> get aux_value item (current_item(self)) to liFile
73233>>>>>>>>> send OnNewFile liFile
73234>>>>>>>>> end
73234>>>>>>>>>>
73234>>>>>>>>> end_procedure
73235>>>>>>>>> function iCurrentFile returns integer
73237>>>>>>>>> function_return (aux_value(self,current_item(self)))
73238>>>>>>>>> end_function
73239>>>>>>>>>end_class // cFieldInf.Table_List
73240>>>>>>>>>
73240>>>>>>>>>class cFieldInf.Field_List is a aps.list
73241>>>>>>>>> procedure construct_object integer liImage
73243>>>>>>>>> forward send construct_object liImage
73245>>>>>>>>> property integer pbDisplayFieldNamesUser public DFTRUE
73246>>>>>>>>> property integer piFile public 0
73247>>>>>>>>> property integer priv.pbDisplayOverlaps public DFFALSE
73248>>>>>>>>> on_key kuser send toggle_display
73249>>>>>>>>> on_key KEY_CTRL+KEY_D send DisplayDefinition
73250>>>>>>>>> on_key KSWITCH send switch
73251>>>>>>>>> on_key KSWITCH_BACK send switch_back
73252>>>>>>>>> on_key KEY_CTRL+KEY_O send ToggleDisplayOverlaps
73253>>>>>>>>> end_procedure
73254>>>>>>>>> procedure GoToField integer liField
73256>>>>>>>>> integer liMax liItm
73256>>>>>>>>> get item_count to liMax
73257>>>>>>>>> decrement liMax
73258>>>>>>>>> for liItm from 0 to liMax
73264>>>>>>>>>>
73264>>>>>>>>> if (aux_value(self,liItm)=liField) set current_item to liItm
73267>>>>>>>>> loop
73268>>>>>>>>>>
73268>>>>>>>>> end_procedure
73269>>>>>>>>> procedure ToggleDisplayOverlaps
73271>>>>>>>>> set priv.pbDisplayOverlaps to (not(priv.pbDisplayOverlaps(self)))
73272>>>>>>>>> send fill_list.i (piFile(self))
73273>>>>>>>>> end_procedure
73274>>>>>>>>> procedure DisplayDefinition
73276>>>>>>>>> if (item_count(self)) send FDX_ModalDisplayFileAttributes 0 (piFile(self))
73279>>>>>>>>> end_procedure
73280>>>>>>>>> procedure toggle_display
73282>>>>>>>>> set pbDisplayFieldNamesUser to (not(pbDisplayFieldNamesUser(self)))
73283>>>>>>>>> send InsertFieldNames
73284>>>>>>>>> end_procedure
73285>>>>>>>>>
73285>>>>>>>>> procedure InsertFieldNames
73287>>>>>>>>> integer liType
73287>>>>>>>>> integer liItem liMax fld# liFile
73287>>>>>>>>> string lsValue
73287>>>>>>>>> get piFile to liFile
73288>>>>>>>>> get pbDisplayFieldNamesUser to liType
73289>>>>>>>>> get item_count to liMax
73290>>>>>>>>> for liItem from 0 to (liMax-1)
73296>>>>>>>>>>
73296>>>>>>>>> get aux_value item liItem to fld#
73297>>>>>>>>> if fld# lt 256 begin
73299>>>>>>>>> if liType get FieldInf_FieldLabel_Long liFile fld# to lsValue
73302>>>>>>>>> else get_attribute DF_FIELD_NAME of liFile fld# to lsValue
73306>>>>>>>>> set value item liItem to lsValue
73307>>>>>>>>> end
73307>>>>>>>>>>
73307>>>>>>>>> loop
73308>>>>>>>>>>
73308>>>>>>>>> set dynamic_update_state to true
73309>>>>>>>>> end_procedure
73310>>>>>>>>>
73310>>>>>>>>> procedure FieldNamesLogical
73312>>>>>>>>> set pbDisplayFieldNamesUser to DFFALSE
73313>>>>>>>>> send InsertFieldNames
73314>>>>>>>>> end_procedure
73315>>>>>>>>> procedure FieldNamesUser
73317>>>>>>>>> set pbDisplayFieldNamesUser to DFTRUE
73318>>>>>>>>> send InsertFieldNames
73319>>>>>>>>> end_procedure
73320>>>>>>>>>
73320>>>>>>>>> procedure OnFieldSelect
73322>>>>>>>>> // Send do_add_field
73322>>>>>>>>> end_procedure
73323>>>>>>>>>
73323>>>>>>>>> procedure mouse_click integer i1 integer i2
73325>>>>>>>>> send OnFieldSelect
73326>>>>>>>>> end_procedure
73327>>>>>>>>>
73327>>>>>>>>> procedure load_virtual_fields integer liFile
73329>>>>>>>>> integer lhObj liField liMax
73329>>>>>>>>> get FieldInf_VirtualFields_Object liFile to lhObj
73330>>>>>>>>> if lhObj begin
73332>>>>>>>>> get row_count of lhObj to liMax
73333>>>>>>>>> decrement liMax
73334>>>>>>>>> for liField from 0 to liMax
73340>>>>>>>>>>
73340>>>>>>>>> if (piFieldActive.i(lhObj,liField)) begin
73342>>>>>>>>> send add_item MSG_OnFieldSelect (psFieldLabel.i(lhObj,liField))
73343>>>>>>>>> set aux_value item (item_count(self)-1) to (liField+256)
73344>>>>>>>>> end
73344>>>>>>>>>>
73344>>>>>>>>> loop
73345>>>>>>>>>>
73345>>>>>>>>> end
73345>>>>>>>>>>
73345>>>>>>>>> end_procedure
73346>>>>>>>>>
73346>>>>>>>>> function bIncludeField integer liFile integer liField returns integer
73348>>>>>>>>> // function_return (not(DfQuery_ExcludeField(liFile,liField)))
73348>>>>>>>>> function_return DFTRUE
73349>>>>>>>>> end_function
73350>>>>>>>>>
73350>>>>>>>>> procedure fill_list.i integer liFile
73352>>>>>>>>> integer liField liMax liType
73352>>>>>>>>> string lsValue
73352>>>>>>>>> send delete_data
73353>>>>>>>>> set piFile to liFile
73354>>>>>>>>>
73354>>>>>>>>> if liFile begin
73356>>>>>>>>> get_attribute DF_FILE_NUMBER_FIELDS of liFile to liMax
73359>>>>>>>>>
73359>>>>>>>>> for liField from 0 to liMax
73365>>>>>>>>>>
73365>>>>>>>>> get_attribute DF_FIELD_NAME of liFile liField to lsValue
73368>>>>>>>>> move (FieldInf_FieldType(liFile,liField)) to liType
73369>>>>>>>>> if ((priv.pbDisplayOverlaps(self) or liType<>DF_OVERLAP) and liType<>DF_BINARY) begin
73371>>>>>>>>> ifnot (StringBeginsWith(lsValue,"@")) begin
73373>>>>>>>>> if (bIncludeField(self,liFile,liField)) begin
73375>>>>>>>>> send add_item MSG_OnFieldSelect ""
73376>>>>>>>>> set aux_value item (item_count(self)-1) to liField
73377>>>>>>>>> end
73377>>>>>>>>>>
73377>>>>>>>>> end
73377>>>>>>>>>>
73377>>>>>>>>> end
73377>>>>>>>>>>
73377>>>>>>>>> loop
73378>>>>>>>>>>
73378>>>>>>>>> send InsertFieldNames
73379>>>>>>>>> send load_virtual_fields liFile
73380>>>>>>>>> end
73380>>>>>>>>>>
73380>>>>>>>>> end_procedure
73381>>>>>>>>> function iCurrentField returns integer
73383>>>>>>>>> function_return (aux_value(self,current_item(self)))
73384>>>>>>>>> end_function
73385>>>>>>>>>end_class // cFieldInf.Field_List
73386>>>>>>>>>
73386>>>>>>>
73386>>>>>>>object oQueryDefineAdhocIndexPn is a aps.ModalPanel label t.QryOrder.Specify
73389>>>>>>> set locate_mode to CENTER_ON_SCREEN
73390>>>>>>> on_key ksave_record send close_panel_ok
73391>>>>>>> on_key kcancel send close_panel
73392>>>>>>>
73392>>>>>>> object oQueryOrderExpression is a cQueryOrderExpression
73394>>>>>>> end_object
73395>>>>>>>
73395>>>>>>> property integer piResult public DFFALSE
73397>>>>>>> object oDBMS_Files is a cFieldInf.Table_List label t.DfQuery.DBMSfiles
73400>>>>>>> set size to 60 150
73401>>>>>>> set label_justification_mode to JMODE_TOP
73402>>>>>>> on_key kenter send next
73403>>>>>>> function bIncludeFile integer liFile returns integer
73406>>>>>>> function_return (DfQuery_ExcludeFile(liFile)<>DFQ_ALWAYS)
73407>>>>>>> end_function
73408>>>>>>> procedure OnNewFile integer liFile
73411>>>>>>> send notify_filechange liFile
73412>>>>>>> end_procedure
73413>>>>>>> end_object // oDBMS_Files
73414>>>>>>>
73414>>>>>>> send aps_goto_max_row
73415>>>>>>> send make_row_space
73416>>>>>>>
73416>>>>>>> object oDBMS_Fields is a cFieldInf.Field_List
73418>>>>>>> set size to 72 150
73419>>>>>>> on_key kswitch send switch
73420>>>>>>> on_key kswitch_back send switch_back
73421>>>>>>> on_key kEnter Send do_add_field
73422>>>>>>> procedure OnFieldSelect
73425>>>>>>> Send do_add_field
73426>>>>>>> end_procedure
73427>>>>>>> function bIncludeField integer liFile integer liField returns integer
73430>>>>>>> function_return (not(DfQuery_ExcludeField(liFile,liField)))
73431>>>>>>> end_function
73432>>>>>>> end_object // oDBMS_Files
73433>>>>>>>
73433>>>>>>> set label of (oDBMS_Fields(self)) to t.DfQuery.DBMSfields
73434>>>>>>> set label_justification_mode of (oDBMS_Fields(self)) to JMODE_TOP
73435>>>>>>> set label_offset of (oDBMS_Fields(self)) to 0 0
73436>>>>>>>
73436>>>>>>> procedure notify_filechange integer file#
73439>>>>>>> send fill_list.i to (oDBMS_Fields(self)) file#
73440>>>>>>> end_procedure
73441>>>>>>>
73441>>>>>>> object oLst is a cQueryOrderingGrid snap SL_RIGHT relative_to (oDBMS_Files(self))
73449>>>>>>> set size to 137 0
73450>>>>>>> end_object
73451>>>>>>>
73451>>>>>>> procedure do_add_field
73454>>>>>>> integer liFile liField
73454>>>>>>> get iCurrentFile of (oDBMS_Files(self)) to liFile
73455>>>>>>> get iCurrentField of (oDBMS_Fields(self)) to liField
73456>>>>>>> send DoAddField to (oLst(self)) liFile liField
73457>>>>>>> end_procedure
73458>>>>>>>
73458>>>>>>> object oBtn11 is a aps.Multi_Button
73460>>>>>>> set size to 14 50
73461>>>>>>> on_item t.btn.move_up send MoveRowUp to (oLst(self))
73462>>>>>>> end_object
73463>>>>>>> object oBtn12 is a aps.Multi_Button
73465>>>>>>> set size to 14 50
73466>>>>>>> on_item t.btn.move_down send MoveRowDown to (oLst(self))
73467>>>>>>> end_object
73468>>>>>>> object oBtn13 is a aps.Multi_Button
73470>>>>>>> set size to 14 50
73471>>>>>>> on_item t.btn.delete send DeleteRow to (oLst(self))
73472>>>>>>> end_object
73473>>>>>>> send aps_locate_multi_buttons
73474>>>>>>> send aps_goto_max_row
73475>>>>>>> object oLine is a aps.LineControl
73477>>>>>>> end_object
73478>>>>>>>
73478>>>>>>> object oBtn1 is a aps.Multi_Button
73480>>>>>>> on_item t.btn.ok send close_panel_ok
73481>>>>>>> end_object
73482>>>>>>> object oBtn2 is a aps.Multi_Button
73484>>>>>>> on_item t.btn.cancel send close_panel
73485>>>>>>> end_object
73486>>>>>>>
73486>>>>>>> send aps_locate_multi_buttons
73487>>>>>>> procedure close_panel_ok
73490>>>>>>> send MoveGridToArray to (oLst(self))
73491>>>>>>> set piResult to DFTRUE
73492>>>>>>> send close_panel
73493>>>>>>> end_procedure
73494>>>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
73495>>>>>>> procedure aps_onResize integer delta_rw# integer delta_cl#
73498>>>>>>> integer lhFields
73498>>>>>>>// send aps_resize (oDBMS_Fields(self)) delta_rw# 0
73498>>>>>>> send aps_resize (oLst(self)) delta_rw# 0
73499>>>>>>> send aps_align_by_sizing (oDBMS_Fields(self)) (oLst(self)) SL_ALIGN_BOTTOM
73500>>>>>>> send aps_register_multi_button (oBtn11(self))
73501>>>>>>> send aps_register_multi_button (oBtn12(self))
73502>>>>>>> send aps_register_multi_button (oBtn13(self))
73503>>>>>>> send aps_locate_multi_buttons
73504>>>>>>> send aps_relocate (oLine(self)) delta_rw# 0
73505>>>>>>> send aps_register_multi_button (oBtn1(self))
73506>>>>>>> send aps_register_multi_button (oBtn2(self))
73507>>>>>>> send aps_locate_multi_buttons
73508>>>>>>> send aps_auto_size_container
73509>>>>>>> end_procedure
73510>>>>>>> procedure aps_beautify
73513>>>>>>> send aps_align_inside_container_by_sizing (oLine(self)) SL_ALIGN_RIGHT
73514>>>>>>> end_procedure
73515>>>>>>> function iPopup.ii integer liFile integer lhQueryOrderExpression returns integer
73518>>>>>>> integer lhExpr
73518>>>>>>> move (oQueryOrderExpression(self)) to lhExpr
73519>>>>>>> send DoCopyFromOtherObject to lhExpr lhQueryOrderExpression
73520>>>>>>> set piResult to DFFALSE
73521>>>>>>> send fill_list.i to (oDBMS_Files(self)) liFile
73522>>>>>>> set phServer of (oLst(self)) to lhQueryOrderExpression
73523>>>>>>> send fill_list to (oLst(self))
73524>>>>>>> forward send popup
73526>>>>>>> ifnot (piResult(self)) send DoCopyFromOtherObject to lhQueryOrderExpression lhExpr
73529>>>>>>> function_return (piResult(self))
73530>>>>>>> end_function
73531>>>>>>>end_object // oQueryDefineAdhocIndexPn
73532>>>>>Use MouseMov.utl // Procedure Mouse_MoveToObject
Including file: mousemov.utl (C:\Apps\VDFQuery\AppSrc\mousemov.utl)
73532>>>>>>>// Use MouseMov.utl // Procedure Mouse_MoveToObject
73532>>>>>>>
73532>>>>>>>procedure Mouse_MoveToObject global integer lhObject
73534>>>>>>> integer liLoc liCol liRow liSzCol liSzRow
73534>>>>>>>
73534>>>>>>> Get Absolute_GUIOrigin of lhObject to liLoc //
73535>>>>>>> move (Hi(liLoc)) to liRow // row
73536>>>>>>> move (Low(liLoc)) to liCol // col
73537>>>>>>>
73537>>>>>>> // I found this correction somewhere in DAW classes, so I have replicated
73537>>>>>>> // it here:
73537>>>>>>> if (liCol>32767) move (liCol-65536) to liCol
73540>>>>>>> if (liRow>32767) move (liRow-65536) to liRow
73543>>>>>>>
73543>>>>>>> get GUISize of lhObject to liLoc
73544>>>>>>> move (Hi(liLoc)/2) to liSzRow // Strange, Hi/Low is opposite of
73545>>>>>>> move (Low(liLoc)/2) to liSzCol // Absolute_GUIOrigin
73546>>>>>>>
73546>>>>>>> // Set absolute_mouse_location takes horizontal before vertial.
73546>>>>>>> // On a 1024x768 monitor 512,384 will place the mouse in the
73546>>>>>>> // exact center (well, as close as possible since the monitor
73546>>>>>>> // ranges are dividable by two).
73546>>>>>>> set absolute_mouse_location to (liSzCol+liCol) (liSzRow+liRow)
73547>>>>>>>
73547>>>>>>>//// Alternative: (doesn't work)
73547>>>>>>>//
73547>>>>>>>//integer xyButton
73547>>>>>>>//handle hWnd iVoid
73547>>>>>>>//string sPoint xScreen yScreen
73547>>>>>>>//
73547>>>>>>>//Get GuiLocation of lhObject To xyButton
73547>>>>>>>//
73547>>>>>>>//ZeroType tPoint To sPoint
73547>>>>>>>//Put (Hi(xyButton)) To sPoint At tPoint.y
73547>>>>>>>//Put (Low(xyButton)) To sPoint At tPoint.x
73547>>>>>>>//
73547>>>>>>>//Get Window_Handle of lhObject To hWnd
73547>>>>>>>//
73547>>>>>>>//Move (ClientToScreen(hWnd, AddressOf(sPoint))) To iVoid
73547>>>>>>>//
73547>>>>>>>//GetBuff From sPoint At tPoint.x To xScreen
73547>>>>>>>//GetBuff From sPoint At tPoint.y To yScreen
73547>>>>>>>//set absolute_mouse_location to xScreen yScreen
73547>>>>>>>end_procedure
73548>>>>>Use Fdx2.utl // FDX aware object for displaying a table definition
73548>>>>>Use QryFolde.pkg // Directory setup for VDFQuery and DbQuery (defs and out)
Including file: qryfolde.pkg (C:\Apps\VDFQuery\AppSrc\qryfolde.pkg)
73548>>>>>>>// Use QryFolde.pkg // Directory setup for VDFQuery and DbQuery (defs and out)
73548>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
73548>>>>>>>Use Files.utl // Utilities for handling file related stuff (No User Interface)
73548>>>>>>>Use DfDir.nui // Identify the location DF files and directories
Including file: dfdir.nui (C:\Apps\VDFQuery\AppSrc\dfdir.nui)
73548>>>>>>>>>// Use DfDir.nui // Identify the location DF files and directories
73548>>>>>>>>>// OBSOLETE! Use AppFolders.nui instead
73548>>>>>>>>>
73548>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
73548>>>>>>>>>Use Strings.nui // String manipulation for VDF (No User Interface)
73548>>>>>>>>>Use Files.nui // Utilities for handling file related stuff (No User Interface)
73548>>>>>>>>>
73548>>>>>>>>>enumeration_list
73548>>>>>>>>> define DFDIR_DFRUN_LOCATION
73548>>>>>>>>> define DFDIR_VDF_ROOTDIR
73548>>>>>>>>> define DFDIR_FILELIST_CFG
73548>>>>>>>>>end_enumeration_list
73548>>>>>>>>>
73548>>>>>>>>>function dfdir_location global integer liWhat returns string
73550>>>>>>>>> string lsRval
73550>>>>>>>>> if (liWhat=DFDIR_VDF_ROOTDIR) begin // VDF Root dir
73552>>>>>>>>> Get_Profile_String "Defaults" "VdfRootDir" To lsRval
73555>>>>>>>>> end
73555>>>>>>>>>>
73555>>>>>>>>> if (liWhat=DFDIR_FILELIST_CFG) begin // Filelist.cfg
73557>>>>>>>>> get SEQ_FindFileAlongDFPath "filelist.cfg" to lsRval
73558>>>>>>>>> end
73558>>>>>>>>>>
73558>>>>>>>>> if (right(lsRval,1)="\" and length(lsRval)>1) get StringLeftBut lsRval 1 to lsRval
73561>>>>>>>>> function_return lsRval
73562>>>>>>>>>end_function
73563>>>>>>>Use WinUser.nui // User_Windows_User_Name function
73563>>>>>>>Use Language // Set default languange if not set by compiler command line
73563>>>>>>>Use WildCard.nui // WildCardMatch function
Including file: wildcard.nui (C:\Apps\VDFQuery\AppSrc\wildcard.nui)
73563>>>>>>>>>// Use WildCard.nui // WildCardMatch function
73563>>>>>>>>>//
73563>>>>>>>>>// This package may be used when checking strings containing wildcard
73563>>>>>>>>>// characters "*" and "?" against strings. I would not bet my life that
73563>>>>>>>>>// this is not exactly the same as undocumentet operator "matches" does.
73563>>>>>>>>>//
73563>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
73563>>>>>>>>>Use Strings.nui // String manipulation for VDF
73563>>>>>>>>>
73563>>>>>>>>>// The public interface of this package is WildCardMatchPrepare and
73563>>>>>>>>>// WildCardMatch messages.
73563>>>>>>>>>//
73563>>>>>>>>>// Use like this:
73563>>>>>>>>>//
73563>>>>>>>>>// send WildCardMatchPrepare "*.nui"
73563>>>>>>>>>// if (WildCardMatch("WildCard.nui")) showln "Matches"
73563>>>>>>>>>// else showln "No Match"
73563>>>>>>>>>
73563>>>>>>>>>enumeration_list
73563>>>>>>>>> define WCAS_THE_HARD_WAY //
73563>>>>>>>>> define WCAS_ALWAYS_TRUE // *
73563>>>>>>>>> define WCAS_EQUAL // Sture
73563>>>>>>>>> define WCAS_LEFT_MATCH // Sture*
73563>>>>>>>>> define WCAS_RIGHT_MATCH // *Andersen
73563>>>>>>>>> define WCAS_LEFT_AND_RIGHT_MATCH // Sture*Andersen
73563>>>>>>>>> define WCAS_CONTAINS // *B*
73563>>>>>>>>>end_enumeration_list
73563>>>>>>>>>enumeration_list
73563>>>>>>>>> define WCAS_CONSTANT
73563>>>>>>>>> define WCAS_QUESTIONMARK
73563>>>>>>>>> define WCAS_ASTERISK
73563>>>>>>>>>end_enumeration_list
73563>>>>>>>>>
73563>>>>>>>>>class cWildCardMatcher is a cArray
73564>>>>>>>>> procedure construct_object integer liImage
73566>>>>>>>>> forward send construct_object liImage
73568>>>>>>>>> // The properties defined here are used only to try to optimise
73568>>>>>>>>> // the evaluation of lsTestValues.
73568>>>>>>>>> property integer piAltStrategy public WCAS_THE_HARD_WAY
73569>>>>>>>>> // If an alternative strategy is active can we use it to accept a
73569>>>>>>>>> // value (piAltStrategyRejectOnly=TRUE) or must we run it the hard
73569>>>>>>>>> // way afterwards (piAltStrategyRejectOnly=FALSE)?
73569>>>>>>>>> property integer piAltStrategyRejectOnly public DFFALSE
73570>>>>>>>>> property string psAltStrategyLeftValue public ""
73571>>>>>>>>> property string psAltStrategyRightValue public ""
73572>>>>>>>>> end_procedure
73573>>>>>>>>> item_property_list
73573>>>>>>>>> item_property integer piType.i // 0=constant 1=? 2=*
73573>>>>>>>>> item_property string psValue.i // Only relevant when piType.i is 0
73573>>>>>>>>> end_item_property_list cWildCardMatcher
#REM 73605 DEFINE FUNCTION PSVALUE.I INTEGER LIROW RETURNS STRING
#REM 73609 DEFINE PROCEDURE SET PSVALUE.I INTEGER LIROW STRING VALUE
#REM 73613 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 73617 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
73622>>>>>>>>>
73622>>>>>>>>> procedure add_row integer liType string lsValue
73624>>>>>>>>> integer liRow
73624>>>>>>>>> get row_count to liRow
73625>>>>>>>>> set piType.i liRow to liType
73626>>>>>>>>> set psValue.i liRow to lsValue
73627>>>>>>>>> end_procedure
73628>>>>>>>>>
73628>>>>>>>>> procedure DoReset
73630>>>>>>>>> send delete_data
73631>>>>>>>>> set piAltStrategy to WCAS_THE_HARD_WAY
73632>>>>>>>>> end_procedure
73633>>>>>>>>>
73633>>>>>>>>> // This procedure tries to find a optimized way to evaluate the expression
73633>>>>>>>>> procedure DoFindShortCuts
73635>>>>>>>>> integer liRows
73635>>>>>>>>> get row_count to liRows
73636>>>>>>>>> set piAltStrategy to WCAS_THE_HARD_WAY
73637>>>>>>>>> set piAltStrategyRejectOnly to DFFALSE
73638>>>>>>>>> if (liRows=1) begin
73640>>>>>>>>> if (piType.i(self,0)=WCAS_ASTERISK) set piAltStrategy to WCAS_ALWAYS_TRUE
73643>>>>>>>>> if (piType.i(self,0)=WCAS_CONSTANT) begin
73645>>>>>>>>> set piAltStrategy to WCAS_EQUAL
73646>>>>>>>>> set psAltStrategyLeftValue to (psValue.i(self,0))
73647>>>>>>>>> end
73647>>>>>>>>>>
73647>>>>>>>>> end
73647>>>>>>>>>>
73647>>>>>>>>> else begin
73648>>>>>>>>> if (piType.i(self,0)=WCAS_CONSTANT) begin // If leftmost is a constant
73650>>>>>>>>> if (piType.i(self,liRows-1)=WCAS_CONSTANT) begin // if rightmost is also a constant
73652>>>>>>>>> if (liRows=3 and piType.i(self,1)=WCAS_ASTERISK) begin
73654>>>>>>>>> set piAltStrategy to WCAS_LEFT_AND_RIGHT_MATCH
73655>>>>>>>>> set psAltStrategyLeftValue to (psValue.i(self,0))
73656>>>>>>>>> set psAltStrategyRightValue to (psValue.i(self,liRows-1))
73657>>>>>>>>> end
73657>>>>>>>>>>
73657>>>>>>>>> else begin
73658>>>>>>>>> set piAltStrategy to WCAS_LEFT_AND_RIGHT_MATCH
73659>>>>>>>>> set psAltStrategyLeftValue to (psValue.i(self,0))
73660>>>>>>>>> set psAltStrategyRightValue to (psValue.i(self,liRows-1))
73661>>>>>>>>> set piAltStrategyRejectOnly to DFTRUE
73662>>>>>>>>> end
73662>>>>>>>>>>
73662>>>>>>>>> end
73662>>>>>>>>>>
73662>>>>>>>>> else begin
73663>>>>>>>>> if (liRows=2 and piType.i(self,1)=WCAS_ASTERISK) begin
73665>>>>>>>>> set piAltStrategy to WCAS_LEFT_MATCH
73666>>>>>>>>> set psAltStrategyLeftValue to (psValue.i(self,0))
73667>>>>>>>>> end
73667>>>>>>>>>>
73667>>>>>>>>> else begin
73668>>>>>>>>> set piAltStrategy to WCAS_LEFT_MATCH
73669>>>>>>>>> set psAltStrategyLeftValue to (psValue.i(self,0))
73670>>>>>>>>> set piAltStrategyRejectOnly to DFTRUE
73671>>>>>>>>> end
73671>>>>>>>>>>
73671>>>>>>>>> end
73671>>>>>>>>>>
73671>>>>>>>>> end
73671>>>>>>>>>>
73671>>>>>>>>> else begin
73672>>>>>>>>> if (piType.i(self,liRows-1)=WCAS_CONSTANT) begin // If rightmost is a constant
73674>>>>>>>>> if (liRows=2 and piType.i(self,0)=WCAS_ASTERISK) begin
73676>>>>>>>>> set piAltStrategy to WCAS_RIGHT_MATCH
73677>>>>>>>>> set psAltStrategyRightValue to (psValue.i(self,liRows-1))
73678>>>>>>>>> end
73678>>>>>>>>>>
73678>>>>>>>>> else begin
73679>>>>>>>>> set piAltStrategy to WCAS_RIGHT_MATCH
73680>>>>>>>>> set psAltStrategyRightValue to (psValue.i(self,liRows-1))
73681>>>>>>>>> set piAltStrategyRejectOnly to DFTRUE
73682>>>>>>>>> end
73682>>>>>>>>>>
73682>>>>>>>>> end
73682>>>>>>>>>>
73682>>>>>>>>> else begin // Now we check if first and last are asterisks
73683>>>>>>>>> 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
73685>>>>>>>>> set piAltStrategy to WCAS_CONTAINS
73686>>>>>>>>> set psAltStrategyLeftValue to (psValue.i(self,1))
73687>>>>>>>>> end
73687>>>>>>>>>>
73687>>>>>>>>> end
73687>>>>>>>>>>
73687>>>>>>>>> end
73687>>>>>>>>>>
73687>>>>>>>>> end
73687>>>>>>>>>>
73687>>>>>>>>> end_procedure
73688>>>>>>>>>
73688>>>>>>>>> procedure BreakDownMask string lsMask
73690>>>>>>>>> integer liPos liLen liType
73690>>>>>>>>> string lsChar lsItem
73690>>>>>>>>> send DoReset
73691>>>>>>>>> move (replaces("**",lsMask,"*")) to lsMask // Simple reduction
73692>>>>>>>>> move (length(lsMask)) to liLen
73693>>>>>>>>> move "" to lsItem
73694>>>>>>>>> for liPos from 1 to liLen
73700>>>>>>>>>>
73700>>>>>>>>> move (mid(lsMask,1,liPos)) to lsChar
73701>>>>>>>>> if lsChar eq "*" begin
73703>>>>>>>>> if lsItem ne "" begin
73705>>>>>>>>> send add_row WCAS_CONSTANT lsItem
73706>>>>>>>>> move "" to lsItem
73707>>>>>>>>> end
73707>>>>>>>>>>
73707>>>>>>>>> send add_row WCAS_ASTERISK ""
73708>>>>>>>>> end
73708>>>>>>>>>>
73708>>>>>>>>> else if lsChar eq "?" begin
73711>>>>>>>>> if lsItem ne "" begin
73713>>>>>>>>> send add_row WCAS_CONSTANT lsItem
73714>>>>>>>>> move "" to lsItem
73715>>>>>>>>> end
73715>>>>>>>>>>
73715>>>>>>>>> send add_row WCAS_QUESTIONMARK ""
73716>>>>>>>>> end
73716>>>>>>>>>>
73716>>>>>>>>> else move (lsItem+lsChar) to lsItem
73718>>>>>>>>> loop
73719>>>>>>>>>>
73719>>>>>>>>> if lsItem ne "" send add_row WCAS_CONSTANT lsItem
73722>>>>>>>>> send DoFindShortCuts
73723>>>>>>>>> end_procedure
73724>>>>>>>>> function iMatch.is integer liRow string lsTestValue returns integer
73726>>>>>>>>> integer lsMax liType liLen liPos
73726>>>>>>>>> string lsItem
73726>>>>>>>>> get row_count to lsMax
73727>>>>>>>>> if liRow ge lsMax begin
73729>>>>>>>>> if (lsTestValue="") function_return 1
73732>>>>>>>>> function_return 0
73733>>>>>>>>> end
73733>>>>>>>>>>
73733>>>>>>>>> get piType.i liRow to liType
73734>>>>>>>>> if liType eq WCAS_CONSTANT begin // constant
73736>>>>>>>>> if (length(lsTestValue)) eq 0 function_return 0
73739>>>>>>>>> get psValue.i liRow to lsItem
73740>>>>>>>>> move (length(lsItem)) to liLen
73741>>>>>>>>> if lsItem eq (left(lsTestValue,liLen)) function_return (iMatch.is(self,liRow+1,StringRightBut(lsTestValue,liLen)))
73744>>>>>>>>> function_return 0
73745>>>>>>>>> end
73745>>>>>>>>>>
73745>>>>>>>>> if liType eq WCAS_QUESTIONMARK begin // ?
73747>>>>>>>>> if (length(lsTestValue)) eq 0 function_return 0
73750>>>>>>>>> function_return (iMatch.is(self,liRow+1,StringRightBut(lsTestValue,1)))
73751>>>>>>>>> end
73751>>>>>>>>>>
73751>>>>>>>>> if liType eq WCAS_ASTERISK begin // *
73753>>>>>>>>> if liRow eq (lsMax-1) function_return 1
73756>>>>>>>>> move (length(lsTestValue)) to liLen
73757>>>>>>>>> for liPos from 0 to liLen
73763>>>>>>>>>>
73763>>>>>>>>> if (iMatch.is(self,liRow+1,StringRightBut(lsTestValue,liPos))) function_return 1
73766>>>>>>>>> loop
73767>>>>>>>>>>
73767>>>>>>>>> end
73767>>>>>>>>>>
73767>>>>>>>>> //function_return 0
73767>>>>>>>>> end_function
73768>>>>>>>>> function iMatch.s string lsTestValue returns integer
73770>>>>>>>>> integer liAltStrategy liAltStrategyRejectOnly
73770>>>>>>>>> get piAltStrategy to liAltStrategy
73771>>>>>>>>> get piAltStrategyRejectOnly to liAltStrategyRejectOnly
73772>>>>>>>>> if liAltStrategy eq WCAS_ALWAYS_TRUE function_return DFTRUE
73775>>>>>>>>> if liAltStrategy eq WCAS_EQUAL function_return (lsTestValue=psAltStrategyLeftValue(self))
73778>>>>>>>>> if liAltStrategy eq WCAS_LEFT_MATCH begin
73780>>>>>>>>> if liAltStrategyRejectOnly begin
73782>>>>>>>>> ifnot (StringBeginsWith(lsTestValue,psAltStrategyLeftValue(self))) function_return DFFALSE
73785>>>>>>>>> end
73785>>>>>>>>>>
73785>>>>>>>>> else function_return (StringBeginsWith(lsTestValue,psAltStrategyLeftValue(self)))
73787>>>>>>>>> end
73787>>>>>>>>>>
73787>>>>>>>>> if liAltStrategy eq WCAS_RIGHT_MATCH begin
73789>>>>>>>>> if liAltStrategyRejectOnly begin
73791>>>>>>>>> ifnot (StringEndsWith(lsTestValue,psAltStrategyRightValue(self))) function_return DFFALSE
73794>>>>>>>>> end
73794>>>>>>>>>>
73794>>>>>>>>> else function_return (StringEndsWith(lsTestValue,psAltStrategyRightValue(self)))
73796>>>>>>>>> end
73796>>>>>>>>>>
73796>>>>>>>>> if liAltStrategy eq WCAS_LEFT_AND_RIGHT_MATCH begin
73798>>>>>>>>> if liAltStrategyRejectOnly begin
73800>>>>>>>>> ifnot (StringBeginsWith(lsTestValue,psAltStrategyLeftValue(self)) and StringEndsWith(lsTestValue,psAltStrategyRightValue(self))) function_return DFFALSE
73803>>>>>>>>> end
73803>>>>>>>>>>
73803>>>>>>>>> else function_return (StringBeginsWith(lsTestValue,psAltStrategyLeftValue(self)) and StringEndsWith(lsTestValue,psAltStrategyRightValue(self)))
73805>>>>>>>>> end
73805>>>>>>>>>>
73805>>>>>>>>> if liAltStrategy eq WCAS_CONTAINS begin
73807>>>>>>>>> function_return (lsTestValue contains psAltStrategyLeftValue(self))
73808>>>>>>>>> end
73808>>>>>>>>>>
73808>>>>>>>>> function_return (iMatch.is(self,0,lsTestValue))
73809>>>>>>>>> end_function
73810>>>>>>>>> function iAnyWildCards returns integer
73812>>>>>>>>> if (row_count(self)>1) function_return DFTRUE
73815>>>>>>>>> function_return (piType.i(self,0)<>WCAS_CONSTANT)
73816>>>>>>>>> end_function
73817>>>>>>>>>end_class // cWildCardMatcher
73818>>>>>>>>>
73818>>>>>>>>>desktop_section
73823>>>>>>>>> object oPrivateWildCardMatch is a cWildCardMatcher NO_IMAGE
73825>>>>>>>>> end_object // oPrivateWildCardMatch
73826>>>>>>>>>end_desktop_section
73831>>>>>>>>>
73831>>>>>>>>>procedure WildCardMatchPrepare global string lsMask
73833>>>>>>>>> send BreakDownMask to (oPrivateWildCardMatch(self)) lsMask
73834>>>>>>>>>end_procedure
73835>>>>>>>>>
73835>>>>>>>>>function WildCardMatch global string lsTestValue returns integer
73837>>>>>>>>> function_return (iMatch.s(oPrivateWildCardMatch(self),lsTestValue))
73838>>>>>>>>>end_function
73839>>>>>>>>>
73839>>>>>>>>>// This may be used to check if the test value was broken down into
73839>>>>>>>>>// more items indicating whether a wildcard character was actually
73839>>>>>>>>>// part of it.
73839>>>>>>>>>function WildCardBreakDownItems global returns integer
73841>>>>>>>>> function_return (iAnyWildCards(oPrivateWildCardMatch(self)))
73842>>>>>>>>>end_function
73843>>>>>>>>>// Test source for DF 3.x (not at all object oriented)
73843>>>>>>>>>//
73843>>>>>>>>>// /Test
73843>>>>>>>>>// Mask......: _________________
73843>>>>>>>>>// Test value: _________________
73843>>>>>>>>>// Result....: _________________
73843>>>>>>>>>// /*
73843>>>>>>>>>//
73843>>>>>>>>>// repeat
73843>>>>>>>>>// accept test.1
73843>>>>>>>>>// accept test.2
73843>>>>>>>>>// send WildCardMatchPrepare (trim(Test.1))
73843>>>>>>>>>// if (WildCardMatch(trim(Test.2))) move "Match!" to Test.3
73843>>>>>>>>>// else move "No match!" to Test.3
73843>>>>>>>>>// [~key.escape] loop
73843>>>>>>>>>// abort
73843>>>>>>>>>
73843>>>>>>>>>class cSetOfMasks is a cArray
73844>>>>>>>>> procedure construct_object integer liImage
73846>>>>>>>>> forward send construct_object liImage
73848>>>>>>>>> property string psName public ""
73849>>>>>>>>> end_procedure
73850>>>>>>>>> item_property_list
73850>>>>>>>>> item_property string psMask.i
73850>>>>>>>>> item_property string psDecription.i
73850>>>>>>>>> end_item_property_list cSetOfMasks
#REM 73882 DEFINE FUNCTION PSDECRIPTION.I INTEGER LIROW RETURNS STRING
#REM 73886 DEFINE PROCEDURE SET PSDECRIPTION.I INTEGER LIROW STRING VALUE
#REM 73890 DEFINE FUNCTION PSMASK.I INTEGER LIROW RETURNS STRING
#REM 73894 DEFINE PROCEDURE SET PSMASK.I INTEGER LIROW STRING VALUE
73899>>>>>>>>> procedure DoReset
73901>>>>>>>>> send delete_data
73902>>>>>>>>> end_procedure
73903>>>>>>>>>
73903>>>>>>>>> function iFindMask.s string lsMask returns integer
73905>>>>>>>>> integer liRow liMax
73905>>>>>>>>> get row_count to liMax
73906>>>>>>>>> decrement liMax
73907>>>>>>>>> for liRow from 0 to liMax
73913>>>>>>>>>>
73913>>>>>>>>> if (lsMask=psMask.i(self,liRow)) function_return liRow
73916>>>>>>>>> loop
73917>>>>>>>>>>
73917>>>>>>>>> function_return -1
73918>>>>>>>>> end_function
73919>>>>>>>>>
73919>>>>>>>>> procedure DoAddMask string lsMask string lsDecription
73921>>>>>>>>> integer liRow
73921>>>>>>>>> if (lsMask<>"" and iFindMask.s(self,lsMask)=-1) begin
73923>>>>>>>>> get row_count to liRow
73924>>>>>>>>> set psMask.i liRow to lsMask
73925>>>>>>>>> set psDecription.i liRow to lsDecription
73926>>>>>>>>> end
73926>>>>>>>>>>
73926>>>>>>>>> end_procedure
73927>>>>>>>>> // This may be used for merging with another cSetOfMasks:
73927>>>>>>>>> procedure DoImport integer lhSetOfMasks
73929>>>>>>>>> integer liRow liMax
73929>>>>>>>>> get row_count of lhSetOfMasks to liMax
73930>>>>>>>>> decrement liMax
73931>>>>>>>>> for liRow from 0 to liMax
73937>>>>>>>>>>
73937>>>>>>>>> send DoAddMask (psMask.i(lhSetOfMasks,liRow)) (psDecription.i(lhSetOfMasks,liRow))
73938>>>>>>>>> loop
73939>>>>>>>>>>
73939>>>>>>>>> end_procedure
73940>>>>>>>>> function sMasksAsString string lsSeparator returns string
73942>>>>>>>>> integer liRow liMax
73942>>>>>>>>> string lsRval
73942>>>>>>>>> move "" to lsRval
73943>>>>>>>>> get row_count to liMax
73944>>>>>>>>> decrement liMax
73945>>>>>>>>> for liRow from 0 to liMax
73951>>>>>>>>>>
73951>>>>>>>>> move (lsRval+psMask.i(self,liRow)) to lsRval
73952>>>>>>>>> if (liRow<>liMax) move (lsRval+lsSeparator) to lsRval
73955>>>>>>>>> loop
73956>>>>>>>>>>
73956>>>>>>>>> function_return lsRval
73957>>>>>>>>> end_function
73958>>>>>>>>> procedure DoCallBack integer liMsg integer lhObj
73960>>>>>>>>> integer liRow liMax
73960>>>>>>>>> get row_count to liMax
73961>>>>>>>>> decrement liMax
73962>>>>>>>>> for liRow from 0 to liMax
73968>>>>>>>>>>
73968>>>>>>>>> send liMsg to lhObj (psMask.i(self,liRow)) (psDecription.i(self,liRow))
73969>>>>>>>>> loop
73970>>>>>>>>>>
73970>>>>>>>>> end_procedure
73971>>>>>>>>>end_class // cSetOfMasks
73972>>>>>>>>>
73972>>>>>>>>>class cWildCardMatcherArray is a cArray
73973>>>>>>>>> procedure DoReset
73975>>>>>>>>> integer liMax liItm
73975>>>>>>>>> get item_count to liMax
73976>>>>>>>>> decrement liMax
73977>>>>>>>>> for liItm from 0 to liMax
73983>>>>>>>>>>
73983>>>>>>>>> send request_destroy_object to (integer(value(self,liItm)))
73984>>>>>>>>> loop
73985>>>>>>>>>>
73985>>>>>>>>> send delete_data
73986>>>>>>>>> end_procedure
73987>>>>>>>>> procedure BreakDownMask string lsMask
73989>>>>>>>>> integer liObj
73989>>>>>>>>> object oWildCardMatcher is a cWildCardMatcher NO_IMAGE
73991>>>>>>>>> send BreakDownMask lsMask
73992>>>>>>>>> move self to liObj
73993>>>>>>>>> end_object
73994>>>>>>>>> set value item (item_count(self)) to liObj
73995>>>>>>>>> end_procedure
73996>>>>>>>>> procedure BreakDownSetOfMasks integer lhObj // An object of the cSetOfMasks class
73998>>>>>>>>> integer liRow liMax
73998>>>>>>>>> get row_count of lhObj to liMax
73999>>>>>>>>> decrement liMax
74000>>>>>>>>> for liRow from 0 to liMax
74006>>>>>>>>>>
74006>>>>>>>>> send BreakDownMask (psMask.i(lhObj,liRow))
74007>>>>>>>>> loop
74008>>>>>>>>>>
74008>>>>>>>>> end_procedure
74009>>>>>>>>> function iMatch.s string lsTestValue returns integer
74011>>>>>>>>> integer liMax liItm
74011>>>>>>>>> get item_count to liMax
74012>>>>>>>>> decrement liMax
74013>>>>>>>>> for liItm from 0 to liMax
74019>>>>>>>>>>
74019>>>>>>>>> if (iMatch.s(integer(value(self,liItm)),lsTestValue)) function_return (liItm+1)
74022>>>>>>>>> loop
74023>>>>>>>>>>
74023>>>>>>>>> function_return 0
74024>>>>>>>>> end_function
74025>>>>>>>>> // Returns the number of items the last added mask was broken into.
74025>>>>>>>>> function iAnyWildCards returns integer
74027>>>>>>>>> integer liObj
74027>>>>>>>>> get value item (item_count(self)-1) to liObj
74028>>>>>>>>> function_return (iAnyWildCards(liObj))
74029>>>>>>>>> end_function
74030>>>>>>>>>end_class // cWildCardMatchArray
74031>>>>>>>
74031>>>>>>> define t.qryfolder.name.QueryDef for "Query definitions"
74031>>>>>>> define t.qryfolder.name.DefPostFix for "Definitions"
74031>>>>>>> define t.qryfolder.name.QueryOut for "Query output"
74031>>>>>>> define t.qryfolder.name.OutPostFix for "Output"
74031>>>>>>>
74031>>>>>>>enumeration_list
74031>>>>>>> define QRYFOLD_DEF_ROOT // data\querydef
74031>>>>>>> define QRYFOLD_OUT_ROOT // data\queryout
74031>>>>>>> define QRYFOLD_USERNAME_FNC
74031>>>>>>> define QRYFOLD_USERNAME_OBJ
74031>>>>>>> define QRYFOLD_PUBLIC_DEF
74031>>>>>>> define QRYFOLD_CURRENT_USER_DEF
74031>>>>>>> define QRYFOLD_CURRENT_USER_OUT
74031>>>>>>> define QRYFOLD_DISABLE_USER_SUBFOLDERS
74031>>>>>>>end_enumeration_list
74031>>>>>>>
74031>>>>>>>desktop_section
74036>>>>>>> object oQry_FolderSetup is a cArray
74038>>>>>>> function bCreateDir string lsDir returns integer
74041>>>>>>> // Attempt to create directory if it does not exists
74041>>>>>>> integer liExists lbCreateError
74041>>>>>>> get SEQ_FileExists lsDir to liExists
74042>>>>>>> if (liExists=SEQIT_NONE) begin
74044>>>>>>> get wvaWin32_CreateDirectory (ToAnsi(lsDir)) to lbCreateError
74045>>>>>>> ifnot lbCreateError get SEQ_FileExists lsDir to liExists
74048>>>>>>> end
74048>>>>>>>>
74048>>>>>>> function_return (liExists=SEQIT_DIRECTORY)
74049>>>>>>> end_function
74050>>>>>>>
74050>>>>>>> procedure DoDefaults
74053>>>>>>> integer liCh
74053>>>>>>> string lsDir lsFile lsDefDir lsOutDir
74053>>>>>>>
74053>>>>>>> get dfdir_location DFDIR_FILELIST_CFG to lsDir
74054>>>>>>> get Files_AppendPath lsDir "vdfquery.ini" to lsFile
74055>>>>>>> if (SEQ_FileExists(lsFile)=SEQIT_FILE) begin
74057>>>>>>> // Config file found, read it
74057>>>>>>> get SEQ_DirectInput lsFile to liCh
74058>>>>>>> if (liCh>=0) begin
74060>>>>>>> get SEQ_ReadLn liCh to lsDefDir
74061>>>>>>> get SEQ_ReadLn liCh to lsOutDir
74062>>>>>>> send SEQ_CloseInput liCh
74063>>>>>>> end
74063>>>>>>>>
74063>>>>>>> end
74063>>>>>>>>
74063>>>>>>> else begin
74064>>>>>>> // Config file not found, locate default directories
74064>>>>>>> get dfdir_location DFDIR_FILELIST_CFG to lsDir
74065>>>>>>> get Files_AppendPath lsDir t.qryfolder.name.QueryDef to lsDefDir
74066>>>>>>> get Files_AppendPath lsDir t.qryfolder.name.QueryOut to lsOutDir
74067>>>>>>> end
74067>>>>>>>>
74067>>>>>>> if (bCreateDir(self,lsDefDir)) set value QRYFOLD_DEF_ROOT to lsDefDir
74070>>>>>>> if (bCreateDir(self,lsOutDir)) set value QRYFOLD_OUT_ROOT to lsOutDir
74073>>>>>>> end_procedure
74074>>>>>>>
74074>>>>>>> function sQryCurrentUserName returns string
74077>>>>>>> integer lhObj lhGet
74077>>>>>>> string lsUser
74077>>>>>>> send DoDefaults
74078>>>>>>> get value item QRYFOLD_USERNAME_OBJ to lhObj
74079>>>>>>> get value item QRYFOLD_USERNAME_FNC to lhGet
74080>>>>>>> if (lhObj and lhGet) get lhGet of lhObj to lsUser
74083>>>>>>> else get User_Windows_User_Name to lsUser
74085>>>>>>> function_return lsUser
74086>>>>>>> end_function
74087>>>>>>>
74087>>>>>>> function sQryPublicDef returns string
74090>>>>>>> string lsRval
74090>>>>>>> send DoDefaults
74091>>>>>>> get value QRYFOLD_DEF_ROOT to lsRval
74092>>>>>>> function_return lsRval
74093>>>>>>> end_function
74094>>>>>>>
74094>>>>>>> function sQryCurUserDef returns string
74097>>>>>>> integer lbOK
74097>>>>>>> string lsRval lsUser lsDir
74097>>>>>>> send DoDefaults
74098>>>>>>> get value QRYFOLD_DEF_ROOT to lsDir
74099>>>>>>> if (lsDir<>"" and integer(value(self,QRYFOLD_DISABLE_USER_SUBFOLDERS))=0) begin
74101>>>>>>> get sQryCurrentUserName to lsUser
74102>>>>>>> get Files_AppendPath lsDir lsUser to lsRval
74103>>>>>>> get bCreateDir lsRval to lbOK
74104>>>>>>> ifnot lbOK move "" to lsRval
74107>>>>>>> end
74107>>>>>>>>
74107>>>>>>> else move "" to lsRval
74109>>>>>>> function_return lsRval
74110>>>>>>> end_function
74111>>>>>>>
74111>>>>>>> function sQryCurUserOut returns string
74114>>>>>>> integer lbOK
74114>>>>>>> string lsRval lsUser lsDir
74114>>>>>>> send DoDefaults
74115>>>>>>>
74115>>>>>>> get value QRYFOLD_OUT_ROOT to lsDir
74116>>>>>>> if (lsDir<>"" and integer(value(self,QRYFOLD_DISABLE_USER_SUBFOLDERS))=0) begin
74118>>>>>>> get sQryCurrentUserName to lsUser
74119>>>>>>> move (lsUser*t.qryfolder.name.OutPostFix) to lsUser
74120>>>>>>> get Files_AppendPath lsDir lsUser to lsRval
74121>>>>>>> get bCreateDir lsRval to lbOK
74122>>>>>>> ifnot lbOK move "" to lsRval
74125>>>>>>> end
74125>>>>>>>>
74125>>>>>>> else move "" to lsRval
74127>>>>>>> function_return lsRval
74128>>>>>>> end_function
74129>>>>>>>
74129>>>>>>> end_object
74130>>>>>>>end_desktop_section
74135>>>>>>>
74135>>>>>>>procedure set Query_Folder global integer liItem string lsValue
74137>>>>>>> set value of (oQry_FolderSetup(self)) liItem to lsValue
74138>>>>>>>end_procedure
74139>>>>>>>
74139>>>>>>>function Query_Folder global integer liItem returns string
74141>>>>>>> if (liItem=QRYFOLD_PUBLIC_DEF) function_return (sQryPublicDef(oQry_FolderSetup(self)))
74144>>>>>>> if (liItem=QRYFOLD_CURRENT_USER_DEF) function_return (sQryCurUserDef(oQry_FolderSetup(self)))
74147>>>>>>> if (liItem=QRYFOLD_CURRENT_USER_OUT) function_return (sQryCurUserOut(oQry_FolderSetup(self)))
74150>>>>>>> function_return (value(oQry_FolderSetup(self),liItem))
74151>>>>>>>end_function
74152>>>>>>>
74152>>>>>>>object oQry_DefArray is a cArray NO_IMAGE
74154>>>>>>> item_property_list
74154>>>>>>> item_property string psFile.i
74154>>>>>>> item_property string psTitle.i
74154>>>>>>> item_property integer piMainFile.i
74154>>>>>>> end_item_property_list
#REM 74194 DEFINE FUNCTION PIMAINFILE.I INTEGER LIROW RETURNS INTEGER
#REM 74199 DEFINE PROCEDURE SET PIMAINFILE.I INTEGER LIROW INTEGER VALUE
#REM 74204 DEFINE FUNCTION PSTITLE.I INTEGER LIROW RETURNS STRING
#REM 74209 DEFINE PROCEDURE SET PSTITLE.I INTEGER LIROW STRING VALUE
#REM 74214 DEFINE FUNCTION PSFILE.I INTEGER LIROW RETURNS STRING
#REM 74219 DEFINE PROCEDURE SET PSFILE.I INTEGER LIROW STRING VALUE
74225>>>>>>> procedure AddFile string lsFile string lsFolder
74228>>>>>>> integer liFile liChannel liRow
74228>>>>>>> string lsTitle lsLine
74228>>>>>>> if (WildCardMatch(lsFile)) begin
74230>>>>>>> get row_count to liRow
74231>>>>>>>
74231>>>>>>> get Files_AppendPath lsFolder lsFile to lsFile
74232>>>>>>> get SEQ_DirectInput lsFile to liChannel
74233>>>>>>> if (liChannel>=0) begin
74235>>>>>>> readln channel liChannel lsLine
74237>>>>>>> if (lsLine="QDF2.0") begin
74239>>>>>>> readln liFile
74240>>>>>>> readln lsTitle
74241>>>>>>> set psFile.i liRow to lsFile
74242>>>>>>> set psTitle.i liRow to lsTitle
74243>>>>>>> set piMainFile.i liRow to liFile
74244>>>>>>> end
74244>>>>>>>>
74244>>>>>>> send SEQ_CloseInput liChannel
74245>>>>>>> end
74245>>>>>>>>
74245>>>>>>> end
74245>>>>>>>>
74245>>>>>>> end_procedure
74246>>>>>>> procedure fill_array
74249>>>>>>> string lsFolder
74249>>>>>>> send delete_data
74250>>>>>>> send WildCardMatchPrepare "*.qdf"
74251>>>>>>> get Query_Folder QRYFOLD_CURRENT_USER_DEF to lsFolder
74252>>>>>>> send SEQ_Load_ItemsInDir lsFolder
74253>>>>>>> send SEQ_CallBack_ItemsInDir SEQCB_FILES_ONLY MSG_AddFile self
74254>>>>>>> end_procedure
74255>>>>>>>end_object // oQry_DefArray
74256>>>>>Use Focus.utl // Retrieve basic information about object
74256>>>>>
74256>>>>>
74256>>>>> Use DFWinRpt
74256>>>>> Use cWinreport2.pkg // wp2 -- add wp2 stuff (eventually get rid of WP1)
Including file: cWinReport2.pkg (c:\VDF12\Pkg\cWinReport2.pkg)
74256>>>>>>>// cWinReport2.pkg
74256>>>>>>>
74256>>>>>>>// defines support for new Winprint2 cWinReport2 class
74256>>>>>>>
74256>>>>>>>
74256>>>>>>>Use DFRpt.pkg // BasicReport RO Class for VDF
74256>>>>>>>Use WinPrint2.pkg // WinPrint2 engine
Including file: Winprint2.pkg (c:\VDF12\Pkg\Winprint2.pkg)
74256>>>>>>>>>// WinPrint2.pkg
74256>>>>>>>>>//
74256>>>>>>>>>Use windows.pkg
74256>>>>>>>>>Use LanguageText.pkg
74256>>>>>>>>>Use DLL.pkg
74256>>>>>>>>>Use WinPrint2_Api.pkg
Including file: WinPrint2_API.pkg (c:\VDF12\Pkg\WinPrint2_API.pkg)
74256>>>>>>>>>>>//WinPrint2_API.pkg
74256>>>>>>>>>>>
74256>>>>>>>>>>>Use DLL.pkg
74256>>>>>>>>>>>
74256>>>>>>>>>>>
74256>>>>>>>>>>>External_Function WP_ArePrintersInstalled "ArePrintersInstalled" WinPrint.dll ; // determines whether at least one printer is installedReturns Boolean // True, if a printer is installed, False if it is not.
74257>>>>>>>>>>>
74257>>>>>>>>>>>External_Function WP_ExecutePrinterSetupDialog "ExecutePrinterSetupDialog" WinPrint.dll ; // displays the "printer setup" dialog Handle hWndParent; // window handle of the parent windowReturns Boolean // True if the OK button pressed; False, otherwise.
74258>>>>>>>>>>>
74258>>>>>>>>>>>External_Function WP_ExecutePrintDialog "ExecutePrintDialog" WinPrint.dll ; // displays the "Print" dialog Handle hWndParent; // window handle of the parent windowReturns Boolean // True if the OK button pressed; False, otherwise.
74259>>>>>>>>>>>
74259>>>>>>>>>>>External_Function WP_GetCurrentDevice "GetCurrentDevice" WinPrint.dll ; // retrieves the name of the current printer device Address aDevice ; // address of the string (255 chars) that will hold the device name upon returnReturns Boolean // True, if success; False if error occurred
74260>>>>>>>>>>>
74260>>>>>>>>>>>External_Function WP_GetPrintDialogFlags "GetPrintDialogFlags" WinPrint.dll ; // retrieves the current print optionsReturns UInteger // array of flags representing print-related options that are currently set
74261>>>>>>>>>>>
74261>>>>>>>>>>>External_Function WP_GetUserDefinedPapersize "GetUserDefinedPapersize" WinPrint.dll ; // gets the size of user-defined paperReturns UInteger // // hi-word=length; lo-word=width
74262>>>>>>>>>>>
74262>>>>>>>>>>>External_Function WP_IsPrintDialogFlagSet "IsPrintDialogFlagSet" WinPrint.dll ; // determines whether a specific print-flag is set UInteger iFlag ; // the printer flagReturns Boolean // True, if the flag is set; False, if it isn't
74263>>>>>>>>>>>
74263>>>>>>>>>>>External_Function WP_SelectPrinter "SelectPrinter" WinPrint.dll ; // selects a printer programatically String sDevice; // the name of the printerReturns Boolean // True, if success; False, if error (such as an invalid printer name)
74264>>>>>>>>>>>
74264>>>>>>>>>>>External_Function WP_SetFirstPagePaperSource "SetFirstPagePaperSource" WinPrint.dll ; Integer iBin ; // the bim constantReturns Boolean // True if success, false if error
74265>>>>>>>>>>>
74265>>>>>>>>>>>External_Function WP_SetNumberOfPrintCopies "SetNumberOfPrintCopies" WinPrint.dll ; // sets the number of copies to print UInteger iNumCopies; // number of copies to makeReturns Boolean // Always True
74266>>>>>>>>>>>
74266>>>>>>>>>>>External_Function WP_SetSpecificPrintDialogFlag "SetSpecificPrintDialogFlag" WinPrint.dll; // Sets/unsets one printer flag UInteger fFlag; // printer flagReturns Boolean // True, if success; False if error occurred
74267>>>>>>>>>>>
74267>>>>>>>>>>>External_Function WP_SetPrintDialogFlags "SetPrintDialogFlags" WinPrint.dll; // Sets/unsets all printer flags in one call UInteger fFlags; // printer flagsReturns Boolean // True, if success; False if error occurred
74268>>>>>>>>>>>
74268>>>>>>>>>>>External_Function WP_SetUserDefinedPapersize "SetUserDefinedPapersize" WinPrint.dll ; // sets the size of user-defined paper UInteger iPaperSize ; // hi-word=length; lo-word=widthReturns Boolean; // True, if success; False if error occurred
74269>>>>>>>>>>>External_Function WP_SetFontStyle "SetFontStyle" WinPrint.dll ; // sets multiple font attributes Integer iStyles ; // series of flagsReturns Boolean // always True
74270>>>>>>>>>>>
74270>>>>>>>>>>>External_Function WP_SetFontBold "SetFontBold" WinPrint.dll ; // toggles the bold attribute of the current font Boolean bBold ; // True to switch bold attribute on; False to switch it offReturns Boolean // always True
74271>>>>>>>>>>>
74271>>>>>>>>>>>External_Function WP_SetFontItalic "SetFontItalic" WinPrint.dll ; // toggles the italic attribute of the current font Boolean bItalic ; // True to switch italic attribute on; False to switch it offReturns Boolean // always True
74272>>>>>>>>>>>
74272>>>>>>>>>>>External_Function WP_SetFontUnderline "SetFontUnderline" WinPrint.dll ; // toggles the underline attribute of the current font Boolean bUnderline ; // True to switch underline attribute on; False to switch it offReturns Boolean // always True
74273>>>>>>>>>>>
74273>>>>>>>>>>>External_Function WP_SetFontStrikeout "SetFontStrikeout" WinPrint.dll ; // toggles the strikeout attribute of the current font Boolean bStrikeout ; // True to switch strikeout attribute on; False to switch it offReturns Boolean // always True
74274>>>>>>>>>>>
74274>>>>>>>>>>>External_Function WP_SetFontColor "SetFontColor" WinPrint.dll ; // sets the color of the current font Integer iColor ; // color of the fontReturns Boolean // always True
74275>>>>>>>>>>>
74275>>>>>>>>>>>External_Function WP_SetFontHeight "SetFontHeight" WinPrint.dll ; // sets the height of the font UInteger iHeight ; // height of the font in points (multiplied by 100. Eg 12.5 point should be sent as 1250)Returns Boolean // always True
74276>>>>>>>>>>>
74276>>>>>>>>>>>External_Function WP_SetFontName "SetFontName" WinPrint.dll ; // Sets the name of the font to use String sFontName ; // name of the font to useReturns Boolean // always True
74277>>>>>>>>>>>
74277>>>>>>>>>>>External_Function WP_DrawBitmap "DrawBitmap" WinPrint.dll ; // Draws a bitmap (BMP, JPG) String sBitmap; // Name of the bitmap Integer iLeft; // distance from left edge to draw bitmap Integer iTop; // distance from top edge to draw bitmap Integer iWidth; // width of the bitmap Integer iHeight; // height of the bitmap Boolean bUpdateCurrentPosition; // after drawing, should the current position be updated?Returns Boolean // True, if OK; False, if an error occurred.
74278>>>>>>>>>>>
74278>>>>>>>>>>>External_Function WP_DrawEllipse "DrawEllipse" WinPrint.dll ; // draws an elipse within a bounding rectangle Integer iLeft; // distance from left edge to draw the ellipse Integer iTop; // distance from top edge to draw the ellipse Integer iWidth; // width of the bounding rectangle Integer iHeight; // height of the bounding rectangle Integer iBorderColor; // color of the ellipse's edge Integer iFillColor; // internal color of the ellipse Boolean bFill; // should the ellipse be filled? (False=transparent) UInteger iThickness; // thickness of the elipse Boolean bUpdateCurrentPosition; // after drawing, should the current position be updated? Boolean bWrap; // Should the ellipse be drawn on future soft-page breaks?Returns Boolean // True, if OK; False, if an error occurred.
74279>>>>>>>>>>>
74279>>>>>>>>>>>External_Function WP_DrawLine "DrawLine" WinPrint.dll ; // draws a line from the current position Integer iLeft; // distance from left edge to draw the line Integer iTop; // distance from top edge to draw the line Integer iLength; // length of the line Boolean bHorizontal; // draw horizontal? (False=vertical) Integer iColor; // color of the line UInteger iThickness; // thickness of the line Boolean bUpdateCurrentPosition; // after drawing, should the current position be updated?Returns Boolean // True, if OK; False, if an error occurred.
74280>>>>>>>>>>>
74280>>>>>>>>>>>External_Function WP_DrawRectangle "DrawRectangle" WinPrint.dll ; // draws a rectangle Integer iLeft; // distance from left edge to draw the rectangle Integer iTop; // distance from top edge to draw the rectangle Integer iWidth; // width of the rectangle Integer iHeight; // height of the rectangle Integer iBorderColor; // color of the rectangle's border Integer iFillColor; // internal color of the rectangle Boolean bFill; // should the rectangle be filled? (False=transparent) UInteger iThickness; // thickness of the rectangle's border Boolean bUpdateCurrentPosition; // after drawing, should the current position be updated? Boolean bWrap; // Should the rectangle be drawn on future soft-page breaks?Returns Boolean // True, if OK; False, if an error occurred.
74281>>>>>>>>>>>
74281>>>>>>>>>>>External_Function WP_DrawXYLine "DrawXYLine" WinPrint.dll ; // draws a line between two points Integer iLeftStart; // distance from left edge to draw from Integer iTopStart; // distance from top edge to draw from Integer iLeftEnd; // distance from left edge to draw to Integer iTopEnd; // distance from top edge to draw to Integer iColor; // color of the line UInteger iThickness; // thickness of the line Boolean bUpdateCurrentPosition; // after drawing, should the current position be updated? Boolean bWrap; // Should the line be drawn on future soft-page breaks?Returns Boolean // True, if OK; False, if an error occurred.
74282>>>>>>>>>>>
74282>>>>>>>>>>>External_Function WP_SetAbsoluteMargins "SetAbsoluteMargins" WinPrint.dll ; // modifies the top/bottom non-printable margin UInteger iTop; // the top margin offset UInteger iBottom; // the bottom margin offset Boolean bAllPages; // should all pages be affected? True=AllPages; False=first page onlyReturns Boolean // always True
74283>>>>>>>>>>>
74283>>>>>>>>>>>External_Function WP_SetMargins "SetMargins" WinPrint.dll ; // Sets the user-margins UInteger iLeft; // the left margin UInteger iTop; // the top margin UInteger iRight; // the right margin UInteger iBottom; // the bottom marginReturns Boolean // always True
74284>>>>>>>>>>>
74284>>>>>>>>>>>External_Function WP_CreateDiagram "CreateDiagram" WinPrint.dll ; // Creates a new diagram UInteger eType; // type of diagram (Bar, Line, Pie) UInteger eEffect; // how it is drawn (2d or 3d, etc) UInteger iWidth; // width of the diagram UInteger iHeight; // height of the diagram Boolean bDrawXyAxis; // draw the xy-axis (for bar charts only)?Returns Handle // unique id for the diagram used in other diagram funtions
74285>>>>>>>>>>>
74285>>>>>>>>>>>External_Function WP_AddDiagramEntry "AddDiagramEntry" WinPrint.dll ; // Adds an item into a diagram Handle hDiagram; // diagram handle returned by CreateDiagram() String sValueDescription; // description of the item String sValue; // value of the item Integer iBorderColor; // color of the item's border Integer iFillColor; // color of the item's interior Boolean bFilled; // should the item be drawn filled (with iFillColor), or transparent? UInteger iNumDecimals; // Number of decimals in the sValue argument UInteger eValueOrPercent; // How the value should be displayed (as value or percentage, etc) Boolean bExploded; // should the value be "pulled out" (pie charts only)Returns Boolean // True, if success; False, if error
74286>>>>>>>>>>>
74286>>>>>>>>>>>External_Function WP_DrawDiagram "DrawDiagram" WinPrint.dll ; // draws a diagram Handle hDiagram; // diagram handle returned by CreateDiagram() UInteger iLeft; // x-coordinate to draw the diagram UInteger iTop; // y-coordinate to draw the diagram Boolean bUpdateCurrentPosition; // after drawing, should the current position be updated?Returns Boolean // True, if success; False, if error
74287>>>>>>>>>>>
74287>>>>>>>>>>>External_Function WP_LockDiagram "LockDiagram" WinPrint.dll ; // Locks a diagram so that no more entries can be added Handle hDiagram; // diagram handle returned by CreateDiagram()Returns Boolean // True, if success; False, if error
74288>>>>>>>>>>>
74288>>>>>>>>>>>External_Function WP_SetDiagramCaption "SetDiagramCaption" WinPrint.dll ; // Sets the caption of a diagram Handle hDiagram; // diagram handle returned by CreateDiagram() String sCaption; // the diagram's captionReturns Boolean // True, if success; False, if error
74289>>>>>>>>>>>
74289>>>>>>>>>>>External_Function WP_SetDiagramXText "SetDiagramXText" WinPrint.dll ; // Sets the horizontal label of a diagram Handle hDiagram; // diagram handle returned by CreateDiagram() String sText; // the diagram's horizonal labelReturns Boolean // True, if success; False, if error
74290>>>>>>>>>>>
74290>>>>>>>>>>>External_Function WP_SetDiagramYText "SetDiagramYText" WinPrint.dll ; // Sets the vertical label of a diagram Handle hDiagram; // diagram handle returned by CreateDiagram() String sText; // the diagram's vertical label Boolean bVerticalText; // should the text be drawn vertically (False=horizontally)Returns Boolean // True, if success; False, if error
74291>>>>>>>>>>>
74291>>>>>>>>>>>External_Function WP_BeginHeader "BeginHeader" WinPrint.dll ; // creates a new header UInteger iHeaderType; // the type of header UInteger iSubHeaderNum; // for subheaders, then number (1-0)Returns Boolean // always True
74292>>>>>>>>>>>
74292>>>>>>>>>>>External_Function WP_EndHeader "EndHeader" WinPrint.dll ; // declares the end of the current headerReturns Boolean // always True
74293>>>>>>>>>>>
74293>>>>>>>>>>>External_Function WP_SetExtraLineCheck "SetExtraLineCheck" WinPrint.dll ; // forces a soft page break if header plus number of lines don't fit on page UInteger iNumLines; // number of lines in addition to header required before forcing a soft page-breakReturns Boolean; // always True
74294>>>>>>>>>>>External_Function WP_SetHeaderFrame "SetHeaderFrame" WinPrint.dll ; // sets the style, color and frame of a header UInteger eFrame; // style of frame (margin-to-margin, etc) Integer iColor; // color of the frame's edge UInteger iThickness; // thickness of the frame Integer iFillCol; // the internal color of the frame (only used if bBilled=True) Boolean bFilled; // True, if the frame should be filled with the iFillColor (False=Transparent)Returns Boolean // Always True
74295>>>>>>>>>>>
74295>>>>>>>>>>>External_Function WP_SetHeaderMargin "SetHeaderMargin" WinPrint.dll ; // Sets a margin of space on the inside and outside of the current header UInteger eType; // Specifies which margin areas is being set. Integer iSize; // Size of the margin setting in the current report metricsReturns Boolean // False if document is not started
74296>>>>>>>>>>>
74296>>>>>>>>>>>External_Function WP_SetHeaderPlacement "SetHeaderPlacement" WinPrint.dll ; // placement (left, center or right) of the header UInteger ePlacement; // placed left, center or rightReturns Boolean //always True
74297>>>>>>>>>>>
74297>>>>>>>>>>>External_Function WP_SetHeaderWrap "SetHeaderWrap" WinPrint.dll ; // determines whether the current header is drawn on soft page-breaks Boolean bWrap; // True, to wrap onto following pages; False, for current page onlyReturns Boolean // always True
74298>>>>>>>>>>>
74298>>>>>>>>>>>External_Function WP_WriteHeader "WriteHeader" WinPrint.dll ; // writes a header to the current page UInteger eHeaderType; // type of header UInteger iSubHeaderNum; // for subheaders, the number (1-9)Returns Boolean // True, if success; False, if error
74299>>>>>>>>>>>
74299>>>>>>>>>>>External_Function WP_RGBToDFPrintColor "RGBToDFPrintColor" WinPrint.dll ; // converts R, G, and B values into a composite color that WinPrint expects UInteger iRed; // red component (1-255) UInteger iGreen; // green component (1-255) UInteger iBlue; // blue component (1-255)Returns Integer // composite color
74300>>>>>>>>>>>
74300>>>>>>>>>>>External_Function WP_GetMetrics "GetMetrics" WinPrint.dll ; // gets the current unit of measurementReturns UInteger // unit of measurement (Inch or CM)
74301>>>>>>>>>>>
74301>>>>>>>>>>>External_Function WP_SetMetrics "SetMetrics" WinPrint.dll ; // sets the unit of measurement UInteger eMetrics; // Inch or CMReturns Boolean // always True
74302>>>>>>>>>>>
74302>>>>>>>>>>>External_Function WP_ClearDocument "ClearDocument" WinPrint.dll ; // clears the resources of the document from memoryReturns Boolean // always True
74303>>>>>>>>>>>
74303>>>>>>>>>>>External_Function WP_NewDocument "NewDocument" WinPrint.dll ; // starts a new document, but preserves the printer settings Boolean bAutoPreview ; // Should the Previewer be displayed immediatelyReturns Boolean // True, if success; False, if an error occurred
74304>>>>>>>>>>>
74304>>>>>>>>>>>External_Function WP_EndDocument "EndDocument" WinPrint.dll ; // Indicates that the document is finishedReturns Boolean // always True
74305>>>>>>>>>>>
74305>>>>>>>>>>>External_Function WP_ClearPrinter "ClearPrinter" WinPrint.dll ; // clears all printer and document resourcesReturns Boolean // True, if success; False, if an error occurred
74306>>>>>>>>>>>
74306>>>>>>>>>>>External_Function WP_ConfirmLines "ConfirmLines" WinPrint.dll ; // ensures that a specified number of lines will fit on the page; if not, a soft page-break is performed automatically UInteger iNumLines; // number of lines that must fit on the pageReturns Boolean // True, if success; False, if an error occurred
74307>>>>>>>>>>>
74307>>>>>>>>>>>External_Function WP_CreatePage "CreatePage" WinPrint.dll ; // creates a new page of specified columns UInteger iNumColumns; // number of columns (zero= no columns)Returns UInteger; // page number that was created
74308>>>>>>>>>>>External_Function WP_PreviewDocument "PreviewDocument" WinPrint.dll ; // previews the current document Boolean bPrintDialog; // Determines whether the Print Dialog (range, etc) is displayed when the "print" button is clicked in the preview window. Boolean bPrintSetup; // Determines whether the Print Setup button is enabled (allows to change orientation, etc) Boolean bPrint; // Determines whether the Print button is enabledReturns Handle // non-zero = hViewerProcess; zero= error
74309>>>>>>>>>>>
74309>>>>>>>>>>>External_Function WP_ClosePreview "ClosePreview" WinPrint.dll ; // closes the preview windowReturns Boolean // True, if closed; False, if an error occurred (such as it not being already open)
74310>>>>>>>>>>>
74310>>>>>>>>>>>External_Function WP_PrintDocument "PrintDocument" WinPrint.dll ; // prints the current document Handle hWndParent; // window handle of object to use for any modal outputReturns Boolean // True, if success; False, if an error occurred
74311>>>>>>>>>>>
74311>>>>>>>>>>>External_Function WP_SetAlign "SetAlign" WinPrint.dll ; // align future text UInteger eAlign; // left, center or rightReturns Boolean // always True
74312>>>>>>>>>>>
74312>>>>>>>>>>>External_Function WP_WriteText "WriteText" WinPrint.dll ; // write text to the current position or column String sText; // the text to write Boolean bNewLineAfterPrint; // should a "CR" be written after the text UInteger iColumnNum; // number of the column to write to (zero=no column, use current position) Integer iNumDecimals; // number of decimals in the text (-1 means sText is a string) UInteger iWidth; // width of text before truncatingReturns Boolean // True, if success; False, if an error occurred
74313>>>>>>>>>>>
74313>>>>>>>>>>>External_Function WP_WriteTextAtPosition "WriteTextAtPosition" WinPrint.dll ; // writes text to a specific position String sText; // the text to write Boolean bNewLineAfterPrint; // should a "CR" be written after the text UInteger iPosition; // horizontal position to write the text Integer iNumDecimals; // number of decimals in the text (-1 means sText is a string) UInteger iWidth; // width of text before truncatingReturns Boolean // True, if success; False, if an error occurred
74314>>>>>>>>>>>
74314>>>>>>>>>>>External_Function WP_SetProgressCaption "SetProgressCaption" WinPrint.dll ; String sProgressCaption ;Returns Boolean
74315>>>>>>>>>>>
74315>>>>>>>>>>>External_Function WP_SetReportTitle "SetReportTitle" WinPrint.dll ; String sCaption ;Returns Boolean
74316>>>>>>>>>>>
74316>>>>>>>>>>>External_Function WP_ViewerWantsToClose "ViewerWantsToClose" WinPrint.dll ;Returns Integer
74317>>>>>>>>>>>
74317>>>>>>>>>>>External_Function WP_DisplayMessageBox "DisplayMessageBox" WinPrint.dll ; String sCaption String sText ;Returns Integer
74318>>>>>>>>>>>
74318>>>>>>>>>>>External_Function WP_GetViewerWindow "GetViewerWindow" Winprint.dll ;Returns Handle
74319>>>>>>>>>>>
74319>>>>>>>>>>>External_Function WP_GetDocumentStatus "GetDocumentStatus" Winprint.dll ;Returns Integer // returns dsNotStarted, dsStarted, or dsFinished
74320>>>>>>>>>>>
74320>>>>>>>>>Use WinPrint_Constants.pkg
74320>>>>>>>>>Use Rgb.pkg
74320>>>>>>>>>Use GlobalFunctionsProcedures.pkg
74320>>>>>>>>>
74320>>>>>>>>>DEFINE INFINITE for -1
74320>>>>>>>>>DEFINE WAIT_TIMEOUT for |CI$00000102
74320>>>>>>>>>
74320>>>>>>>>>
74320>>>>>>>>>DEFINE QS_KEY for |CI$0001
74320>>>>>>>>>DEFINE QS_MOUSEMOVE for |CI$0002
74320>>>>>>>>>DEFINE QS_MOUSEBUTTON for |CI$0004
74320>>>>>>>>>DEFINE QS_POSTMESSAGE for |CI$0008
74320>>>>>>>>>DEFINE QS_TIMER for |CI$0010
74320>>>>>>>>>DEFINE QS_PAINT for |CI$0020
74320>>>>>>>>>DEFINE QS_SENDMESSAGE for |CI$0040
74320>>>>>>>>>DEFINE QS_HOTKEY for |CI$0080
74320>>>>>>>>>DEFINE QS_ALLPOSTMESSAGE for |CI$0100
74320>>>>>>>>>DEFINE QS_MOUSE for (QS_MOUSEMOVE ior QS_MOUSEBUTTON)
74320>>>>>>>>>DEFINE QS_INPUT for (QS_MOUSE ior QS_KEY)
74320>>>>>>>>>DEFINE QS_ALLEVENTS for (QS_INPUT ior QS_POSTMESSAGE ior QS_TIMER ior QS_PAINT ior QS_HOTKEY)
74320>>>>>>>>>DEFINE QS_ALLINPUT for (QS_INPUT ior QS_POSTMESSAGE ior QS_TIMER ior QS_PAINT ior QS_HOTKEY ior QS_SENDMESSAGE)
74320>>>>>>>>>
74320>>>>>>>>>External_Function WaitForSingleObject "WaitForSingleObject" Kernel32.dll Handle hHandle Dword dwMilliseconds Returns DWord
74321>>>>>>>>>External_Function GetCurrentProcessId "GetCurrentProcessId" Kernel32.dll Returns DWord
74322>>>>>>>>>External_Function GetCurrentProcess "GetCurrentProcess" Kernel32.dll Returns DWord
74323>>>>>>>>>
74323>>>>>>>>>External_Function MsgWaitForMultipleObjects "MsgWaitForMultipleObjects" User32.dll ; DWORD nCount; // number of handles in the object handle array Address pHandles; // pointer to the object-handle array Boolean fWaitAll; // wait for all or wait for one DWORD dwMilliseconds; // time-out interval in milliseconds DWORD dwWakeMask; // type of input events to wait forReturns Dword
74324>>>>>>>>>
74324>>>>>>>>>Use GlobalFunctionsProcedures.pkg
74324>>>>>>>>>
74324>>>>>>>>>Class cWinPrint2 is a cObject // JJT: Will we need a windows handle for this like old one
74325>>>>>>>>> Procedure Construct_Object
74327>>>>>>>>> forward send construct_object
74329>>>>>>>>>
74329>>>>>>>>> //*** internal properties
74329>>>>>>>>> Property Integer DFCurrent_Color 0
74330>>>>>>>>> Property String DFCurrent_OutPut "WinPrint"
74331>>>>>>>>> Property Integer DFCurrent_Diagram 0
74332>>>>>>>>> Property Integer DFCurrent_HeaderType 0
74333>>>>>>>>> Property Integer DFCurrent_HeaderNr 0
74334>>>>>>>>> Property Number DFCurrent_FontSize 10
74335>>>>>>>>> Property String DFCurrent_Font "Arial"
74336>>>>>>>>>
74336>>>>>>>>> //*** Default values for margins 2.53 CM = 1 inch
74336>>>>>>>>> Property Number DFLeft_Margin 2.53
74337>>>>>>>>> Property Number DFTop_Margin 2.53
74338>>>>>>>>> Property Number DFright_Margin 2.53
74339>>>>>>>>> Property Number DFBottom_Margin 2.53
74340>>>>>>>>>
74340>>>>>>>>> // If WP1 this defaults to false. In 2, it is true which means that the print job
74340>>>>>>>>> // dialog appears when you hitprint in previewer.
74340>>>>>>>>> Property Integer PrintDlgInPreview 1
74341>>>>>>>>> // This does nothing in Wp2 (because you can't to this anyway)
74341>>>>>>>>> Property Integer EnablePrintSetupFromPreview True
74342>>>>>>>>> Property Integer EnablePrintFromPreview 1
74343>>>>>>>>>
74343>>>>>>>>> // is the GUI Suspended. This is privately maintained and is used
74343>>>>>>>>> // to figure out if a preview panel is up or not
74343>>>>>>>>> Property Integer pbIsSuspended False
74344>>>>>>>>>
74344>>>>>>>>> Object oDFColorArray is an Array
74346>>>>>>>>> //Moved into array
74346>>>>>>>>> Set Value 0 To RGB_WHITE
74347>>>>>>>>> Set Value 1 To RGB_RED
74348>>>>>>>>> Set Value 2 To RGB_BLUE
74349>>>>>>>>> Set Value 3 To RGB_GREEN
74350>>>>>>>>> Set Value 4 To RGB_YELLOW
74351>>>>>>>>> Set Value 5 To RGB_GREY
74352>>>>>>>>> Set Value 6 To RGB_CYAN
74353>>>>>>>>> Set Value 7 To RGB_MAGENTA
74354>>>>>>>>> Set Value 8 To RGB_DRED
74355>>>>>>>>> Set Value 9 To RGB_DBLUE
74356>>>>>>>>> Set Value 10 To RGB_DGREEN
74357>>>>>>>>> Set Value 11 To RGB_DYELLOW
74358>>>>>>>>> Set Value 12 To RGB_DGREY
74359>>>>>>>>> Set Value 13 To RGB_DCYAN
74360>>>>>>>>> Set Value 14 To RGB_DMAGENTA
74361>>>>>>>>> Set Value 15 To RGB_BLACK
74362>>>>>>>>> End_Object
74363>>>>>>>>>
74363>>>>>>>>> Object oDiagramArray is an Array
74365>>>>>>>>> End_Object
74366>>>>>>>>>
74366>>>>>>>>> End_Procedure
74367>>>>>>>>>
74367>>>>>>>>> Function ViewerWantsToClose returns Boolean
74369>>>>>>>>> Function_return (WP_ViewerWantsToClose())
74370>>>>>>>>> end_Function
74371>>>>>>>>>
74371>>>>>>>>> Function IsViewerActive returns boolean
74373>>>>>>>>> Function_Return (WP_GetViewerWindow()<>0)
74374>>>>>>>>> end_function
74375>>>>>>>>>
74375>>>>>>>>> Function ArePrintersInstalled returns boolean
74377>>>>>>>>> Function_Return (WP_ArePrintersInstalled()<>0)
74378>>>>>>>>> end_function
74379>>>>>>>>>
74379>>>>>>>>>
74379>>>>>>>>> // returns docucument state: dsNotStarted, dsStarted, dsFinished
74379>>>>>>>>> Function DocumentStatus returns Integer
74381>>>>>>>>> Function_Return (WP_GetDocumentStatus())
74382>>>>>>>>> end_function
74383>>>>>>>>>
74383>>>>>>>>> // Might still be called from report class. Leave dummy stub
74383>>>>>>>>> Procedure DFZeroCounters
74385>>>>>>>>> End_Procedure
74386>>>>>>>>>
74386>>>>>>>>> //***
74386>>>>>>>>> Function DFNewPage Integer Columns Returns Integer
74388>>>>>>>>> Integer iPageNum
74388>>>>>>>>> // This returns a page number used in report object....(this may change)
74388>>>>>>>>> Move (WP_CreatePage(Columns)) To iPageNum
74389>>>>>>>>> If (iPageNum=0) Begin
74391>>>>>>>>> Error DFERR_WINPRINT DFPrintError900
74392>>>>>>>>>>
74392>>>>>>>>> End
74392>>>>>>>>>>
74392>>>>>>>>> Function_Return iPageNum
74393>>>>>>>>> End_Function
74394>>>>>>>>>
74394>>>>>>>>> //***Return handle to use for winprint dialog. If main_window
74394>>>>>>>>> // exists, use it. Else, get object's handle
74394>>>>>>>>> Function Report_Window_Handle returns handle
74396>>>>>>>>> Handle hWnd
74396>>>>>>>>> Handle hoObj
74396>>>>>>>>> Get Focus of desktop to hoObj // start with the focus
74397>>>>>>>>> Move (gOwnerWindowHandle(hoObj)) to hWnd // global function finds the right handle for us
74398>>>>>>>>> function_return hWnd
74399>>>>>>>>> End_Function
74400>>>>>>>>>
74400>>>>>>>>>
74400>>>>>>>>> //***
74400>>>>>>>>> Function DFPrintDialog Returns Boolean
74402>>>>>>>>> Handle hwnd
74402>>>>>>>>> Boolean bOk
74402>>>>>>>>>
74402>>>>>>>>> Get Report_Window_Handle to hWnd
74403>>>>>>>>> Move (WP_ExecutePrintDialog(hwnd)) To bOk
74404>>>>>>>>>
74404>>>>>>>>> Function_Return bOk
74405>>>>>>>>> End_Function
74406>>>>>>>>>
74406>>>>>>>>>
74406>>>>>>>>> //*** You can only invoke the print setup if the report is cleared. If you try to to do this in
74406>>>>>>>>> // the wrong state you will get an error.
74406>>>>>>>>> Function DFPrintSetupDialog returns boolean
74408>>>>>>>>> Handle hwnd
74408>>>>>>>>> Boolean bOk
74408>>>>>>>>> integer iStatus
74408>>>>>>>>> Get ArePrintersInstalled to bOk
74409>>>>>>>>> If not bOk begin
74411>>>>>>>>> Error DFERR_WINPRINT C_$NoInstalledPrinters
74412>>>>>>>>>>
74412>>>>>>>>> end
74412>>>>>>>>>>
74412>>>>>>>>> Else begin
74413>>>>>>>>> Get DocumentStatus to iStatus
74414>>>>>>>>> If (iStatus=dsNotStarted) begin
74416>>>>>>>>> Get Report_Window_Handle to hWnd
74417>>>>>>>>> Move (WP_ExecutePrinterSetupDialog(hwnd)) To bOk
74418>>>>>>>>> end
74418>>>>>>>>>>
74418>>>>>>>>> else Begin
74419>>>>>>>>> Error DFERR_WINPRINT DFPrintError966
74420>>>>>>>>>>
74420>>>>>>>>> end
74420>>>>>>>>>>
74420>>>>>>>>> end
74420>>>>>>>>>>
74420>>>>>>>>> Function_return bOk
74421>>>>>>>>> End_Function
74422>>>>>>>>>
74422>>>>>>>>>
74422>>>>>>>>> //*** Provided for backwards compatibility. DFPrintSetupDialog is more flexible because it returns a
74422>>>>>>>>> // false if cancel was selected.
74422>>>>>>>>> Procedure DFPrintSetup
74424>>>>>>>>> Boolean bOk
74424>>>>>>>>> Get DFPrintSetupDialog to bOk
74425>>>>>>>>> End_Procedure
74426>>>>>>>>>
74426>>>>>>>>> //*** This invokes the print job dialog, prints the report, then clears the report document.
74426>>>>>>>>> // This should be called after the report is complete.
74426>>>>>>>>> Procedure DFPrint
74428>>>>>>>>> Integer bOk
74428>>>>>>>>> Get DFPrintDialog To bOk
74429>>>>>>>>> If bOk Begin
74431>>>>>>>>> Send DFPrintDoc
74432>>>>>>>>> Send DFClearDoc
74433>>>>>>>>> End
74433>>>>>>>>>>
74433>>>>>>>>> End_Procedure
74434>>>>>>>>>
74434>>>>>>>>> Procedure DFSuspendGui boolean bSuspend
74436>>>>>>>>> If (bSuspend<>pbIsSuspended(self)) begin
74438>>>>>>>>> Send SuspendGui of Desktop bSuspend
74439>>>>>>>>> Set pbIsSuspended to bSuspend
74440>>>>>>>>> end
74440>>>>>>>>>>
74440>>>>>>>>> end_procedure
74441>>>>>>>>>
74441>>>>>>>>> // this is protected so that the queue is only pumped if the
74441>>>>>>>>> // gui is suspended.
74441>>>>>>>>> Procedure PumpMsgQueue
74443>>>>>>>>> If (pbIsSuspended(self)) begin
74445>>>>>>>>> Send PumpMsgQueue of desktop // permit painting
74446>>>>>>>>> end
74446>>>>>>>>>>
74446>>>>>>>>> end_procedure
74447>>>>>>>>>
74447>>>>>>>>>
74447>>>>>>>>> //*** This does a modeless preview. This is what you'd want during
74447>>>>>>>>> // report generation and it may be what you want for report viewing.
74447>>>>>>>>> Procedure DFPreviewNoWait
74449>>>>>>>>> Boolean bOk
74449>>>>>>>>> Boolean bPrntDlg bPrintSetup bPrint
74449>>>>>>>>> integer iStatus
74449>>>>>>>>> Get PrintDlgInPreview to bPrntDlg
74450>>>>>>>>> Get EnablePrintSetupFromPreview to bPrintSetup
74451>>>>>>>>> Get EnablePrintFromPreview to bPrint
74452>>>>>>>>> Get DocumentStatus to iStatus
74453>>>>>>>>> If (iStatus=dsStarted) begin
74455>>>>>>>>> Send DfSuspendGui True
74456>>>>>>>>> end
74456>>>>>>>>>>
74456>>>>>>>>> Move (WP_PreviewDocument(bPrntDlg,bPrintSetup,bPrint)) To bOk
74457>>>>>>>>> If not bOk Begin
74459>>>>>>>>> Error DFERR_WINPRINT DFPrintError901
74460>>>>>>>>>>
74460>>>>>>>>> Send DfSuspendGui False
74461>>>>>>>>> End
74461>>>>>>>>>>
74461>>>>>>>>> End_Procedure
74462>>>>>>>>>
74462>>>>>>>>>
74462>>>>>>>>> //*** This does a modal preview. You might want this for report
74462>>>>>>>>> // viewing as the program knows when the viewer is closed
74462>>>>>>>>> // Note that this is a private message and it was never intended that this
74462>>>>>>>>> // should be used. We expect winprint reports to use modeless viewers.
74462>>>>>>>>> Procedure DFPreviewWait
74464>>>>>>>>> Handle hViewerProcess
74464>>>>>>>>> Boolean bPrntDlg bPrintSetup bPrint
74464>>>>>>>>> Integer iRetVal
74464>>>>>>>>> Integer hwMain hMain
74464>>>>>>>>>
74464>>>>>>>>> Get PrintDlgInPreview to bPrntDlg
74465>>>>>>>>> Get EnablePrintSetupFromPreview to bPrintSetup
74466>>>>>>>>> Get EnablePrintFromPreview to bPrint
74467>>>>>>>>>
74467>>>>>>>>> Send DfSuspendGui True
74468>>>>>>>>> Move (WP_PreviewDocument(bPrntDlg,bPrintSetup,bPrint)) To hViewerProcess
74469>>>>>>>>>
74469>>>>>>>>> If (hViewerProcess = 0) Begin
74471>>>>>>>>> Error DFERR_WINPRINT DFPrintError901
74472>>>>>>>>>>
74472>>>>>>>>> End
74472>>>>>>>>>>
74472>>>>>>>>> Else Begin
74473>>>>>>>>> // We need to wait for either the Viewer to close, or a WM_PAINT message in the thread's queue...
74473>>>>>>>>> Repeat
74473>>>>>>>>>>
74473>>>>>>>>> Move (MsgWaitForMultipleObjects(1, AddressOf(hViewerProcess), False, INFINITE, QS_PAINT)) To iRetVal
74474>>>>>>>>> Send PumpMsgQueue // permit painting
74475>>>>>>>>> Until (iRetVal = 0) // 0 means that the viewer process terminated
74477>>>>>>>>> end
74477>>>>>>>>>>
74477>>>>>>>>> Send DfSuspendGui False
74478>>>>>>>>>
74478>>>>>>>>> // Do what we can to force VDF application to the top.
74478>>>>>>>>> // As 12.0 dfSuspendGUI actually properly disables the underlying windows. When the viewer
74478>>>>>>>>> // is closed it cannot give the focus back to this so it goes elsewhere. This will force it
74478>>>>>>>>> // back.
74478>>>>>>>>>
74478>>>>>>>>> Get main_window of desktop to hMain
74479>>>>>>>>> If hMain Begin
74481>>>>>>>>> Get window_handle of hMain to hwMain
74482>>>>>>>>> If hwMain Begin
74484>>>>>>>>> If (GetForegroundWindow()<>hwMain) Begin
74486>>>>>>>>> Move (SetForegroundWindow(hwMain)) to hwMain
74487>>>>>>>>> End
74487>>>>>>>>>>
74487>>>>>>>>> End
74487>>>>>>>>>>
74487>>>>>>>>> End
74487>>>>>>>>>>
74487>>>>>>>>>
74487>>>>>>>>> End_Procedure
74488>>>>>>>>>
74488>>>>>>>>> Procedure DfPreview
74490>>>>>>>>> send DfPreviewNoWait
74491>>>>>>>>> end_procedure
74492>>>>>>>>>
74492>>>>>>>>>
74492>>>>>>>>> //***
74492>>>>>>>>> Procedure DFPrintDoc
74494>>>>>>>>> Handle hwnd
74494>>>>>>>>> Boolean bOk
74494>>>>>>>>> Get Report_Window_Handle to hWnd
74495>>>>>>>>> Move (WP_PrintDocument(hwnd)) To bOk
74496>>>>>>>>>
74496>>>>>>>>> If not bOk Begin
74498>>>>>>>>> Error DFERR_WINPRINT DFPrintError902
74499>>>>>>>>>>
74499>>>>>>>>> End
74499>>>>>>>>>>
74499>>>>>>>>> End_Procedure
74500>>>>>>>>>
74500>>>>>>>>>
74500>>>>>>>>> //***
74500>>>>>>>>> Procedure DFClearDoc
74502>>>>>>>>> Boolean bOk
74502>>>>>>>>> Get ArePrintersInstalled to bOk
74503>>>>>>>>> If bOk begin
74505>>>>>>>>> Move (WP_ClearDocument()) To bOk
74506>>>>>>>>> Send DFSuspendGUI False
74507>>>>>>>>> If not bOk Begin
74509>>>>>>>>> Error DFERR_WINPRINT DFPrintError903 // error number right?
74510>>>>>>>>>>
74510>>>>>>>>> End
74510>>>>>>>>>>
74510>>>>>>>>> End
74510>>>>>>>>>>
74510>>>>>>>>> End_Procedure
74511>>>>>>>>>
74511>>>>>>>>> Procedure DFNewDoc Boolean bAutoPreview
74513>>>>>>>>> Boolean bOk
74513>>>>>>>>> // this is the most likely place we will encounter when we start a report. Check for
74513>>>>>>>>> // printers and return an explicit error to make it easy to identify the error
74513>>>>>>>>> Get ArePrintersInstalled to bOk
74514>>>>>>>>> If not bOk begin
74516>>>>>>>>> Error DFERR_WINPRINT C_$NoInstalledPrinters
74517>>>>>>>>>>
74517>>>>>>>>> end
74517>>>>>>>>>>
74517>>>>>>>>> else begin
74518>>>>>>>>> Send DfClearDoc //JJT - a new doc should always start with a clear
74519>>>>>>>>> If bAutoPreview Send DFSuspendGUI True
74522>>>>>>>>> Move (WP_NewDocument(bAutoPreview)) To bOk
74523>>>>>>>>>
74523>>>>>>>>> If not bOk Begin
74525>>>>>>>>> Error DFERR_WINPRINT DFPrintError903 // error number right?
74526>>>>>>>>>>
74526>>>>>>>>> Send DFSuspendGUI False
74527>>>>>>>>> End
74527>>>>>>>>>>
74527>>>>>>>>> end
74527>>>>>>>>>>
74527>>>>>>>>> End_Procedure
74528>>>>>>>>>
74528>>>>>>>>> //***
74528>>>>>>>>> Procedure DFSetFont String sFontName
74530>>>>>>>>> boolean bOk
74530>>>>>>>>> Move (WP_SetFontName(sFontName)) To bOk
74531>>>>>>>>>
74531>>>>>>>>> If not bOK Begin
74533>>>>>>>>> Error DFERR_WINPRINT DFPrintError904
74534>>>>>>>>>>
74534>>>>>>>>> End
74534>>>>>>>>>>
74534>>>>>>>>> End_Procedure
74535>>>>>>>>>
74535>>>>>>>>>
74535>>>>>>>>> //***
74535>>>>>>>>> Procedure DFSetFontSize Integer iHeight Integer iWidth
74537>>>>>>>>> boolean bOk
74537>>>>>>>>> // note that width is ignored in new implementation
74537>>>>>>>>> Move (WP_SetFontHeight(iHeight)) To bOk
74538>>>>>>>>>
74538>>>>>>>>> If not bOK Begin
74540>>>>>>>>> Error DFERR_WINPRINT DFPrintError905
74541>>>>>>>>>>
74541>>>>>>>>> End
74541>>>>>>>>>>
74541>>>>>>>>> End_Procedure
74542>>>>>>>>>
74542>>>>>>>>>
74542>>>>>>>>> //***
74542>>>>>>>>> Procedure DFSetFontStyle DWORD dwStyle
74544>>>>>>>>> boolean bOk
74544>>>>>>>>> Move (WP_SetFontStyle(dwStyle)) To bOk
74545>>>>>>>>>
74545>>>>>>>>> If not bOK Begin
74547>>>>>>>>> Error DFERR_WINPRINT DFPrintError906
74548>>>>>>>>>>
74548>>>>>>>>> End
74548>>>>>>>>>>
74548>>>>>>>>> End_Procedure
74549>>>>>>>>>
74549>>>>>>>>>
74549>>>>>>>>> //***
74549>>>>>>>>> Procedure DFSetUnderline boolean bUnderline
74551>>>>>>>>> boolean bOk
74551>>>>>>>>>
74551>>>>>>>>> Move (WP_SetFontUnderline(bUnderline)) To bOk
74552>>>>>>>>>
74552>>>>>>>>> If not bOK Begin
74554>>>>>>>>> Error DFERR_WINPRINT DFPrintError907
74555>>>>>>>>>>
74555>>>>>>>>> End
74555>>>>>>>>>>
74555>>>>>>>>> End_Procedure
74556>>>>>>>>>
74556>>>>>>>>>
74556>>>>>>>>> //***
74556>>>>>>>>> Procedure DFSetBold Boolean bBold
74558>>>>>>>>> Boolean bOk
74558>>>>>>>>>
74558>>>>>>>>> Move (WP_SetFontBold(bBold)) To bOk
74559>>>>>>>>>
74559>>>>>>>>> If not bOK Begin
74561>>>>>>>>> Error DFERR_WINPRINT DFPrintError908
74562>>>>>>>>>>
74562>>>>>>>>> End
74562>>>>>>>>>>
74562>>>>>>>>> End_Procedure
74563>>>>>>>>>
74563>>>>>>>>>
74563>>>>>>>>> //***
74563>>>>>>>>> Procedure DFSetItalic Boolean bItalic
74565>>>>>>>>> Boolean bOk
74565>>>>>>>>>
74565>>>>>>>>> Move (WP_SetFontItalic(bItalic)) To bOk
74566>>>>>>>>>
74566>>>>>>>>> If not bOK Begin
74568>>>>>>>>> Error DFERR_WINPRINT DFPrintError909
74569>>>>>>>>>>
74569>>>>>>>>> End
74569>>>>>>>>>>
74569>>>>>>>>> End_Procedure
74570>>>>>>>>>
74570>>>>>>>>>
74570>>>>>>>>> //***
74570>>>>>>>>> Procedure DFSetStrikeout Boolean bStrikeout
74572>>>>>>>>> Boolean bOk
74572>>>>>>>>>
74572>>>>>>>>> Move (WP_SetFontStrikeout(bStrikeout)) To bOk
74573>>>>>>>>>
74573>>>>>>>>> If not bOK Begin
74575>>>>>>>>> Error DFERR_WINPRINT DFPrintError910
74576>>>>>>>>>>
74576>>>>>>>>> End
74576>>>>>>>>>>
74576>>>>>>>>> End_Procedure
74577>>>>>>>>>
74577>>>>>>>>>
74577>>>>>>>>> //***
74577>>>>>>>>> Procedure DFSetMargins Number nLeft Number nTop Number nRight Number nBottom
74579>>>>>>>>> Boolean bOk
74579>>>>>>>>> integer iLeft iRight iTop iBottom
74579>>>>>>>>>
74579>>>>>>>>> Move (nLeft * 100) to iLeft
74580>>>>>>>>> Move (nRight * 100) to iRight
74581>>>>>>>>> Move (nTop * 100) to iTop
74582>>>>>>>>> Move (nBottom * 100) to iBottom
74583>>>>>>>>>
74583>>>>>>>>> Move (WP_SetMargins(iLeft,iTop,iRight,iBottom)) To bOk
74584>>>>>>>>>
74584>>>>>>>>> If bOk Begin
74586>>>>>>>>> Set DFLeft_Margin To nLeft
74587>>>>>>>>> Set DFTop_Margin To nTop
74588>>>>>>>>> Set DFRight_Margin To nRight
74589>>>>>>>>> Set DFBottom_Margin To nBottom
74590>>>>>>>>> End
74590>>>>>>>>>>
74590>>>>>>>>> Else Begin
74591>>>>>>>>> Error DFERR_WINPRINT DFPrintError911
74592>>>>>>>>>>
74592>>>>>>>>> End
74592>>>>>>>>>>
74592>>>>>>>>> End_Procedure
74593>>>>>>>>>
74593>>>>>>>>>
74593>>>>>>>>> //***
74593>>>>>>>>> Procedure DFSetLeftMargin Number nLeft
74595>>>>>>>>> number nTop nRight nBottom
74595>>>>>>>>> Get DFTop_Margin To nTop
74596>>>>>>>>> Get DFRight_Margin To nRight
74597>>>>>>>>> Get DFBottom_Margin To nBottom
74598>>>>>>>>> Send DFSetMargins nLeft nTop nRight nBottom
74599>>>>>>>>> End_Procedure
74600>>>>>>>>>
74600>>>>>>>>>
74600>>>>>>>>> //***
74600>>>>>>>>> Procedure DFSetRightMargin Number nRight
74602>>>>>>>>> number nLeft nTop nBottom
74602>>>>>>>>> Get DFLeft_Margin To nLeft
74603>>>>>>>>> Get DFTop_Margin To nTop
74604>>>>>>>>> Get DFBottom_Margin To nBottom
74605>>>>>>>>> Send DFSetMargins nLeft nTop nRight nBottom
74606>>>>>>>>> End_Procedure
74607>>>>>>>>>
74607>>>>>>>>>
74607>>>>>>>>> //***
74607>>>>>>>>> Procedure DFSetTopMargin Number nTop
74609>>>>>>>>> number nLeft nRight nBottom
74609>>>>>>>>> Get DFLeft_Margin To nLeft
74610>>>>>>>>> Get DFRight_Margin To nRight
74611>>>>>>>>> Get DFBottom_Margin To nBottom
74612>>>>>>>>> Send DFSetMargins nLeft nTop nRight nBottom
74613>>>>>>>>> End_Procedure
74614>>>>>>>>>
74614>>>>>>>>>
74614>>>>>>>>> //***
74614>>>>>>>>> Procedure DFSetBottomMargin Number nBottom
74616>>>>>>>>> number nLeft nTop nRight
74616>>>>>>>>> Get DFLeft_Margin To nLeft
74617>>>>>>>>> Get DFTop_Margin To nTop
74618>>>>>>>>> Get DFRight_Margin To nRight
74619>>>>>>>>> Send DFSetMargins nLeft nTop nRight nBottom
74620>>>>>>>>> End_Procedure
74621>>>>>>>>>
74621>>>>>>>>>
74621>>>>>>>>> //***
74621>>>>>>>>> Procedure DFWriteText String sText Integer iStyle Integer iColumn Integer iDecimal Boolean bNewLineAfterPrint
74623>>>>>>>>> Boolean bOk
74623>>>>>>>>>
74623>>>>>>>>> Send DFSetFontStyle iStyle
74624>>>>>>>>> Get ToAnsi sText To sText
74625>>>>>>>>> Move (WP_WriteText(sText,bNewLineAfterPrint,iColumn,iDecimal,0)) To bOk
74626>>>>>>>>> If not bOk Begin
74628>>>>>>>>> Error DFERR_WINPRINT DFPrintError918
74629>>>>>>>>>>
74629>>>>>>>>> End
74629>>>>>>>>>>
74629>>>>>>>>> Send PumpMsgQueue // permit painting //JJT!!!!!!!!!!!
74630>>>>>>>>> End_Procedure
74631>>>>>>>>>
74631>>>>>>>>> //***
74631>>>>>>>>> Procedure DFWrite String sText DWORD iStyle Integer iColumn Integer iDecimal Boolean bTrim
74633>>>>>>>>> If (Num_Arguments>=5 and bTrim) Begin
74635>>>>>>>>> Move (Rtrim(sText)) to sText
74636>>>>>>>>> end
74636>>>>>>>>>>
74636>>>>>>>>> Send DFWriteText sText iStyle iColumn iDecimal False
74637>>>>>>>>> End_Procedure
74638>>>>>>>>>
74638>>>>>>>>> //***
74638>>>>>>>>> Procedure DFWriteLn String sText DWORD iStyle Integer iColumn Integer iDecimal Boolean bTrim
74640>>>>>>>>> If (Num_Arguments>=5 and bTrim) Begin
74642>>>>>>>>> Move (Rtrim(sText)) to sText
74643>>>>>>>>> end
74643>>>>>>>>>>
74643>>>>>>>>> Send DFWriteText sText iStyle iColumn iDecimal True
74644>>>>>>>>> End_Procedure
74645>>>>>>>>>
74645>>>>>>>>>
74645>>>>>>>>> //***
74645>>>>>>>>> Procedure DFWriteTextAtPosition String sText integer iStyle Number nPosition Integer iDecimal ; Number nMaxLength Boolean bNewLineAfterPrint
74647>>>>>>>>> Boolean bOk
74647>>>>>>>>> Integer iPosition iMaxLength
74647>>>>>>>>> Send DFSetFontStyle iStyle
74648>>>>>>>>> Get ToAnsi sText To sText
74649>>>>>>>>> Move (nPosition * 100) to iPosition
74650>>>>>>>>> Move (nMaxLength * 100) to iMaxLength
74651>>>>>>>>> Move (WP_WriteTextAtPosition(sText,bNewLineAfterPrint,iPosition,iDecimal,iMaxLength)) To bOk
74652>>>>>>>>> If not bOk Begin
74654>>>>>>>>> Error DFERR_WINPRINT DFPrintError922
74655>>>>>>>>>>
74655>>>>>>>>> End
74655>>>>>>>>>>
74655>>>>>>>>> Send PumpMsgQueue // permit painting //JJT!!!!!!!!!!!
74656>>>>>>>>> End_Procedure
74657>>>>>>>>>
74657>>>>>>>>> //***
74657>>>>>>>>> Procedure DFWritePos String sText integer iStyle Number nPosition Integer iDecimal Number nMaxLength boolean bTrim
74659>>>>>>>>> Number nMax
74659>>>>>>>>> If (Num_Arguments>=6 and bTrim) Begin
74661>>>>>>>>> Move (Rtrim(sText)) to sText
74662>>>>>>>>> end
74662>>>>>>>>>>
74662>>>>>>>>>
74662>>>>>>>>> If (Num_Arguments<5) ; Move 0 to nMax
74665>>>>>>>>> Else ; Move nMaxLength to nMax
74667>>>>>>>>> Send DFWriteTextAtPosition sText iStyle nPosition iDecimal nMax False
74668>>>>>>>>> End_Procedure
74669>>>>>>>>>
74669>>>>>>>>> //***
74669>>>>>>>>> Procedure DFWriteLnPos String sText integer iStyle Number nPosition Integer iDecimal Number nMaxLength boolean bTrim
74671>>>>>>>>> Number nMax
74671>>>>>>>>> If (Num_Arguments>=6 and bTrim) Begin
74673>>>>>>>>> Move (Rtrim(sText)) to sText
74674>>>>>>>>> end
74674>>>>>>>>>>
74674>>>>>>>>>
74674>>>>>>>>> If (Num_Arguments<5) ; Move 0 to nMax
74677>>>>>>>>> Else ; Move nMaxLength to nMax
74679>>>>>>>>> Send DFWriteTextAtPosition sText iStyle nPosition iDecimal nMax True
74680>>>>>>>>> End_Procedure
74681>>>>>>>>>
74681>>>>>>>>> Procedure DFSetMetrics String sMetrics
74683>>>>>>>>> integer eMetrics
74683>>>>>>>>> // for backwards compatibility support both string names and integer enumerations
74683>>>>>>>>> // it is better to use the enumeration value
74683>>>>>>>>> If (sMetrics="INCH" or sMetrics="CM") Begin
74685>>>>>>>>> Set DFCurrent_Metrics to sMetrics
74686>>>>>>>>> end
74686>>>>>>>>>>
74686>>>>>>>>> else Begin
74687>>>>>>>>> Move sMetrics to eMetrics
74688>>>>>>>>> Move (WP_SetMetrics(eMetrics)) To eMetrics
74689>>>>>>>>> End
74689>>>>>>>>>>
74689>>>>>>>>> End_Procedure
74690>>>>>>>>>
74690>>>>>>>>> Function DFGetMetrics Returns Integer
74692>>>>>>>>> Integer eMetrics
74692>>>>>>>>> Move (WP_GetMetrics()) To eMetrics
74693>>>>>>>>> Function_return eMetrics
74694>>>>>>>>> End_Function
74695>>>>>>>>>
74695>>>>>>>>>
74695>>>>>>>>> //**** Properties Maintained for compatibility with old Winprint (obsolete)
74695>>>>>>>>> Function DFCurrent_Metrics returns string
74697>>>>>>>>> Integer eMetrics
74697>>>>>>>>> Get DFGetMetrics to eMetrics
74698>>>>>>>>> Function_return (if(eMetrics=WPM_INCH,"INCH","CM"))
74699>>>>>>>>> end_function
74700>>>>>>>>>
74700>>>>>>>>> Procedure Set DFCurrent_Metrics string sCMorINCH
74702>>>>>>>>> Send DFSetMetrics (if(sCMorINCH="INCH", WPM_INCH, WPM_CM))
74703>>>>>>>>> End_Procedure
74704>>>>>>>>>
74704>>>>>>>>>
74704>>>>>>>>>
74704>>>>>>>>>
74704>>>>>>>>>
74704>>>>>>>>> //***
74704>>>>>>>>> Procedure DFBeginHeaderType Integer iHeaderNr Integer eHeaderType
74706>>>>>>>>> Boolean bOk
74706>>>>>>>>>
74706>>>>>>>>> If (eHeaderType=DFSubHeader or eHeaderType=DFSubTotal) Begin
74708>>>>>>>>> //*** Do nothing for the moment
74708>>>>>>>>> End
74708>>>>>>>>>>
74708>>>>>>>>> Else ; Move 0 to iHeaderNr // If the user made a mistake
74710>>>>>>>>>
74710>>>>>>>>> Set DFCurrent_HeaderType To eHeaderType
74711>>>>>>>>> Set DFCurrent_HeaderNr To iHeaderNr
74712>>>>>>>>>
74712>>>>>>>>> Move (WP_BeginHeader(eHeaderType, iHeaderNr)) To bOk
74713>>>>>>>>>
74713>>>>>>>>> If not bOk Begin
74715>>>>>>>>> Error DFERR_WINPRINT DFPrintError925
74716>>>>>>>>>>
74716>>>>>>>>> End
74716>>>>>>>>>>
74716>>>>>>>>> End_Procedure
74717>>>>>>>>>
74717>>>>>>>>>
74717>>>>>>>>> //***
74717>>>>>>>>> Procedure DFEndHeaderType
74719>>>>>>>>> Boolean bOk
74719>>>>>>>>>
74719>>>>>>>>> Move (WP_EndHeader()) To bOk
74720>>>>>>>>>
74720>>>>>>>>> if not bOk begin
74722>>>>>>>>> Error DFERR_WINPRINT DFPrintError926
74723>>>>>>>>>>
74723>>>>>>>>> End
74723>>>>>>>>>>
74723>>>>>>>>> End_Procedure
74724>>>>>>>>>
74724>>>>>>>>>
74724>>>>>>>>> //***
74724>>>>>>>>> Procedure DFWriteHeaderType Integer iHeaderNr Integer eHeaderType
74726>>>>>>>>> Boolean bOk
74726>>>>>>>>> Move (WP_WriteHeader(eHeaderType, iHeaderNr)) To bOk
74727>>>>>>>>> if not bOk begin
74729>>>>>>>>> Error DFERR_WINPRINT DFPrintError927
74730>>>>>>>>>>
74730>>>>>>>>> End
74730>>>>>>>>>>
74730>>>>>>>>> End_Procedure
74731>>>>>>>>>
74731>>>>>>>>>
74731>>>>>>>>> //***
74731>>>>>>>>> Procedure DFHeaderPosition Integer ePlace
74733>>>>>>>>> Boolean bOk
74733>>>>>>>>>
74733>>>>>>>>> Move (WP_SetHeaderPlacement(ePlace)) To bOk
74734>>>>>>>>>
74734>>>>>>>>> if not bOk begin
74736>>>>>>>>> Error DFERR_WINPRINT DFPrintError929
74737>>>>>>>>>>
74737>>>>>>>>> End
74737>>>>>>>>>>
74737>>>>>>>>> End_Procedure
74738>>>>>>>>>
74738>>>>>>>>>
74738>>>>>>>>> //***
74738>>>>>>>>> Procedure DFHeaderFrameType Integer eFrame integer iColor Number nWeight; Integer iFillColor Boolean bFillFrame
74740>>>>>>>>> Integer iWeight
74740>>>>>>>>> Boolean bOk
74740>>>>>>>>>
74740>>>>>>>>> move (nWeight*100) To iWeight
74741>>>>>>>>>
74741>>>>>>>>> Move (WP_SetHeaderFrame(eFrame,iColor,iWeight,iFillColor,bFillFrame)) To bOk
74742>>>>>>>>>
74742>>>>>>>>> if not bOk begin
74744>>>>>>>>> Error DFERR_WINPRINT DFPrintError930
74745>>>>>>>>>>
74745>>>>>>>>> End
74745>>>>>>>>>>
74745>>>>>>>>> End_Procedure
74746>>>>>>>>>
74746>>>>>>>>> Procedure DFHeaderMargin Integer eType Number nSize
74748>>>>>>>>> Boolean bOk
74748>>>>>>>>> Integer iSize
74748>>>>>>>>>
74748>>>>>>>>> move (nSize * 100) to iSize
74749>>>>>>>>>
74749>>>>>>>>> move (WP_SetHeaderMargin(eType, iSize)) To bOk
74750>>>>>>>>>
74750>>>>>>>>> if not bOk begin
74752>>>>>>>>> Error DFERR_WINPRINT DFPrintError930
74753>>>>>>>>>>
74753>>>>>>>>> end
74753>>>>>>>>>>
74753>>>>>>>>> End_Procedure
74754>>>>>>>>>
74754>>>>>>>>>
74754>>>>>>>>> //***
74754>>>>>>>>> Procedure DFHeaderWrap Integer eOnOff
74756>>>>>>>>> Boolean bOk
74756>>>>>>>>>
74756>>>>>>>>> Move (WP_SetHeaderWrap(eOnOff)) To bOk
74757>>>>>>>>>
74757>>>>>>>>> if not bOk begin
74759>>>>>>>>> Error DFERR_WINPRINT DFPrintError931
74760>>>>>>>>>>
74760>>>>>>>>> End
74760>>>>>>>>>>
74760>>>>>>>>> End_Procedure
74761>>>>>>>>>
74761>>>>>>>>> //***
74761>>>>>>>>> Procedure DFWriteBMP String sFileName Number nStartX Number nStartY Number nHeight Number nWidth Boolean bUCp
74763>>>>>>>>> Boolean bOk
74763>>>>>>>>> Integer iStartX iStartY iHeight iWidth
74763>>>>>>>>>
74763>>>>>>>>> If ((nStartX = -998) or (nStartX = -999)); move nStartX to iStartX
74766>>>>>>>>> else ; move (nStartX*100) To iStartX
74768>>>>>>>>>
74768>>>>>>>>> If ((nStartY = -998) or (nStartY = -999)); move nStartY to iStartY
74771>>>>>>>>> else ; move (nStartY*100) To iStartY
74773>>>>>>>>>
74773>>>>>>>>> If ((nWidth = -998) or (nWidth = -999)); move nWidth To iWidth
74776>>>>>>>>> else ; move (nWidth*100) To iWidth
74778>>>>>>>>>
74778>>>>>>>>> If ((nHeight = -998) or (nHeight = -999)); move nHeight To iHeight
74781>>>>>>>>> else ; move (nHeight*100) To iHeight
74783>>>>>>>>>
74783>>>>>>>>> Get_File_Path sFileName To sFileName
74784>>>>>>>>> Move (WP_DrawBitmap(sFileName,iStartX,iStartY,iWidth,iHeight,bUCp)) to bOk
74785>>>>>>>>>
74785>>>>>>>>> If not bOk Begin
74787>>>>>>>>> Error DFERR_WINPRINT DFPrintError932
74788>>>>>>>>>>
74788>>>>>>>>> End
74788>>>>>>>>>>
74788>>>>>>>>> End_Procedure
74789>>>>>>>>>
74789>>>>>>>>>
74789>>>>>>>>> //***
74789>>>>>>>>> Procedure DFHeaderLineCheck Integer iLines
74791>>>>>>>>> Boolean bOk
74791>>>>>>>>>
74791>>>>>>>>> Move (WP_SetExtraLineCheck(iLines)) To bOk
74792>>>>>>>>>
74792>>>>>>>>> If not bOk begin
74794>>>>>>>>> Error DFERR_WINPRINT DFPrintError934
74795>>>>>>>>>>
74795>>>>>>>>> End
74795>>>>>>>>>>
74795>>>>>>>>> End_Procedure
74796>>>>>>>>>
74796>>>>>>>>>
74796>>>>>>>>> //***
74796>>>>>>>>> Procedure DFPrintFlags Integer Flags
74798>>>>>>>>> Boolean bOk
74798>>>>>>>>>
74798>>>>>>>>> Move (WP_SetPrintDialogFlags(Flags)) To bOk
74799>>>>>>>>>
74799>>>>>>>>> If not bOk begin
74801>>>>>>>>> Error DFERR_WINPRINT DFPrintError935
74802>>>>>>>>>>
74802>>>>>>>>> End
74802>>>>>>>>>>
74802>>>>>>>>> End_Procedure
74803>>>>>>>>>
74803>>>>>>>>>
74803>>>>>>>>> //*** obsolete and maintained for winprint-I backwards compatibility (maybe should be removed)
74803>>>>>>>>> //
74803>>>>>>>>> Procedure DFSelectPrinter String sDriver String sDevice String sPort Boolean bUpdate
74805>>>>>>>>> Send DFSetDevice sDevice
74806>>>>>>>>> End_Procedure
74807>>>>>>>>>
74807>>>>>>>>> //*** Preferred usage for WinprintII
74807>>>>>>>>> Procedure DFSetDevice String sDevice
74809>>>>>>>>> Boolean bOk
74809>>>>>>>>>
74809>>>>>>>>> Move (WP_SelectPrinter(sDevice)) To bOk
74810>>>>>>>>>
74810>>>>>>>>> If not bOk Begin
74812>>>>>>>>> Error DFERR_WINPRINT DFPrintError936
74813>>>>>>>>>>
74813>>>>>>>>> End
74813>>>>>>>>>>
74813>>>>>>>>> End_Procedure
74814>>>>>>>>>
74814>>>>>>>>> Procedure DFPrinterBinFirstPage Integer eBin
74816>>>>>>>>> Boolean bOk
74816>>>>>>>>>
74816>>>>>>>>> Move (WP_SetFirstPagePaperSource(eBin)) To bOk
74817>>>>>>>>>
74817>>>>>>>>> If not bOk Begin
74819>>>>>>>>> Error DFERR_WINPRINT DFPrintError937
74820>>>>>>>>>>
74820>>>>>>>>> End
74820>>>>>>>>>>
74820>>>>>>>>> End_Procedure
74821>>>>>>>>>
74821>>>>>>>>>
74821>>>>>>>>> //***
74821>>>>>>>>> Function DFGetDFColor Integer iRed Integer iGreen Integer iBlue Returns Integer
74823>>>>>>>>> Integer iColor
74823>>>>>>>>>
74823>>>>>>>>> Move (WP_RGBToDFPrintColor(iRed,iGreen,iBlue)) To iColor
74824>>>>>>>>>
74824>>>>>>>>> If (iColor=0) Begin
74826>>>>>>>>> Error DFERR_WINPRINT DFPrintError938
74827>>>>>>>>>>
74827>>>>>>>>> End
74827>>>>>>>>>>
74827>>>>>>>>> Function_Return iColor
74828>>>>>>>>> End_Function
74829>>>>>>>>>
74829>>>>>>>>>
74829>>>>>>>>> //***
74829>>>>>>>>> Procedure DFSetDFColor Dword dwColor
74831>>>>>>>>> Integer bOk
74831>>>>>>>>>
74831>>>>>>>>> Move (WP_SetFontColor(dwColor)) To bOk
74832>>>>>>>>>
74832>>>>>>>>> If not bOk Begin
74834>>>>>>>>> Error DFERR_WINPRINT DFPrintError939
74835>>>>>>>>>>
74835>>>>>>>>> End
74835>>>>>>>>>>
74835>>>>>>>>> End_Procedure
74836>>>>>>>>>
74836>>>>>>>>>
74836>>>>>>>>> //***
74836>>>>>>>>> Procedure DFSetTopBottom Number nTop Number nBottom Boolean bAllPages
74838>>>>>>>>> Boolean bOk
74838>>>>>>>>> Integer iTop iBottom
74838>>>>>>>>>
74838>>>>>>>>> move (nTop*100) To iTop
74839>>>>>>>>> move (nBottom*100) To iBottom
74840>>>>>>>>>
74840>>>>>>>>> Move (WP_SetAbsoluteMargins(iTop,iBottom,bAllPages)) To bOk
74841>>>>>>>>>
74841>>>>>>>>> If Not bOk Begin
74843>>>>>>>>> Error DFERR_WINPRINT DFPrintError940
74844>>>>>>>>>>
74844>>>>>>>>> End
74844>>>>>>>>>>
74844>>>>>>>>> End_Procedure
74845>>>>>>>>>
74845>>>>>>>>>
74845>>>>>>>>> //***
74845>>>>>>>>> Procedure DFSetJMode Integer eAlign
74847>>>>>>>>> Boolean bOk
74847>>>>>>>>>
74847>>>>>>>>> Move (WP_SetAlign(eAlign)) To bOk
74848>>>>>>>>>
74848>>>>>>>>> If Not bOk Begin
74850>>>>>>>>> Error DFERR_WINPRINT DFPrintError941
74851>>>>>>>>>>
74851>>>>>>>>> End
74851>>>>>>>>>>
74851>>>>>>>>> End_Procedure
74852>>>>>>>>>
74852>>>>>>>>>
74852>>>>>>>>> //***
74852>>>>>>>>> Procedure DFWriteEllip Number nStartX Number nStartY Number nHeight Number nWidth ; Dword dwBColor Dword dwFColor Boolean bFill Number nWeight Boolean bWrap Boolean bUCp
74854>>>>>>>>>
74854>>>>>>>>> Boolean bOk
74854>>>>>>>>> Integer iWeight
74854>>>>>>>>> Integer iStartX iStartY iHeight iWidth
74854>>>>>>>>>
74854>>>>>>>>> If ((nStartX = -998) or (nStartX = -999)); move nStartX To iStartX
74857>>>>>>>>> else ; move (nStartX*100) To iStartX
74859>>>>>>>>>
74859>>>>>>>>> If ((nStartY = -998) or (nStartY = -999)); move nStartY To iStartY
74862>>>>>>>>> else ; move (nStartY*100) To iStartY
74864>>>>>>>>>
74864>>>>>>>>> If ((nWidth = -998) or (nWidth = -999)); move nWidth To iWidth
74867>>>>>>>>> else ; move (nWidth*100) To iWidth
74869>>>>>>>>>
74869>>>>>>>>> If ((nHeight = -998) or (nHeight = -999)); move nHeight To iHeight
74872>>>>>>>>> else ; move (nHeight*100) To iHeight
74874>>>>>>>>>
74874>>>>>>>>> move (nWeight*100) To iWeight
74875>>>>>>>>>
74875>>>>>>>>>
74875>>>>>>>>> Move (WP_DrawEllipse(iStartX,iStartY,iWidth,iHeight,; dwBColor,dwFColor,bFill,iWeight,bUCp,bWrap)) To bOk
74876>>>>>>>>>
74876>>>>>>>>> If Not bOk Begin
74878>>>>>>>>> Error DFERR_WINPRINT DFPrintError942
74879>>>>>>>>>>
74879>>>>>>>>> End
74879>>>>>>>>>>
74879>>>>>>>>> End_Procedure
74880>>>>>>>>>
74880>>>>>>>>>
74880>>>>>>>>>
74880>>>>>>>>>
74880>>>>>>>>> //***
74880>>>>>>>>> Procedure DFWriteRect Number nStartX Number nStartY Number nHeight Number nWidth; Dword dwBColor Dword dwFColor Boolean bFill Number nWeight Boolean bWrap Boolean bUCp
74882>>>>>>>>>
74882>>>>>>>>> Boolean bOk
74882>>>>>>>>> Integer iWeight
74882>>>>>>>>> Integer iStartX iStartY iHeight iWidth
74882>>>>>>>>>
74882>>>>>>>>> If ((nStartX = -998) or (nStartX = -999)); move nStartX To iStartX
74885>>>>>>>>> else ; move (nStartX*100) To iStartX
74887>>>>>>>>>
74887>>>>>>>>> If ((nStartY = -998) or (nStartY = -999)); move nStartY To iStartY
74890>>>>>>>>> else ; move (nStartY*100) To iStartY
74892>>>>>>>>>
74892>>>>>>>>> If ((nWidth = -998) or (nWidth = -999)); move nWidth To iWidth
74895>>>>>>>>> else ; move (nWidth*100) To iWidth
74897>>>>>>>>>
74897>>>>>>>>> If ((nHeight = -998) or (nHeight = -999)); move nHeight To iHeight
74900>>>>>>>>> else ; move (nHeight*100) To iHeight
74902>>>>>>>>>
74902>>>>>>>>> move (nWeight*100) To iWeight
74903>>>>>>>>>
74903>>>>>>>>> Move (WP_DrawRectangle(iStartX,iStartY,iWidth,iHeight,; dwBColor,dwFColor,bFill,iWeight,bUCp,bWrap)) To bOk
74904>>>>>>>>>
74904>>>>>>>>> If Not bOk Begin
74906>>>>>>>>> Error DFERR_WINPRINT DFPrintError944
74907>>>>>>>>>>
74907>>>>>>>>> End
74907>>>>>>>>>>
74907>>>>>>>>> End_Procedure
74908>>>>>>>>>
74908>>>>>>>>>
74908>>>>>>>>>
74908>>>>>>>>>
74908>>>>>>>>> //***
74908>>>>>>>>> Procedure DFLineCheck Integer iLines
74910>>>>>>>>> Boolean bOk
74910>>>>>>>>>
74910>>>>>>>>> Move (WP_ConfirmLines(iLines)) To bOk
74911>>>>>>>>>
74911>>>>>>>>> If Not bOk Begin
74913>>>>>>>>> Error DFERR_WINPRINT DFPrintError946
74914>>>>>>>>>>
74914>>>>>>>>> End
74914>>>>>>>>>>
74914>>>>>>>>> End_Procedure
74915>>>>>>>>>
74915>>>>>>>>>
74915>>>>>>>>> //***
74915>>>>>>>>> Procedure DFCreateDiagram Integer eType Integer eFx Number nHeight Number nWidth Integer bXyAxis
74917>>>>>>>>> Handle hDiagram
74917>>>>>>>>> Integer iWidth iHeight
74917>>>>>>>>>
74917>>>>>>>>> move (nHeight*100) To iHeight
74918>>>>>>>>> move (nWidth*100) To iWidth
74919>>>>>>>>>
74919>>>>>>>>> Set DFCurrent_Color To 0
74920>>>>>>>>>
74920>>>>>>>>> Move (WP_CreateDiagram(eType,eFx,iWidth,iHeight,bXyAxis)) To hDiagram
74921>>>>>>>>>
74921>>>>>>>>> If (hDiagram) Begin
74923>>>>>>>>> Error DFERR_WINPRINT DFPrintError947
74924>>>>>>>>>>
74924>>>>>>>>> End
74924>>>>>>>>>>
74924>>>>>>>>> Else Begin
74925>>>>>>>>> Set DFCurrent_Diagram To hDiagram
74926>>>>>>>>> end
74926>>>>>>>>>>
74926>>>>>>>>> End_Procedure
74927>>>>>>>>>
74927>>>>>>>>>
74927>>>>>>>>> //***
74927>>>>>>>>> Procedure DFDiagram_Item handle hDiagram String sLabel Number nValue; Dword dwBColor Dword dwFColor Integer eFill; Integer iDec Integer eValueOrPercent Integer eExt
74929>>>>>>>>>
74929>>>>>>>>> Boolean bOk
74929>>>>>>>>> Integer iCurrColor iValue
74929>>>>>>>>>
74929>>>>>>>>> If (dwFColor = -1) Begin
74931>>>>>>>>> Get DFCurrent_Color To iCurrColor
74932>>>>>>>>> Increment iCurrColor
74933>>>>>>>>> If (iCurrColor>15) Move 1 To iCurrColor
74936>>>>>>>>> Set DFCurrent_Color To iCurrColor
74937>>>>>>>>> Get DFGetColor iCurrColor To dwFColor
74938>>>>>>>>> End
74938>>>>>>>>>>
74938>>>>>>>>>
74938>>>>>>>>> Move (nValue *100) to iValue
74939>>>>>>>>>
74939>>>>>>>>> Get ToAnsi sLabel To sLabel
74940>>>>>>>>>
74940>>>>>>>>> Move (WP_AddDiagramEntry(hDiagram,sLabel,iValue,dwBColor,dwFColor,eFill,iDec,eValueorPercent,eExt)) To bOk
74941>>>>>>>>>
74941>>>>>>>>> If not bOk Begin
74943>>>>>>>>> Error DFERR_WINPRINT DFPrintError948
74944>>>>>>>>>>
74944>>>>>>>>> End
74944>>>>>>>>>>
74944>>>>>>>>> End_Procedure
74945>>>>>>>>>
74945>>>>>>>>>
74945>>>>>>>>> //***
74945>>>>>>>>> Procedure DFLockDiagram Handle hDiagram
74947>>>>>>>>> Boolean bOk
74947>>>>>>>>>
74947>>>>>>>>> Move (WP_LockDiagram(hDiagram)) To bOk
74948>>>>>>>>>
74948>>>>>>>>> If not bOk Begin
74950>>>>>>>>> Error DFERR_WINPRINT DFPrintError949
74951>>>>>>>>>>
74951>>>>>>>>> End
74951>>>>>>>>>>
74951>>>>>>>>> End_Procedure
74952>>>>>>>>>
74952>>>>>>>>>
74952>>>>>>>>>
74952>>>>>>>>> //***
74952>>>>>>>>> Procedure DFDrawDiagram Handle hDiagram Number nYPos Number nXPos Boolean bUCp
74954>>>>>>>>> Boolean bOk
74954>>>>>>>>> Integer iXPos
74954>>>>>>>>> Integer iYPos
74954>>>>>>>>>
74954>>>>>>>>> move (nXPos*100) To iXPos
74955>>>>>>>>> move (nYPos*100) To iYPos
74956>>>>>>>>>
74956>>>>>>>>> If nYPos Eq -999 Move -999 To iYPos
74959>>>>>>>>>
74959>>>>>>>>> Move (WP_DrawDiagram(hDiagram,iXPos,iYPos,bUCp)) To bOk
74960>>>>>>>>>
74960>>>>>>>>> If not bOk Begin
74962>>>>>>>>> Error DFERR_WINPRINT DFPrintError950
74963>>>>>>>>>>
74963>>>>>>>>> End
74963>>>>>>>>>>
74963>>>>>>>>> End_Procedure
74964>>>>>>>>>
74964>>>>>>>>>
74964>>>>>>>>>
74964>>>>>>>>> //***
74964>>>>>>>>> Procedure DFDiagramLabel handle hDiagram String sLabel
74966>>>>>>>>> Boolean bOk
74966>>>>>>>>> Integer iLabelLen
74966>>>>>>>>>
74966>>>>>>>>> Get ToAnsi sLabel To sLabel
74967>>>>>>>>>
74967>>>>>>>>> Move (WP_SetDiagramCaption(hDiagram,sLabel)) To bOk
74968>>>>>>>>>
74968>>>>>>>>> if not bOk Begin
74970>>>>>>>>> Error DFERR_WINPRINT DFPrintError952
74971>>>>>>>>>>
74971>>>>>>>>> End
74971>>>>>>>>>>
74971>>>>>>>>> End_Procedure
74972>>>>>>>>>
74972>>>>>>>>>
74972>>>>>>>>> //***
74972>>>>>>>>> Procedure DFDiagramXLabel handle hDiagram String sLabel
74974>>>>>>>>> Boolean bOk
74974>>>>>>>>> Get ToAnsi sLabel To sLabel
74975>>>>>>>>>
74975>>>>>>>>> Move (WP_SetDiagramXText(hDiagram,sLabel)) To bOk
74976>>>>>>>>>
74976>>>>>>>>> if not bOk Begin
74978>>>>>>>>> Error DFERR_WINPRINT DFPrintError953
74979>>>>>>>>>>
74979>>>>>>>>> End
74979>>>>>>>>>>
74979>>>>>>>>> End_Procedure
74980>>>>>>>>>
74980>>>>>>>>>
74980>>>>>>>>> //***
74980>>>>>>>>> Procedure DFDiagramYLabel handle hDiagram String sLabel Boolean bVertical
74982>>>>>>>>> Boolean bOk
74982>>>>>>>>> Get ToAnsi sLabel To sLabel
74983>>>>>>>>>
74983>>>>>>>>> Move (WP_SetDiagramYText(hDiagram,sLabel,bVertical)) To bOk
74984>>>>>>>>>
74984>>>>>>>>> if not bOk Begin
74986>>>>>>>>> Error DFERR_WINPRINT DFPrintError954
74987>>>>>>>>>>
74987>>>>>>>>> End
74987>>>>>>>>>>
74987>>>>>>>>> End_Procedure
74988>>>>>>>>>
74988>>>>>>>>>
74988>>>>>>>>> //***
74988>>>>>>>>> Procedure DFWriteXYLine Number nStartX Number nStartY Number nStopX Number nStopY; Dword dwColor Number nWeight Boolean bWrap Boolean bUCp
74990>>>>>>>>>
74990>>>>>>>>> Boolean bOk
74990>>>>>>>>> Integer iStartX iStartY iStopX iStopY
74990>>>>>>>>> Integer iWeight
74990>>>>>>>>>
74990>>>>>>>>> move (nStartX*100) To iStartX
74991>>>>>>>>> move (nStartY*100) To iStartY
74992>>>>>>>>> move (nStopX*100) To iStopX
74993>>>>>>>>> move (nStopY*100) To iStopY
74994>>>>>>>>>
74994>>>>>>>>> move (nWeight*100) To iWeight
74995>>>>>>>>>
74995>>>>>>>>> If (nStopY = -998) Move -998 To iStopY
74998>>>>>>>>> If (nStopX = -998) Move -998 To iStopX
75001>>>>>>>>>
75001>>>>>>>>> If (nStartY = -999) Move -999 To iStartY
75004>>>>>>>>> If (nStartX = -999) Move -999 To iStartX
75007>>>>>>>>>
75007>>>>>>>>> Move (WP_DrawXYLine(iStartX,iStartY,iStopX,iStopY,dwColor,iWeight,bUCp,bWrap)) To bOk
75008>>>>>>>>>
75008>>>>>>>>> if not bOk Begin
75010>>>>>>>>> Error DFERR_WINPRINT DFPrintError955
75011>>>>>>>>>>
75011>>>>>>>>> End
75011>>>>>>>>>>
75011>>>>>>>>> End_Procedure
75012>>>>>>>>>
75012>>>>>>>>>
75012>>>>>>>>> //***
75012>>>>>>>>> Procedure DFWriteLine Number nStartX Number nStartY Number nLength; Boolean bHorizontal Dword dwColor Number nWeight Boolean bUCp
75014>>>>>>>>>
75014>>>>>>>>> Boolean bOk
75014>>>>>>>>> Integer iStartX iStartY iLength
75014>>>>>>>>> Integer iWeight
75014>>>>>>>>>
75014>>>>>>>>> move (nStartX*100) To iStartX
75015>>>>>>>>> move (nStartY*100) To iStartY
75016>>>>>>>>> move (nLength*100) To iLength
75017>>>>>>>>> move (nWeight*100) To iWeight
75018>>>>>>>>>
75018>>>>>>>>> If (nStartY = -999) Move -999 To iStartY
75021>>>>>>>>> If (nStartX = -999) Move -999 To iStartX
75024>>>>>>>>> If (nLength = -998) Move -998 To iLength
75027>>>>>>>>>
75027>>>>>>>>> Move (WP_DrawLine(iSTartX,iStartY,iLength,bHorizontal,dwColor,iWeight,bUCp)) To bOk
75028>>>>>>>>>
75028>>>>>>>>> if not bOk Begin
75030>>>>>>>>> Error DFERR_WINPRINT DFPrintError956
75031>>>>>>>>>>
75031>>>>>>>>> End
75031>>>>>>>>>>
75031>>>>>>>>> End_Procedure
75032>>>>>>>>>
75032>>>>>>>>>
75032>>>>>>>>> //***
75032>>>>>>>>> Procedure DFClearPrinter
75034>>>>>>>>> Boolean bOk
75034>>>>>>>>>
75034>>>>>>>>> Move (WP_ClearPrinter()) To bOk
75035>>>>>>>>>
75035>>>>>>>>> If not bOk Begin
75037>>>>>>>>> Error DFERR_WINPRINT DFPrintError957
75038>>>>>>>>>>
75038>>>>>>>>> End
75038>>>>>>>>>>
75038>>>>>>>>> End_Procedure
75039>>>>>>>>>
75039>>>>>>>>>
75039>>>>>>>>>
75039>>>>>>>>> //***
75039>>>>>>>>> Function DFGetCurrentDevice Returns String
75041>>>>>>>>> Boolean bOk
75041>>>>>>>>> String sDFStr
75041>>>>>>>>> Address pDFStr
75041>>>>>>>>>
75041>>>>>>>>> Move (Repeat( Character(0), 255 )) to sDFStr
75042>>>>>>>>> GetAddress of sDFStr to pDFStr
75043>>>>>>>>>
75043>>>>>>>>> Move (WP_GetCurrentDevice(pDFStr)) To bOk
75044>>>>>>>>>
75044>>>>>>>>> If not bOk Begin
75046>>>>>>>>> Error DFERR_WINPRINT DFPrintError959
75047>>>>>>>>>>
75047>>>>>>>>> End
75047>>>>>>>>>>
75047>>>>>>>>>
75047>>>>>>>>> Move (CString(sDFStr)) To sDFStr
75048>>>>>>>>> Function_Return sDFStr
75049>>>>>>>>> End_Function
75050>>>>>>>>>
75050>>>>>>>>>
75050>>>>>>>>> // Note: DfGetCurrentPort and DFGetCurrentDriver do not exist in winprint2. Trying to
75050>>>>>>>>> // use these will result in a runtime error (which is good - don't use them)
75050>>>>>>>>>
75050>>>>>>>>>
75050>>>>>>>>> //***
75050>>>>>>>>> Function DFGetPrintDialogFlags Returns Dword
75052>>>>>>>>> Dword dwRetVal
75052>>>>>>>>>
75052>>>>>>>>> Move (WP_GetPrintDialogFlags()) To dwRetVal
75053>>>>>>>>>
75053>>>>>>>>> Function_Return dwRetVal
75054>>>>>>>>> End_Function
75055>>>>>>>>>
75055>>>>>>>>>
75055>>>>>>>>> //***
75055>>>>>>>>> //*** Returns PRN_TRUE= if the flag is set (1)
75055>>>>>>>>> //*** Returns PRN_FALSE= If the flag not is set (0)
75055>>>>>>>>> //***
75055>>>>>>>>> Function DFCheckPrintDialogFlag Dword dwPDFlag Returns Boolean
75057>>>>>>>>> Boolean bIsSet
75057>>>>>>>>>
75057>>>>>>>>> Move (WP_IsPrintDialogFlagSet(dwPDFlag)) To bIsSet
75058>>>>>>>>>
75058>>>>>>>>> Function_Return bIsSet
75059>>>>>>>>> End_Function
75060>>>>>>>>>
75060>>>>>>>>>
75060>>>>>>>>> //***
75060>>>>>>>>> Procedure DFSetSpecPrintFlag Dword dwPDFlag
75062>>>>>>>>> Boolean bOk
75062>>>>>>>>>
75062>>>>>>>>> Move (WP_SetSpecificPrintDialogFlag(dwPDFlag)) To bOk
75063>>>>>>>>>
75063>>>>>>>>> If not bOk Begin
75065>>>>>>>>> Error DFERR_WINPRINT DFPrintError961
75066>>>>>>>>>>
75066>>>>>>>>> End
75066>>>>>>>>>>
75066>>>>>>>>> End_Procedure
75067>>>>>>>>>
75067>>>>>>>>>
75067>>>>>>>>> //***
75067>>>>>>>>> Function DFGetUserDefinedLength Returns Number
75069>>>>>>>>> Integer iRetVal
75069>>>>>>>>> Number nRetVal
75069>>>>>>>>>
75069>>>>>>>>> Move (WP_GetUserDefinedPapersize()) To iRetVal
75070>>>>>>>>>
75070>>>>>>>>> If (iRetVal=0) Begin
75072>>>>>>>>> Error DFERR_WINPRINT DFPrintError962
75073>>>>>>>>>>
75073>>>>>>>>> Function_Return 0
75074>>>>>>>>> End
75074>>>>>>>>>>
75074>>>>>>>>>
75074>>>>>>>>> Move (Hi(iRetVal)) To nRetVal
75075>>>>>>>>> move (nRetVal/100) To nRetVal //Returns CM
75076>>>>>>>>>
75076>>>>>>>>> Function_Return nRetVal
75077>>>>>>>>> End_Function
75078>>>>>>>>>
75078>>>>>>>>>
75078>>>>>>>>> //***
75078>>>>>>>>> Function DFGetUserDefinedWidth Returns Number
75080>>>>>>>>> Integer iRetVal
75080>>>>>>>>> Number nRetVal
75080>>>>>>>>>
75080>>>>>>>>> Move (WP_GetUserDefinedPapersize()) To iRetVal
75081>>>>>>>>>
75081>>>>>>>>> If (iRetVal=0) Begin
75083>>>>>>>>> Error DFERR_WINPRINT DFPrintError963
75084>>>>>>>>>>
75084>>>>>>>>> Function_Return 0
75085>>>>>>>>> End
75085>>>>>>>>>>
75085>>>>>>>>>
75085>>>>>>>>> Move (Low(iRetVal)) To nRetVal
75086>>>>>>>>> Move (nRetVal/100) To nRetVal //Returns CM
75087>>>>>>>>>
75087>>>>>>>>> Function_Return nRetVal
75088>>>>>>>>> End_Function
75089>>>>>>>>>
75089>>>>>>>>>
75089>>>>>>>>> //*** To be set in CM
75089>>>>>>>>> Procedure DFSetUserDefinedPapersize Number nLength Number nWidth
75091>>>>>>>>> Integer bOk
75091>>>>>>>>> Integer iLength iWidth iSize
75091>>>>>>>>>
75091>>>>>>>>> move (nLength*100) To iLength
75092>>>>>>>>> move (nWidth*100) To iWidth
75093>>>>>>>>> move ((iLength*65536)+iWidth) To iSize
75094>>>>>>>>>
75094>>>>>>>>> Move (WP_SetUserDefinedPapersize(iSize)) To bOk
75095>>>>>>>>>
75095>>>>>>>>> If not bOk Begin
75097>>>>>>>>> Error DFERR_WINPRINT DFPrintError964
75098>>>>>>>>>>
75098>>>>>>>>> End
75098>>>>>>>>>>
75098>>>>>>>>> End_Procedure
75099>>>>>>>>>
75099>>>>>>>>> Procedure DFSetNumberOfCopies Integer iNrOfCopies
75101>>>>>>>>> Boolean bOk
75101>>>>>>>>>
75101>>>>>>>>> Move (WP_SetNumberOfPrintCopies(iNrOfCopies)) to bOk
75102>>>>>>>>>
75102>>>>>>>>> If not bOk Begin
75104>>>>>>>>> Error DFERR_WINPRINT DFPrintError965
75105>>>>>>>>>>
75105>>>>>>>>> end
75105>>>>>>>>>>
75105>>>>>>>>> End_Procedure
75106>>>>>>>>>
75106>>>>>>>>>
75106>>>>>>>>>
75106>>>>>>>>>
75106>>>>>>>>> //*************************************************************
75106>>>>>>>>> //*** This procedures and functions are used when building ***
75106>>>>>>>>> //*** complex graphics when you need to change value of the ***
75106>>>>>>>>> //*** current diagram, so you can mix diagrams within each ***
75106>>>>>>>>> //*** other. ***
75106>>>>>>>>> //*************************************************************
75106>>>>>>>>>
75106>>>>>>>>>
75106>>>>>>>>> Function DFGetCurrentDiagram Returns Integer
75108>>>>>>>>> Integer iRetVal
75108>>>>>>>>> Get DFCurrent_Diagram To iRetVal
75109>>>>>>>>> Function_Return iRetVal
75110>>>>>>>>> End_Function
75111>>>>>>>>>
75111>>>>>>>>> Procedure DFSetCurrentDiagram Integer iDiagram
75113>>>>>>>>> Set DFCurrent_Diagram To iDiagram
75114>>>>>>>>> End_Procedure
75115>>>>>>>>>
75115>>>>>>>>> Procedure DFSetDiagramList Integer iItem Integer iDiagram
75117>>>>>>>>> Set Value of oDiagramArray iItem To iDiagram
75118>>>>>>>>> End_Procedure
75119>>>>>>>>>
75119>>>>>>>>> Function DFGetDiagramList Integer iItem Returns Integer
75121>>>>>>>>> Integer iRetVal
75121>>>>>>>>> Get Value of oDiagramArray iItem To iRetVal
75122>>>>>>>>> Function_Return iRetVal
75123>>>>>>>>> End_Function
75124>>>>>>>>>
75124>>>>>>>>> Procedure DFClearDiagramList
75126>>>>>>>>> Send Delete_Data To oDiagramArray
75127>>>>>>>>> End_Procedure
75128>>>>>>>>>
75128>>>>>>>>>
75128>>>>>>>>> Function DFGetColor Integer iColor Returns Dword
75130>>>>>>>>> Dword dwRetVal
75130>>>>>>>>> Get Value of oDFColorArray iColor To dwRetVal
75131>>>>>>>>> Function_Return dwRetVal
75132>>>>>>>>> End_Function
75133>>>>>>>>>
75133>>>>>>>>> Function DFGetCurrentColor Returns Dword
75135>>>>>>>>> Dword dwRetVal
75135>>>>>>>>> Integer iCurrColor
75135>>>>>>>>>
75135>>>>>>>>> Get DFCurrent_Color To iCurrColor
75136>>>>>>>>> Get DFGetColor iCurrColor To dwRetVal
75137>>>>>>>>>
75137>>>>>>>>> Function_Return dwRetVal
75138>>>>>>>>> End_Function
75139>>>>>>>>>
75139>>>>>>>>> Procedure DFEndDocument
75141>>>>>>>>> integer iVoid
75141>>>>>>>>> Move (WP_EndDocument()) To iVoid
75142>>>>>>>>> Send DfSuspendGui False
75143>>>>>>>>> End_procedure
75144>>>>>>>>>
75144>>>>>>>>> Procedure DFClosePreview
75146>>>>>>>>> integer iVoid
75146>>>>>>>>> Move (WP_ClosePreview()) To iVoid
75147>>>>>>>>> Send DfSuspendGui False
75148>>>>>>>>> End_procedure
75149>>>>>>>>>
75149>>>>>>>>> Procedure SetProgressCaption string sCaption
75151>>>>>>>>> integer iVoid
75151>>>>>>>>> Move (ToAnsi(sCaption)) to sCaption
75152>>>>>>>>> Move (WP_SetProgressCaption(sCaption)) To iVoid
75153>>>>>>>>> End_procedure
75154>>>>>>>>>
75154>>>>>>>>> Procedure SetReportTitle string sTitle
75156>>>>>>>>> integer iVoid
75156>>>>>>>>> Move (ToAnsi(sTitle)) to sTitle
75157>>>>>>>>> Move (WP_SetReportTitle(sTitle)) To iVoid
75158>>>>>>>>> End_procedure
75159>>>>>>>>>
75159>>>>>>>>> Function PreviewYesNoBox string sCaption string sText returns integer
75161>>>>>>>>> integer eResult
75161>>>>>>>>> Move (ToAnsi(sCaption)) to sCaption
75162>>>>>>>>> Move (ToAnsi(sText)) to sText
75163>>>>>>>>> Move (WP_DisplayMessageBox(sCaption, sText)) To eResult
75164>>>>>>>>> Function_return eResult
75165>>>>>>>>> end_function
75166>>>>>>>>>
75166>>>>>>>>> // internal function, used to extract different printer flags ranges based on
75166>>>>>>>>> // the print flag integer. These flags use a decimal style of packing information
75166>>>>>>>>> // where different printer options (paper, bin, etc) use different ranges and
75166>>>>>>>>> // different steps. Everything above iTopVal is removed and everything that is not
75166>>>>>>>>> // within the iStep range is removed.
75166>>>>>>>>> Function PrintFlagRange integer iTopVal integer iStep returns integer
75168>>>>>>>>> integer iFgs iFg
75168>>>>>>>>> Get DFGetPrintDialogFlags to iFg
75169>>>>>>>>> Move (mod(iFg,iTopVal) / iStep * iStep ) to iFg
75170>>>>>>>>> function_return iFg
75171>>>>>>>>> end_Function
75172>>>>>>>>>
75172>>>>>>>>> Procedure DFSetPrinterPaper integer ePaperType
75174>>>>>>>>> Send DFSetSpecPrintFlag ePaperType
75175>>>>>>>>> End_Procedure
75176>>>>>>>>>
75176>>>>>>>>> Function DFGetPrinterPaper returns integer //ePaperType
75178>>>>>>>>> integer ePaperType
75178>>>>>>>>> Get PrintFlagRange 500 10 to ePaperType // 10-490 in steps of 10
75179>>>>>>>>> function_return ePaperType
75180>>>>>>>>> End_Function
75181>>>>>>>>>
75181>>>>>>>>>
75181>>>>>>>>> Procedure DFSetPrinterBin integer eBinType
75183>>>>>>>>> Send DFSetSpecPrintFlag eBinType
75184>>>>>>>>> End_Procedure
75185>>>>>>>>>
75185>>>>>>>>> Function DFGetPrinterBin returns integer //eBinType
75187>>>>>>>>> integer eBinType
75187>>>>>>>>> Get PrintFlagRange 10000 500 to eBinType // 1000-9000 steps 500
75188>>>>>>>>> function_return eBinType
75189>>>>>>>>> End_Function
75190>>>>>>>>>
75190>>>>>>>>>
75190>>>>>>>>> Procedure DFSetPrinterResolution integer eResType
75192>>>>>>>>> Send DFSetSpecPrintFlag eResType
75193>>>>>>>>> End_Procedure
75194>>>>>>>>>
75194>>>>>>>>> Function DFGetPrinterResolution returns integer //eResType
75196>>>>>>>>> integer eResType
75196>>>>>>>>> Get PrintFlagRange 50000 10000 to eResType // 10000-500000 steps 10000
75197>>>>>>>>> function_return eResType
75198>>>>>>>>> End_Function
75199>>>>>>>>>
75199>>>>>>>>>
75199>>>>>>>>> Procedure DFSetLandscape boolean bIsLandscape
75201>>>>>>>>> Send DFSetSpecPrintFlag (If(bIsLandscape,DF_Landscape,DF_Portrait))
75202>>>>>>>>> End_Procedure
75203>>>>>>>>>
75203>>>>>>>>> Function DFGetLandscape returns boolean // bIsLandscape
75205>>>>>>>>> boolean bIsLandscape
75205>>>>>>>>> Get DFCheckPrintDialogFlag DF_Landscape to bIsLandscape
75206>>>>>>>>> function_return bIsLandscape
75207>>>>>>>>> End_Function
75208>>>>>>>>>
75208>>>>>>>>> Function RGBToWPColor integer iRgb returns integer
75210>>>>>>>>> integer iRed iGreen iBlue
75210>>>>>>>>> integer iWPColor
75210>>>>>>>>> Move (R_from_rgb(iRGB)) to iRed
75211>>>>>>>>> Move (G_from_rgb(iRGB)) to iGreen
75212>>>>>>>>> Move (B_from_rgb(iRGB)) to iBlue
75213>>>>>>>>> Get DfGetDfColor iRed iGreen iBlue to iWPColor
75214>>>>>>>>> function_Return iWPColor
75215>>>>>>>>> end_function
75216>>>>>>>>>
75216>>>>>>>>>
75216>>>>>>>>>
75216>>>>>>>>>End_Class
75217>>>>>>>>>
75217>>>>>>>>>Global_Variable Integer ghoWinPrint2
75217>>>>>>>>>
75217>>>>>>>>>Get Create of desktop U_cWinPrint2 to ghoWinPrint2
75218>>>>>>>>>
75218>>>>>>>>>
75218>>>>>>>Use Winprint_Commands.pkg // commands used by this class
75218>>>>>>>
75218>>>>>>>Class cWinReport2 is a BasicReport
75219>>>>>>>
75219>>>>>>> Procedure Construct_Object
75221>>>>>>> Forward send construct_object
75223>>>>>>>
75223>>>>>>> Date Today
75223>>>>>>> Sysdate Today
75224>>>>>>>
75224>>>>>>> // should use built in DF function CurrentDateTime()
75224>>>>>>> Property Date RptToday Today
75225>>>>>>>
75225>>>>>>> Object RptTotal is an Array
75227>>>>>>> End_Object
75228>>>>>>>
75228>>>>>>> // If true, report is output upon completion. Either preview
75228>>>>>>> // or printer depending on output_device_mode
75228>>>>>>> Property Boolean AutoOutput_State True
75229>>>>>>>
75229>>>>>>> // When a new page is created (DFNew_Page) and the number
75229>>>>>>> // of columns is not passed, this is used.
75229>>>>>>> Property Integer Print_Columns 0
75230>>>>>>>
75230>>>>>>> // This determines if a DFNew_Page should be executed when the
75230>>>>>>> // report starts. In some rare cases, you would not want this to
75230>>>>>>> // occur until a subheader
75230>>>>>>> Property Boolean AutoNew_Page_State True
75231>>>>>>>
75231>>>>>>> // Output device (print or preview). Normally this is delegated to
75231>>>>>>> // the report view.
75231>>>>>>> //
75231>>>>>>>
75231>>>>>>> Property Integer Private.Output_Device_Mode PRINT_TO_UNDEFINED
75232>>>>>>>
75232>>>>>>> Property Handle phoWinPrint ghoWinPrint2 // the report engine to use.
75233>>>>>>>
75233>>>>>>> // JJT: For now this is for testing.
75233>>>>>>> Property boolean pbModalViewer False
75234>>>>>>>
75234>>>>>>> Property boolean pbMultiReports False
75235>>>>>>>
75235>>>>>>> Property boolean pbFirstPagePrinted false
75236>>>>>>>
75236>>>>>>> End_Procedure
75237>>>>>>>
75237>>>>>>> // returns the current status of Winprint Document object. dsNotStarted, dsStarted, dsFinished
75237>>>>>>> // note that the status can reflect a status from a different report. The winprint object is global.
75237>>>>>>> Function DocumentStatus returns Boolean
75239>>>>>>> integer iStatus
75239>>>>>>> Get DocumentStatus of (phoWinprint(self)) to iStatus
75240>>>>>>> function_return iStatus
75241>>>>>>> End_function
75242>>>>>>>
75242>>>>>>> Function IsViewerActive returns Boolean
75244>>>>>>> boolean bIsActive
75244>>>>>>> Get IsViewerActive of (phoWinPrint(self)) to bIsActive
75245>>>>>>> Function_return bIsActive
75246>>>>>>> end_Function
75247>>>>>>>
75247>>>>>>> Function ArePrintersInstalled returns boolean
75249>>>>>>> Function_Return (WP_ArePrintersInstalled()<>0)
75250>>>>>>> end_function
75251>>>>>>>
75251>>>>>>>
75251>>>>>>> // All subtotal commands use the outer main report. This makes it easier to keep
75251>>>>>>> // track of these numbers
75251>>>>>>>
75251>>>>>>> Procedure Add_SubTotal Integer iCounter Number nData
75253>>>>>>> Number nValue
75253>>>>>>> Integer iObj
75253>>>>>>> Move (RptTotal(Main_Report_Id(Self))) to iObj
75254>>>>>>> Get Number_Value of iObj iCounter To nValue
75255>>>>>>> Add nData To nValue
75256>>>>>>> Set Array_Value of iObj iCounter To nValue
75257>>>>>>> End_Procedure
75258>>>>>>>
75258>>>>>>> Procedure Clr_SubTotal Integer iCounter
75260>>>>>>> Set Array_Value of (RptTotal(Main_Report_Id(Self))) iCounter To 0
75261>>>>>>> End_Procedure
75262>>>>>>>
75262>>>>>>> Procedure Clr_AllSubTotals
75264>>>>>>> Send Delete_Data of (RptTotal(Main_Report_Id(Self)))
75265>>>>>>> End_Procedure
75266>>>>>>>
75266>>>>>>> Function Sum_SubTotal Integer iTotal Returns Number
75268>>>>>>> Number nRetVal
75268>>>>>>> Get Number_Value of (RptTotal(Main_Report_Id(Self))) iTotal To nRetVal
75269>>>>>>> Function_Return nRetVal
75270>>>>>>> End_Function
75271>>>>>>>
75271>>>>>>> //Return sub-total and clear accumulator
75271>>>>>>> //
75271>>>>>>> Function SubTotal Integer iTotal Returns Number
75273>>>>>>> Number nRetVal
75273>>>>>>> Get Sum_SubTotal iTotal to nRetVal
75274>>>>>>> Send Clr_SubTotal iTotal
75275>>>>>>> Function_Return nRetVal
75276>>>>>>> End_Function
75277>>>>>>>
75277>>>>>>>
75277>>>>>>> // Note: Cols is optional. If no argument is passed it will use
75277>>>>>>> // the object's property Print_Columns (0 by default)
75277>>>>>>> //
75277>>>>>>> Procedure DFNew_Page Integer Cols
75279>>>>>>> Integer PageNumber Columns
75279>>>>>>> Boolean bFirstPagePrinted
75279>>>>>>> // If no args passed used default setting
75279>>>>>>> If (Num_Arguments=0) ; Move (Print_Columns(Main_Report_id(Self))) to Columns
75282>>>>>>> Else ; Move Cols to Columns
75284>>>>>>> Set Page_Feed to -2 // No FormFeed
75285>>>>>>> If (Child_Rpt_State(self)) ; Send DFNew_Page of (Main_Report_Id(Self)) Columns
75288>>>>>>> Else Begin
75289>>>>>>> // we only want to print report_header once. When report starts
75289>>>>>>> // this is set true, after the first print it is false. You can set
75289>>>>>>> // this to true before and explicit dfNew_page to force a header
75289>>>>>>> Get pbFirstPagePrinted to bFirstPagePrinted
75290>>>>>>> Get DFNewPage of (phoWinPrint(self)) Columns To PageNumber
75291>>>>>>> If (PageNumber<>0) begin // if 0, it failed
75293>>>>>>> Set No_PageCheck_State to True
75294>>>>>>>
75294>>>>>>> //Top section
75294>>>>>>> Send Page_Top
75295>>>>>>> If Not bFirstPagePrinted Send Report_Header
75298>>>>>>> Send Page_Header
75299>>>>>>> Send Page_Title
75300>>>>>>>
75300>>>>>>> Set New_Page_State to False
75301>>>>>>> Set Page_End_State to False
75302>>>>>>> Set No_PageCheck_State to False // No longer Paging
75303>>>>>>> Set pbFirstPagePrinted to True
75304>>>>>>> End
75304>>>>>>>>
75304>>>>>>> End
75304>>>>>>>>
75304>>>>>>>
75304>>>>>>> // Footer section
75304>>>>>>> //
75304>>>>>>> // DO NOT CHANGE THE ORDER OF BOTTOM SECTIONS !!!!!
75304>>>>>>> //
75304>>>>>>>
75304>>>>>>> Send Page_Bottom
75305>>>>>>>
75305>>>>>>> // in WinPrint it is not possible to replace Page_Footer
75305>>>>>>> // with Report_Footer. If you use Report_Footer you will
75305>>>>>>> // have both Page_Footer and Report_Footer
75305>>>>>>> //
75305>>>>>>> //If LastTime eq 0 Send Page_Footer
75305>>>>>>> //else Send Report_Footer
75305>>>>>>>
75305>>>>>>> Send Page_Footer
75306>>>>>>> Send Page_Total
75307>>>>>>> End_Procedure
75308>>>>>>>
75308>>>>>>> Procedure Ending_Main_Report
75310>>>>>>> Boolean bCancel bMultiReports
75310>>>>>>>
75310>>>>>>> Get Cancelled_state to bCancel
75311>>>>>>> Get pbMultiReports to bMultiReports
75312>>>>>>>
75312>>>>>>> Forward Send Ending_Main_Report
75314>>>>>>>
75314>>>>>>> If bCancel Begin
75316>>>>>>> Send DFEndDocument
75317>>>>>>> Send DFClearDoc // this will also close the previewer
75318>>>>>>> end
75318>>>>>>>>
75318>>>>>>> Else Begin
75319>>>>>>> Send Report_Footer
75320>>>>>>>
75320>>>>>>> // if multi-reports, we don't do an end of report yet. The programmer must
75320>>>>>>> // manually end the report by sending EndMultiReport
75320>>>>>>> If (not(bMultiReports)) begin
75322>>>>>>> Send EndWinPrintReport
75323>>>>>>> end
75323>>>>>>>>
75323>>>>>>>
75323>>>>>>> end
75323>>>>>>>>
75323>>>>>>>
75323>>>>>>> End_Procedure
75324>>>>>>>
75324>>>>>>> // This must get called when you are running multiple reports (pbMultiReport).
75324>>>>>>> // Send this when the last report is complete.
75324>>>>>>> Procedure EndMultiReport
75326>>>>>>> Send EndWinPrintReport
75327>>>>>>> End_procedure
75328>>>>>>>
75328>>>>>>>
75328>>>>>>> Procedure EndWinPrintReport
75330>>>>>>> Boolean bAutoOutput
75330>>>>>>> integer iStatus eMode
75330>>>>>>> Get DocumentStatus to iStatus
75331>>>>>>> If (iStatus<>dsStarted) procedure_return
75334>>>>>>>
75334>>>>>>> // this tells winprint that the report is complete
75334>>>>>>> Send DFEndDocument
75335>>>>>>> // if auto-output we print or display automatically.
75335>>>>>>> // for winprint2, if in preview mode you must do this so the previewer can enter
75335>>>>>>> // a modal state (which it may or may not need to do).
75335>>>>>>> Get AutoOutput_state to bAutoOutput
75336>>>>>>> Get Output_device_mode to eMode
75337>>>>>>> If (bAutoOutput or eMode=PRINT_TO_WINDOW) begin
75339>>>>>>> Send PrintReport
75340>>>>>>> // if auto output, we assume that you are done when it is all over
75340>>>>>>> // we only can do this with the modal viewer
75340>>>>>>> If (bAutoOutput and pbModalViewer(self)) begin
75342>>>>>>> Send DFClearDoc
75343>>>>>>> end
75343>>>>>>>>
75343>>>>>>> end
75343>>>>>>>>
75343>>>>>>>
75343>>>>>>> End_Procedure
75344>>>>>>>
75344>>>>>>>
75344>>>>>>> Function Setup_Report Returns Integer
75346>>>>>>> Integer iErr iStatus eMode
75346>>>>>>> Boolean bActiveViewer bChildReport bMultiReports bOk
75346>>>>>>>
75346>>>>>>>
75346>>>>>>> Get Child_rpt_state to bChildReport
75347>>>>>>>
75347>>>>>>> If not bChildReport Begin
75349>>>>>>>
75349>>>>>>> // This makes sure that we are pointing to the new winprint2 engine object.
75349>>>>>>> // normally this will be the new winprint, but it can be redirected
75349>>>>>>> Get phoWinPrint to WinPrintID
75350>>>>>>>
75350>>>>>>> // winprint must have installed printer. If not installed, generate error and stop the report
75350>>>>>>> Get ArePrintersInstalled to bOk
75351>>>>>>> If not bOk begin
75353>>>>>>> Error DFERR_WINPRINT C_$NoInstalledPrinters
75354>>>>>>>>
75354>>>>>>> Function_return 1
75355>>>>>>> end
75355>>>>>>>>
75355>>>>>>>
75355>>>>>>> // make sure it is ok to start a new report but try to be smart about it.
75355>>>>>>> // if a report is active (dsstarted or dsFinished) check to see if it is
75355>>>>>>> // finished w/ no viewer. If so, assume the user closed the report and is done
75355>>>>>>> // so just clear the report. If a viewer is present, declare an error.
75355>>>>>>> Get DocumentStatus to iStatus
75356>>>>>>> Get pbMultiReports to bMultiReports
75357>>>>>>> // multi-report only in-progress is multi and it is started
75357>>>>>>> Move (bMultiReports and iStatus=dsStarted) to bMultiReports
75358>>>>>>> If not bMultiReports begin
75360>>>>>>> If (iStatus<>dsNotStarted) begin
75362>>>>>>> Get IsViewerActive to bActiveViewer
75363>>>>>>> If (iStatus=dsFinished and not(bActiveViewer)) begin
75365>>>>>>> send DfClearDoc
75366>>>>>>> end
75366>>>>>>>>
75366>>>>>>> else begin
75367>>>>>>> Error DFERR_WINPRINT DFPrintError967
75368>>>>>>>>
75368>>>>>>> Function_return 1
75369>>>>>>> end
75369>>>>>>>>
75369>>>>>>> end
75369>>>>>>>>
75369>>>>>>>
75369>>>>>>> // all new reports by default allow printing from viewer and they have the print job set up when you select print
75369>>>>>>> // if you need to change these defaults, you can change these inside of Starting_main_report
75369>>>>>>> // We only do this with non-multi-reports.
75369>>>>>>> Send DFSetPrintDlgInPreview True
75370>>>>>>> Send DFSetEnablePrintFromPreview True
75371>>>>>>>
75371>>>>>>> end
75371>>>>>>>>
75371>>>>>>>
75371>>>>>>> // In the new winprint, this message is not needed and is a stub. For
75371>>>>>>> // now it is in here for compatibility purposes
75371>>>>>>> //You MUST always start a new report with this procedure
75371>>>>>>> send DFZeroCounters of (phoWinPrint(self))
75372>>>>>>> Send Clr_AllSubTotals
75373>>>>>>>
75373>>>>>>> End
75373>>>>>>>>
75373>>>>>>>
75373>>>>>>> Forward Get Setup_report to iErr
75375>>>>>>>
75375>>>>>>> If (iErr=0) begin
75377>>>>>>> If not bChildReport begin
75379>>>>>>> // if part of a multi-report we don't do a new doc
75379>>>>>>> If not bMultiReports begin
75381>>>>>>> Get Output_Device_Mode to eMode
75382>>>>>>> Send DFNewDoc of (phoWinPrint(self)) (eMode = PRINT_TO_WINDOW) // pass True of display while printing
75383>>>>>>> end
75383>>>>>>>>
75383>>>>>>> // Do new page if not part of a multi-report and we say don't do a new page
75383>>>>>>> If (not(bMultiReports) or AutoNew_Page_State(self)) begin
75385>>>>>>> Set pbFirstPagePrinted to False // tells new page that this is the first time for this report
75386>>>>>>> Send DFNew_page
75387>>>>>>> End
75387>>>>>>>>
75387>>>>>>> End
75387>>>>>>>>
75387>>>>>>> end
75387>>>>>>>>
75387>>>>>>>
75387>>>>>>> End_Function
75388>>>>>>>
75388>>>>>>>
75388>>>>>>>
75388>>>>>>> // Cancel RO behavior - there is no device to close
75388>>>>>>> //
75388>>>>>>> Procedure Close_Output_Device
75390>>>>>>> End_Procedure
75391>>>>>>>
75391>>>>>>> // Cancel RO Behavior
75391>>>>>>> //
75391>>>>>>> Procedure Initialize_Output_Device
75393>>>>>>> End_procedure
75394>>>>>>>
75394>>>>>>>
75394>>>>>>> Function Output_Device_Mode Returns Integer
75396>>>>>>> Integer hoId
75396>>>>>>> String DevMode
75396>>>>>>> Get Private.Output_Device_Mode to DevMode
75397>>>>>>> If (DevMode=PRINT_TO_UNDEFINED) Begin
75399>>>>>>> Get Report_View_Id to hoId
75400>>>>>>> If hoID ; Get OutPut_Device_Mode of hoID to DevMode
75403>>>>>>> If (DevMode=PRINT_TO_UNDEFINED) ; Move PRINT_TO_WINDOW to DevMode
75406>>>>>>> End
75406>>>>>>>>
75406>>>>>>> Function_Return DevMode
75407>>>>>>> End_Function // Output_Destination
75408>>>>>>>
75408>>>>>>> Procedure Set Output_Device_Mode Integer DevMode
75410>>>>>>> Set Private.Output_Device_Mode to DevMode
75411>>>>>>> End_Procedure // Set Output_Device
75412>>>>>>>
75412>>>>>>> // displays a metric ruler in .5 increments. This can be
75412>>>>>>> // sent to make it easy to see how fields and labels should
75412>>>>>>> // be moved for alignment.
75412>>>>>>> //
75412>>>>>>> Procedure ShowRuler
75414>>>>>>> integer i
75414>>>>>>> number n
75414>>>>>>> for i from 0 to 30
75420>>>>>>>>
75420>>>>>>> Send DFWritePos of (phoWinPrint(self)) (String(i)) FONT_DEFAULT i -1 0
75421>>>>>>> Move (i+.5) to n
75422>>>>>>> Send DFWritePos of (phoWinPrint(self)) "." FONT_DEFAULT n -1 0
75423>>>>>>> Loop
75424>>>>>>>>
75424>>>>>>> Send DFWriteln of (phoWinPrint(self)) '' FONT_DEFAULT FONT_DEFAULT -1
75425>>>>>>> End_procedure
75426>>>>>>>
75426>>>>>>> // status panel related agumentations to handle the auto-previewer
75426>>>>>>>
75426>>>>>>> Procedure Update_Status string sVal
75428>>>>>>> Integer eMode
75428>>>>>>> Get Output_device_mode to eMode
75429>>>>>>> If (eMode=PRINT_TO_WINDOW) Begin
75431>>>>>>> Send SetProgressCaption of (phoWinPrint(self)) sVal
75432>>>>>>> End
75432>>>>>>>>
75432>>>>>>> Else Begin
75433>>>>>>> forward Send Update_Status sVal
75435>>>>>>> end
75435>>>>>>>>
75435>>>>>>> End_Procedure
75436>>>>>>>
75436>>>>>>> Procedure Start_Status
75438>>>>>>> Integer eMode
75438>>>>>>> string sTitle sCaption
75438>>>>>>> Get Output_device_mode to eMode
75439>>>>>>> If (eMode=PRINT_TO_WINDOW) Begin
75441>>>>>>> Get Report_Caption to sCaption
75442>>>>>>> Get Report_Title to sTitle
75443>>>>>>> If (sTitle<>"" and sCaption<>"") begin
75445>>>>>>> Move ( sCaption- ":" * sTitle) to sTitle
75446>>>>>>> end
75446>>>>>>>>
75446>>>>>>> else begin
75447>>>>>>> Move (sCaption - sTitle) to sTitle
75448>>>>>>> end
75448>>>>>>>>
75448>>>>>>> Send SetReportTitle of (phoWinPrint(self)) sTitle
75449>>>>>>> End
75449>>>>>>>>
75449>>>>>>> Else Begin
75450>>>>>>> forward Send Start_status
75452>>>>>>> end
75452>>>>>>>>
75452>>>>>>> End_Procedure
75453>>>>>>>
75453>>>>>>> Procedure Resume_Status
75455>>>>>>> Integer eMode
75455>>>>>>> Get Output_device_mode to eMode
75456>>>>>>> If (eMode=PRINT_TO_WINDOW) Begin
75458>>>>>>> Send DfPreviewNoWait of (phoWinPrint(self))
75459>>>>>>> End
75459>>>>>>>>
75459>>>>>>> Else Begin
75460>>>>>>> forward Send Resume_Status
75462>>>>>>> end
75462>>>>>>>>
75462>>>>>>> End_Procedure
75463>>>>>>>
75463>>>>>>> Procedure End_Status
75465>>>>>>> Integer eMode
75465>>>>>>> Get Output_device_mode to eMode
75466>>>>>>> If (error_processing_state(self)) Begin
75468>>>>>>> Send DFClosePreview
75469>>>>>>> end
75469>>>>>>>>
75469>>>>>>> If (eMode=PRINT_TO_WINDOW) Begin
75471>>>>>>> End
75471>>>>>>>>
75471>>>>>>> Else Begin
75472>>>>>>> forward Send End_Status
75474>>>>>>> end
75474>>>>>>>>
75474>>>>>>> End_Procedure
75475>>>>>>>
75475>>>>>>> Function Report_Interrupt Returns Integer
75477>>>>>>> integer eStat
75477>>>>>>> String sMess
75477>>>>>>> Boolean bActiveViewer
75477>>>>>>> Get IsViewerActive to bActiveViewer
75478>>>>>>> If (Error_Check_State(self)) begin
75480>>>>>>> Move C_$AnErrorWishToCancel to sMess
75481>>>>>>> end
75481>>>>>>>>
75481>>>>>>> Else begin
75482>>>>>>> Move C_$CancelThisReport to sMess
75483>>>>>>> end
75483>>>>>>>>
75483>>>>>>> If bActiveViewer Begin
75485>>>>>>> Get PreviewYesNoBox of (phoWinPrint(self)) C_$ReportInterrupt sMess to eStat
75486>>>>>>> end
75486>>>>>>>>
75486>>>>>>> Else Begin
75487>>>>>>> Get YesNo_Box sMess C_$ReportInterrupt to eStat
75488>>>>>>> End
75488>>>>>>>>
75488>>>>>>>
75488>>>>>>> Function_Return (eStat=MBR_YES)
75489>>>>>>>
75489>>>>>>> End_Function
75490>>>>>>>
75490>>>>>>> Function Test_KeyPressed Returns Integer
75492>>>>>>> Boolean bStop bError bActiveViewer
75492>>>>>>> integer eMode
75492>>>>>>> // winreport will do this also, but this makes sure that this gets called
75492>>>>>>> // for each body loop -- even if the body loop prints nothing
75492>>>>>>> Send PumpMsgQueue of (phoWinPrint(self)) // permit painting
75493>>>>>>> Get IsViewerActive to bActiveViewer
75494>>>>>>> Get Output_device_mode to eMode
75495>>>>>>> If bActiveViewer Begin
75497>>>>>>> Get ViewerWantsToClose of (phoWinPrint(self)) to bStop
75498>>>>>>> Get Error_Check_State to bError
75499>>>>>>> if (bStop or bError) begin
75501>>>>>>> Get Report_Interrupt to bStop
75502>>>>>>> end
75502>>>>>>>>
75502>>>>>>> end
75502>>>>>>>>
75502>>>>>>> Else Begin
75503>>>>>>> Forward Get Test_KeyPressed to bStop
75505>>>>>>> If (eMode=PRINT_TO_WINDOW and not(bStop)) Begin
75507>>>>>>> Send DfPreviewNoWait
75508>>>>>>> end
75508>>>>>>>>
75508>>>>>>> End
75508>>>>>>>>
75508>>>>>>>
75508>>>>>>> Function_Return bStop
75509>>>>>>> End_Function
75510>>>>>>>
75510>>>>>>> Procedure OnClosingView
75512>>>>>>> Send DFClearDoc
75513>>>>>>> end_procedure
75514>>>>>>>
75514>>>>>>>
75514>>>>>>> // Attempt to make this as intuitive as possible. You cannot invoke this when a
75514>>>>>>> // report is active. If a report is not finished, you cannot do this.
75514>>>>>>> // If a report is finsihed it may or may not have a viewer present.
75514>>>>>>> // If a viewer is not present, we will clear the exising report (making the assumption
75514>>>>>>> // that a modeless viewer was closed and the report will not be invoked again). If a viewer
75514>>>>>>> // is active, we will pass this through to the winprint object which will show an error
75514>>>>>>>
75514>>>>>>> Function DFPrintSetupDialog returns Boolean// invoke printer setup dialog
75516>>>>>>> Integer iStatus
75516>>>>>>> Boolean bActiveViewer bOk
75516>>>>>>> // we must have printers installed for this to work
75516>>>>>>> Get ArePrintersInstalled to bOk
75517>>>>>>> If not bOk begin
75519>>>>>>> Error DFERR_WINPRINT C_$NoInstalledPrinters
75520>>>>>>>>
75520>>>>>>> end
75520>>>>>>>>
75520>>>>>>> else begin
75521>>>>>>> Get DocumentStatus to iStatus
75522>>>>>>> If (iStatus=dsFinished) begin
75524>>>>>>> Get IsViewerActive to bActiveViewer
75525>>>>>>> If not bActiveViewer begin
75527>>>>>>> send DfClearDoc
75528>>>>>>> end
75528>>>>>>>>
75528>>>>>>> end
75528>>>>>>>>
75528>>>>>>> // the winprint object will generate an error if the status is not dsNotStarted.
75528>>>>>>> // we want those errors
75528>>>>>>> Get DFPrintSetupDialog of (phoWinPrint(self)) to bOk
75529>>>>>>> end
75529>>>>>>>>
75529>>>>>>> Function_return bOk
75530>>>>>>> End_procedure
75531>>>>>>>
75531>>>>>>> // It is better to use DFPrintSetupDialog which tells you if the dialog was canceled
75531>>>>>>> Procedure DFPrintSetup // invoke printer setup dialog
75533>>>>>>> Boolean bOk
75533>>>>>>> Get DFPrintSetupDialog to bOk
75534>>>>>>> End_procedure
75535>>>>>>>
75535>>>>>>> Procedure DfClearDoc // clear document, remove viewer
75537>>>>>>> Send DFClearDoc of (phoWinPrint(self))
75538>>>>>>> end_procedure
75539>>>>>>>
75539>>>>>>> Procedure DfEndDocument // tell winprint that the report is complete
75541>>>>>>> Send DfEndDocument of (phoWinPrint(self))
75542>>>>>>> end_procedure
75543>>>>>>>
75543>>>>>>> Procedure DfClosePreview //close the previewer, does not clear the document
75545>>>>>>> Send DfClosePreview of (phoWinPrint(self))
75546>>>>>>> end_procedure
75547>>>>>>>
75547>>>>>>> Procedure DFPrintDialog // popup print job dialog
75549>>>>>>> Send DFPrintDialog of (phoWinPrint(self))
75550>>>>>>> End_procedure
75551>>>>>>>
75551>>>>>>> Procedure DFPrint // print with printer dialog
75553>>>>>>> Send DFPrint of (phoWinPrint(self))
75554>>>>>>> End_procedure
75555>>>>>>>
75555>>>>>>> Procedure DFPrintDoc // print without printer dialog
75557>>>>>>> Send DFPrintDoc of (phoWinPrint(self))
75558>>>>>>> End_Procedure
75559>>>>>>>
75559>>>>>>> Procedure DFPreviewWait // invoke previewer in modal mode
75561>>>>>>> Send DFPreviewWait of (phoWinPrint(self))
75562>>>>>>> End_Procedure
75563>>>>>>>
75563>>>>>>> Procedure DFPreviewNoWait // invoke previwer in modeless mode
75565>>>>>>> Send DFPreviewNoWait of (phoWinPrint(self))
75566>>>>>>> End_Procedure
75567>>>>>>>
75567>>>>>>> Procedure DFPreview // invokde previewer based on pbModalViewer property
75569>>>>>>> Boolean bModalViewer
75569>>>>>>> Get pbModalViewer to bModalViewer
75570>>>>>>> If bModalViewer Begin
75572>>>>>>> Send DFPreviewWait
75573>>>>>>> end
75573>>>>>>>>
75573>>>>>>> else Begin
75574>>>>>>> Send DFPreviewNoWait
75575>>>>>>> end
75575>>>>>>>>
75575>>>>>>> End_Procedure
75576>>>>>>>
75576>>>>>>> // Print report to appropriate device (printer, preview) based
75576>>>>>>> // on output_device_mode
75576>>>>>>> //
75576>>>>>>> Procedure PrintReport
75578>>>>>>> Integer eMode
75578>>>>>>> Get OutPut_Device_Mode to eMode
75579>>>>>>> If ((eMode=PRINT_TO_WINDOW) or (eMode=DEFERRED_PRINT_TO_WINDOW)) Begin
75581>>>>>>> Send DFPreview
75582>>>>>>> end
75582>>>>>>>>
75582>>>>>>> Else If (eMode=PRINT_TO_PRINTER_NO_DIALOG) Begin
75585>>>>>>> Send DFPrintDoc // print, no print job dialog
75586>>>>>>> end
75586>>>>>>>>
75586>>>>>>> Else Begin // (eMode=PRINT_TO_PRINTER)
75587>>>>>>> Send DFPrint // print with print job dialog
75588>>>>>>> end
75588>>>>>>>>
75588>>>>>>> End_Procedure
75589>>>>>>>
75589>>>>>>>
75589>>>>>>> Procedure DFSetPrinterPaper integer ePaperType
75591>>>>>>> Send DFSetPrinterPaper of (phoWinPrint(self)) ePaperType
75592>>>>>>> End_Procedure
75593>>>>>>>
75593>>>>>>> Function DFGetPrinterPaper returns integer //ePaperType
75595>>>>>>> integer ePaperType
75595>>>>>>> Get DFGetPrinterPaper of (phoWinPrint(self)) to ePaperType
75596>>>>>>> Function_return ePaperType
75597>>>>>>> end_function
75598>>>>>>>
75598>>>>>>>
75598>>>>>>> Procedure DFSetPrinterBin integer eBinType
75600>>>>>>> Send DFSetPrinterBin of (phoWinPrint(self)) eBinType
75601>>>>>>> End_Procedure
75602>>>>>>>
75602>>>>>>> Function DFGetPrinterBin returns integer //eBinType
75604>>>>>>> integer eBinType
75604>>>>>>> Get DFGetPrinterBin of (phoWinPrint(self)) to eBinType
75605>>>>>>> Function_return eBinType
75606>>>>>>> end_function
75607>>>>>>>
75607>>>>>>>
75607>>>>>>> Procedure DFSetPrinterResolution integer eResType
75609>>>>>>> Send DFSetPrinterResolution of (phoWinPrint(self)) eResType
75610>>>>>>> End_Procedure
75611>>>>>>>
75611>>>>>>> Function DFGetPrinterResolution returns integer //eResType
75613>>>>>>> Boolean eResType
75613>>>>>>> Get DFGetPrinterResolution of (phoWinPrint(self)) to eResType
75614>>>>>>> Function_return eResType
75615>>>>>>> end_function
75616>>>>>>>
75616>>>>>>>
75616>>>>>>> Procedure DFSetLandscape boolean bIsLandscape
75618>>>>>>> Send DFSetLandscape of (phoWinPrint(self)) bIsLandscape
75619>>>>>>> End_Procedure
75620>>>>>>>
75620>>>>>>> Function DFGetLandscape returns boolean // bIsLandscape
75622>>>>>>> Boolean bIsLandscape
75622>>>>>>> Get DFGetLandscape of (phoWinPrint(self)) to bIsLandscape
75623>>>>>>> Function_return bIsLandscape
75624>>>>>>> end_function
75625>>>>>>>
75625>>>>>>> Procedure DFSetMetrics integer eType
75627>>>>>>> Send DFSetMetrics of (phoWinPrint(self)) eType
75628>>>>>>> End_Procedure
75629>>>>>>>
75629>>>>>>> Function DFGetMetrics returns integer
75631>>>>>>> integer eType
75631>>>>>>> Get DFGetMetrics of (phoWinPrint(self)) to eType
75632>>>>>>> Function_return eType
75633>>>>>>> end_function
75634>>>>>>>
75634>>>>>>>
75634>>>>>>> Procedure DFSetPrintDlgInPreview boolean bShowDialog
75636>>>>>>> Set PrintDlgInPreview of (phoWinPrint(self)) to bShowDialog
75637>>>>>>> End_Procedure
75638>>>>>>>
75638>>>>>>> Function DFGetPrintDlgInPreview returns boolean
75640>>>>>>> boolean bShowDialog
75640>>>>>>> Get PrintDlgInPreview of (phoWinPrint(self)) to bShowDialog
75641>>>>>>> Function_return bShowDialog
75642>>>>>>> end_function
75643>>>>>>>
75643>>>>>>>
75643>>>>>>> Procedure DFSetEnablePrintFromPreview boolean bEnablePrint
75645>>>>>>> Set EnablePrintFromPreview of (phoWinPrint(self)) to bEnablePrint
75646>>>>>>> End_Procedure
75647>>>>>>>
75647>>>>>>> Function DFGetEnablePrintFromPreview returns boolean
75649>>>>>>> boolean bEnablePrint
75649>>>>>>> Get EnablePrintFromPreview of (phoWinPrint(self)) to bEnablePrint
75650>>>>>>> Function_return bEnablePrint
75651>>>>>>> end_function
75652>>>>>>>
75652>>>>>>>
75652>>>>>>>
75652>>>>>>> Procedure DFSetMargins number nLeft number nTop number nRight number nBottom
75654>>>>>>> Send DFSetMargins of (phoWinPrint(self)) nLeft nTop nRight nBottom
75655>>>>>>> End_Procedure
75656>>>>>>>
75656>>>>>>> Procedure DFSetTopBottom number nTop number nBottom Boolean bAllPages
75658>>>>>>> Send DFSetTopBottom of (phoWinPrint(self)) nTop nBottom bAllPages
75659>>>>>>> End_Procedure
75660>>>>>>>
75660>>>>>>>
75660>>>>>>> Procedure DFSetDevice string sPrinterName
75662>>>>>>> Send DFSetDevice of (phoWinPrint(self)) sPrinterName
75663>>>>>>> End_Procedure
75664>>>>>>>
75664>>>>>>> Function DFGetCurrentDevice returns string // sPrinterName
75666>>>>>>> String sPrinterName
75666>>>>>>> Get DFGetCurrentDevice of (phoWinPrint(self)) to sPrinterName
75667>>>>>>> Function_return sPrinterName
75668>>>>>>> end_function
75669>>>>>>>
75669>>>>>>>
75669>>>>>>> Procedure DFSetUserDefinedPapersize number nLength number nWidth
75671>>>>>>> Send DFSetUserDefinedPapersize of (phoWinPrint(self)) nLength nWidth
75672>>>>>>> End_Procedure
75673>>>>>>>
75673>>>>>>> Function DFGetUserDefinedLength returns number
75675>>>>>>> number nSize
75675>>>>>>> Get DFGetUserDefinedLength of (phoWinPrint(self)) to nSize
75676>>>>>>> Function_return nSize
75677>>>>>>> end_function
75678>>>>>>>
75678>>>>>>> Function DFGetUserDefinedWidth returns number
75680>>>>>>> number nSize
75680>>>>>>> Get DFGetUserDefinedWidth of (phoWinPrint(self)) to nSize
75681>>>>>>> Function_return nSize
75682>>>>>>> end_function
75683>>>>>>>
75683>>>>>>>
75683>>>>>>> Procedure DFSetNumberOfCopies integer iCopies
75685>>>>>>> Send DFSetNumberOfCopies of (phoWinPrint(self)) iCopies
75686>>>>>>> End_Procedure
75687>>>>>>>
75687>>>>>>> Procedure DFPrinterBinFirstPage integer eBinType
75689>>>>>>> Send DFPrinterBinFirstPage of (phoWinPrint(self)) eBinType
75690>>>>>>> End_Procedure
75691>>>>>>>
75691>>>>>>> Procedure DFClearPrinter
75693>>>>>>> Send DFClearPrinter of (phoWinPrint(self))
75694>>>>>>> End_Procedure
75695>>>>>>>
75695>>>>>>> Function DFGetDFColor integer iRed integer iGreen integer iBlue returns integer
75697>>>>>>> integer iWPColor
75697>>>>>>> Get DFGetDFColor of (phoWinPrint(self)) iRed iGreen iBlue to iWPColor
75698>>>>>>> Function_return iWPColor
75699>>>>>>> end_function
75700>>>>>>>
75700>>>>>>> Function RGBToWPColor integer iRgb returns integer
75702>>>>>>> integer iWPColor
75702>>>>>>> Get RGBToWPColor of (phoWinPrint(self)) iRGB to iWPColor
75703>>>>>>> Function_return iWPColor
75704>>>>>>> end_function
75705>>>>>>>
75705>>>>>>>
75705>>>>>>>End_Class
75706>>>>> integer oWinPrintReport#
75706>>>>> Move ghoWinprint2 to WinprintId
75707>>>>> DEFINE ALIGN_LEFT for 0
75707>>>>> DEFINE ALIGN_RIGHT for 1
75707>>>>>
75707>>>>>// *** A few functions ****************************************************
75707>>>>>
75707>>>>>desktop_section
75712>>>>> register_procedure DoAppendItem
75712>>>>> register_procedure DoClear
75712>>>>> register_procedure DoDeleteItem
75712>>>>> register_procedure DoUppercase
75712>>>>> register_procedure DoLowercase
75712>>>>> register_procedure DoCopy
75712>>>>> register_procedure DoPaste
75712>>>>> register_procedure DoSort
75712>>>>> object oVdfQuery_OrList_FM is a FloatingPopupMenu
75714>>>>> send add_item msg_DoClear "Clear all\aF5"
75715>>>>> send add_item msg_DoDeleteItem "Delete item\aShift+F2"
75716>>>>> send add_item msg_DoUppercase "Uppercase all"
75717>>>>> send add_item msg_DoLowercase "Lowercase all"
75718>>>>> send add_item msg_DoSort "Sort items"
75719>>>>> send add_item msg_DoAppendItem "Append item\aCtrl+A"
75720>>>>> send add_item msg_NONE ""
75721>>>>> send add_item msg_DoCopy "Copy\aCtrl+C"
75722>>>>> send add_item msg_DoPaste "Paste\aCtrl+V"
75723>>>>> end_object
75724>>>>>end_desktop_section
75729>>>>>
75729>>>>>class vdq.orlist_grid is a aps.Grid // or-list
75730>>>>> procedure construct_object
75732>>>>> forward send construct_object
75734>>>>>
75734>>>>> set line_width to 2 0
75735>>>>> set form_margin item 0 to 30
75736>>>>> set form_margin item 1 to 0
75737>>>>>
75737>>>>> set CurrentCellColor to clHighlight
75738>>>>> set CurrentCellTextColor to clHighlightText
75739>>>>> set CurrentRowColor to clHighlight
75740>>>>> set CurrentRowTextColor to clHighlightText
75741>>>>>
75741>>>>> set select_mode to multi_select
75742>>>>> set auto_top_item_state to false
75743>>>>>
75743>>>>> set gridline_mode to GRID_VISIBLE_NONE
75744>>>>> set Header_Visible_State to DFFALSE
75745>>>>>
75745>>>>> set size to 47 90
75746>>>>> set p_auto_size_control_state to false
75747>>>>> set Horz_Scroll_Bar_Visible_State to false
75748>>>>> on_key KENTER send DoAppendOrEnter
75749>>>>> on_key KDELETE_RECORD send DoDeleteItem
75750>>>>> on_key KCLEAR send DoClear
75751>>>>> on_key KEY_CTRL+KEY_A send DoAppendItem
75752>>>>> on_key KEY_CTRL+KEY_C send DoCopy
75753>>>>> on_key KEY_CTRL+KEY_V send DoPaste
75754>>>>> set aps_fixed_column_width item 1 to 2
75755>>>>> end_procedure
75756>>>>>
75756>>>>> procedure DoSetup integer liFile integer liField
75758>>>>> integer liType
75758>>>>> get gl_generic_form_datatype liFile liField to liType
75759>>>>> set form_datatype item 0 to liType
75760>>>>> end_procedure
75761>>>>>
75761>>>>> procedure entering // Make sure that there is at least one item on entering
75763>>>>> ifnot (item_count(self)) begin
75765>>>>> send add_item MSG_NONE ""
75766>>>>> send add_item MSG_NONE ""
75767>>>>> set item_shadow_state item (item_count(self)-1) to true
75768>>>>> end
75768>>>>>>
75768>>>>> forward send entering
75770>>>>> end_procedure
75771>>>>>
75771>>>>> procedure next
75773>>>>> if (current_item(self)>=item_count(self)-2) send switch
75776>>>>> else forward send next
75779>>>>> end_procedure
75780>>>>>
75780>>>>> procedure DoAppendOrEnter
75782>>>>> integer liItem liMax
75782>>>>> string lsValue
75782>>>>> get item_count to liMax
75783>>>>> if liMax begin
75785>>>>> decrement liMax
75786>>>>> get current_item to liItem
75787>>>>> get value item liItem to lsValue
75788>>>>> if (liItem=liMax-1) begin
75790>>>>> if (lsValue="") send next
75793>>>>> else send DoAppendItem
75795>>>>> end
75795>>>>>>
75795>>>>> else send next
75797>>>>> end
75797>>>>>>
75797>>>>> else send next
75799>>>>> end_procedure
75800>>>>>
75800>>>>> procedure item_change integer liItm1 integer liItm2 returns integer
75802>>>>> integer liTarget liMaxItem
75802>>>>> forward get msg_item_change liItm1 liItm2 to liTarget
75804>>>>> if (mod(liTarget,2)) begin
75806>>>>> if (abs(liItm1-liItm2)=1) begin
75808>>>>> if (liItm1<liItm2) increment liTarget
75811>>>>> else decrement liTarget
75813>>>>> end
75813>>>>>>
75813>>>>> else decrement liTarget
75815>>>>> end
75815>>>>>>
75815>>>>> get item_count to liMaxItem
75816>>>>> decrement liMaxItem
75817>>>>> decrement liMaxItem
75818>>>>> if (liTarget>liMaxItem) move liMaxItem to liTarget
75821>>>>> if (liTarget<0) move 0 to liTarget
75824>>>>> procedure_return liTarget
75825>>>>> end_procedure
75826>>>>>
75826>>>>> procedure set select_value string lsValue
75828>>>>> integer liItm liMax
75828>>>>> string lsItem
75828>>>>> get HowManyWords lsValue "|" to liMax
75829>>>>> for liItm from 1 to liMax
75835>>>>>>
75835>>>>> get ExtractWord lsValue "|" liItm to lsItem
75836>>>>> send add_item MSG_NONE lsItem
75837>>>>> send add_item MSG_NONE ""
75838>>>>> set item_shadow_state item (item_count(self)-1) to true
75839>>>>> loop
75840>>>>>>
75840>>>>> end_procedure
75841>>>>>
75841>>>>> function select_value returns string
75843>>>>> integer liRow liMax liBase
75843>>>>> string lsValue lsItem
75843>>>>> get Grid_RowCount self to liMax
75844>>>>> decrement liMax
75845>>>>> for liRow from 0 to liMax
75851>>>>>>
75851>>>>> get Grid_RowBaseItem self liRow to liBase
75852>>>>> get value item liBase to lsItem
75853>>>>> if (length(lsItem)<>0) begin
75855>>>>> if (lsValue<>"") move (lsValue+"|") to lsValue
75858>>>>> move (lsValue+lsItem) to lsValue
75859>>>>> end
75859>>>>>>
75859>>>>>// if liRow move (lsValue+"|") to lsValue
75859>>>>>// move (lsValue+lsItem) to lsValue
75859>>>>> loop
75860>>>>>>
75860>>>>> function_return lsValue
75861>>>>> end_function
75862>>>>>
75862>>>>> procedure mouse_down2 integer liWin integer liCharPos
75864>>>>> send mouse_down liWin liCharPos // Take focus
75865>>>>> send popup to (oVdfQuery_OrList_FM(self))
75866>>>>> end_procedure
75867>>>>>
75867>>>>> procedure DoAppendItem
75869>>>>> send add_item MSG_NONE ""
75870>>>>> send add_item MSG_NONE ""
75871>>>>> set item_shadow_state item (item_count(self)-1) to true
75872>>>>> set current_item to (item_count(self)-2)
75873>>>>> end_procedure
75874>>>>> procedure DoClear
75876>>>>> send delete_data
75877>>>>> send DoAppendItem
75878>>>>> end_procedure
75879>>>>> procedure DoDeleteItem
75881>>>>> integer liItem
75881>>>>> if (item_count(self)) begin
75883>>>>> send Grid_DeleteCurrentRow self
75884>>>>> end
75884>>>>>>
75884>>>>> ifnot (item_count(self)) send DoAppendItem
75887>>>>> end_procedure
75888>>>>> procedure DoUppercase
75890>>>>> integer liMax liItem
75890>>>>> set dynamic_update_state to FALSE
75891>>>>> get item_count to liMax
75892>>>>> decrement liMax
75893>>>>> for liItem from 0 to liMax
75899>>>>>>
75899>>>>> set value item liItem to (uppercase(value(self,liItem)))
75900>>>>> loop
75901>>>>>>
75901>>>>> set dynamic_update_state to TRUE
75902>>>>> end_procedure
75903>>>>> procedure DoLowercase
75905>>>>> integer liMax liItem
75905>>>>> set dynamic_update_state to FALSE
75906>>>>> get item_count to liMax
75907>>>>> decrement liMax
75908>>>>> for liItem from 0 to liMax
75914>>>>>>
75914>>>>> set value item liItem to (lowercase(value(self,liItem)))
75915>>>>> loop
75916>>>>>>
75916>>>>> set dynamic_update_state to TRUE
75917>>>>> end_procedure
75918>>>>> procedure DoCopy
75920>>>>> integer liMax liRow liBase
75920>>>>> direct_output channel 1 "CLIPBOARD:"
75922>>>>> get Grid_RowCount self to liMax
75923>>>>> decrement liMax
75924>>>>> for liRow from 0 to liMax
75930>>>>>>
75930>>>>> get Grid_RowBaseItem self liRow to liBase
75931>>>>> writeln channel 1 (value(self,liBase))
75934>>>>> loop
75935>>>>>>
75935>>>>> close_output channel 1
75937>>>>> end_procedure
75938>>>>> procedure DoPaste
75940>>>>> string lsValue
75940>>>>> send DoClear
75941>>>>> direct_input channel 0 "CLIPBOARD:"
75943>>>>> while (not(seqeof))
75947>>>>> readln channel 0 lsValue
75949>>>>> ifnot (seqeof) begin
75951>>>>> send add_item MSG_NONE lsValue
75952>>>>> send add_item MSG_NONE ""
75953>>>>> set item_shadow_state item (item_count(self)-1) to true
75954>>>>> end
75954>>>>>>
75954>>>>> end
75955>>>>>>
75955>>>>> close_input channel 0
75957>>>>> end_procedure
75958>>>>> procedure DoSort
75960>>>>> send Grid_SortByColumn self 0
75961>>>>> end_procedure
75962>>>>>end_class // vdq.orlist_grid
75963>>>>>
75963>>>>>Use Query.nui // Basic things needed for a query tool
75963>>>>>// *** Dynamic object components *****************************************
75963>>>>>// 0 1 2 3 4 5 6 7
75963>>>>>DEFINE_OBJECT_GROUP OG_QuerySelectDialogElement // label# mrg# type# comp# val1# val2# file# field#
75964>>>>> if (og_param(3)=SC_COMP_OR_LIST) begin // or-list
75966>>>>> set p_auto_column to 0
75967>>>>> send aps_goto_max_row
75968>>>>> send aps_make_row_space 5
75969>>>>> object oLabel is a aps.TextBox
75971>>>>> procedure do_label
75974>>>>> string label#
75974>>>>> move (og_param(0)) to label#
75975>>>>> // Remove ":"
75975>>>>> if (right(label#,1)) eq ":" move (StringLeftBut(label#,1)) to label#
75978>>>>> move (label#+" ("+DfQuery_CompModeTxt_Short(SC_COMP_OR_LIST)+"):") to label#
75979>>>>> set label to label#
75980>>>>> end_procedure
75981>>>>> send do_label
75982>>>>> end_object
75983>>>>> object oList is a vdq.orlist_grid snap 1
75986>>>>> move self to OG_Current_Object#
75987>>>>> send DoSetup (og_param(6)) (og_param(7))
75988>>>>> set select_value to (og_param(4))
75989>>>>> end_object
75990>>>>> send add_object_id (0-OG_Current_Object#)
75991>>>>> send add_object_id 0
75992>>>>>
75992>>>>> set p_auto_column to 1
75993>>>>> send aps_goto_max_row
75994>>>>> end
75994>>>>>>
75994>>>>> else begin
75995>>>>> object oVal1 is a aps.form
75997>>>>> property integer piPopupFile public 0
75999>>>>> property integer piPopupField public 0
76001>>>>> procedure do_label
76004>>>>> integer comp#
76004>>>>> string label#
76004>>>>> move (og_param(0)) to label#
76005>>>>> move (og_param(3)) to comp#
76006>>>>> // Remove ":"
76006>>>>> if (right(label#,1)) eq ":" move (StringLeftBut(label#,1)) to label#
76009>>>>> move (label#+" ("+DfQuery_CompModeTxt_Short(comp#)+"):") to label#
76010>>>>> set label to label#
76011>>>>> end_procedure
76012>>>>> send do_label
76013>>>>> set form_datatype item 0 to (og_param(2))
76014>>>>> set form_margin item 0 to (og_param(1) min 40)
76015>>>>> set value item 0 to (og_param(4))
76016>>>>> set status_help item 0 to (DfQuery_CompModeTxt_Long(og_param(3)))
76017>>>>> procedure OnSetFocus
76020>>>>> forward send OnSetFocus
76022>>>>> send request_status_help 1
76023>>>>> end_procedure
76024>>>>> move self to OG_Current_Object#
76025>>>>> if (integer(og_param(7))<256) begin
76027>>>>> set piPopupFile to (integer(API_AttrValue_FIELD(DF_FIELD_RELATED_FILE,og_param(6),og_param(7))))
76028>>>>> set piPopupField to (integer(API_AttrValue_FIELD(DF_FIELD_RELATED_FIELD,og_param(6),og_param(7))))
76029>>>>> end
76029>>>>>>
76029>>>>> else begin
76030>>>>> set piPopupFile to 0
76031>>>>> set piPopupField to 0
76032>>>>> end
76032>>>>>>
76032>>>>> if (piPopupFile(self)) begin
76034>>>>> set form_button item 0 to 1 // Manually add a prompt button
76035>>>>> set form_button_value item 0 to "..."
76036>>>>> on_key kprompt send form_button_notification
76037>>>>> procedure form_button_notification integer itm#
76040>>>>> integer rec# file# field# rfile# rfield#
76040>>>>> string str#
76040>>>>> get piPopupFile to rfile#
76041>>>>> get PromptListSelectRecord rfile# "" to rec#
76042>>>>> if rec# begin
76044>>>>> get piPopupField to rfield#
76045>>>>> get_field_value rfile# rfield# to str#
76048>>>>> set value item 0 to str#
76049>>>>> end
76049>>>>>>
76049>>>>> send activate
76050>>>>> end_procedure
76051>>>>> end
76051>>>>>>
76051>>>>> send add_object_id OG_Current_Object#
76052>>>>> if (og_param(3)) eq SC_COMP_NOT_BLANK set object_shadow_state to true
76055>>>>> if (og_param(3)) eq SC_COMP_BLANK set object_shadow_state to true
76058>>>>> end_object
76059>>>>> if (og_param(3)=SC_COMP_BETWEEN or og_param(3)=SC_COMP_CBETWEEN) begin
76061>>>>> object oVal2 is a aps.form label "-" snap (if(integer(og_param(1))>15,0,sl_right))
76065>>>>> property integer piPopupFile public 0
76067>>>>> property integer piPopupField public 0
76069>>>>> set form_datatype item 0 to (og_param(2))
76070>>>>> set form_margin item 0 to (og_param(1) min 40)
76071>>>>> set value item 0 to (og_param(5))
76072>>>>> set status_help item 0 to (DfQuery_CompModeTxt_Long(og_param(3)))
76073>>>>> procedure OnSetFocus
76076>>>>> forward send OnSetFocus
76078>>>>> send request_status_help 1
76079>>>>> end_procedure
76080>>>>> move self to OG_Current_Object#
76081>>>>> if (integer(og_param(7))<256) begin
76083>>>>> set piPopupFile to (integer(API_AttrValue_FIELD(DF_FIELD_RELATED_FILE,og_param(6),og_param(7))))
76084>>>>> set piPopupField to (integer(API_AttrValue_FIELD(DF_FIELD_RELATED_FIELD,og_param(6),og_param(7))))
76085>>>>> end
76085>>>>>>
76085>>>>> else begin
76086>>>>> set piPopupFile to 0
76087>>>>> set piPopupField to 0
76088>>>>> end
76088>>>>>>
76088>>>>> if (piPopupFile(self)) begin
76090>>>>> set form_button item 0 to 1 // Manually add a prompt button
76091>>>>> set form_button_value item 0 to "..."
76092>>>>> on_key kprompt send form_button_notification
76093>>>>> procedure form_button_notification integer itm#
76096>>>>> integer rec# file# field# rfile# rfield#
76096>>>>> string str#
76096>>>>> get piPopupFile to rfile#
76097>>>>> get PromptListSelectRecord rfile# "" to rec#
76098>>>>> if rec# begin
76100>>>>> get piPopupField to rfield#
76101>>>>> get_field_value rfile# rfield# to str#
76104>>>>> set value item 0 to str#
76105>>>>> end
76105>>>>>>
76105>>>>> send activate
76106>>>>> end_procedure
76107>>>>> end
76107>>>>>>
76107>>>>> send add_object_id OG_Current_Object#
76108>>>>> end_object
76109>>>>> end
76109>>>>>>
76109>>>>> else send add_object_id 0
76111>>>>> end
76111>>>>>>
76111>>>>>END_DEFINE_OBJECT_GROUP // OG_QuerySelectDialogElement
76112>>>>>
76112>>>>>DEFINE_OBJECT_GROUP OG_QuerySelectDialog // caption array_id
76113>>>>> object QueryMultiCrit is a aps.ModalPanel label (t.DfQuery.LblTab2+", "+og_param(0))
76116>>>>> on_key key_ctrl+key_P send MSG_NONE
76117>>>>> on_key kcancel send close_panel_cancel
76118>>>>> set locate_mode to CENTER_ON_SCREEN
76119>>>>> property integer pReturnValue public 0
76121>>>>> property integer pArrayID public 0
76123>>>>> set pArrayID to (og_param(1))
76124>>>>> object object_ids_array is an array
76126>>>>> end_object
76127>>>>> procedure add_object_id integer obj#
76130>>>>> integer arr#
76130>>>>> move (object_ids_array(self)) to arr#
76131>>>>> set value of arr# item (item_count(arr#)) to obj#
76132>>>>> end_procedure
76133>>>>> object oCont is a aps.Group
76135>>>>> on_key ksave_record send close_panel_ok
76136>>>>> on_key kenter send next
76137>>>>> set p_max_column to 200 // Minimum width
76138>>>>> send aps_tab_column_define 1 70 65 JMODE_RIGHT
76139>>>>> procedure add_objects integer obj#
76142>>>>> integer mrg# type# comp# crit# max# file# field#
76142>>>>> string label# val1# val2#
76142>>>>> get row_count of obj# to max#
76143>>>>> for crit# from 0 to (max#-1)
76149>>>>>>
76149>>>>> get psLabel.i of obj# item crit# to label#
76150>>>>> get piMargin.i of obj# item crit# to mrg#
76151>>>>> get piType.i of obj# item crit# to type#
76152>>>>> get piComp.i of obj# item crit# to comp#
76153>>>>> get psVal1.i of obj# item crit# to val1#
76154>>>>> get psVal2.i of obj# item crit# to val2#
76155>>>>> get piFile.i of obj# item crit# to file#
76156>>>>> get piField.i of obj# item crit# to field#
76157>>>>> CREATE_OBJECT_GROUP OG_QuerySelectDialogElement label# mrg# type# comp# val1# val2# file# field#
76168>>>>> loop
76169>>>>>>
76169>>>>> end_procedure
76170>>>>> send add_objects (og_param(1))
76171>>>>> end_object
76172>>>>> procedure close_panel_ok
76175>>>>> integer object_ids_array# pArrayID# crit# max# obj# oFrm#
76175>>>>> // Now we move the current values back to the array:
76175>>>>> get pArrayID to pArrayID#
76176>>>>> move (object_ids_array(self)) to object_ids_array#
76177>>>>> get row_count of pArrayID# to max#
76178>>>>> for crit# from 0 to (max#-1)
76184>>>>>>
76184>>>>> move (value(object_ids_array#,crit#*2+0)) to oFrm#
76185>>>>> if (oFrm#>0) begin
76187>>>>> set psVal1.i of pArrayID# item crit# to (value(oFrm#,0))
76188>>>>> end
76188>>>>>>
76188>>>>> else if (oFrm#<0) begin // Oh! It's an or-list!!!
76191>>>>> move (0-oFrm#) to oFrm#
76192>>>>> set psVal1.i of pArrayID# item crit# to (select_value(oFrm#))
76193>>>>> end
76193>>>>>>
76193>>>>> move (value(object_ids_array#,crit#*2+1)) to oFrm#
76194>>>>> if oFrm# set psVal2.i of pArrayID# item crit# to (value(oFrm#,0))
76197>>>>> loop
76198>>>>>>
76198>>>>> set pReturnValue to 1
76199>>>>> send close_panel
76200>>>>> end_procedure
76201>>>>> procedure close_panel_cancel
76204>>>>> set pReturnValue to 0
76205>>>>> send close_panel
76206>>>>> end_procedure
76207>>>>> object oBtn1 is a aps.Multi_Button
76209>>>>> on_item t.btn.ok send close_panel_ok
76210>>>>> end_object
76211>>>>> object oBtn2 is a aps.Multi_Button
76213>>>>> on_item t.btn.cancel send close_panel_cancel
76214>>>>> end_object
76215>>>>> send aps_locate_multi_buttons
76216>>>>> //procedure request_clear // not used?
76216>>>>> // set value of (oVal1(oCont(self))) item 0 to ""
76216>>>>> // set value of (oVal2(oCont(self))) item 0 to ""
76216>>>>> // send activate to (oVal1(oCont(self)))
76216>>>>> //end_procedure
76216>>>>> //function string_value integer item# returns string // Not used?
76216>>>>> // function_return (value(value(object_ids_array(self),item#),0))
76216>>>>> //end_function
76216>>>>> move self to OG_Current_Object#
76217>>>>> end_object
76218>>>>>END_DEFINE_OBJECT_GROUP // OG_QuerySelectDialog
76219>>>>>
76219>>>>>DEFINE_OBJECT_GROUP OG_QuerySingleCrit // label# mrg# type# comp# val1# val2# liFile liFIeld
76220>>>>> object QuerySingleCrit is a aps.ModalPanel label (t.DfQuery.SetDefaultValue+", "+DfQuery_CompModeTxt_Long(og_param(3)))
76223>>>>> on_key key_ctrl+key_P send msg_none
76224>>>>> on_key kcancel send close_panel_cancel
76225>>>>> on_key kclear send request_clear
76226>>>>> on_key kclear_all send close_panel_reset
76227>>>>> set locate_mode to center_on_screen
76228>>>>> property integer pReturnValue public 0
76230>>>>> property integer piComp public -1
76232>>>>>
76232>>>>> object oCont is a aps.Group
76234>>>>> on_key ksave_record send close_panel_ok
76235>>>>> on_key kenter send next
76236>>>>> set p_max_column to 200 // Minimum width
76237>>>>> set piComp to (og_param(3)) // or-list ()
76238>>>>>
76238>>>>> if (og_param(3)=SC_COMP_OR_LIST) begin // or-list
76240>>>>> set p_auto_column to 0
76241>>>>> send aps_goto_max_row
76242>>>>> send aps_make_row_space 5
76243>>>>> object oLabel is a aps.TextBox
76245>>>>> procedure do_label
76248>>>>> string label#
76248>>>>> move (og_param(0)) to label#
76249>>>>> if (right(label#,1)) eq ":" move (StringLeftBut(label#,1)) to label#
76252>>>>> move (label#+" ("+DfQuery_CompModeTxt_Short(SC_COMP_OR_LIST)+"):") to label#
76253>>>>> set label to label#
76254>>>>> end_procedure
76255>>>>> send do_label
76256>>>>> end_object
76257>>>>> object oList is a vdq.orlist_grid snap 1
76260>>>>> send DoSetup (og_param(6)) (og_param(7))
76261>>>>> set select_value to (og_param(4))
76262>>>>> end_object
76263>>>>>
76263>>>>> set p_auto_column to 1
76264>>>>> send aps_goto_max_row
76265>>>>> end
76265>>>>>>
76265>>>>> else begin
76266>>>>> object oVal1 is a aps.form label (og_param(0))
76269>>>>> set form_datatype item 0 to (og_param(2))
76270>>>>> set form_margin item 0 to (og_param(1) min 40)
76271>>>>> set value item 0 to (og_param(4))
76272>>>>> if (og_param(3)) eq SC_COMP_NOT_BLANK set object_shadow_state to true
76275>>>>> if (og_param(3)) eq SC_COMP_BLANK set object_shadow_state to true
76278>>>>> end_object
76279>>>>> if (og_param(3)=SC_COMP_BETWEEN or og_param(3)=SC_COMP_CBETWEEN) begin
76281>>>>> object oVal2 is a aps.form label "-" snap (if(integer(og_param(1))>15,0,sl_right))
76285>>>>> set form_datatype item 0 to (og_param(2))
76286>>>>> set form_margin item 0 to (og_param(1) min 40)
76287>>>>> set value item 0 to (og_param(5))
76288>>>>> end_object
76289>>>>> end
76289>>>>>>
76289>>>>> end
76289>>>>>>
76289>>>>> end_object // oCont
76290>>>>> procedure close_panel_ok
76293>>>>> set pReturnValue to 1
76294>>>>> send close_panel
76295>>>>> end_procedure
76296>>>>> procedure close_panel_reset
76299>>>>> set pReturnValue to -1
76300>>>>> send close_panel
76301>>>>> end_procedure
76302>>>>> procedure close_panel_cancel
76305>>>>> set pReturnValue to 0
76306>>>>> send close_panel
76307>>>>> end_procedure
76308>>>>> object oBtn1 is a aps.Multi_Button
76310>>>>> on_item t.btn.ok send close_panel_ok
76311>>>>> end_object
76312>>>>> object oBtn2 is a aps.Multi_Button
76314>>>>> on_item t.btn.reset send close_panel_reset
76315>>>>> end_object
76316>>>>> object oBtn3 is a aps.Multi_Button
76318>>>>> on_item t.btn.cancel send close_panel_cancel
76319>>>>> end_object
76320>>>>> send aps_locate_multi_buttons
76321>>>>> if (og_param(3)=SC_COMP_BETWEEN or og_param(3)=SC_COMP_CBETWEEN) begin
76323>>>>> procedure request_clear
76326>>>>> set value of (oVal1(oCont(self))) item 0 to ""
76327>>>>> set value of (oVal2(oCont(self))) item 0 to ""
76328>>>>> send activate to (oVal1(oCont(self)))
76329>>>>> end_procedure
76330>>>>> end
76330>>>>>>
76330>>>>> else if (og_param(3)=SC_COMP_OR_LIST) begin // or-list
76333>>>>> procedure request_clear
76336>>>>> send DoClear to (oList(self))
76337>>>>> send activate to (oList(self))
76338>>>>> end_procedure
76339>>>>> end
76339>>>>>>
76339>>>>> else begin
76340>>>>> procedure request_clear
76343>>>>> set value of (oVal1(oCont(self))) item 0 to ""
76344>>>>> send activate to (oVal1(oCont(self)))
76345>>>>> end_procedure
76346>>>>> end
76346>>>>>>
76346>>>>>
76346>>>>> function value_from returns string
76349>>>>> string rval#
76349>>>>> if (piComp(self)=SC_COMP_OR_LIST) get select_value of (oList(oCont(self))) to rval# // or-list
76352>>>>> else get value of (oVal1(oCont(self))) item 0 to rval#
76354>>>>> function_return rval#
76355>>>>> end_function
76356>>>>> if (og_param(3)=SC_COMP_BETWEEN or og_param(3)=SC_COMP_CBETWEEN) begin
76358>>>>> function value_to returns string
76361>>>>> string rval#
76361>>>>> get value of (oVal2(oCont(self))) item 0 to rval#
76362>>>>> function_return rval#
76363>>>>> end_function
76364>>>>> end
76364>>>>>>
76364>>>>> else begin
76365>>>>> function value_to returns string
76368>>>>> function_return ""
76369>>>>> end_function
76370>>>>> end
76370>>>>>>
76370>>>>> move self to OG_Current_Object#
76371>>>>> end_object
76372>>>>>END_DEFINE_OBJECT_GROUP // OG_QuerySingleCrit
76373>>>>>
76373>>>>>// *** A few more functions ***********************************************
76373>>>>>
76373>>>>>register_procedure close_panel_ok
76373>>>>>
76373>>>>>desktop_section // Place object on desktop no matter where declared
76378>>>>> object QueryCompMode_SL is a aps.ModalPanel label t.DfQuery.Operators
76381>>>>> on_key key_ctrl+key_P send msg_none
76382>>>>> property integer pReturnValue public 0
76384>>>>> on_key kcancel send close_panel
76385>>>>> object oLst is a aps.list
76387>>>>> set size to 120 150
76388>>>>> procedure Mouse_click integer i1 integer i2
76391>>>>> send close_panel_ok
76392>>>>> end_procedure
76393>>>>> procedure add_item.ii integer current# integer aux#
76396>>>>> send add_item msg_close_panel_ok (DfQuery_CompModeTxt_Long(aux#)+" ("+DfQuery_CompModeTxt_Short(aux#)+")") aux#
76397>>>>> set aux_value item (item_count(self)-1) to aux#
76398>>>>> if current# eq aux# set current_item to (item_count(self)-1)
76401>>>>> end_procedure
76402>>>>> procedure fill_list integer current# integer type#
76405>>>>> send delete_data
76406>>>>> if type# ne DF_TEXT begin
76408>>>>> send add_item.ii current# SC_COMP_EQ
76409>>>>> send add_item.ii current# SC_COMP_LT
76410>>>>> send add_item.ii current# SC_COMP_LE
76411>>>>> send add_item.ii current# SC_COMP_GE
76412>>>>> send add_item.ii current# SC_COMP_GT
76413>>>>> send add_item.ii current# SC_COMP_NE
76414>>>>> end
76414>>>>>>
76414>>>>> send add_item.ii current# SC_COMP_IN
76415>>>>> send add_item.ii current# SC_COMP_CIN
76416>>>>> if type# ne DF_TEXT begin
76418>>>>> send add_item.ii current# SC_COMP_BETWEEN
76419>>>>> send add_item.ii current# SC_COMP_CBETWEEN
76420>>>>> end
76420>>>>>>
76420>>>>> else begin
76421>>>>> send add_item.ii current# SC_COMP_NOT_BLANK
76422>>>>> send add_item.ii current# SC_COMP_BLANK
76423>>>>> end
76423>>>>>>
76423>>>>> if type# ne DF_TEXT begin // or-list
76425>>>>> send add_item.ii current# SC_COMP_OR_LIST
76426>>>>> end
76426>>>>>>
76426>>>>> end_procedure
76427>>>>> end_object
76428>>>>> procedure close_panel_ok
76431>>>>> integer obj#
76431>>>>> move (oLst(self)) to obj#
76432>>>>> set pReturnValue to (aux_value(obj#,current_item(obj#)))
76433>>>>> send close_panel
76434>>>>> end_procedure
76435>>>>> object oBtn1 is a aps.Multi_Button
76437>>>>> set default_state to True
76438>>>>> on_item t.btn.ok send close_panel_ok
76439>>>>> end_object
76440>>>>> object oBtn2 is a aps.Multi_Button
76442>>>>> on_item t.btn.cancel send close_panel
76443>>>>> end_object
76444>>>>> send aps_locate_multi_buttons
76445>>>>> end_object
76446>>>>>end_desktop_section
76451>>>>>
76451>>>>>function VdfQuery_SelectCompMode global integer type# integer current# returns integer
76453>>>>> integer obj#
76453>>>>> move (QueryCompMode_SL(self)) to obj#
76454>>>>> set pReturnValue of obj# to current#
76455>>>>> send fill_list to (oLst(obj#)) current# type#
76456>>>>> send popup_modal to obj#
76457>>>>> function_return (pReturnValue(obj#))
76458>>>>>end_function
76459>>>>>
76459>>>>>function VdfQuery_field_width_cm global integer typ# integer mrg# integer caps# string font# integer fontsize# returns number
76461>>>>> number rval# factor#
76461>>>>> move (120/fontsize#/2.56) to factor#
76462>>>>> move (1.0/factor#) to factor#
76463>>>>> //move (factor#*0.8) to factor# // Un-explainable factor (0.8)
76463>>>>> if typ# eq DF_ASCII begin
76465>>>>> if caps# move (mrg#*factor#*1.5) to rval#
76468>>>>> else move (mrg#*factor#) to rval#
76470>>>>> end
76470>>>>>>
76470>>>>> if typ# eq DF_DATE move (10*factor#) to rval#
76473>>>>> if typ# eq DF_BCD move (mrg#*factor#) to rval#
76476>>>>> function_return rval#
76477>>>>>end_function
76478>>>>>
76478>>>>>function VdfQuery_value_width_cm global string str# string font# integer fontsize# returns number
76480>>>>> number rval#
76480>>>>> get VdfQuery_field_width_cm DF_ASCII (length(str#)) 0 font# fontsize# to rval#
76481>>>>> function_return rval#
76482>>>>>end_function
76483>>>>>
76483>>>>>function VdfQuery_field_margin global integer file# integer field# returns integer
76485>>>>> integer fieldtype# len# dec# obj#
76485>>>>> if field# lt 256 begin
76487>>>>> get_attribute DF_FIELD_TYPE of file# field# to fieldtype#
76490>>>>> get_attribute DF_FIELD_LENGTH of file# field# to len#
76493>>>>> if fieldtype# eq DF_DATE move 10 to len#
76496>>>>> if fieldtype# eq DF_BCD begin
76498>>>>> get gl_effective_form_datatype file# field# to dec#
76499>>>>> if dec# move (len#+1) to len#
76502>>>>> end
76502>>>>>>
76502>>>>> end
76502>>>>>>
76502>>>>> else begin
76503>>>>> get FieldInf_VirtualFields_Object file# to obj#
76504>>>>> move (field#-256) to field#
76505>>>>> get piFieldType.i of obj# field# to fieldtype#
76506>>>>> get piFieldLength.i of obj# field# to len#
76507>>>>> if fieldtype# eq DF_DATE move 10 to len#
76510>>>>> end
76510>>>>>>
76510>>>>> function_return len#
76511>>>>>end_function
76512>>>>>
76512>>>>>function VdfQuery_file_status_help global integer file# returns string
76514>>>>> integer fieldtype#
76514>>>>> string rval# str#
76514>>>>> move "DF-name: #, Root: #" to rval#
76515>>>>> get_attribute DF_FILE_LOGICAL_NAME of file# to str#
76518>>>>> replace "#" in rval# with str#
76520>>>>> get_attribute DF_FILE_ROOT_NAME of file# to str#
76523>>>>> replace "#" in rval# with str#
76525>>>>> function_return rval#
76526>>>>>end_function
76527>>>>>
76527>>>>>function VdfQuery_field_status_help global integer file# integer field# returns string
76529>>>>> integer fieldtype# obj#
76529>>>>> string rval# str#
76529>>>>> move "# (#)" to rval#
76530>>>>> move (FieldInf_FieldType(file#,field#)) to fieldtype#
76531>>>>> if fieldtype# eq DF_ASCII move "Ascii" to str#
76534>>>>> if fieldtype# eq DF_DATE move "Date" to str#
76537>>>>> if fieldtype# eq DF_TEXT move "Text" to str#
76540>>>>> if fieldtype# eq DF_BCD move "Number" to str#
76543>>>>> if fieldtype# eq DF_BINARY move "Binary" to str#
76546>>>>> if str# eq "" move "Unknown" to str#
76549>>>>> replace "#" in rval# with str#
76551>>>>> replace "#" in rval# with (FieldInf_field_length_string(file#,field#))
76553>>>>> function_return rval#
76554>>>>>end_function
76555>>>>>
76555>>>>> string gsVdfQuery_Icon#
76555>>>>> move "" to gsVdfQuery_Icon#
76556>>>>>
76556>>>>>procedure set VdfQuery_Icon global string icon_filename#
76558>>>>> move icon_filename# to gsVdfQuery_Icon#
76559>>>>>end_procedure
76560>>>>>
76560>>>>>integer giVdfQuery_Expressions_State
76560>>>>>move DFTRUE to giVdfQuery_Expressions_State
76561>>>>>procedure set VdfQuery_Expressions_State global integer liValue
76563>>>>> move liValue to giVdfQuery_Expressions_State
76564>>>>>end_procedure
76565>>>>>
76565>>>>>integer giVdfQuery_OldFolders_State
76565>>>>>move DFFALSE to giVdfQuery_OldFolders_State
76566>>>>>procedure set VdfQuery_OldFolders_State global integer liValue
76568>>>>> move liValue to giVdfQuery_OldFolders_State
76569>>>>>end_procedure
76570>>>>>
76570>>>>>desktop_section // Place object on desktop no matter where declared
76575>>>>> object oVdfQuery_SaveAs is a SaveAsDialog
76577>>>>> set Filter_String to t.DfQuery.Filter1
76578>>>>> set Dialog_Caption to t.DfQuery.Caption1
76579>>>>> set OverwritePrompt_State to false
76580>>>>> set NoChangeDir_State to true
76581>>>>> set HideReadOnly_State To True
76582>>>>> end_object
76583>>>>>end_desktop_section
76588>>>>>
76588>>>>>// *** Report generating **************************************************
76588>>>>>
76588>>>>>integer oReport_info#
76588>>>>>object oReport_info is an cReport_info
76590>>>>> set pOnlyMostSignificantBreakLevel to true
76591>>>>> property integer current_row public 0
76593>>>>> property integer next_current_row public 0
76595>>>>> property string pDeferredHeader public t.DfQuery.RightHeader
76597>>>>> property string pCurDeferredHeader public ""
76599>>>>> property integer pLeftMargin public 200
76601>>>>> property integer pRightMargin public 2000
76603>>>>> property integer pTopMargin public 150
76605>>>>> property integer pBottomMargin public 2750
76607>>>>> property integer pColumnHeaderRowStart public 0
76609>>>>> property integer pTotalsOnly public 0
76611>>>>> property integer pLandscape public 0
76613>>>>> property integer pPrintCriteria public 0
76615>>>>> property integer pDestination public 0 // 0:Printer 1:Preview 2:File
76617>>>>> property integer pFileFormat public 0 // 0:Comma 1:Line 2:Formatted 3:HTML
76619>>>>> property integer pPageLength public 60
76621>>>>> property integer pLineCount public 0
76623>>>>> property string pOutFileName public ""
76625>>>>> property string pCurrentFileLine public ""
76627>>>>> property string pHTML_TabelHdrColor public clYellow // (RGB_Compose(192,192,64))
76629>>>>> property integer pIncludeLabels public 0
76631>>>>> property integer pSemiColon public 0
76633>>>>> property integer pUseAnsiCharacters public 0
76635>>>>> property string psTextTop public ""
76637>>>>> property string psTextBottom public ""
76639>>>>> property integer phXMLDocumentRoot public 0
76641>>>>> property string psFieldsInIndex public ""
76643>>>>> Property string psFontName public ''
76645>>>>> Property integer piFontSize public 0
76647>>>>>
76647>>>>> property integer pbQuiet public 0
76649>>>>>
76649>>>>> move self to oReport_info#
76650>>>>> object oValues is an array
76652>>>>> end_object
76653>>>>> object oTotals is an cReportTotals
76655>>>>> end_object
76656>>>>> object oBatchCompanion is a cBatchCompanion
76658>>>>> end_object
76659>>>>> object oCriteriaTexts is an array
76661>>>>> end_object
76662>>>>> object oBreakInfo is an array
76664>>>>> set delegation_mode to delegate_to_parent
76665>>>>> property integer pMaxLogicalLevel public 0
76667>>>>> item_property_list
76667>>>>> item_property integer piFile.i
76667>>>>> item_property integer piField.i
76667>>>>> item_property integer piExprRow.i
76667>>>>> item_property integer phExprArr.i
76667>>>>> item_property integer piSelect.i
76667>>>>> item_property string psLabel.i
76667>>>>> // If this break level is not selected this property will point to a
76667>>>>> // level that is selected (in less significant direction):
76667>>>>> item_property integer piTranslateLevel.i
76667>>>>> // This property translates break level to a logical break level (since
76667>>>>> // some physical levels may not be selected):
76667>>>>> item_property integer piLogicalLevel.i
76667>>>>> end_item_property_list
#REM 76722 DEFINE FUNCTION PILOGICALLEVEL.I INTEGER LIROW RETURNS INTEGER
#REM 76727 DEFINE PROCEDURE SET PILOGICALLEVEL.I INTEGER LIROW INTEGER VALUE
#REM 76732 DEFINE FUNCTION PITRANSLATELEVEL.I INTEGER LIROW RETURNS INTEGER
#REM 76737 DEFINE PROCEDURE SET PITRANSLATELEVEL.I INTEGER LIROW INTEGER VALUE
#REM 76742 DEFINE FUNCTION PSLABEL.I INTEGER LIROW RETURNS STRING
#REM 76747 DEFINE PROCEDURE SET PSLABEL.I INTEGER LIROW STRING VALUE
#REM 76752 DEFINE FUNCTION PISELECT.I INTEGER LIROW RETURNS INTEGER
#REM 76757 DEFINE PROCEDURE SET PISELECT.I INTEGER LIROW INTEGER VALUE
#REM 76762 DEFINE FUNCTION PHEXPRARR.I INTEGER LIROW RETURNS INTEGER
#REM 76767 DEFINE PROCEDURE SET PHEXPRARR.I INTEGER LIROW INTEGER VALUE
#REM 76772 DEFINE FUNCTION PIEXPRROW.I INTEGER LIROW RETURNS INTEGER
#REM 76777 DEFINE PROCEDURE SET PIEXPRROW.I INTEGER LIROW INTEGER VALUE
#REM 76782 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 76787 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 76792 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 76797 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
76803>>>>> end_object
76804>>>>> procedure initialize_breaks
76807>>>>> integer current_level# level# max# oBreakInfo#
76807>>>>> move (oBreakInfo(self)) to oBreakInfo#
76808>>>>> set piNumberOfColumns of (oTotals(self)) to (rpt_field_count(self))
76809>>>>> get row_count of oBreakInfo# to max#
76810>>>>> move 0 to current_level#
76811>>>>> for_ex level# from (max#-1) down_to 0
76818>>>>> if (piSelect.i(oBreakInfo#,level#)) move level# to current_level#
76821>>>>> set piTranslateLevel.i of oBreakInfo# item level# to current_level#
76822>>>>> loop
76823>>>>>>
76823>>>>> move 0 to current_level#
76824>>>>> for level# from 0 to (max#-1)
76830>>>>>>
76830>>>>> if (piSelect.i(oBreakInfo#,level#)) increment current_level#
76833>>>>> set piLogicalLevel.i of oBreakInfo# item level# to current_level#
76834>>>>> loop
76835>>>>>>
76835>>>>> set pMaxLogicalLevel of oBreakInfo# to current_level#
76836>>>>> end_procedure
76837>>>>> procedure define_break_level integer file# integer fld# integer liExprRow integer lhExprArr integer select# string label#
76840>>>>> integer row# oBreakInfo#
76840>>>>> move (oBreakInfo(self)) to oBreakInfo#
76841>>>>> get row_count of oBreakInfo# to row#
76842>>>>> set piFile.i of oBreakInfo# item row# to file#
76843>>>>> set piField.i of oBreakInfo# item row# to fld#
76844>>>>> set piExprRow.i of oBreakInfo# item row# to liExprRow
76845>>>>> set phExprArr.i of oBreakInfo# item row# to lhExprArr
76846>>>>> set piSelect.i of oBreakInfo# item row# to select#
76847>>>>> set psLabel.i of oBreakInfo# item row# to label#
76848>>>>> send add_break_field file# fld# liExprRow lhExprArr
76849>>>>> end_procedure
76850>>>>> function sBreakField_Value.i integer level# returns string
76853>>>>> integer file# fld# oBreakInfo# liExprRow lhExprArr
76853>>>>> string rval# label#
76853>>>>> move (oBreakInfo(self)) to oBreakInfo#
76854>>>>> get piFile.i of oBreakInfo# level# to file#
76855>>>>> if file# begin
76857>>>>> get piField.i of oBreakInfo# level# to fld#
76858>>>>> get FieldInf_FieldValue file# fld# to rval#
76859>>>>> end
76859>>>>>>
76859>>>>> else begin
76860>>>>> get phExprArr.i of oBreakInfo# level# to lhExprArr
76861>>>>> get piExprRow.i of oBreakInfo# level# to liExprRow
76862>>>>> get sEvalExpression of (Query_ExprEvaluator(self)) (piExprId.i(lhExprArr,liExprRow)) to rval#
76863>>>>> end
76863>>>>>>
76863>>>>> if rval# eq "" move " " to rval# // Make evident that field is empty!
76866>>>>> else move (trim(rval#)) to rval#
76868>>>>> move (psLabel.i(oBreakInfo#,level#)) to label#
76869>>>>> function_return (label#+rval#)
76870>>>>> end_function
76871>>>>>
76871>>>>> procedure print_subheader string str# integer level#
76874>>>>> integer vbottom#
76874>>>>> if (pDestination(self)<>DFQ.DEST.FILE) begin // If not file
76876>>>>> send print_subheader to oWinPrintReport# str# level#
76877>>>>> end
76877>>>>>>
76877>>>>> else begin // File:
76878>>>>> if (pFileFormat(self)=DFQ.FORMAT.HTML) begin
76880>>>>> writeln channel 1 " <tr>"
76883>>>>> increment level#
76884>>>>> writeln (' <td align="center" bgcolor=#FFFF20 colspan="'+string(rpt_field_count(self))+'"> <h'+string(level#)+'>'+html_DfToHtmlTable(str#)+'</h'+string(level#)+'> </td>')
76886>>>>> writeln " </tr>"
76888>>>>> end
76888>>>>>>
76888>>>>> if (pFileFormat(self)=DFQ.FORMAT.PRINT) begin
76890>>>>> if level# eq 1 writeln channel 1 ""
76895>>>>> writeln channel 1 (pad("",level#*2)+str#)
76898>>>>> end
76898>>>>>>
76898>>>>> end
76898>>>>>>
76898>>>>> end_procedure
76899>>>>> procedure print_subtotal string str# integer level#
76902>>>>> if (pDestination(self)<>DFQ.DEST.FILE) begin // If not file
76904>>>>> send print_subtotal to oWinPrintReport# str# level#
76905>>>>> end
76905>>>>>>
76905>>>>> else send print_totals 0 // Print totals but do not end it all!
76907>>>>> end_procedure
76908>>>>>
76908>>>>> procedure Handle_SubHeader integer level#
76911>>>>> integer oBreakInfo# fin# logical_level#
76911>>>>> string str#
76911>>>>> move (oBreakInfo(self)) to oBreakInfo#
76912>>>>> move (piLogicalLevel.i(oBreakInfo#,level#)) to logical_level#
76913>>>>> move 0 to fin#
76914>>>>> move (sBreakField_Value.i(self,level#)) to str#
76915>>>>> repeat
76915>>>>>>
76915>>>>> decrement level#
76916>>>>> move (level#<0 or piSelect.i(oBreakInfo#,level#)) to fin#
76917>>>>> ifnot fin# ; move (sBreakField_Value.i(self,level#)+", "+str#) to str#
76920>>>>> until fin#
76922>>>>> send print_subheader str# logical_level#
76923>>>>> end_procedure
76924>>>>> procedure Handle_SubTotal integer level#
76927>>>>> integer oBreakInfo# logical_level#
76927>>>>> move (oBreakInfo(self)) to oBreakInfo#
76928>>>>> move (piLogicalLevel.i(oBreakInfo#,level#)) to logical_level#
76929>>>>> send print_subtotal "Test" logical_level#
76930>>>>> end_procedure
76931>>>>> procedure SubHeader integer break_level#
76934>>>>> integer oBreakInfo# level# max_level#
76934>>>>> move (oBreakInfo(self)) to oBreakInfo#
76935>>>>> get piTranslateLevel.i of oBreakInfo# item (break_level#-1) to break_level#
76936>>>>> get row_count of oBreakInfo# to max_level#
76937>>>>> for level# from break_level# to (max_level#-1)
76943>>>>>>
76943>>>>> if (piSelect.i(oBreakInfo#,level#)) begin
76945>>>>> send handle_subheader level#
76946>>>>> send New_Level to (oTotals(self))
76947>>>>> end
76947>>>>>>
76947>>>>> loop
76948>>>>>>
76948>>>>> end_procedure
76949>>>>> procedure SubTotal integer level#
76952>>>>> integer oBreakInfo# break_level# max_level#
76952>>>>> move (oBreakInfo(self)) to oBreakInfo#
76953>>>>> get piTranslateLevel.i of oBreakInfo# item (level#-1) to break_level#
76954>>>>> get row_count of oBreakInfo# to max_level#
76955>>>>> for_ex level# from (max_level#-1) down_to break_level#
76962>>>>> if (piSelect.i(oBreakInfo#,level#)) begin
76964>>>>> send handle_subtotal level#
76965>>>>> send Drop_Level to (oTotals(self))
76966>>>>> end
76966>>>>>>
76966>>>>> loop
76967>>>>>>
76967>>>>> end_procedure
76968>>>>> // wp2 - major changes through out the entire object...
76968>>>>>// object oWinPrintReport is a WinReport
76968>>>>> object oWinPrintReport is a cWinReport2
76970>>>>> move self to oWinPrintReport#
76971>>>>> set no_finding_state to true
76972>>>>> set status_panel_state to false // Handled outside
76973>>>>>
76973>>>>>// function start_report returns integer
76973>>>>>// integer rval#
76973>>>>>// forward get start_report to rval#
76973>>>>>// if rval# eq RPT_OK begin
76973>>>>>// DFFont "Arial"
76973>>>>>// DFFontSize 10
76973>>>>>// DFWriteln (psTextTop(self)) FONT_ITALIC
76973>>>>>// end
76973>>>>>// end_function
76973>>>>>
76973>>>>> Procedure_Section Page_Top
76976>>>>> integer max# fld# FieldType# file# field# fontsize#
76976>>>>> integer style# cr# FontRight# base#
76976>>>>> integer idx# sum#
76976>>>>> number start# width# RightStart#
76976>>>>> string name# font#
76976>>>>> string sFont
76976>>>>> Integer iFontSize
76976>>>>> Get psFontName to sFont
76977>>>>> Move 8 to iFontSize
76978>>>>>
76978>>>>> DFFont sFont
76979>>>>> DFFontSize iFontSize
76980>>>>> DFBeginHeader DFPageTop
76981>>>>> DFHeaderPos HDR_Left
76982>>>>> DFHeaderFrame HDR_NOFRAME
76983>>>>> DFWriteLn (t.DfQuery.Page + "#pagecount#") (font_right)
76984>>>>>
76984>>>>> DFEndHeader
76986>>>>> end_procedure
76987>>>>>
76987>>>>> Procedure_Section Report_Header
76990>>>>> string sFont
76990>>>>> Integer iFontSize
76990>>>>> Get psFontName to sFont
76991>>>>> Get piFontSize to iFontSize
76992>>>>>
76992>>>>> DFFont sFont
76993>>>>> DFFontSize iFontSize
76994>>>>> If (trim(psTextTop(self))<>"") Begin
76996>>>>> DFBeginHeader DFReportHeader
76997>>>>> DFHeaderFrame HDR_NOFRAME
76998>>>>> DFHeaderPos HDR_Left
76999>>>>> DFWriteln
77000>>>>> DFWriteln (psTextTop(self)) FONT_ITALIC
77001>>>>> DFWriteln
77002>>>>> DFEndHeader
77004>>>>> end
77004>>>>>>
77004>>>>> end_Procedure
77005>>>>>
77005>>>>>
77005>>>>> Procedure_Section Page_Header
77008>>>>> integer max# fld# FieldType# file# field# fontsize#
77008>>>>> integer style# cr# FontRight# base#
77008>>>>> integer idx# sum#
77008>>>>> number start# width# RightStart#
77008>>>>> string name# font#
77008>>>>> string sFont
77008>>>>> Integer iFontSize
77008>>>>> Get psFontName to sFont
77009>>>>> Get piFontSize to iFontSize
77010>>>>>
77010>>>>> DFFont sFont
77011>>>>> DFFontSize 16
77012>>>>>
77012>>>>> DFBeginHeader DFPageHeader
77013>>>>> DFHeaderPos HDR_LEFT
77014>>>>> DFHeaderFrame HDR_MARGINS 0 rgb_dGrey rgb_dGrey
77015>>>>> DFWritelnPos (pReportTitle(oReport_info#)) 0.10 (FONT_BOLD+rgb_white)
77016>>>>> DFHeaderMargin HM_BottomOuter 0.08
77017>>>>> DFEndHeader
77019>>>>> end_procedure
77020>>>>>
77020>>>>>
77020>>>>> Procedure_Section Page_Title
77023>>>>> integer max# fld# FieldType# file# field# fontsize#
77023>>>>> integer style# cr# FontRight# base#
77023>>>>> integer idx# sum#
77023>>>>> number start# width# RightStart#
77023>>>>> string name# font#
77023>>>>>
77023>>>>>// DFFont "Arial"
77023>>>>>
77023>>>>> DFBeginHeader DFPageTitle
77024>>>>> DFHeaderPos HDR_LEFT
77025>>>>> DFHeaderFrame HDR_Margins 0 rgb_Grey rgb_grey
77026>>>>> DFHeaderMargin HM_BottomOuter 0.08
77027>>>>>
77027>>>>>// DFFontSize 10
77027>>>>>
77027>>>>> send delete_data to (oValues(self))
77028>>>>> get rpt_field_count of oReport_info# to max#
77029>>>>>
77029>>>>> for fld# from 0 to (max#-1)
77035>>>>>>
77035>>>>> get rpt_field_file item fld# to file#
77036>>>>> get rpt_field_field item fld# to field#
77037>>>>> get rpt_field_name item fld# to name#
77038>>>>> get rpt_field_width item fld# to width#
77039>>>>> get rpt_field_start item fld# to start#
77040>>>>> get rpt_field_cr item fld# to cr#
77041>>>>> get rpt_field_sum item fld# to sum#
77042>>>>> get rpt_field_font item fld# to font#
77043>>>>> get rpt_field_fontsize item fld# to fontsize#
77044>>>>> get rpt_field_type item fld# to fieldtype#
77045>>>>>
77045>>>>> Move (start#+.10) to start#
77046>>>>>
77046>>>>>//EXPR move (FieldInf_FieldType(file#,field#)) to fieldtype#
77046>>>>> if fieldtype# eq DF_BCD move 1 to FontRight#
77049>>>>> else move 0 to FontRight#
77051>>>>>
77051>>>>> if FieldType# eq DF_TEXT begin
77053>>>>> get item_count of (oValues(self)) to base#
77054>>>>> set value of (oValues(self)) item base# to fld#
77055>>>>> end
77055>>>>>>
77055>>>>> else begin
77056>>>>> if cr# DFWriteLn ""
77059>>>>> DFFont Font#
77060>>>>> DFFontSize FontSize#
77061>>>>> move (start#+width#) to RightStart#
77062>>>>> if FontRight# DFWritePos name# RightStart# (FONT_BOLD+FONT_RIGHT+Rgb_dBlue) -1 width#
77065>>>>> else DFWritePos name# start# (FONT_BOLD+Rgb_dBlue) -1 width#
77067>>>>> end
77067>>>>>>
77067>>>>> loop
77068>>>>>>
77068>>>>>
77068>>>>> move (item_count(oValues(self))) to max#
77069>>>>> for fld# from 0 to (max#-1)
77075>>>>>>
77075>>>>> move (value(oValues(self),fld#)) to idx#
77076>>>>> get rpt_field_name item idx# to name#
77077>>>>> get rpt_field_start item idx# to start#
77078>>>>> get rpt_field_font item idx# to font#
77079>>>>> get rpt_field_fontsize item idx# to fontsize#
77080>>>>> Move (start#+.10) to start#
77081>>>>> DFWriteLn ""
77082>>>>> DFFont Font#
77083>>>>> DFFontSize FontSize#
77084>>>>> DFWritePos name# start# (FONT_BOLD+Rgb_dBlue)
77085>>>>> loop
77086>>>>>>
77086>>>>> DFWriteLn ""
77087>>>>>// DFWriteLine DFGR_CURRLINE 0 DFGR_RB_MARGIN DFGR_HORI
77087>>>>> DFEndHeader
77089>>>>> end_procedure
77090>>>>>
77090>>>>>
77090>>>>> Procedure_Section Body
77093>>>>> integer font_size# font_style# max# fld#
77093>>>>> integer FieldType# file# field# style# cr#
77093>>>>> integer FontRight# base# idx#
77093>>>>> integer precision# sum# TotalsOnly# lhExprArr liExprRow
77093>>>>> number start# width# RightStart#
77093>>>>> string name# field_value# font#
77093>>>>> // update WP status
77093>>>>> send Update_Status (replace("#",replace("#",t.DfQuery.ReadingRecords,pScanCount(self)),pRecordCount(self)))
77094>>>>>
77094>>>>> send delete_data to (oValues(self))
77095>>>>> get pTotalsOnly to TotalsOnly#
77096>>>>> get rpt_field_count to max#
77097>>>>>
77097>>>>> for fld# from 0 to (max#-1)
77103>>>>>>
77103>>>>> get rpt_field_file item fld# to file#
77104>>>>> get rpt_field_field item fld# to field#
77105>>>>> get rpt_field_name item fld# to name#
77106>>>>> get rpt_field_cr item fld# to cr#
77107>>>>> get rpt_field_start item fld# to start#
77108>>>>> get rpt_field_width item fld# to width#
77109>>>>> get rpt_field_font item fld# to font#
77110>>>>> get rpt_field_sum item fld# to sum#
77111>>>>> get rpt_field_fontsize item fld# to font_size#
77112>>>>> get rpt_field_fontstyle item fld# to font_style#
77113>>>>>//EXPR move (FieldInf_FieldType(file#,field#)) to fieldtype#
77113>>>>> get rpt_field_expr_array item fld# to lhExprArr
77114>>>>> get rpt_field_expr_row item fld# to liExprRow
77115>>>>> get rpt_field_type item fld# to fieldtype#
77116>>>>>
77116>>>>> Move (start#+.10) to start#
77117>>>>>
77117>>>>> if file# move (FieldInf_FieldValue(file#,field#)) to field_value#
77120>>>>> else begin
77121>>>>> get sEvalExpression of (Query_ExprEvaluator(self)) (piExprId.i(lhExprArr,liExprRow)) to field_value#
77122>>>>> end
77122>>>>>>
77122>>>>> move (rtrim(field_value#)) to field_value#
77123>>>>>
77123>>>>> DFFont font# //Font and size
77124>>>>> DFFontSize font_size#
77125>>>>>
77125>>>>>
77125>>>>> if fieldtype# eq DF_BCD move 1 to FontRight#
77128>>>>> else move 0 to FontRight#
77130>>>>>
77130>>>>> if sum# send Sum_Data.in to (oTotals(self)) fld# field_value#
77133>>>>>
77133>>>>> ifnot TotalsOnly# begin
77135>>>>> if FieldType# eq DF_TEXT ; set value of (oValues(self)) item (item_count(oValues(self))) to (Text_RemoveTrailingCr(field_value#))
77138>>>>> else begin
77139>>>>> if cr# DFWriteLn ""
77142>>>>> move (start#+width#) to RightStart#
77143>>>>> if FontRight# begin
77145>>>>> if file# get FieldInf_DecPoints file# field# to precision#
77148>>>>> else get piDecimals.i of lhExprArr liExprRow to precision#
77150>>>>> DFWritePos field_value# RightStart# (font_style#+FONT_RIGHT) precision# width#
77151>>>>> end
77151>>>>>>
77151>>>>> else DFWritePos field_value# start# font_style# -1 width#
77153>>>>> end
77153>>>>>>
77153>>>>> end
77153>>>>>>
77153>>>>> loop
77154>>>>>>
77154>>>>> ifnot TotalsOnly# begin
77156>>>>> If Max# DFWriteLn "" // Only if any fields have been printed
77159>>>>> move (item_count(oValues(self))) to max#
77160>>>>> for fld# from 0 to (max#-1)
77166>>>>>>
77166>>>>> move (value(oValues(self),fld#)) to field_value#
77167>>>>> get rpt_field_font item idx# to font#
77168>>>>> get rpt_field_fontsize item idx# to font_size#
77169>>>>> Move (start#+.10) to start#
77170>>>>> DFFont font#
77171>>>>> DFFontSize font_size#
77172>>>>>
77172>>>>> DFWritePos field_value# 0 FONT_ITALIC -1 0
77173>>>>> DFWriteLn ""
77174>>>>> loop
77175>>>>>>
77175>>>>> end
77175>>>>>>
77175>>>>> end_procedure
77176>>>>>
77176>>>>> procedure Print_Subheader string str# integer level#
77179>>>>> string sFont
77179>>>>> Integer iFontSize
77179>>>>> Get psFontName to sFont
77180>>>>> Get piFontSize to iFontSize
77181>>>>> Move ( (iFontSize+2) min 16) to iFontSize
77182>>>>> DFFont "Arial"
77183>>>>> DFFontSize iFontSize
77184>>>>>
77184>>>>> if level# eq 1 DFWriteLn ""
77187>>>>>
77187>>>>>// Send DFSetFontSize To WinPrintID ((4-level#*2+10) max 10) 0
77187>>>>>
77187>>>>> DFBeginHeader DFSubHeader level#
77188>>>>> DFHeaderWrap HDR_WRAP
77189>>>>> DFHeaderPos HDR_LEFT
77190>>>>> DFHeaderFrame HDR_NOFRAME
77191>>>>> DfHeaderLineCheck 3
77192>>>>> DFWritePos str# 0.10 (font_bold)
77193>>>>> DFEndHeader
77195>>>>> end_procedure
77196>>>>>
77196>>>>> procedure print_totals integer end_it_all#
77199>>>>> number nTotal#
77199>>>>> integer max# idx# fld# sum# itm#
77199>>>>> integer precision# field# file# lhExprArr liExprRow
77199>>>>> integer font_size#
77199>>>>> string font#
77199>>>>> number start# width# RightStart# oCriteriaTexts#
77199>>>>>
77199>>>>> DFWriteLn ""
77200>>>>> ifnot end_it_all# DFWriteLine DFGR_CURRLINE DFGR_CURRLINE DFGR_RB_MARGIN DFGR_HORI
77203>>>>>
77203>>>>> DFBeginHeader DFTotal
77204>>>>> DFHeaderPos HDR_LEFT
77205>>>>> DFHeaderWrap HDR_NOWRAP
77206>>>>> if end_it_all# DFHeaderFrame HDR_MARGINS 0 rgb_dgrey rgb_grey
77209>>>>> else DFHeaderFrame HDR_NOFRAME
77211>>>>>
77211>>>>> get rpt_field_count to max#
77212>>>>>
77212>>>>> for fld# from 0 to (max#-1)
77218>>>>>>
77218>>>>> get rpt_field_sum item fld# to sum#
77219>>>>> if sum# begin
77221>>>>> get rpt_field_file item fld# to file#
77222>>>>> get rpt_field_field item fld# to field#
77223>>>>> get rpt_field_start item fld# to start#
77224>>>>> get rpt_field_width item fld# to width#
77225>>>>> get rpt_field_font item fld# to font#
77226>>>>> get rpt_field_fontsize item fld# to font_size#
77227>>>>> get rpt_field_expr_array item fld# to lhExprArr
77228>>>>> get rpt_field_expr_row item fld# to liExprRow
77229>>>>>
77229>>>>> Move (start#+.10) to start#
77230>>>>>
77230>>>>> if file# get FieldInf_DecPoints file# field# to precision#
77233>>>>> else get piDecimals.i of lhExprArr liExprRow to precision#
77235>>>>>
77235>>>>> move (start#+width#) to RightStart#
77236>>>>> get nRcl_Data.i of (oTotals(self)) item fld# to nTotal#
77237>>>>>
77237>>>>> DFFont font#
77238>>>>> DFFontSize font_size#
77239>>>>>
77239>>>>> DFWritePos nTotal# RightStart# (FONT_BOLD+FONT_RIGHT) precision#
77240>>>>> end
77240>>>>>>
77240>>>>> loop
77241>>>>>>
77241>>>>> DFEndHeader
77243>>>>>// if end_it_all# begin
77243>>>>>// if (pPrintCriteria(self)) begin
77243>>>>>// move (oCriteriaTexts(self)) to oCriteriaTexts#
77243>>>>>// DFWriteLn ""
77243>>>>>// ifnot (item_count(oCriteriaTexts#)) DFWriteLn t.DfQuery.NoSelectionCrit
77243>>>>>// else begin
77243>>>>>// DFWriteLn t.DfQuery.SelectionCrit
77243>>>>>// for itm# from 0 to (item_count(oCriteriaTexts#)-1)
77243>>>>>// DFWriteLn (value(oCriteriaTexts#,itm#))
77243>>>>>// loop
77243>>>>>// end
77243>>>>>// end
77243>>>>>
77243>>>>>// DFWriteLn (t.DfQuery.LblRecords+" "+string(pRecordCount(self)))
77243>>>>>// if (pInterrupted(self)) DFWriteLn t.DfQuery.ReportCancelled
77243>>>>>// if (psTextBottom(self)) ne "" begin
77243>>>>>// DFFont "Arial"
77243>>>>>// DFFontSize 10
77243>>>>>// DFWriteLn ""
77243>>>>>// DFWriteln (psTextBottom(self)) FONT_ITALIC
77243>>>>>// end
77243>>>>>// end
77243>>>>> end_procedure
77244>>>>>
77244>>>>> Procedure report_Footer
77247>>>>> number start# width# RightStart# oCriteriaTexts#
77247>>>>> integer itm#
77247>>>>> string sFont
77247>>>>> Integer iFontSize
77247>>>>> Get psFontName to sFont
77248>>>>> Get piFontSize to iFontSize
77249>>>>>
77249>>>>> DFBeginHeader DFreportFooter
77250>>>>> DFHeaderFrame HDR_NOFRAME
77251>>>>> DFHeaderPos HDR_LEFT
77252>>>>> if (pPrintCriteria(self)) begin
77254>>>>> move (oCriteriaTexts(self)) to oCriteriaTexts#
77255>>>>> DFWriteLn ""
77256>>>>> ifnot (item_count(oCriteriaTexts#)) DFWriteLn t.DfQuery.NoSelectionCrit
77259>>>>> else begin
77260>>>>> DFWriteLn t.DfQuery.SelectionCrit
77261>>>>> for itm# from 0 to (item_count(oCriteriaTexts#)-1)
77267>>>>>>
77267>>>>> DFWriteLn (value(oCriteriaTexts#,itm#))
77268>>>>> loop
77269>>>>>>
77269>>>>> end
77269>>>>>>
77269>>>>> end
77269>>>>>>
77269>>>>> DFWriteLn (t.DfQuery.LblRecords+" "+string(pRecordCount(self)))
77270>>>>> if (pInterrupted(self)) DFWriteLn t.DfQuery.ReportCancelled
77273>>>>> if (psTextBottom(self)) ne "" begin
77275>>>>>// DFFont "Arial"
77275>>>>>// DFFontSize 10
77275>>>>> DFWriteLn ""
77276>>>>> DFWriteln (psTextBottom(self)) FONT_ITALIC
77277>>>>> end
77277>>>>>>
77277>>>>> DFEndHeader
77279>>>>> End_procedure
77280>>>>>
77280>>>>> procedure Print_SubTotal string str# integer level#
77283>>>>> send print_totals 0 // Print totals but do not end it all!
77284>>>>> end_procedure
77285>>>>>
77285>>>>> procedure_section Total
77288>>>>> send print_totals 1 // That's it! Finish
77289>>>>> end_procedure
77290>>>>>
77290>>>>> procedure_section Page_Bottom
77293>>>>> string sFont
77293>>>>> Integer iFontSize
77293>>>>> Get psFontName to sFont
77294>>>>> Move 8 to iFontSize
77295>>>>> DFFont sFont
77296>>>>> DFFontSize iFontSize
77297>>>>> DFBeginHeader DFPageBottom
77298>>>>> DFHeaderFrame hdr_Margins 0.01 rgb_dGrey
77299>>>>> DfHeaderPos hdr_left
77300>>>>> DFWriteln (t.DfQuery.GenerationTime+" "+string(dSysDate())+", "+sSysTime()) (rgb_dBlue+font_center)
77301>>>>> DFEndHeader
77303>>>>> end_procedure
77304>>>>>
77304>>>>> // Handle a canceled report like a normal one, print totals, etc
77304>>>>> procedure Handle_Cancelled_Report
77307>>>>> Send Handle_end_report
77308>>>>> end_procedure
77309>>>>> end_object // oWinPrintReport
77310>>>>>
77310>>>>> procedure reset
77313>>>>> Send reset_crit
77314>>>>> Send reset_breaks
77315>>>>> send delete_data to (oCriteriaTexts(self))
77316>>>>> send delete_data to (oBreakInfo(self))
77317>>>>> set pMaxLogicalLevel of (oBreakInfo(self)) to 0
77318>>>>> end_procedure
77319>>>>>
77319>>>>> procedure add_criteria_text string field_name# integer comp# string value#
77322>>>>> integer oCriteriaTexts# liRow liMax
77322>>>>> move (oCriteriaTexts(self)) to oCriteriaTexts#
77323>>>>> if (field_name#<>"") begin
77325>>>>> move (trim(field_name#)+", "+lowercase(DfQuery_CompModeTxt_Long(comp#))+": "+value#) to value#
77326>>>>> if (pUseAnsiCharacters(self)) begin
77328>>>>> if (pFileFormat(self)<>DFQ.FORMAT.HTML) move (StringOemToAnsi(value#)) to value#
77331>>>>> end
77331>>>>>>
77331>>>>> set value of oCriteriaTexts# item (item_count(oCriteriaTexts#)) to value#
77332>>>>> end
77332>>>>>>
77332>>>>> else begin
77333>>>>> get Text_Format.sii value# 50 DFTRUE to liMax
77334>>>>> decrement liMax
77335>>>>> for liRow from 0 to liMax
77341>>>>>>
77341>>>>> if (liRow=0) set value of oCriteriaTexts# item (item_count(oCriteriaTexts#)) to (t.DfQuery.Expression+": "+Text_FormattedLine.i(liRow))
77344>>>>> else set value of oCriteriaTexts# item (item_count(oCriteriaTexts#)) to (" "+Text_FormattedLine.i(liRow))
77346>>>>> loop
77347>>>>>>
77347>>>>> end
77347>>>>>>
77347>>>>> end_procedure
77348>>>>>
77348>>>>> procedure initialize
77351>>>>> integer liDestination grb# liFileFormat hoXML hoXMLDocumentRoot
77351>>>>> string lsFields lsFileName
77351>>>>> Boolean bOk
77351>>>>> get pDestination to liDestination
77352>>>>> get pFileFormat to liFileFormat
77353>>>>> forward send initialize
77355>>>>> // wp2 --- only use with with VPE or a non-viewer report,
77355>>>>> if liDestination eq DFQ.DEST.FILE begin // File
77357>>>>> send batch_on to (oBatchCompanion(self)) (pReportTitle(self))
77358>>>>> end
77358>>>>>>
77358>>>>> get FDX_IndexAsFields 0 (pMainFile(self)) (pOrdering(self)) to lsFields
77359>>>>> get FDX_FieldsTranslateOverlaps 0 (pMainFile(self)) lsFields to lsFields
77360>>>>> set psFieldsInIndex to lsFields
77361>>>>> if liDestination eq DFQ.DEST.FILE begin // File
77363>>>>> get pOutFileName to lsFileName
77364>>>>> direct_output channel 1 (StringOemToAnsi(lsFileName))
77366>>>>> set pLineCount to 0
77367>>>>> set pCurrentFileLine to ""
77368>>>>> if (liFileFormat=DFQ.FORMAT.HTML) begin
77370>>>>> send html_WriteHeader 1 (pReportTitle(self))
77371>>>>> writeln '<body>'
77373>>>>> writeln ('<center><h1>'+html_DfToHtmlTable(pReportTitle(self))+'</h1></center>')
77375>>>>> writeln '<br>'
77377>>>>> writeln '<center>'
77379>>>>> end
77379>>>>>>
77379>>>>> end
77379>>>>>>
77379>>>>> else begin
77380>>>>> // wp2 - chnages for wp2
77380>>>>> set report_title of oWinPrintReport# to (pReportTitle(self))
77381>>>>> set report_message of oWinPrintReport# to "" // TL
77382>>>>> set output_device_mode of oWinPrintReport# to (if(liDestination=1,PRINT_TO_WINDOW,PRINT_TO_PRINTER_NO_DIALOG))
77383>>>>> send DFSetLandscape of oWinPrintReport# (pLandscape(self))
77384>>>>> send DFSetMargins of oWinPrintReport# 2.5 2 2 2.5
77385>>>>> get start_report of oWinPrintReport# to Grb#
77386>>>>> end
77386>>>>>>
77386>>>>>
77386>>>>> send reset to (oTotals(self))
77387>>>>> set current_row to 0
77388>>>>> set next_current_row to 0
77389>>>>> send print_header_first_time
77390>>>>> end_procedure
77391>>>>>
77391>>>>> procedure print_column string value# integer align# integer start# integer width#
77394>>>>> integer vbottom# current_row# vtop#
77394>>>>> string CurrentFileLine#
77394>>>>> if (pDestination(self)<>DFQ.DEST.FILE) begin // Not file
77396>>>>> end
77396>>>>>>
77396>>>>> else begin
77397>>>>> get pCurrentFileLine to CurrentFileLine#
77398>>>>> if align# eq ALIGN_RIGHT move (overstrike(RightShift(value#,width#),CurrentFileLine#,start#)) to CurrentFileLine#
77401>>>>> else move (overstrike(Pad(value#,width#),CurrentFileLine#,start#)) to CurrentFileLine#
77403>>>>> set pCurrentFileLine to CurrentFileLine#
77404>>>>> end
77404>>>>>>
77404>>>>> end_procedure
77405>>>>>
77405>>>>> procedure print_header // This is not called when file
77408>>>>> end_procedure
77409>>>>>
77409>>>>> procedure print_deferred_headers // Not called when file
77412>>>>> end_procedure
77413>>>>>
77413>>>>> function sSeqFile.sii string str# integer format# integer ansi# returns string
77416>>>>> if format# eq DFQ.FORMAT.CD move ('"'+replaces('"',str#,"'")+'"') to str#
77419>>>>> if ansi# move (StringOemToAnsi(str#)) to str#
77422>>>>> function_return str#
77423>>>>> end_function
77424>>>>>
77424>>>>> procedure print_header_first_time
77427>>>>> integer vbottom# max# itm# type# file# fld# cr# pLeftMargin#
77427>>>>> integer format# oValues# IncludeLabels# UseAnsiCharacters#
77427>>>>> number start# width#
77427>>>>> string str# field_sep#
77427>>>>>
77427>>>>> get pCurDeferredHeader to str#
77428>>>>> move (oValues(self)) to oValues#
77429>>>>> send delete_data to oValues#
77430>>>>> move (replace("<D>",str#,string(dSysDate()))) to str#
77431>>>>> move (replace("<T>",str#,sSysTime())) to str#
77432>>>>> set pCurDeferredHeader to str#
77433>>>>>
77433>>>>> if (pDestination(self)<>DFQ.DEST.FILE) begin // If not file
77435>>>>> end // if not file
77435>>>>>>
77435>>>>> else begin
77436>>>>> get pFileFormat to format#
77437>>>>> if (format#=DFQ.FORMAT.PRINT) begin
77439>>>>> move (pReportTitle(self)+" ("+string(dSysDate())+", "+sSysTime()+")") to str#
77440>>>>> if (pUseAnsiCharacters(self)) move (StringOemToAnsi(str#)) to str#
77443>>>>> writeln channel 1 str#
77446>>>>> writeln ""
77448>>>>> get psTextTop to str#
77449>>>>> if (pUseAnsiCharacters(self)) move (StringOemToAnsi(str#)) to str#
77452>>>>> send print_text str#
77453>>>>> writeln ""
77455>>>>> get rpt_field_count to max#
77456>>>>> get pLeftMargin to pLeftMargin#
77457>>>>> for itm# from 0 to (max#-1)
77463>>>>>>
77463>>>>> get rpt_field_file item itm# to file#
77464>>>>> get rpt_field_field item itm# to fld#
77465>>>>> get rpt_field_name item itm# to str#
77466>>>>> get rpt_field_cr item itm# to cr#
77467>>>>> get rpt_field_start item itm# to start#
77468>>>>> get rpt_field_width item itm# to width#
77469>>>>> get rpt_field_type item itm# to type#
77470>>>>>// EXPR move (FieldInf_FieldType(file#,fld#)) to type#
77470>>>>> if cr# send new_line
77473>>>>> 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)
77476>>>>> else ; set value of oValues# item (item_count(oValues#)) to str#
77478>>>>> loop
77479>>>>>>
77479>>>>>
77479>>>>> for itm# from 0 to (item_count(oValues#)-1)
77485>>>>>>
77485>>>>> get value of oValues# item itm# to str#
77486>>>>> if str# ne "" begin
77488>>>>> send new_line
77489>>>>> send print_column str# ALIGN_LEFT (pLeftMargin(self)) 512
77490>>>>> end
77490>>>>>>
77490>>>>> loop
77491>>>>>>
77491>>>>> send new_line
77492>>>>> writeln channel 1 "--------------------------------------------------------------------------"
77495>>>>> end // if formatted
77495>>>>>>
77495>>>>> if (format#=DFQ.FORMAT.HTML) begin
77497>>>>> writeln channel 1 (t.DfQuery.GenerationTime+" "+string(dSysDate())+", "+sSysTime())
77500>>>>> writeln '<br>'
77502>>>>> writeln '<br>'
77504>>>>> get psTextTop to str#
77505>>>>> if (str#<>"") begin
77507>>>>> if (pUseAnsiCharacters(self)) move (StringOemToAnsi(str#)) to str#
77510>>>>> write str#
77511>>>>> writeln '<br>'
77513>>>>> writeln '<br>'
77515>>>>> end
77515>>>>>>
77515>>>>> writeln "<table border=1 cellpadding=2 cellspacing=2>"
77517>>>>> writeln ' <tr valign=top>'
77519>>>>> get rpt_field_count to max#
77520>>>>> for itm# from 0 to (max#-1)
77526>>>>>>
77526>>>>> get rpt_field_file item itm# to file#
77527>>>>> get rpt_field_field item itm# to fld#
77528>>>>> get rpt_field_name item itm# to str#
77529>>>>> get rpt_field_type item itm# to type#
77530>>>>>// EXPR move (FieldInf_FieldType(file#,fld#)) to type#
77530>>>>> if (type#<>DF_TEXT and type#<>DF_BINARY) begin
77532>>>>> write (' <td bgcolor='+RGB_ToHTML(pHTML_TabelHdrColor(self))+if(type#=DF_BCD,' align=right','')+'><strong>')
77533>>>>> write (html_DfToHtmlTable(str#))
77534>>>>> writeln '</strong></td>'
77536>>>>> end
77536>>>>>>
77536>>>>> else set value of oValues# item (item_count(oValues#)) to str#
77538>>>>> loop
77539>>>>>>
77539>>>>> for itm# from 0 to (item_count(oValues#)-1)
77545>>>>>>
77545>>>>> get value of oValues# item itm# to str#
77546>>>>> if str# ne "" begin
77548>>>>> writeln (' <td bgcolor='+RGB_ToHTML(pHTML_TabelHdrColor(self))+'><strong>'+html_DfToHtmlTable(str#)+'</strong></td>')
77550>>>>> end
77550>>>>>>
77550>>>>> loop
77551>>>>>>
77551>>>>> writeln ' </tr>'
77553>>>>> end // HTML
77553>>>>>>
77553>>>>> if (format#=DFQ.FORMAT.CD or format#=DFQ.FORMAT.LD) begin
77555>>>>> get pIncludeLabels to IncludeLabels#
77556>>>>> if IncludeLabels# begin
77558>>>>> if (pSemiColon(self)) move ";" to field_sep#
77561>>>>> else move "," to field_sep#
77563>>>>> get pUseAnsiCharacters to UseAnsiCharacters#
77564>>>>> get rpt_field_count to max#
77565>>>>> for itm# from 0 to (max#-1)
77571>>>>>>
77571>>>>> get rpt_field_file item itm# to file#
77572>>>>> get rpt_field_field item itm# to fld#
77573>>>>> get rpt_field_name item itm# to str#
77574>>>>> get rpt_field_type item itm# to type#
77575>>>>>// move (FieldInf_FieldType(file#,fld#)) to type#
77575>>>>> if (type#<>DF_TEXT and type#<>DF_BINARY) begin
77577>>>>> if format# eq DFQ.FORMAT.LD writeln channel 1 (sSeqFile.sii(self,str#,format#,UseAnsiCharacters#))
77582>>>>> else begin
77583>>>>> write channel 1 (sSeqFile.sii(self,str#,format#,UseAnsiCharacters#))
77585>>>>> if (itm#<>(max#-1) or item_count(oValues#)) write field_sep#
77588>>>>> end
77588>>>>>>
77588>>>>> end
77588>>>>>>
77588>>>>> else set value of oValues# item (item_count(oValues#)) to (sSeqFile.sii(self,str#,format#,UseAnsiCharacters#))
77590>>>>> loop
77591>>>>>>
77591>>>>> get item_count of oValues# to max#
77592>>>>> for itm# from 0 to (max#-1)
77598>>>>>>
77598>>>>> get value of oValues# item itm# to str#
77599>>>>> if format# eq DFQ.FORMAT.LD writeln channel 1 str#
77604>>>>> else begin
77605>>>>> write channel 1 str#
77607>>>>> if itm# ne (max#-1) write field_sep#
77610>>>>> end
77610>>>>>>
77610>>>>> loop
77611>>>>>>
77611>>>>> if format# eq DFQ.FORMAT.CD writeln channel 1 ""
77616>>>>> end
77616>>>>>>
77616>>>>> end //
77616>>>>>>
77616>>>>> end // if file
77616>>>>>>
77616>>>>> end_procedure // print_header_first_time
77617>>>>>
77617>>>>> function any_totals_at_all returns integer
77620>>>>> integer itm# max# sum#
77620>>>>> get rpt_field_count to max#
77621>>>>> for itm# from 0 to (max#-1)
77627>>>>>>
77627>>>>> get rpt_field_sum item itm# to sum#
77628>>>>> if sum# function_return 1
77631>>>>> loop
77632>>>>>>
77632>>>>> function_return 0
77633>>>>> end_function
77634>>>>>
77634>>>>> procedure print_totals integer end_it_all#
77637>>>>> integer vbottom# max# itm# type# file# fld# cr# pLeftMargin# sum# oCriteriaTexts#
77637>>>>> integer precision# lhExprArr liExprRow
77637>>>>> integer FileFormat# any_totals_at_all#
77637>>>>> number start# width#
77637>>>>> string str# value#
77637>>>>> get pFileFormat to FileFormat#
77638>>>>> move (oCriteriaTexts(self)) to oCriteriaTexts#
77639>>>>> get any_totals_at_all to any_totals_at_all#
77640>>>>>
77640>>>>> if (pDestination(self)<>DFQ.DEST.FILE) begin // If not file
77642>>>>> end
77642>>>>>>
77642>>>>> else if (FileFormat#=DFQ.FORMAT.PRINT or FileFormat#=DFQ.FORMAT.HTML) begin
77645>>>>> if FileFormat# eq DFQ.FORMAT.PRINT begin
77647>>>>> send new_line
77648>>>>> if (any_totals_at_all# or end_it_all#) writeln channel 1 "--------------------------------------------------------------------------"
77653>>>>> end
77653>>>>>>
77653>>>>> if FileFormat# eq DFQ.FORMAT.HTML begin
77655>>>>> if any_totals_at_all# writeln channel 1 " <tr>"
77660>>>>> end
77660>>>>>>
77660>>>>> get pLeftMargin to pLeftMargin#
77661>>>>> get rpt_field_count to max#
77662>>>>> for itm# from 0 to (max#-1)
77668>>>>>>
77668>>>>> get rpt_field_file item itm# to file#
77669>>>>> get rpt_field_field item itm# to fld#
77670>>>>> get rpt_field_name item itm# to str#
77671>>>>> get rpt_field_cr item itm# to cr#
77672>>>>> get rpt_field_start item itm# to start#
77673>>>>> get rpt_field_width item itm# to width#
77674>>>>> get rpt_field_sum item itm# to sum#
77675>>>>> get rpt_field_type item itm# to type#
77676>>>>> get rpt_field_expr_array item itm# to lhExprArr
77677>>>>> get rpt_field_expr_row item itm# to liExprRow
77678>>>>>// EXPR move (FieldInf_FieldType(file#,fld#)) to type#
77678>>>>> if cr# send new_line
77681>>>>> if sum# begin
77683>>>>> move (nRcl_Data.i(oTotals(self),itm#)) to value#
77684>>>>>
77684>>>>> if file# get FieldInf_DecPoints file# fld# to precision#
77687>>>>> else get piDecimals.i of lhExprArr liExprRow to precision#
77689>>>>> move (NumToStr(value#,precision#)) to value#
77690>>>>>
77690>>>>> if FileFormat# eq DFQ.FORMAT.PRINT ; send print_column value# ALIGN_RIGHT (start#*100+pLeftMargin#) (width#*100)
77693>>>>> else ; writeln (' <td bgcolor='+RGB_ToHTML(RGB_Brighten(pHTML_TabelHdrColor(self),50))+if(type#=DF_BCD,' align=right','')+'>'+html_DfToHtmlTable(value#)+'</td>')
77696>>>>> end
77696>>>>>>
77696>>>>> else begin
77697>>>>> if FileFormat# eq DFQ.FORMAT.HTML begin
77699>>>>> if any_totals_at_all# if type# ne DF_TEXT writeln ' <td></td>'
77705>>>>> end
77705>>>>>>
77705>>>>> end
77705>>>>>>
77705>>>>> loop
77706>>>>>>
77706>>>>> if FileFormat# eq DFQ.FORMAT.HTML begin
77708>>>>> if any_totals_at_all# writeln channel 1 " </tr>"
77713>>>>> end
77713>>>>>>
77713>>>>> if end_it_all# begin
77715>>>>> if FileFormat# eq DFQ.FORMAT.PRINT begin
77717>>>>> send new_line
77718>>>>> writeln (t.DfQuery.LblRecords+" "+string(pRecordCount(self)))
77720>>>>> end
77720>>>>>>
77720>>>>> else begin
77721>>>>> writeln channel 1 '</table></center>'
77724>>>>> writeln '<br>'
77726>>>>> writeln (html_DfToHtmlTable(t.DfQuery.LblRecords+" "+string(pRecordCount(self)))+"<br>")
77728>>>>> end
77728>>>>>>
77728>>>>> if (pPrintCriteria(self)) begin
77730>>>>> if FileFormat# eq DFQ.FORMAT.PRINT begin
77732>>>>> writeln ""
77734>>>>> ifnot (item_count(oCriteriaTexts#)) writeln t.DfQuery.NoSelectionCrit
77738>>>>> else begin
77739>>>>> writeln t.DfQuery.SelectionCrit
77741>>>>> for itm# from 0 to (item_count(oCriteriaTexts#)-1)
77747>>>>>>
77747>>>>> writeln (value(oCriteriaTexts#,itm#))
77749>>>>> loop
77750>>>>>>
77750>>>>> end
77750>>>>>>
77750>>>>> writeln ""
77752>>>>> end
77752>>>>>>
77752>>>>> else begin
77753>>>>> writeln "<br>"
77755>>>>> ifnot (item_count(oCriteriaTexts#)) writeln (html_DfToHtmlTable(t.DfQuery.NoSelectionCrit)+'<br>')
77759>>>>> else begin
77760>>>>> writeln (html_DfToHtmlTable(t.DfQuery.SelectionCrit)+'<br>')
77762>>>>> for itm# from 0 to (item_count(oCriteriaTexts#)-1)
77768>>>>>>
77768>>>>> writeln (html_DfToHtmlTable(value(oCriteriaTexts#,itm#))+"<br>")
77770>>>>> loop
77771>>>>>>
77771>>>>> end
77771>>>>>>
77771>>>>> writeln "<br>"
77773>>>>> end
77773>>>>>>
77773>>>>> end
77773>>>>>>
77773>>>>> if (pInterrupted(self)) begin
77775>>>>> if FileFormat# eq DFQ.FORMAT.PRINT writeln t.DfQuery.ReportCancelled
77779>>>>> else writeln (html_DfToHtmlTable(t.DfQuery.ReportCancelled)+"<br>")
77782>>>>> end
77782>>>>>>
77782>>>>> if (psTextBottom(self)) ne "" begin
77784>>>>> if FileFormat# eq DFQ.FORMAT.PRINT writeln ""
77788>>>>> else write "<br>"
77790>>>>> get psTextBottom to str#
77791>>>>> if (pUseAnsiCharacters(self)) move (StringOemToAnsi(str#)) to str#
77794>>>>> send print_text str#
77795>>>>> end
77795>>>>>>
77795>>>>> end
77795>>>>>>
77795>>>>> end
77795>>>>>>
77795>>>>> end_procedure
77796>>>>>
77796>>>>> procedure New_Page
77799>>>>> end_procedure
77800>>>>>
77800>>>>> procedure print_text string value#
77803>>>>> integer lines# line#
77803>>>>> if (pDestination(self)=DFQ.DEST.FILE) begin // If file
77805>>>>> move (Text_Format.sii(value#,74,1)) to lines#
77806>>>>> for line# from 0 to (lines#-1)
77812>>>>>>
77812>>>>> writeln channel 1 (Text_FormattedLine.i(line#))
77815>>>>> loop
77816>>>>>>
77816>>>>> end
77816>>>>>>
77816>>>>> end_procedure
77817>>>>>
77817>>>>> procedure new_line
77820>>>>> integer delta#
77820>>>>> if (pDestination(self)<>DFQ.DEST.FILE) begin // If not file
77822>>>>> end
77822>>>>>>
77822>>>>> else begin
77823>>>>> writeln channel 1 (pCurrentFileLine(self))
77826>>>>> set pCurrentFileLine to ""
77827>>>>> end
77827>>>>>>
77827>>>>> end_procedure
77828>>>>>
77828>>>>> procedure record_selected
77831>>>>> integer itm# max# file# fld# size# style# sum# len#
77831>>>>> integer cr# type# row# next_row# pLeftMargin# grb# dec#
77831>>>>> integer related# mainfile# TotalsOnly# liDestination FileFormat#
77831>>>>> integer UseAnsiCharacters#
77831>>>>> integer hoRow hoXMLDocumentRoot hoField
77831>>>>> integer lhExprArr liExprRow
77831>>>>> number start# width#
77831>>>>> string font# value# field_sep# name#
77831>>>>> forward send Record_Selected
77833>>>>> get pDestination to liDestination
77834>>>>> get pFileFormat to FileFormat#
77835>>>>> get pTotalsOnly to TotalsOnly#
77836>>>>> get rpt_field_count to max#
77837>>>>> get pLeftMargin to pLeftMargin#
77838>>>>> get pUseAnsiCharacters to UseAnsiCharacters#
77839>>>>> if (pSemiColon(self)) move ";" to field_sep#
77842>>>>> else move "," to field_sep#
77844>>>>> if (not(TotalsOnly#) and (liDestination<>DFQ.DEST.FILE or FileFormat#=DFQ.FORMAT.PRINT)) send new_line
77847>>>>> send delete_data to (oValues(self))
77848>>>>> get pMainFile to mainfile#
77849>>>>> move 0 to related#
77850>>>>> if (liDestination=DFQ.DEST.FILE and FileFormat#=DFQ.FORMAT.HTML and not(TotalsOnly#)) writeln channel 1 " <tr valign=top>"
77855>>>>> if (liDestination=DFQ.DEST.FILE and FileFormat#=DFQ.FORMAT.XML) begin
77857>>>>> get phXMLDocumentRoot to hoXMLDocumentRoot
77858>>>>> Get AddElement Of hoXMLDocumentRoot (API_AttrValue_FILELIST(DF_FILE_LOGICAL_NAME,mainfile#)) '' To hoRow
77859>>>>> move DFFALSE to TotalsOnly#
77860>>>>> end
77860>>>>>>
77860>>>>> if (VPE.USED or liDestination=DFQ.DEST.FILE) begin // If file# or VPE
77862>>>>> for itm# from 0 to (max#-1) // Go through the selected columns
77868>>>>>>
77868>>>>> if (file#<>mainfile# and not(related#)) begin
77870>>>>> relate mainfile#
77871>>>>> move 1 to related#
77872>>>>> end
77872>>>>>>
77872>>>>> get rpt_field_file item itm# to file#
77873>>>>> get rpt_field_field item itm# to fld#
77874>>>>> get rpt_field_start item itm# to start#
77875>>>>> get rpt_field_width item itm# to width#
77876>>>>> get rpt_field_font item itm# to font#
77877>>>>> get rpt_field_fontsize item itm# to size#
77878>>>>> get rpt_field_fontstyle item itm# to style#
77879>>>>> get rpt_field_cr item itm# to cr#
77880>>>>> get rpt_field_sum item itm# to sum#
77881>>>>> get rpt_field_expr_array item itm# to lhExprArr
77882>>>>> get rpt_field_expr_row item itm# to liExprRow
77883>>>>> get rpt_field_type item itm# to type#
77884>>>>> if file# move (FieldInf_FieldValue(file#,fld#)) to value#
77887>>>>> else begin
77888>>>>> get sEvalExpression of (Query_ExprEvaluator(self)) (piExprId.i(lhExprArr,liExprRow)) to value#
77889>>>>> end
77889>>>>>>
77889>>>>> move (rtrim(value#)) to value#
77890>>>>>
77890>>>>> if sum# send Sum_Data.in to (oTotals(self)) itm# value#
77893>>>>> if (not(TotalsOnly#) or (liDestination=DFQ.DEST.FILE and (FileFormat#<>DFQ.FORMAT.PRINT and FileFormat#<>DFQ.FORMAT.HTML))) begin
77895>>>>> //move (FieldInf_FieldType(file#,fld#)) to type#
77895>>>>> if cr# send new_line
77898>>>>> if liDestination ne DFQ.DEST.FILE begin // If not file
77900>>>>> end
77900>>>>>>
77900>>>>> else begin // If file:
77901>>>>> if (FileFormat#=DFQ.FORMAT.PRINT or FileFormat#=DFQ.FORMAT.HTML) begin
77903>>>>>
77903>>>>> if UseAnsiCharacters# begin
77905>>>>> if (FileFormat#<>DFQ.FORMAT.HTML) move (StringOemToAnsi(value#)) to value#
77908>>>>> end
77908>>>>>>
77908>>>>> if (type#<>DF_TEXT and type#<>DF_BINARY) begin
77910>>>>> if type# eq DF_BCD begin
77912>>>>> if file# get FieldInf_DecPoints file# fld# to dec#
77915>>>>> else get piDecimals.i of lhExprArr liExprRow to dec#
77917>>>>>
77917>>>>> move (NumToStr(value#,dec#)) to value#
77918>>>>> end
77918>>>>>>
77918>>>>> if FileFormat# eq DFQ.FORMAT.HTML writeln channel 1 (' <td'+if(type#=DF_BCD,' align=right','')+'>'+html_DfToHtmlTable(value#)+'</td>')
77923>>>>> else send print_column value# (if(type#=DF_BCD,ALIGN_RIGHT,ALIGN_LEFT)) (start#*100+pLeftMargin#) (width#*100)
77925>>>>> end
77925>>>>>>
77925>>>>> else set value of (oValues(self)) item (item_count(oValues(self))) to value#
77927>>>>> end
77927>>>>>>
77927>>>>> else begin // DFQ.FORMAT.CD, DFQ.FORMAT.LD or DFQ.FORMAT.XML
77928>>>>> if UseAnsiCharacters# move (StringOemToAnsi(value#)) to value#
77931>>>>> if (FileFormat#=DFQ.FORMAT.XML) begin
77933>>>>> get rpt_field_name item itm# to name#
77934>>>>> move (replaces(" ",name#,"_")) to name#
77935>>>>> Get AddElement Of hoRow name# '' To hoField
77936>>>>> if (type#=DF_TEXT or type#=DF_BINARY) ; Send AddCDataSection To hoField (rtrim(value#))
77939>>>>> else Set psText Of hoField To (rtrim(value#))
77941>>>>> Send Destroy To hoField
77942>>>>> end
77942>>>>>>
77942>>>>> else begin // DFQ.FORMAT.CD or DFQ.FORMAT.LD
77943>>>>> if (type#=DF_TEXT or type#=DF_BINARY) begin // Text or binary
77945>>>>> move (length(value#)) to len#
77946>>>>> if FileFormat# eq DFQ.FORMAT.CD begin // Comma delimited
77948>>>>> move (replaces('"',value#,"'")) to value#
77949>>>>> move ('"'+Text_CompressSubstCr(value#," ")+'"') to value#
77950>>>>> if itm# ne (max#-1) write (value#+field_sep#)
77953>>>>> else writeln value#
77956>>>>> end
77956>>>>>>
77956>>>>> else begin // Line delimited
77957>>>>> writeln len#
77959>>>>> write value#
77960>>>>> end
77960>>>>>>
77960>>>>> end
77960>>>>>>
77960>>>>> else begin // Everything but text or binary
77961>>>>> move (rtrim(value#)) to value#
77962>>>>> if FileFormat# eq DFQ.FORMAT.CD begin
77964>>>>> if type# eq DF_ASCII move (replaces('"',value#,"'")) to value#
77967>>>>> if type# ne DF_DATE move ('"'+value#+'"') to value#
77970>>>>> if itm# ne (max#-1) write (value#+field_sep#)
77973>>>>> else writeln value#
77976>>>>> end
77976>>>>>>
77976>>>>> else begin // DFQ.FORMAT.LD
77977>>>>> writeln value#
77979>>>>> end
77979>>>>>>
77979>>>>> end
77979>>>>>>
77979>>>>> end
77979>>>>>>
77979>>>>> end
77979>>>>>>
77979>>>>> end // If file
77979>>>>>>
77979>>>>> end // IfNot TotalsOnly#
77979>>>>>>
77979>>>>> loop
77980>>>>>>
77980>>>>> ifnot TotalsOnly# begin
77982>>>>> for itm# from 0 to (item_count(oValues(self))-1)
77988>>>>>>
77988>>>>> get value of (oValues(self)) item itm# to value#
77989>>>>> move (Text_RemoveTrailingCr(value#)) to value#
77990>>>>> if (liDestination=DFQ.DEST.FILE and FileFormat#=DFQ.FORMAT.HTML) writeln channel 1 (' <td>'+html_DfToHtmlTable(value#)+'</td>')
77995>>>>> else begin
77996>>>>> if value# ne "" begin
77998>>>>> send new_line
77999>>>>> send print_text value#
78000>>>>> end
78000>>>>>>
78000>>>>> end
78000>>>>>>
78000>>>>> loop
78001>>>>>>
78001>>>>> end
78001>>>>>>
78001>>>>> end
78001>>>>>>
78001>>>>> if (liDestination=DFQ.DEST.FILE and FileFormat#=DFQ.FORMAT.HTML and not(TotalsOnly#)) writeln channel 1 " </tr>"
78006>>>>>// if (liDestination=DFQ.DEST.FILE and FileFormat#=DFQ.FORMAT.XML) begin
78006>>>>> if (liDestination=DFQ.DEST.FILE) begin
78008>>>>>
78008>>>>> end
78008>>>>>>
78008>>>>> else begin
78009>>>>> get handle_report_line of oWinPrintReport# to Grb#
78010>>>>> If (grb#=RPT_CANCEL) Begin // wp2 - added for Wp2. Rpt gets cancelled
78012>>>>> set pInterrupted to True // within the viewer
78013>>>>> end
78013>>>>>>
78013>>>>> end
78013>>>>>>
78013>>>>> end_procedure // record_selected
78014>>>>>
78014>>>>> procedure record_found
78017>>>>> integer oSent# liDestination
78017>>>>> get pDestination to liDestination
78018>>>>>
78018>>>>> move (oBatchCompanion(self)) to oSent#
78019>>>>>
78019>>>>> if (Sentinel_Running_State(oSent#)) begin
78021>>>>>
78021>>>>> send batch_update to oSent# (replace("#",replace("#",t.DfQuery.ReadingRecords,pScanCount(self)),pRecordCount(self)))
78022>>>>> send batch_update2 to oSent# (FDX_FieldValues(0,pMainFile(self),psFieldsInIndex(self)))
78023>>>>> // (idx_field_value(oIndexAnalyzer#,pOrdering(self),1,1))
78023>>>>> set pInterrupted to (batch_interrupt(oSent#))
78024>>>>> end
78024>>>>>>
78024>>>>> else begin
78025>>>>> set pInterrupted to (Test_KeyPressed(oWinPrintReport))
78026>>>>> end
78026>>>>>>
78026>>>>> //
78026>>>>> //send Update_Status of oWinPrintReport "Blabla" //(replace("#",replace("#",t.DfQuery.ReadingRecords,pScanCount(self)),pRecordCount(self)))
78026>>>>> //
78026>>>>> end_procedure
78027>>>>>
78027>>>>> procedure scan_ended
78030>>>>> integer liDestination st#
78030>>>>> get pDestination to liDestination
78031>>>>> forward send scan_ended
78033>>>>> send print_totals 1 // Parameter 1 makes it print number of records etc...
78034>>>>> if liDestination ne DFQ.DEST.FILE send print_deferred_headers
78037>>>>> send batch_off to (oBatchCompanion(self))
78038>>>>>
78038>>>>> if liDestination ne DFQ.DEST.FILE begin
78040>>>>> Get End_Report of oWinPrintReport# (if(pInterrupted(self),RPT_CANCEL,RPT_OK)) to st#
78041>>>>> send dfClearPrinter of oWinPrintReport#
78042>>>>> end
78042>>>>>>
78042>>>>> if liDestination eq DFQ.DEST.FILE begin
78044>>>>> if (pFileFormat(self)=DFQ.FORMAT.HTML) writeln '</body></html>'
78048>>>>> close_output channel 1
78050>>>>> ifnot (pbQuiet(self)) begin
78052>>>>> if (pFileFormat(self)=DFQ.FORMAT.HTML or pFileFormat(self)=DFQ.FORMAT.XML) send html_StartDoc (pOutFileName(self))
78055>>>>> else send info_box t.DfQuery.FileCompleted t.MsgBox.Message
78057>>>>> end
78057>>>>>>
78057>>>>> end
78057>>>>>>
78057>>>>>// send CloseDoc to oVPE#
78057>>>>> end_procedure
78058>>>>>
78058>>>>> function sXmlRootElementName string lsValue returns string
78061>>>>> integer liPos liLen
78061>>>>> string lsIllegal lsChar
78061>>>>> move (" .,;:/()&%Ï#[]{}=?+^@$\'"+'"') to lsIllegal
78062>>>>> move (length(lsIllegal)) to liLen
78063>>>>> for liPos from 1 to liLen
78069>>>>>>
78069>>>>> move (mid(lsIllegal,1,liPos)) to lsChar
78070>>>>> move (replaces(lsChar,lsValue,"")) to lsValue
78071>>>>> loop
78072>>>>>>
78072>>>>> function_return lsValue
78073>>>>> end_function
78074>>>>>
78074>>>>> procedure run
78077>>>>> integer pLeftMargin# liDestination liFileFormat lbSaveOk
78077>>>>> integer tmp# max# itm# pOpenOptions# vpetmp# argument_size#
78077>>>>> integer hoXML hoXMLDocumentRoot
78077>>>>> string metrics# lsFileName lsCurDir
78077>>>>> string lsRootName
78077>>>>>
78077>>>>> send initialize_breaks
78078>>>>> get pDestination to liDestination
78079>>>>> get pFileFormat to liFileFormat
78080>>>>> if liDestination eq DFQ.DEST.FILE begin // File#
78082>>>>> get pOutFileName to lsFileName
78083>>>>> if lsFileName eq "" begin
78085>>>>> send obs t.DfQuery.FileNameNotSpec
78086>>>>> procedure_return // Goodbye!
78087>>>>> end
78087>>>>>>
78087>>>>> if (SEQ_ExtractPathFromFileName(lsFileName)="") begin
78089>>>>> get_current_directory to lsCurDir
78090>>>>> get SEQ_ComposeAbsoluteFileName lsCurDir lsFileName to lsFileName
78091>>>>> end
78091>>>>>>
78091>>>>> set pOutFileName to lsFileName
78092>>>>>
78092>>>>> get pLeftMargin to pLeftMargin#
78093>>>>> set pLeftMargin to 1 // First position is 1
78094>>>>> get rpt_field_count to max#
78095>>>>> for itm# from 0 to (max#-1)
78101>>>>>>
78101>>>>> // Shift unit from 1/10mm to characters:
78101>>>>> set rpt_field_start item itm# to (rpt_field_start(self,itm#)/100)
78102>>>>> set rpt_field_width item itm# to (rpt_field_width(self,itm#)/100)
78103>>>>> loop
78104>>>>>>
78104>>>>> if (liFileFormat=DFQ.FORMAT.XML) begin
78106>>>>> Object oXML Is A cXMLDOMDocument
78108>>>>> Move Self To hoXML
78109>>>>> Set psDocumentName To lsFileName
78110>>>>> Get pReportTitle to lsRootName
78111>>>>> get sXmlRootElementName lsRootName to lsRootName
78112>>>>> if (lsRootName<>"") begin
78114>>>>> Get CreateDocumentElement lsRootName To hoXMLDocumentRoot
78115>>>>> Set pbPreserveWhitespace To DFFALSE
78116>>>>> Set pbValidateOnParse To DFFALSE
78117>>>>> end
78117>>>>>>
78117>>>>> End_Object // oXML
78118>>>>> If (hoXMLDocumentRoot = 0) Begin
78120>>>>> 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"
78121>>>>> Send Destroy To hoXML
78122>>>>> Procedure_Return
78123>>>>> End
78123>>>>>>
78123>>>>> set phXMLDocumentRoot to hoXMLDocumentRoot
78124>>>>> end
78124>>>>>>
78124>>>>> end
78124>>>>>>
78124>>>>> // wp2.... add a printer select dialog with cancel
78124>>>>> if liDestination ne DFQ.DEST.FILE begin // File#
78126>>>>> send DfClosePreview of oWinPrintReport# //<-inserted Feb 22nd 2005
78127>>>>> send DFClearDoc of oWinPrintReport#
78128>>>>> end
78128>>>>>>
78128>>>>> Get DFGetMetrics of oWinPrintReport# to metrics#
78129>>>>> Send DFSetMetrics of oWinPrintReport# wpm_cm
78130>>>>> get_argument_size to argument_size#
78131>>>>> // This we do to avoid having the RT crash because of default 2048:
78131>>>>> if argument_size# lt 32767 set_argument_size 32767 // 32K-1
78134>>>>> forward send run
78136>>>>> set_argument_size argument_size#
78137>>>>>>
78137>>>>> Send DFSetMetrics of oWinPrintReport# metrics#
78138>>>>> if liDestination eq DFQ.DEST.FILE begin // File#
78140>>>>> set pLeftMargin to pLeftMargin#
78141>>>>> for itm# from 0 to (max#-1)
78147>>>>>>
78147>>>>> set rpt_field_start item itm# to (rpt_field_start(self,itm#)*100)
78148>>>>> set rpt_field_width item itm# to (rpt_field_width(self,itm#)*100)
78149>>>>> loop
78150>>>>>>
78150>>>>> if (liFileFormat=DFQ.FORMAT.XML) begin
78152>>>>> Get SaveXMLDocument Of hoXML To lbSaveOk
78153>>>>> Send Destroy To hoXML
78154>>>>> end
78154>>>>>>
78154>>>>> end
78154>>>>>>
78154>>>>> end_procedure
78155>>>>>end_object // oReport_info
78156>>>>>
78156>>>>>// *** Main user interface section ****************************************
78156>>>>>
78156>>>>>class vdq.ComboFormAux is a aps.ComboFormAux
78157>>>>> procedure construct_object
78159>>>>> forward send construct_object
78161>>>>> set combo_sort_state to false
78162>>>>> on_key key_ctrl+key_r send request_run_report
78163>>>>> on_key key_ctrl+key_o send Read_Report_Definition
78164>>>>> on_key key_ctrl+key_s send Write_Report_Definition
78165>>>>> end_procedure
78166>>>>>end_class
78167>>>>>
78167>>>>>register_procedure do_add_field
78167>>>>>register_object oTabs
78167>>>>>register_object oRun_Button
78167>>>>>
78167>>>>>desktop_section // Place object on desktop no matter where declared
78172>>>>> object oVdfQuery_IndexAnalyzer is a cIndexAnalyzer
78174>>>>> end_object
78175>>>>>end_desktop_section
78180>>>>>
78180>>>>>register_procedure DoFileNamesLogical
78180>>>>>register_procedure DoFileNamesUser
78180>>>>>register_procedure DoFieldNamesLogical
78180>>>>>register_procedure DoFieldNamesUser
78180>>>>>register_procedure DoAddAllFields
78180>>>>>register_procedure DoAddIndexFields
78180>>>>>register_procedure DoDisplayTableDefinition
78180>>>>>
78180>>>>>desktop_section // Place objects on desktop no matter where declared
78185>>>>> object oVdfQuery_FileSelectTab1_FM is a FloatingPopupMenu
78187>>>>> send add_item msg_DoFileNamesLogical t.DfQuery.LogicalNames
78188>>>>> send add_item msg_DoFileNamesUser t.DfQuery.UserNames
78189>>>>> send add_item msg_NONE ""
78190>>>>> send add_item msg_DoDisplayTableDefinition (t.DfQuery.DisplayTblDef*"\aCtrl+D")
78191>>>>> end_object
78192>>>>> object oVdfQuery_FieldSelectTab1_FM is a FloatingPopupMenu
78194>>>>> send add_item msg_DoFieldNamesLogical t.DfQuery.LogicalNames
78195>>>>> send add_item msg_DoFieldNamesUser t.DfQuery.UserNames
78196>>>>> send add_item msg_NONE ""
78197>>>>> send add_item msg_DoAddAllFields (t.DfQuery.AddAllFields*"\aCtrl+A")
78198>>>>> send add_item msg_DoAddIndexFields (t.DfQuery.AddIndexFields*"\aCtrl+I")
78199>>>>> end_object
78200>>>>>
78200>>>>> object oVdfQuery_FileSelect_FM is a FloatingPopupMenu
78202>>>>> send add_item msg_DoFileNamesLogical t.DfQuery.LogicalNames
78203>>>>> send add_item msg_DoFileNamesUser t.DfQuery.UserNames
78204>>>>> end_object
78205>>>>> object oVdfQuery_FieldSelect_FM is a FloatingPopupMenu
78207>>>>> send add_item msg_DoFieldNamesLogical t.DfQuery.LogicalNames
78208>>>>> send add_item msg_DoFieldNamesUser t.DfQuery.UserNames
78209>>>>> end_object
78210>>>>>end_desktop_section
78215>>>>>
78215>>>>>// The creating of OG_QueryView must be guarded by the opening of
78215>>>>>// file (og_param(0)) if not 0.
78215>>>>>DEFINE_OBJECT_GROUP OG_QueryView // file# index# subreport?
78216>>>>>
78216>>>>> object oVDFQuery_View is a aps.View
78218>>>>> register_procedure write_report_definition
78218>>>>> register_procedure read_report_definition
78218>>>>> register_procedure NewQuery
78218>>>>> property integer pMainFile public (og_param(0))
78220>>>>> property integer pOrdering public 0
78222>>>>> property number pColumnSpace public 0.2
78224>>>>> property string pFont public ""
78226>>>>> property integer pFontSize public 0
78228>>>>> property integer phForcedDD public 0
78230>>>>> if gsVdfQuery_Icon# ne "" set icon to gsVdfQuery_Icon#
78233>>>>> set help_id to hlpid.VdfQuery
78234>>>>> set Window_Style to WS_MAXIMIZEBOX 1
78235>>>>> property integer pDestroyOnClose public (not(og_param(2)))
78237>>>>>
78237>>>>> object oQuery_ExprArray is a Query_cExprArray
78239>>>>> end_object
78240>>>>> object oQueryOrderExpression is a cQueryOrderExpression
78242>>>>> set phExprArr to (oQuery_ExprArray(self))
78243>>>>> end_object
78244>>>>>
78244>>>>> set p_auto_column to 1
78245>>>>> on_key kcancel send close_panel
78246>>>>> on_key key_F3 send close_panel
78247>>>>> on_key ksave_record send request_run_report
78248>>>>> on_key key_ctrl+key_r send request_run_report
78249>>>>> on_key key_ctrl+key_o send Read_Report_Definition
78250>>>>> on_key key_ctrl+key_s send Write_Report_Definition
78251>>>>> //on_key kuser2 send debug_display_string
78251>>>>> send aps_tab_column_define 1 80 55 jmode_right
78252>>>>>
78252>>>>> procedure DoFieldNamesLogical
78255>>>>> broadcast recursive send FieldNamesLogical
78257>>>>> end_procedure
78258>>>>> procedure DoFieldNamesUser
78261>>>>> broadcast recursive send FieldNamesUser
78263>>>>> end_procedure
78264>>>>> procedure DoFileNamesLogical
78267>>>>> broadcast recursive send FileNamesLogical
78269>>>>> end_procedure
78270>>>>> procedure DoFileNamesUser
78273>>>>> broadcast recursive send FileNamesUser
78275>>>>> end_procedure
78276>>>>>
78276>>>>> procedure Print_Report
78279>>>>> // Cancel toolbar message
78279>>>>> end_procedure
78280>>>>>
78280>>>>> object oDefault_Selection_Values is an array
78282>>>>> procedure qry_change_criteria integer crit# string val1# string val2#
78285>>>>> set value item (crit#*2) to val1#
78286>>>>> set value item (crit#*2+1) to val2#
78287>>>>> end_procedure
78288>>>>> function qry_new_criteria returns integer
78291>>>>> integer crit#
78291>>>>> get item_count to crit#
78292>>>>> function_return (crit#/2 max 1)
78293>>>>> end_function
78294>>>>> function qry_crit_val1 integer crit# returns string
78297>>>>> function_return (value(self,crit#*2))
78298>>>>> end_function
78299>>>>> function qry_crit_val2 integer crit# returns string
78302>>>>> function_return (value(self,crit#*2+1))
78303>>>>> end_function
78304>>>>> end_object // oDefault_Selection_Values
78305>>>>>
78305>>>>> object oMainFile is a vdq.ComboFormAux label t.DfQuery.MainFile abstract aft_ascii50
78309>>>>> set entry_state item 0 to false
78310>>>>> set allow_blank_state to true
78311>>>>> on_key kuser send select_table
78312>>>>>
78312>>>>> set peAnchors to (anTop+anLeft+anRight)
78313>>>>> procedure init
78316>>>>> integer file#
78316>>>>> string str#
78316>>>>> get pMainFile to file#
78317>>>>> if file# begin
78319>>>>> get_attribute DF_FILE_DISPLAY_NAME of file# to str#
78322>>>>> move (rtrim(str#)) to str#
78323>>>>> end
78323>>>>>>
78323>>>>> else send combo_add_item str# 0
78325>>>>> set value item 0 to str#
78326>>>>> send delete_data
78327>>>>> move 0 to file#
78328>>>>> repeat
78328>>>>>>
78328>>>>> get_attribute df_file_next_used of file# to file#
78331>>>>> if file# begin
78333>>>>> if (DfQuery_ExcludeFile(file#)=DFQ_FALSE) begin
78335>>>>> get_attribute DF_FILE_DISPLAY_NAME of file# to str#
78338>>>>> move (rtrim(str#)) to str#
78339>>>>> ifnot (StringBeginsWith(str#,"@")) send combo_add_item str# file#
78342>>>>> end
78342>>>>>>
78342>>>>> end
78342>>>>>>
78342>>>>> until file# eq 0
78344>>>>> end_procedure
78345>>>>> send init
78346>>>>>
78346>>>>> property integer pbNoRecursion public 0
78348>>>>> procedure DoSetFile integer file# integer set_main_window#
78351>>>>> integer callfile#
78351>>>>> string str#
78351>>>>> ifnot (pbNoRecursion(self)) begin
78353>>>>> set pbNoRecursion to DFTRUE
78354>>>>> move file# to callfile#
78355>>>>> if (DBMS_OpenFile(file#,DF_SHARE,0)) begin
78357>>>>> set pMainFile to file#
78358>>>>> send new_main_file to (oTabs(self))
78359>>>>> end
78359>>>>>>
78359>>>>> else begin
78360>>>>> if file# error 200 "File could not be opened"
78363>>>>> get pMainFile to file#
78364>>>>> end
78364>>>>>>
78364>>>>> if file# eq 0 move "" to str#
78367>>>>> else begin
78368>>>>> get_attribute DF_FILE_DISPLAY_NAME of file# to str#
78371>>>>> move (rtrim(str#)) to str#
78372>>>>> end
78372>>>>>>
78372>>>>> if (set_main_window# or not(callfile#)) set value item 0 to str#
78375>>>>> set pbNoRecursion to DFFALSE
78376>>>>> end
78376>>>>>>
78376>>>>> end_procedure
78377>>>>>
78377>>>>> procedure OnChange
78380>>>>> integer file#
78380>>>>> get Combo_Current_Aux_Value to file#
78381>>>>> send DoSetFile file# 0
78382>>>>> end_procedure
78383>>>>> set object_shadow_state to (og_param(2)) // Shadow if sub-report
78384>>>>>
78384>>>>> function select_table_validate integer file# returns integer
78387>>>>> string str#
78387>>>>> get_attribute DF_FILE_DISPLAY_NAME of file# to str#
78390>>>>> move (rtrim(str#)) to str#
78391>>>>> if (StringBeginsWith(str#,"@")) function_return 0
78394>>>>> function_return (DfQuery_ExcludeFile(file#)=0)
78395>>>>> end_function
78396>>>>>
78396>>>>> procedure select_table
78399>>>>> integer file# obj#
78399>>>>> move self to obj#
78400>>>>> get pMainFile to file#
78401>>>>> move (iFdxSelectOneFileValidate(0,file#,get_select_table_validate,obj#)) to file#
78402>>>>> if file# send DoSetFile file# 1
78405>>>>> end_procedure
78406>>>>> end_object // oMainFile
78407>>>>>
78407>>>>> procedure AdvancedTableOpen
78410>>>>> send select_table to (oMainFile(self))
78411>>>>> end_procedure
78412>>>>>
78412>>>>> object oToolButton is a aps.ToolButton snap sl_right
78415>>>>> set peAnchors to (anTop+anRight)
78416>>>>> set p_extra_external_width to 10
78417>>>>> send Add_Button ICO_STD_FIND msg_AdvancedTableOpen
78418>>>>> send Add_ToolTip t.DfQuery.tt.AdvTableOpen
78419>>>>> send Add_Button ICO_STD_FILEOPEN msg_Read_Report_Definition
78420>>>>> send Add_ToolTip t.DfQuery.tt.Open
78421>>>>> ifnot (integer(og_param(2))) begin // If not a sub-report
78423>>>>> send Add_Button ICO_STD_FILESAVE msg_Write_Report_Definition
78424>>>>> send Add_ToolTip t.DfQuery.tt.Save
78425>>>>> send Add_Button ICO_STD_FILENEW msg_NewQuery
78426>>>>> send Add_ToolTip t.DfQuery.tt.New
78427>>>>> end
78427>>>>>>
78427>>>>> end_object
78428>>>>>
78428>>>>> object oTitle is a aps.Form label t.DfQuery.QueryTitle abstract aft_ascii50
78432>>>>> set peAnchors to (anTop+anLeft+anRight)
78433>>>>> procedure OnChange
78436>>>>> send OnChangeMainFile
78437>>>>> end_procedure
78438>>>>> end_object
78439>>>>>
78439>>>>> function report_title returns string
78442>>>>> integer file#
78442>>>>> string str#
78442>>>>> get pMainFile to file#
78443>>>>> get value of (oTitle(self)) item 0 to str#
78444>>>>> if str# eq "" if file# get_attribute DF_FILE_DISPLAY_NAME of file# to str#
78451>>>>> function_return (trim(str#))
78452>>>>> end_function
78453>>>>>
78453>>>>> procedure OnChangeMainFile
78456>>>>> string str# caption# title#
78456>>>>> get report_title to title#
78457>>>>> if title# ne "" begin
78459>>>>> move (t.DfQuery.QueryDefinition+" (#)") to caption#
78460>>>>> replace "#" in caption# with (report_title(self))
78462>>>>> end
78462>>>>>>
78462>>>>> else move t.DfQuery.QueryDefinition to caption#
78464>>>>> set label to caption#
78465>>>>> end_procedure
78466>>>>>
78466>>>>> set p_auto_column to 0
78467>>>>> send aps_goto_max_row
78468>>>>> send aps_make_row_space 4 // Insert 4 MDU
78469>>>>> object oTabs is a aps.TabDialog
78471>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
78472>>>>> object oTab1 is a aps.TabPage label t.DfQuery.LblTab1
78475>>>>> set p_auto_column to 0
78476>>>>>
78476>>>>> DEFINE_OBJECT_GROUP OG_QueryViewComponent // int: allow DoAddAllFields
78477>>>>> object oDBMS_Files is a aps.list label t.DfQuery.DBMSfiles
78480>>>>> property integer pDisplayFileNamesUser public 1
78482>>>>> set size to 60 150
78483>>>>> set label_justification_mode to JMODE_TOP
78484>>>>>
78484>>>>> set Label_Shadow_Display_Mode to TBSHADOW_ON_NONE // Nicholas Herlick
78485>>>>> set label to t.DfQuery.DBMSfiles
78486>>>>>
78486>>>>> on_key kenter send next
78487>>>>> on_key kswitch_back send activate to (oTitle(self))
78488>>>>> on_key key_ctrl+key_p send OpenQueryOnParentFile
78489>>>>> on_key kuser send toggle_display
78490>>>>> on_key KEY_CTRL+KEY_D send DoDisplayTableDefinition
78491>>>>> set peAnchors to (anTop+anLeft)
78492>>>>> procedure toggle_display
78495>>>>> set pDisplayFileNamesUser to (not(pDisplayFileNamesUser(self)))
78496>>>>> send InsertFileNames
78497>>>>> end_procedure
78498>>>>>
78498>>>>> procedure OpenQueryOnParentFile
78501>>>>> integer file# itm#
78501>>>>> if (item_count(self)) begin
78503>>>>> get current_item to itm#
78504>>>>> get aux_value item itm# to file#
78505>>>>> send CreateNewQuery file#
78506>>>>> end
78506>>>>>>
78506>>>>> end_procedure
78507>>>>>
78507>>>>> procedure DoInformExpressionThingAboutAllowedTables
78510>>>>> integer liMax liItem liFile lhQuery_ExprParser
78510>>>>> move (Query_ExprParser(self)) to lhQuery_ExprParser
78511>>>>> send AllowedTables_Reset to lhQuery_ExprParser
78512>>>>> get item_count to liMax
78513>>>>> decrement liMax
78514>>>>> for liItem from 0 to liMax
78520>>>>>>
78520>>>>> get aux_value item liItem to liFile
78521>>>>> send AllowedTables_Add to lhQuery_ExprParser liFile
78522>>>>> loop
78523>>>>>>
78523>>>>> end_procedure
78524>>>>>
78524>>>>> procedure DoDisplayTableDefinition
78527>>>>> integer liFile
78527>>>>> get aux_value item CURRENT to liFile
78528>>>>> send FDX_ModalDisplayFileAttributes 0 liFile
78529>>>>> end_procedure
78530>>>>>
78530>>>>> object oSet is a set
78532>>>>> end_object
78533>>>>>
78533>>>>> procedure InsertFileNames
78536>>>>> integer type#
78536>>>>> integer itm# max# file#
78536>>>>> string str#
78536>>>>> get pDisplayFileNamesUser to type#
78537>>>>> get item_count to max#
78538>>>>> for itm# from 0 to (max#-1)
78544>>>>>>
78544>>>>> get aux_value item itm# to file#
78545>>>>> if type# get File_Display_Name file# to str#
78548>>>>> else get_attribute DF_FILE_LOGICAL_NAME of file# to str#
78552>>>>> set value item itm# to str#
78553>>>>> loop
78554>>>>>>
78554>>>>> set dynamic_update_state to true
78555>>>>> end_procedure
78556>>>>> procedure FileNamesLogical
78559>>>>> set pDisplayFileNamesUser to false
78560>>>>> send InsertFileNames
78561>>>>> end_procedure
78562>>>>> procedure FileNamesUser
78565>>>>> set pDisplayFileNamesUser to true
78566>>>>> send InsertFileNames
78567>>>>> end_procedure
78568>>>>>
78568>>>>> property integer piOgParam0 public 0
78570>>>>> set piOgParam0 to (og_param(0))
78571>>>>> procedure mouse_down2 integer liWin integer liCharPos
78574>>>>> send mouse_down liWin liCharPos // Take focus
78575>>>>> if (piOgParam0(self)) send popup to (oVdfQuery_FileSelectTab1_FM(self))
78578>>>>> else send popup to (oVdfQuery_FileSelect_FM(self))
78580>>>>> end_procedure
78581>>>>>
78581>>>>> procedure add_file integer file#
78584>>>>> integer field# max_field# rel_file#
78584>>>>>
78584>>>>> if (DBMS_OpenFile(file#,DF_SHARE,0)) begin
78586>>>>> get_attribute DF_FILE_NUMBER_FIELDS of file# to max_field#
78589>>>>>
78589>>>>> if (find_element(oSet(self),file#)) eq -1 begin
78591>>>>> send add_element to (oSet(self)) file#
78592>>>>> send add_item msg_none ""
78593>>>>> set aux_value item (item_count(self) - 1) to file#
78594>>>>>
78594>>>>> for field# from 1 to max_field#
78600>>>>>>
78600>>>>> get_attribute DF_FIELD_RELATED_FILE of file# field# to rel_file#
78603>>>>> if rel_file# ne 0 begin
78605>>>>> if (DfQuery_ExcludeFile(file#)<>DFQ_ALWAYS) ; send add_file rel_file#
78608>>>>> end
78608>>>>>>
78608>>>>> loop
78609>>>>>>
78609>>>>> end
78609>>>>>>
78609>>>>> end
78609>>>>>>
78609>>>>> else error 200 ("Related file could not be opened (entry: "+string(file#)+")")
78611>>>>> end_procedure
78612>>>>>
78612>>>>> procedure fill_list
78615>>>>> integer file# st#
78615>>>>>
78615>>>>> send delete_data
78616>>>>> send delete_data to (oSet(self))
78617>>>>>
78617>>>>> get pMainFile to file#
78618>>>>> if file# send add_file file#
78621>>>>> send InsertFileNames
78622>>>>> send notify_filechange file#
78623>>>>> end_procedure
78624>>>>>
78624>>>>> procedure OnChangeMainFile
78627>>>>> send fill_list
78628>>>>> end_procedure
78629>>>>>
78629>>>>> procedure onchange
78632>>>>> integer file#
78632>>>>> get aux_value item (current_item(self)) to file#
78633>>>>> send notify_filechange file#
78634>>>>> send request_status_help 1
78635>>>>> end_procedure
78636>>>>>
78636>>>>> function current_aux returns integer
78639>>>>> function_return (aux_value(self,current_item(self)))
78640>>>>> end_function
78641>>>>>
78641>>>>> Function Status_Help integer itm_tmp# returns string
78644>>>>> integer itm# aux#
78644>>>>> string str#
78644>>>>> if num_arguments eq 0 get current_item to itm#
78647>>>>> //else move itm_tmp# to itm#
78647>>>>> get aux_value item itm# to aux#
78648>>>>> get VdfQuery_file_status_help aux# to str#
78649>>>>> function_return str#
78650>>>>> End_Function
78651>>>>>
78651>>>>> procedure DoGotoFile integer liFile
78654>>>>> integer liMax liItm
78654>>>>> get item_count to liMax
78655>>>>> decrement liMax
78656>>>>> for liItm from 0 to liMax
78662>>>>>>
78662>>>>> if (aux_value(self,liItm)=liFile) set current_item to liItm
78665>>>>> loop
78666>>>>>>
78666>>>>> end_procedure
78667>>>>> end_object
78668>>>>> send aps_goto_max_row
78669>>>>> send make_row_space
78670>>>>> object oDBMS_Fields is a aps.list //snap sl_down
78672>>>>> property integer pDisplayFieldNamesUser public 1
78674>>>>> property integer pFileNumber public 0
78676>>>>> set size to 75 150
78677>>>>>
78677>>>>> on_key kswitch send switch
78678>>>>> on_key kswitch_back send switch_back
78679>>>>> on_key kEnter Send do_add_field
78680>>>>> on_key kuser send toggle_display
78681>>>>>
78681>>>>> set peAnchors to (anTop+anLeft+anBottom)
78682>>>>> procedure toggle_display
78685>>>>> set pDisplayFieldNamesUser to (not(pDisplayFieldNamesUser(self)))
78686>>>>> send InsertFieldNames
78687>>>>> end_procedure
78688>>>>>
78688>>>>> property integer piOgParam0 public 0
78690>>>>> set piOgParam0 to (og_param(0))
78691>>>>> procedure mouse_down2 integer liWin integer liCharPos
78694>>>>> send mouse_down liWin liCharPos // Take focus
78695>>>>> if (piOgParam0(self)) send popup to (oVdfQuery_FieldSelectTab1_FM(self))
78698>>>>> else send popup to (oVdfQuery_FieldSelect_FM(self))
78700>>>>> end_procedure
78701>>>>>
78701>>>>> procedure InsertFieldNames
78704>>>>> integer type#
78704>>>>> integer itm# max# fld# file#
78704>>>>> string str#
78704>>>>> get pFileNumber to file#
78705>>>>> get pDisplayFieldNamesUser to type#
78706>>>>> get item_count to max#
78707>>>>> for itm# from 0 to (max#-1)
78713>>>>>>
78713>>>>> get aux_value item itm# to fld#
78714>>>>> if fld# lt 256 begin
78716>>>>> if type# get FieldInf_FieldLabel_Long file# fld# to str#
78719>>>>> else get_attribute DF_FIELD_NAME of file# fld# to str#
78723>>>>> set value item itm# to str#
78724>>>>> end
78724>>>>>>
78724>>>>> loop
78725>>>>>>
78725>>>>> set dynamic_update_state to true
78726>>>>> end_procedure
78727>>>>>
78727>>>>> if (integer(og_param(0))) on_key key_ctrl+key_a send DoAddAllFields
78730>>>>> if (integer(og_param(0))) on_key key_ctrl+key_i send DoAddIndexFields
78733>>>>> procedure FieldNamesLogical
78736>>>>> set pDisplayFieldNamesUser to false
78737>>>>> send InsertFieldNames
78738>>>>> end_procedure
78739>>>>> procedure FieldNamesUser
78742>>>>> set pDisplayFieldNamesUser to true
78743>>>>> send InsertFieldNames
78744>>>>> end_procedure
78745>>>>> procedure mouse_click integer i1 integer i2
78748>>>>> Send do_add_field
78749>>>>> end_procedure
78750>>>>> procedure load_virtual_fields integer file#
78753>>>>> integer obj# fld# max#
78753>>>>> get FieldInf_VirtualFields_Object file# to obj#
78754>>>>> if obj# begin
78756>>>>> get row_count of obj# to max#
78757>>>>> for fld# from 0 to (max#-1)
78763>>>>>>
78763>>>>> if (piFieldActive.i(obj#,fld#)) begin
78765>>>>> send add_item msg_do_add_field (psFieldLabel.i(obj#,fld#))
78766>>>>> set aux_value item (item_count(self) - 1) to (fld#+256)
78767>>>>> end
78767>>>>>>
78767>>>>> loop
78768>>>>>>
78768>>>>> end
78768>>>>>>
78768>>>>> end_procedure
78769>>>>> procedure file_change integer file#
78772>>>>> integer field# max_field# fieldtype# st#
78772>>>>> string str#
78772>>>>> send delete_data
78773>>>>> set pFileNumber to file#
78774>>>>>
78774>>>>> if file# begin
78776>>>>> get_attribute DF_FILE_NUMBER_FIELDS of file# to max_field#
78779>>>>>
78779>>>>> for field# from 0 to max_field#
78785>>>>>>
78785>>>>> get_attribute DF_FIELD_NAME of file# field# to str#
78788>>>>> move (FieldInf_FieldType(file#,field#)) to fieldtype#
78789>>>>> if (fieldtype#<>DF_OVERLAP and fieldtype#<>DF_BINARY) begin
78791>>>>> ifnot (StringBeginsWith(str#,"@")) begin
78793>>>>> ifnot (DfQuery_ExcludeField(file#,field#)) begin
78795>>>>> send add_item msg_do_add_field "" //str#
78796>>>>> set aux_value item (item_count(self)-1) to field#
78797>>>>> end
78797>>>>>>
78797>>>>> end
78797>>>>>>
78797>>>>> end
78797>>>>>>
78797>>>>> loop
78798>>>>>>
78798>>>>> send InsertFieldNames
78799>>>>> send load_virtual_fields file#
78800>>>>> end
78800>>>>>>
78800>>>>> end_procedure
78801>>>>> function current_aux returns integer
78804>>>>> function_return (aux_value(self,current_item(self)))
78805>>>>> end_function
78806>>>>> function iFindField.i integer liField returns integer
78809>>>>> integer liItm liMax
78809>>>>> get item_count to liMax
78810>>>>> decrement liMax
78811>>>>> for liItm from 0 to liMax
78817>>>>>>
78817>>>>> if (aux_value(self,liItm)=liField) function_return liItm
78820>>>>> loop
78821>>>>>>
78821>>>>> function_return -1 // not found
78822>>>>> end_function
78823>>>>> procedure DoAddIndexFields
78826>>>>> integer liIndex liFile liMax liItm liField lbFieldAllowed
78826>>>>> string lsFields
78826>>>>> get current_aux of (oDBMS_Files(self)) to liFile
78827>>>>> if liFile begin
78829>>>>> get iFdxSelectIndex 0 liFile to liIndex
78830>>>>> if liIndex begin
78832>>>>> get FDX_IndexAsFields 0 liFile liIndex to lsFields
78833>>>>> get FDX_FieldsTranslateOverlaps 0 liFile lsFields to lsFields
78834>>>>> get HowManyIntegers lsFields to liMax
78835>>>>> for liItm from 1 to liMax
78841>>>>>>
78841>>>>> get ExtractInteger lsFields liItm to liField
78842>>>>> if liField begin // Exclude recnum
78844>>>>> get iFindField.i liField to lbFieldAllowed
78845>>>>> if (lbFieldAllowed<>-1) begin
78847>>>>> send DoGotoField liField
78848>>>>> send do_add_field
78849>>>>> end
78849>>>>>>
78849>>>>> end
78849>>>>>>
78849>>>>> loop
78850>>>>>>
78850>>>>> end
78850>>>>>>
78850>>>>> end
78850>>>>>>
78850>>>>> end_procedure
78851>>>>> procedure DoAddAllFields
78854>>>>> integer itm# max#
78854>>>>> get item_count to max#
78855>>>>> for itm# from 0 to (max#-1)
78861>>>>>>
78861>>>>> if (aux_value(self,itm#)) begin // Exclude recnum
78863>>>>> set current_item to itm#
78864>>>>> send do_add_field
78865>>>>> end
78865>>>>>>
78865>>>>> loop
78866>>>>>>
78866>>>>> end_procedure
78867>>>>> Function Status_Help integer itm_tmp# returns string
78870>>>>> integer itm# file# aux#
78870>>>>> string str#
78870>>>>> if num_arguments eq 0 get current_item to itm#
78873>>>>> else move itm_tmp# to itm#
78875>>>>> get current_aux of (oDBMS_Files(self)) to file#
78876>>>>> get aux_value item itm# to aux#
78877>>>>> get VdfQuery_field_status_help file# aux# to str#
78878>>>>> function_return str#
78879>>>>> End_Function
78880>>>>> procedure OnChange
78883>>>>> send request_status_help 1
78884>>>>> end_procedure
78885>>>>> procedure DoGotoField integer liField
78888>>>>> integer liMax liItm
78888>>>>> get item_count to liMax
78889>>>>> decrement liMax
78890>>>>> for liItm from 0 to liMax
78896>>>>>>
78896>>>>> if (aux_value(self,liItm)=liField) set current_item to liItm
78899>>>>> loop
78900>>>>>>
78900>>>>> end_procedure
78901>>>>> end_object // oDBMS_Files
78902>>>>> set label of (oDBMS_Fields(self)) to t.DfQuery.DBMSfields
78903>>>>> set Label_Shadow_Display_Mode of (oDBMS_Fields(self)) to TBSHADOW_ON_NONE // Nicholas Herlick
78904>>>>> set label_justification_mode of (oDBMS_Fields(self)) to JMODE_TOP
78905>>>>> set label_offset of (oDBMS_Fields(self)) to 0 0
78906>>>>> procedure notify_filechange integer file#
78909>>>>> send file_change to (oDBMS_Fields(self)) file#
78910>>>>> end_procedure
78911>>>>> END_DEFINE_OBJECT_GROUP
78912>>>>> CREATE_OBJECT_GROUP OG_QueryViewComponent 1
78916>>>>>
78916>>>>> object oGrp is a aps.Group label t.DfQuery.LblGrpPrnt snap sl_right relative_to (oDBMS_Files(self))
78925>>>>> set p_auto_column to 0
78926>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
78927>>>>> object oGrd is a aps.Grid
78929>>>>> set peResizeColumn to rcAll
78930>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
78931>>>>> on_key kenter send next
78932>>>>> set size to 100 0
78933>>>>> set line_width to 5 0
78934>>>>> set form_margin item 0 to 25
78935>>>>> set form_margin item 1 to 2
78936>>>>> set form_margin item 2 to 2
78937>>>>> set form_margin item 3 to 4
78938>>>>> set form_margin item 4 to 4
78939>>>>> set form_datatype item 0 to ascii_window
78940>>>>> set form_datatype item 1 to ascii_window
78941>>>>> set form_datatype item 2 to ascii_window
78942>>>>> set form_datatype item 3 to 1
78943>>>>> set form_datatype item 4 to 1
78944>>>>> set header_label item 0 to t.DfQuery.LblGrdPrnt0
78945>>>>> set header_label item 1 to t.DfQuery.LblGrdPrnt1
78946>>>>> set header_label item 2 to t.DfQuery.LblGrdPrnt2
78947>>>>> set header_label item 3 to t.DfQuery.LblGrdPrnt3
78948>>>>> set header_label item 4 to t.DfQuery.LblGrdPrnt4
78949>>>>> set Status_Help item 0 to t.DfQuery.SthGrdPrnt0
78950>>>>> set Status_Help item 1 to t.DfQuery.SthGrdPrnt1
78951>>>>> set Status_Help item 2 to t.DfQuery.SthGrdPrnt2
78952>>>>> set Status_Help item 3 to t.DfQuery.SthGrdPrnt3
78953>>>>> set Status_Help item 4 to t.DfQuery.SthGrdPrnt4
78954>>>>> //set highlight_row_state to true
78954>>>>> //set highlight_row_color to (rgb(0,255,255))
78954>>>>>
78954>>>>> set CurrentCellColor to clHighlight
78955>>>>> set CurrentCellTextColor to clHighlightText
78956>>>>> set CurrentRowColor to clHighlight
78957>>>>> set CurrentRowTextColor to clHighlightText
78958>>>>>
78958>>>>> set select_mode to multi_select
78959>>>>> set auto_top_item_state to false
78960>>>>> on_key kdelete_record send delete_row
78961>>>>> on_key key_ctrl+key_j send calculate_offsets
78962>>>>> on_key kswitch send switch
78963>>>>> on_key kswitch_back send switch_back
78964>>>>>
78964>>>>> procedure load_report_info // Title, file, fields to be printed
78967>>>>> integer row# max# file# field# base# sum# cr# fontsize#
78967>>>>> integer lhExprArr liExprRow
78967>>>>> number start# width#
78967>>>>> string name# font#
78967>>>>> set pReportTitle of oReport_info# to (report_title(self))
78968>>>>> set pMainFile of oReport_info# to (pMainFile(self))
78969>>>>> set pOrdering of oReport_info# to (pOrdering(self))
78970>>>>> set pBottomText of oReport_info# to "bottom"
78971>>>>> send delete_data to oReport_info#
78972>>>>> get report_fontsize to fontsize#
78973>>>>> get report_font to font#
78974>>>>> // wp2 - addded for wp1
78974>>>>> set psFontName of oReport_info# to Font#
78975>>>>> set piFontSize of oReport_info# to FontSize#
78976>>>>>
78976>>>>> move (oQuery_ExprArray(self)) to lhExprArr
78977>>>>>
78977>>>>> get item_count to max#
78978>>>>>
78978>>>>> for row# from 0 to (max#/5-1)
78984>>>>>>
78984>>>>> move (row#*5) to base#
78985>>>>> get aux_value item base# to file#
78986>>>>> move (low(file#)) to field#
78987>>>>> move (hi(file#)) to file#
78988>>>>> get value item base# to name#
78989>>>>> get select_state item (base#+1) to sum#
78990>>>>> get select_state item (base#+2) to cr#
78991>>>>> get value item (base#+3) to start#
78992>>>>> get value item (base#+4) to width#
78993>>>>> if file# begin
78995>>>>> send add_field to oReport_info# file# field# name# cr# start# width# font# fontsize# sum# 0 0 0
78996>>>>> end
78996>>>>>>
78996>>>>> else begin
78997>>>>> get aux_value item (base#+1) to liExprRow
78998>>>>> send add_field to oReport_info# file# field# name# cr# start# width# font# fontsize# sum# 0 lhExprArr liExprRow
78999>>>>> end
78999>>>>>>
78999>>>>> loop
79000>>>>>>
79000>>>>> end_procedure
79001>>>>> function base_item returns integer
79004>>>>> integer itm#
79004>>>>> get current_item to itm#
79005>>>>> function_return ((itm#/5)*5)
79006>>>>> end_function
79007>>>>> procedure add_row
79010>>>>> integer base#
79010>>>>> get item_count to base#
79011>>>>> set dynamic_update_state to DFFALSE
79012>>>>> send add_item msg_none ""
79013>>>>> send add_item msg_none ""
79014>>>>> send add_item msg_none ""
79015>>>>> send add_item msg_none ""
79016>>>>> send add_item msg_none ""
79017>>>>> set dynamic_update_state to DFTRUE
79018>>>>> end_procedure
79019>>>>> procedure insert_row
79022>>>>> integer base#
79022>>>>> if (item_count(self)) begin
79024>>>>> get base_item to base#
79025>>>>> set dynamic_update_state to DFFALSE
79026>>>>> send insert_item 0 "" base#
79027>>>>> send insert_item 0 "" base#
79028>>>>> send insert_item 0 "" base#
79029>>>>> send insert_item 0 "" base#
79030>>>>> send insert_item 0 "" base#
79031>>>>> set dynamic_update_state to DFTRUE
79032>>>>> end
79032>>>>>>
79032>>>>> else send add_row
79034>>>>> end_procedure
79035>>>>> procedure delete_row
79038>>>>> integer base#
79038>>>>> if (item_count(self)) begin
79040>>>>> get base_item to base#
79041>>>>> set dynamic_update_state to DFFALSE
79042>>>>> send delete_item base#
79043>>>>> send delete_item base#
79044>>>>> send delete_item base#
79045>>>>> send delete_item base#
79046>>>>> send delete_item base#
79047>>>>> set dynamic_update_state to DFTRUE
79048>>>>> end
79048>>>>>>
79048>>>>> end_procedure
79049>>>>>
79049>>>>> procedure do_expression integer liRow integer liBase
79052>>>>> integer liType lhExprArr liFieldType
79052>>>>> move (oQuery_ExprArray(self)) to lhExprArr
79053>>>>>
79053>>>>> set aux_value item liBase to 0
79054>>>>> set value item liBase to (psLabel.i(lhExprArr,liRow))
79055>>>>>
79055>>>>> set aux_value item (liBase+1) to liRow
79056>>>>>
79056>>>>> move (piType.i(lhExprArr,liRow)) to liFieldType
79057>>>>>
79057>>>>> if liFieldType ne DF_BCD set item_shadow_state item (liBase+1) to DFTRUE
79060>>>>> else set checkbox_item_state item (liBase+1) to DFTRUE
79062>>>>>
79062>>>>> set checkbox_item_state item (liBase+2) to DFTRUE
79063>>>>>
79063>>>>> if liFieldType eq DF_TEXT set item_shadow_state item (liBase+4) to DFTRUE
79066>>>>> set current_item to liBase
79067>>>>> end_procedure
79068>>>>>
79068>>>>> procedure do_field integer file# integer field# integer base#
79071>>>>> integer fieldtype#
79071>>>>> set aux_value item base# to (file#*65536+field#)
79072>>>>> set value item base# to (FieldInf_FieldLabel_Short(file#,field#))
79073>>>>>
79073>>>>> move (FieldInf_FieldType(file#,field#)) to fieldtype#
79074>>>>>
79074>>>>> if fieldtype# ne DF_BCD set item_shadow_state item (base#+1) to DFTRUE
79077>>>>> else set checkbox_item_state item (base#+1) to DFTRUE
79079>>>>>
79079>>>>> set checkbox_item_state item (base#+2) to DFTRUE
79080>>>>>
79080>>>>> if fieldtype# eq DF_TEXT set item_shadow_state item (base#+4) to DFTRUE
79083>>>>> set current_item to base#
79084>>>>> end_procedure
79085>>>>>
79085>>>>> procedure add_field integer file# integer field#
79088>>>>> integer base#
79088>>>>> get item_count to base#
79089>>>>> send add_row
79090>>>>> send do_field file# field# base#
79091>>>>> set dynamic_update_state to true
79092>>>>> send calculate_offsets
79093>>>>> end_procedure
79094>>>>>
79094>>>>> procedure insert_field integer file# integer field#
79097>>>>> integer base#
79097>>>>> get base_item to base#
79098>>>>> send insert_row
79099>>>>> send do_field file# field# base#
79100>>>>> set dynamic_update_state to true
79101>>>>> send key kuparrow
79102>>>>> end_procedure
79103>>>>>
79103>>>>> function bIsExprRow integer liBase returns integer
79106>>>>> function_return (not(aux_value(self,liBase)))
79107>>>>> end_function
79108>>>>>
79108>>>>> procedure DoCcAdd
79111>>>>> integer liRow lhExprArr liBase
79111>>>>> move (oQuery_ExprArray(self)) to lhExprArr
79112>>>>> send DoInformExpressionThingAboutAllowedTables to (oDBMS_Files(self))
79113>>>>> get iPopup.ii of (Query_ColumnExpression(self)) lhExprArr -1 to liRow
79114>>>>> if (liRow<>-1) begin
79116>>>>> get item_count to liBase
79117>>>>> send add_row
79118>>>>> send do_expression liRow liBase
79119>>>>> set dynamic_update_state to DFTRUE
79120>>>>> send calculate_offsets
79121>>>>> end
79121>>>>>>
79121>>>>> end_procedure
79122>>>>> procedure DoCcInsert
79125>>>>> integer liRow lhExprArr liBase
79125>>>>> move (oQuery_ExprArray(self)) to lhExprArr
79126>>>>> send DoInformExpressionThingAboutAllowedTables to (oDBMS_Files(self))
79127>>>>> get iPopup.ii of (Query_ColumnExpression(self)) lhExprArr -1 to liRow
79128>>>>> if (liRow<>-1) begin
79130>>>>> get base_item to liBase
79131>>>>> send insert_row
79132>>>>> send do_expression liRow liBase
79133>>>>> set dynamic_update_state to DFTRUE
79134>>>>> send calculate_offsets
79135>>>>> end
79135>>>>>>
79135>>>>> end_procedure
79136>>>>>
79136>>>>> procedure DoCcEdit
79139>>>>> integer liBase lhExprArr liExprRow liRow
79139>>>>> if (item_count(self)) begin
79141>>>>> get base_item to liBase
79142>>>>> if (bIsExprRow(self,liBase)) begin
79144>>>>> send DoInformExpressionThingAboutAllowedTables to (oDBMS_Files(self))
79145>>>>> move (oQuery_ExprArray(self)) to lhExprArr
79146>>>>> get aux_value item (liBase+1) to liExprRow
79147>>>>> get iPopup.ii of (Query_ColumnExpression(self)) lhExprArr liExprRow to liRow
79148>>>>> if (liRow<>-1) begin
79150>>>>> send do_expression liRow liBase
79151>>>>> set dynamic_update_state to DFTRUE
79152>>>>> send calculate_offsets
79153>>>>> end
79153>>>>>>
79153>>>>> end
79153>>>>>>
79153>>>>> end
79153>>>>>>
79153>>>>> end_procedure
79154>>>>>
79154>>>>>
79154>>>>> function row_start integer row# returns number
79157>>>>> function_return (value(self,row#*5+3))
79158>>>>> end_function
79159>>>>> function row_width integer row# returns number
79162>>>>> function_return (value(self,row#*5+4))
79163>>>>> end_function
79164>>>>> procedure set row_start integer row# number value#
79167>>>>> set value item (row#*5+3) to value#
79168>>>>> end_procedure
79169>>>>> procedure set row_width integer row# number value#
79172>>>>> set value item (row#*5+4) to value#
79173>>>>> end_procedure
79174>>>>> function row_file integer row# returns integer
79177>>>>> function_return (hi(integer(aux_value(self,row#*5))))
79178>>>>> end_function
79179>>>>> function row_field integer row# returns integer
79182>>>>> function_return (low(integer(aux_value(self,row#*5))))
79183>>>>> end_function
79184>>>>> function row_cr integer row# returns integer
79187>>>>> function_return (select_state(self,row#*5+2))
79188>>>>> end_function
79189>>>>> function row_label integer row# returns string
79192>>>>> function_return (value(self,row#*5))
79193>>>>> end_function
79194>>>>> function row_expr_row integer row# returns string
79197>>>>> function_return (integer(aux_value(self,row#*5+1)))
79198>>>>> end_function
79199>>>>>
79199>>>>> procedure row_change integer liRowFrom integer liRowTo
79202>>>>> integer liFile liField
79202>>>>> get row_file liRowTo to liFile
79203>>>>> get row_field liRowTo to liField
79204>>>>> if (liFile<>0) begin
79206>>>>> send DoGotoFile to (oDBMS_Files(self)) liFile
79207>>>>> send DoGotoField to (oDBMS_Fields(self)) liField
79208>>>>> end
79208>>>>>>
79208>>>>> end_procedure
79209>>>>> procedure item_change integer liItm1 integer liItm2 returns integer
79212>>>>> integer liRval liColumns
79212>>>>> get Grid_Columns self to liColumns
79213>>>>> forward get msg_item_change liItm1 liItm2 to liRval
79215>>>>> if ((liItm1/liColumns)<>(liRval/liColumns)) send row_change (liItm1/liColumns) (liRval/liColumns)
79218>>>>> procedure_return liRval
79219>>>>> end_procedure
79220>>>>>
79220>>>>>
79220>>>>> procedure MarkUsedExpressions
79223>>>>> integer liRow liMax liExprRow liBase liFileField lhExprArr
79223>>>>> move (oQuery_ExprArray(self)) to lhExprArr
79224>>>>> get Grid_RowCount self to liMax
79225>>>>> decrement liMax
79226>>>>> for liRow from 0 to liMax
79232>>>>>>
79232>>>>> get Grid_RowBaseItem self liRow to liBase
79233>>>>> get aux_value item liBase to liFileField
79234>>>>> ifnot liFileField begin
79236>>>>> get aux_value item (liBase+1) to liExprRow
79237>>>>> send CleanUp_MarkAsUsed to lhExprArr liExprRow
79238>>>>> end
79238>>>>>>
79238>>>>> loop
79239>>>>>>
79239>>>>> end_procedure
79240>>>>>
79240>>>>> procedure GetNewExpressionIDs
79243>>>>> integer liRow liMax liExprRow liBase liFileField lhExprArr
79243>>>>> move (oQuery_ExprArray(self)) to lhExprArr
79244>>>>> get Grid_RowCount self to liMax
79245>>>>> decrement liMax
79246>>>>> for liRow from 0 to liMax
79252>>>>>>
79252>>>>> get Grid_RowBaseItem self liRow to liBase
79253>>>>> get aux_value item liBase to liFileField
79254>>>>> ifnot liFileField begin
79256>>>>> get aux_value item (liBase+1) to liExprRow
79257>>>>> get pbCleanupNewRow.i of lhExprArr liExprRow to liExprRow
79258>>>>> set aux_value item (liBase+1) to liExprRow
79259>>>>> end
79259>>>>>>
79259>>>>> loop
79260>>>>>>
79260>>>>> end_procedure
79261>>>>>
79261>>>>> procedure calculate_offsets
79264>>>>> integer max# row# fieldtype# mrg# file# field# fontsize#
79264>>>>> integer printable_file# obj# liExprRow lhExprArr
79264>>>>> number width# start# space# label_width#
79264>>>>> string font# row_label#
79264>>>>> move (oQuery_ExprArray(self)) to lhExprArr
79265>>>>>
79265>>>>> get Current_Destination to printable_file#
79266>>>>> if printable_file# eq 2 begin
79268>>>>> get Current_FileFormat to printable_file#
79269>>>>> if printable_file# eq DFQ.FORMAT.PRINT move 1 to printable_file#
79272>>>>> else move 0 to printable_file#
79274>>>>> end
79274>>>>>>
79274>>>>> else move 0 to printable_file#
79276>>>>>
79276>>>>> if printable_file# move 1 to space#
79279>>>>> else get pColumnSpace to space#
79281>>>>>
79281>>>>> move (item_count(self)/5) to max#
79282>>>>> move (base_item(self)/5) to row#
79283>>>>> if row# ne 0 begin
79285>>>>> get row_width (row#-1) to width#
79286>>>>> get row_start (row#-1) to start#
79287>>>>> move (start#+space#) to start#
79288>>>>> end
79288>>>>>>
79288>>>>> else begin
79289>>>>> move 0 to width#
79290>>>>> move 0 to start#
79291>>>>> end
79291>>>>>>
79291>>>>> get report_fontsize to fontsize#
79292>>>>> get report_font to font#
79293>>>>> for row# from row# to (max#-1)
79299>>>>>>
79299>>>>> get row_file row# to file#
79300>>>>> get row_field row# to field#
79301>>>>> if (file#=0) begin
79303>>>>> get row_expr_row row# to liExprRow
79304>>>>> move (piType.i(lhExprArr,liExprRow)) to fieldtype#
79305>>>>> end
79305>>>>>>
79305>>>>> else move (FieldInf_FieldType(file#,field#)) to fieldtype#
79307>>>>> if fieldtype# ne DF_TEXT begin
79309>>>>> move (start#+width#) to start#
79310>>>>> if (row_cr(self,row#)) move 0 to start#
79313>>>>> if (file#=0) get piWidth.i of lhExprArr liExprRow to mrg#
79316>>>>> else get VdfQuery_field_margin file# field# to mrg#
79318>>>>> if printable_file# begin
79320>>>>> move mrg# to width#
79321>>>>> move (length(row_label(self,row#))) to label_width#
79322>>>>> end
79322>>>>>>
79322>>>>> else begin
79323>>>>> get VdfQuery_field_width_cm fieldtype# mrg# 0 font# fontsize# to width#
79324>>>>> get row_label row# to row_label#
79325>>>>> get VdfQuery_value_width_cm row_label# font# fontsize# to label_width#
79326>>>>> end
79326>>>>>>
79326>>>>> if label_width# gt width# move label_width# to width#
79329>>>>> set row_start row# to start#
79330>>>>> set row_width row# to width#
79331>>>>> move (start#+space#) to start#
79332>>>>> end
79332>>>>>>
79332>>>>> loop
79333>>>>>>
79333>>>>> end_procedure
79334>>>>>
79334>>>>> procedure OnChangeMainFile
79337>>>>> send delete_data
79338>>>>> end_procedure
79339>>>>> end_object
79340>>>>> set multi_button_size to 14 40
79341>>>>> object oBtn1 is a aps.Multi_Button
79343>>>>> set peAnchors to (anRight+anBottom)
79344>>>>> on_item t.DfQuery.LblAddField send do_add_field
79345>>>>> end_object
79346>>>>> object oBtn2 is a aps.Multi_Button
79348>>>>> set peAnchors to (anRight+anBottom)
79349>>>>> on_item t.DfQuery.LblInsertField send do_insert_field
79350>>>>> end_object
79351>>>>> object oBtn3 is a aps.Multi_Button
79353>>>>> set peAnchors to (anRight+anBottom)
79354>>>>> on_item t.DfQuery.LblDeleteField send delete_row to (oGrd(self))
79355>>>>> end_object
79356>>>>> if giVdfQuery_Expressions_State begin
79358>>>>> object oBtn4 is a aps.Multi_Button
79360>>>>> set peAnchors to (anRight+anBottom)
79361>>>>> procedure DoCcAdd
79364>>>>> send DoCcAdd to (oGrd(self))
79365>>>>> end_procedure
79366>>>>> procedure DoCcInsert
79369>>>>> send DoCcInsert to (oGrd(self))
79370>>>>> end_procedure
79371>>>>> procedure DoCcEdit
79374>>>>> send DoCcEdit to (oGrd(self))
79375>>>>> end_procedure
79376>>>>> procedure PopupFM
79379>>>>> integer liLoc liCol liRow liSzCol liSzRow
79379>>>>> send Mouse_MoveToObject self
79380>>>>> send FLOATMENU_PrepareAddItem msg_DoCcAdd t.btn.add
79381>>>>> send FLOATMENU_PrepareAddItem msg_DoCcInsert t.btn.insert
79382>>>>> send FLOATMENU_PrepareAddItem msg_DoCcEdit t.btn.edit
79383>>>>> send popup to (FLOATMENU_Apply(self))
79384>>>>> end_procedure
79385>>>>> procedure OnClick
79388>>>>> send popupFM
79389>>>>> end_procedure
79390>>>>> set label to t.DfQuery.Expression
79391>>>>> end_object
79392>>>>> end
79392>>>>>>
79392>>>>> object oBtn5 is a aps.Multi_Button
79394>>>>> set peAnchors to (anRight+anBottom)
79395>>>>> set multi_button_size to 14 50
79396>>>>> on_item t.DfQuery.LblAdjustBelow send calculate_offsets to (oGrd(self))
79397>>>>> end_object
79398>>>>> send aps_locate_multi_buttons
79399>>>>> end_object
79400>>>>> procedure do_add_field
79403>>>>> integer file# field#
79403>>>>> get current_aux of (oDBMS_Files(self)) to file#
79404>>>>> get current_aux of (oDBMS_Fields(self)) to field#
79405>>>>> send add_field to (oGrd(oGrp(self))) file# field#
79406>>>>> send key to (oDBMS_Fields(self)) kdownarrow
79407>>>>> end_procedure
79408>>>>> procedure do_insert_field
79411>>>>> integer file# field#
79411>>>>> get current_aux of (oDBMS_Files(self)) to file#
79412>>>>> get current_aux of (oDBMS_Fields(self)) to field#
79413>>>>> send insert_field to (oGrd(oGrp(self))) file# field#
79414>>>>> end_procedure
79415>>>>> procedure add_report_field integer file# integer field#
79418>>>>> send add_field to (oGrd(oGrp(self))) file# field#
79419>>>>> end_procedure
79420>>>>> end_object
79421>>>>> object oTab2 is a aps.TabPage label t.DfQuery.LblTab2
79424>>>>> CREATE_OBJECT_GROUP OG_QueryViewComponent 0
79428>>>>>
79428>>>>> property integer piExprRow public -1
79430>>>>>
79430>>>>> procedure MarkUsedExpressions
79433>>>>> integer liExprRow
79433>>>>> get piExprRow to liExprRow
79434>>>>> if (liExprRow<>-1) send CleanUp_MarkAsUsed to (oQuery_ExprArray(self)) liExprRow
79437>>>>> end_procedure
79438>>>>>
79438>>>>> procedure GetNewExpressionIDs
79441>>>>> integer liExprRow
79441>>>>> get piExprRow to liExprRow
79442>>>>> if (liExprRow<>-1) set piExprRow to (pbCleanupNewRow.i(oQuery_ExprArray(self),liExprRow))
79445>>>>> end_procedure
79446>>>>> register_object oGrp
79446>>>>> procedure DoCritExpression
79449>>>>> integer lbOk liExprRow lhExprArr
79449>>>>> string lsExpression
79449>>>>> move (oQuery_ExprArray(self)) to lhExprArr
79450>>>>> get piExprRow to liExprRow
79451>>>>> if (liExprRow=-1) begin
79453>>>>> get row_count of lhExprArr to liExprRow
79454>>>>> set psLongLabel.i of lhExprArr liExprRow to (replace(":",t.DfQuery.SelectionCrit,""))
79455>>>>> set psLabel.i of lhExprArr liExprRow to (replace(":",t.DfQuery.SelectionCrit,""))
79456>>>>> set piType.i of lhExprArr liExprRow to DF_BCD
79457>>>>> set psExpression.i of lhExprArr liExprRow to ""
79458>>>>> end
79458>>>>>>
79458>>>>> get psExpression.i of lhExprArr liExprRow to lsExpression
79459>>>>>
79459>>>>> send DoInformExpressionThingAboutAllowedTables to (oDBMS_Files(oTab1(oTabs(self))))
79460>>>>>
79460>>>>> get iPopup.sis of (Query_EditCriteriaExpression(self)) lsExpression TYPE.INTEGER t.DfQuery.SelCritExpr to lbOk
79461>>>>> if (lbOk<>-1) begin
79463>>>>> get psExpression of (Query_EditCriteriaExpression(self)) to lsExpression
79464>>>>> move (trim(Text_CompressSubstCr(lsExpression,""))) to lsExpression
79465>>>>> if (lsExpression<>"") begin
79467>>>>> set psExpression.i of lhExprArr liExprRow to lsExpression
79468>>>>> set piExprRow to liExprRow
79469>>>>> end
79469>>>>>>
79469>>>>> else set piExprRow to -1
79471>>>>> end
79471>>>>>>
79471>>>>> send UpdateExpressionIndicatorText to (oGrp(self))
79472>>>>> end_procedure
79473>>>>>
79473>>>>> object oGrp is a aps.Group label t.DfQuery.LblGrpCrit snap SL_RIGHT relative_to (oDBMS_Files(self))
79482>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
79483>>>>> object oCritDialogArray is a cArray
79485>>>>> property integer pDisplayLocked public 0
79487>>>>> property integer pFieldRowsPerTab public 4
79489>>>>> item_property_list
79489>>>>> item_property string psLabel.i
79489>>>>> item_property integer piMargin.i
79489>>>>> item_property integer piType.i // Field type
79489>>>>> item_property integer piComp.i // Comparator
79489>>>>> item_property string psVal1.i
79489>>>>> item_property string psVal2.i
79489>>>>> item_property integer piFile.i
79489>>>>> item_property integer piField.i
79489>>>>> end_item_property_list
#REM 79544 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 79549 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 79554 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 79559 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
#REM 79564 DEFINE FUNCTION PSVAL2.I INTEGER LIROW RETURNS STRING
#REM 79569 DEFINE PROCEDURE SET PSVAL2.I INTEGER LIROW STRING VALUE
#REM 79574 DEFINE FUNCTION PSVAL1.I INTEGER LIROW RETURNS STRING
#REM 79579 DEFINE PROCEDURE SET PSVAL1.I INTEGER LIROW STRING VALUE
#REM 79584 DEFINE FUNCTION PICOMP.I INTEGER LIROW RETURNS INTEGER
#REM 79589 DEFINE PROCEDURE SET PICOMP.I INTEGER LIROW INTEGER VALUE
#REM 79594 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 79599 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 79604 DEFINE FUNCTION PIMARGIN.I INTEGER LIROW RETURNS INTEGER
#REM 79609 DEFINE PROCEDURE SET PIMARGIN.I INTEGER LIROW INTEGER VALUE
#REM 79614 DEFINE FUNCTION PSLABEL.I INTEGER LIROW RETURNS STRING
#REM 79619 DEFINE PROCEDURE SET PSLABEL.I INTEGER LIROW STRING VALUE
79625>>>>> procedure add_crit_and_value string label# integer mrg# integer type# integer comp# string val1# string val2# integer file# integer field#
79628>>>>> integer row#
79628>>>>> get row_count to row#
79629>>>>> set psLabel.i item row# to label#
79630>>>>> set piMargin.i item row# to mrg#
79631>>>>> set piType.i item row# to type#
79632>>>>> set piComp.i item row# to comp#
79633>>>>> set psVal1.i item row# to val1#
79634>>>>> set psVal2.i item row# to val2#
79635>>>>> set piFile.i item row# to file#
79636>>>>> set piField.i item row# to field#
79637>>>>> end_procedure
79638>>>>> end_object
79639>>>>>
79639>>>>> set p_auto_column to 0
79640>>>>> object oGrd is a aps.Grid
79642>>>>> set peResizeColumn to rcAll
79643>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
79644>>>>> if giVdfQuery_Expressions_State set Size to 87 0
79647>>>>> else set Size to 100 0
79649>>>>> set Line_Width to 3 0
79650>>>>> set Form_Margin item 0 to 20
79651>>>>> set Form_Margin item 1 to 2
79652>>>>> set Form_Margin item 2 to 20
79653>>>>> set Form_Datatype item 0 to ascii_window
79654>>>>> set Form_Datatype item 1 to ascii_window
79655>>>>> set Form_Datatype item 2 to ascii_window
79656>>>>> set Header_Label item 0 to t.DfQuery.LblGrdCrit0
79657>>>>> set Header_Label item 1 to t.DfQuery.LblGrdCrit1
79658>>>>> set Header_Label item 2 to t.DfQuery.LblGrdCrit2
79659>>>>> set Status_Help item 0 to t.DfQuery.SthGrdCrit0
79660>>>>> set Status_Help item 1 to t.DfQuery.SthGrdCrit1
79661>>>>> set Status_Help item 2 to t.DfQuery.SthGrdCrit2
79662>>>>> set Highlight_Row_State to true
79663>>>>>// set Highlight_Row_Color to (rgb(0,255,255))
79663>>>>> set CurrentCellColor to clHighlight
79664>>>>> set CurrentCellTextColor to clHighlightText
79665>>>>> set CurrentRowColor to clHighlight
79666>>>>> set CurrentRowTextColor to clHighlightText
79667>>>>>
79667>>>>>
79667>>>>> set Select_Mode to MULTI_SELECT
79668>>>>> set Auto_Top_Item_State to false
79669>>>>> on_key kdelete_record send delete_row
79670>>>>> on_key kswitch send switch
79671>>>>> on_key kswitch_back send switch_back
79672>>>>>
79672>>>>> function row_count returns integer
79675>>>>> function_return (item_count(self)/3)
79676>>>>> end_function
79677>>>>>
79677>>>>> procedure load_report_info // Selection criteria
79680>>>>> integer row# max# oDSV# file# fld# comp# critidx# newcomp#
79680>>>>> integer lbError liExprRow lhExprArr
79680>>>>> string val1# val2#
79680>>>>> move (oDefault_Selection_Values(self)) to oDSV#
79681>>>>> get row_count to max#
79682>>>>>
79682>>>>> for row# from 0 to (max#-1)
79688>>>>>>
79688>>>>> get row_file row# to file#
79689>>>>> get row_field row# to fld#
79690>>>>> get row_crit row# to critidx#
79691>>>>> get row_comp row# to comp#
79692>>>>> get qry_crit_val1 of oDSV# critidx# to val1#
79693>>>>> get qry_crit_val2 of oDSV# critidx# to val2#
79694>>>>>
79694>>>>> if comp# eq SC_COMP_OR_LIST begin // or-list
79696>>>>> send add_criteria_orlist to oReport_info# file# fld# val1#
79697>>>>> send add_criteria_text to oReport_info# (value(self,row#*3+0)) comp# (replaces("|",val1#,"; "))
79698>>>>> end
79698>>>>>>
79698>>>>> else begin
79699>>>>> send add_criteria_simple to oReport_info# file# fld# comp# val1# val2#
79700>>>>> send add_criteria_text to oReport_info# (value(self,row#*3+0)) comp# (value(self,row#*3+2))
79701>>>>> end
79701>>>>>>
79701>>>>> loop
79702>>>>>>
79702>>>>>
79702>>>>> get piExprRow to liExprRow
79703>>>>> if (liExprRow<>-1) begin
79705>>>>> move (oQuery_ExprArray(self)) to lhExprArr
79706>>>>> send add_criteria_boolean_expr to oReport_info# (piExprId.i(lhExprArr,liExprRow))
79707>>>>> send add_criteria_text to oReport_info# "" -1 (psExpression.i(lhExprArr,liExprRow))
79708>>>>> end
79708>>>>>>
79708>>>>>
79708>>>>> // liExprRow lhExprArr
79708>>>>> //
79708>>>>> // send DoInformExpressionThingAboutAllowedTables to (oDBMS_Files(oTab1(self)))
79708>>>>> //
79708>>>>> // get psExpression to lsExpression
79708>>>>> // get sPrepareExpression.s of (Query_ExprParser(self)) lsExpression to lsExpression
79708>>>>> // if (trim(lsExpression)<>"") begin
79708>>>>> // get iParse_Expr.s of (Query_ExprParser(self)) lsExpression to lbError
79708>>>>> // // If lbError is not 0 we have to abort the query!!!
79708>>>>> // get piExprID of (Query_ExprParser(self)) to liExprId
79708>>>>> // send add_criteria_boolean_expr to oReport_info# liExprId
79708>>>>> // // send add_criteria_text to oReport_info# (value(self,row#*3+0)) comp# (value(self,row#*3+2))
79708>>>>> // end
79708>>>>> end_procedure
79709>>>>> function base_item returns integer
79712>>>>> integer itm#
79712>>>>> get current_item to itm#
79713>>>>> function_return ((itm#/3)*3)
79714>>>>> end_function
79715>>>>> register_procedure do_one_value
79715>>>>> procedure add_row
79718>>>>> integer base#
79718>>>>> get item_count to base#
79719>>>>> set dynamic_update_state to false
79720>>>>> send add_item msg_none ""
79721>>>>> send add_item msg_none ""
79722>>>>> send add_item msg_do_one_value ""
79723>>>>> set dynamic_update_state to true
79724>>>>> end_procedure
79725>>>>> procedure insert_row
79728>>>>> integer base#
79728>>>>> if (item_count(self)) begin
79730>>>>> get base_item to base#
79731>>>>> set dynamic_update_state to false
79732>>>>> send insert_item 0 "" base#
79733>>>>> send insert_item 0 "" base#
79734>>>>> send insert_item 0 "" base#
79735>>>>> set dynamic_update_state to true
79736>>>>> end
79736>>>>>>
79736>>>>> else send add_row
79738>>>>> end_procedure
79739>>>>> procedure delete_row
79742>>>>> integer base#
79742>>>>> if (item_count(self)) begin
79744>>>>> get base_item to base#
79745>>>>> set dynamic_update_state to false
79746>>>>> send delete_item base#
79747>>>>> send delete_item base#
79748>>>>> send delete_item base#
79749>>>>> set dynamic_update_state to true
79750>>>>> end
79750>>>>>>
79750>>>>> end_procedure
79751>>>>> procedure do_field integer file# integer field# integer base#
79754>>>>> integer fieldtype# comp# type# obj#
79754>>>>>
79754>>>>> set aux_value item base# to (file#*65536+field#)
79755>>>>>
79755>>>>> set value item base# to (FieldInf_FieldLabel_Long(file#,field#))
79756>>>>> set item_shadow_state item (base#+1) to true
79757>>>>> set item_shadow_state item (base#+2) to true
79758>>>>> set dynamic_update_state to true // Force update
79759>>>>>
79759>>>>> move (FieldInf_FieldType(file#,field#)) to fieldtype#
79760>>>>>
79760>>>>> get VdfQuery_SelectCompMode fieldtype# 0 to comp#
79761>>>>>
79761>>>>> set value item (base#+1) to (DfQuery_CompModeTxt_Short(comp#))
79762>>>>> set aux_value item (base#+1) to comp#
79763>>>>>
79763>>>>> if fieldtype# eq DF_ASCII move ascii_window to type#
79766>>>>> else begin
79767>>>>> if fieldtype# eq DF_DATE move date_window to type#
79770>>>>> else begin
79771>>>>> if fieldtype# eq DF_TEXT move ascii_window to type#
79774>>>>> else move 0 to type#
79776>>>>> end
79776>>>>>>
79776>>>>> end
79776>>>>>>
79776>>>>> set value item (base#+2) to (DfQuery_CritText(self,type#,comp#,"",""))
79777>>>>>
79777>>>>> set dynamic_update_state to true
79778>>>>> set current_item to (base#+2)
79779>>>>> end_procedure
79780>>>>>
79780>>>>> procedure add_field integer file# integer field#
79783>>>>> integer base#
79783>>>>> get item_count to base#
79784>>>>> send add_row
79785>>>>> set dynamic_update_state to true
79786>>>>> send do_field file# field# base#
79787>>>>> end_procedure
79788>>>>>
79788>>>>> procedure insert_field integer file# integer field#
79791>>>>> integer base#
79791>>>>> get base_item to base#
79792>>>>> send insert_row
79793>>>>> set dynamic_update_state to true
79794>>>>> send do_field file# field# base#
79795>>>>> send key kuparrow
79796>>>>> end_procedure
79797>>>>>
79797>>>>> function row_file integer row# returns integer
79800>>>>> function_return (hi(integer(aux_value(self,row#*3))))
79801>>>>> end_function
79802>>>>> function row_field integer row# returns integer
79805>>>>> function_return (low(integer(aux_value(self,row#*3))))
79806>>>>> end_function
79807>>>>> function row_field_type integer row# returns integer
79810>>>>> integer file# field# fieldtype#
79810>>>>> get row_file row# to file#
79811>>>>> get row_field row# to field#
79812>>>>> move (FieldInf_FieldType(file#,field#)) to fieldtype#
79813>>>>> function_return fieldtype#
79814>>>>> end_function
79815>>>>> function row_label integer row# returns string
79818>>>>> function_return (value(self,row#*3))
79819>>>>> end_function
79820>>>>> function row_crit integer row# returns integer
79823>>>>> function_return (aux_value(self,row#*3+2))
79824>>>>> end_function
79825>>>>> function row_form_margin integer row# returns integer
79828>>>>> integer file# field# rval#
79828>>>>> get row_file row# to file#
79829>>>>> get row_field row# to field#
79830>>>>> get VdfQuery_field_margin file# field# to rval#
79831>>>>> function_return rval#
79832>>>>> end_function
79833>>>>> function row_comp integer row# returns integer
79836>>>>> function_return (aux_value(self,row#*3+1))
79837>>>>> end_function
79838>>>>>
79838>>>>> procedure OnChangeMainFile
79841>>>>> send delete_data
79842>>>>> end_procedure
79843>>>>>
79843>>>>> //procedure DoDisplayArrayValues
79843>>>>> // send debug_display_array (oDefault_Selection_Values(self))
79843>>>>> //end_procedure
79843>>>>> //on_key kuser send DoDisplayArrayValues
79843>>>>>
79843>>>>> procedure add_criteria_to_CritDialogArray integer row#
79846>>>>> integer arr# obj# crit# base# type# comp# mrg# lock# cr#
79846>>>>> integer file# field#
79846>>>>> string val1# val2# label#
79846>>>>> move (oCritDialogArray(self)) to arr#
79847>>>>> move (oDefault_Selection_Values(self)) to obj#
79848>>>>> get row_crit row# to crit#
79849>>>>> if crit# begin
79851>>>>> get qry_crit_val1 of obj# crit# to val1#
79852>>>>> get qry_crit_val2 of obj# crit# to val2#
79853>>>>> end
79853>>>>>>
79853>>>>> get row_label row# to label#
79854>>>>> get row_form_margin row# to mrg#
79855>>>>> get row_field_type row# to type#
79856>>>>> get row_comp row# to comp#
79857>>>>> get row_file row# to file#
79858>>>>> get row_field row# to field#
79859>>>>>
79859>>>>> if type# eq DF_ASCII move ASCII_WINDOW to type#
79862>>>>> else begin
79863>>>>> if type# eq DF_DATE move DATE_WINDOW to type#
79866>>>>> else begin
79867>>>>> if type# eq DF_TEXT move ASCII_WINDOW to type#
79870>>>>> else get FieldInf_DecPoints file# field# to type#
79872>>>>> end
79872>>>>>>
79872>>>>> end
79872>>>>>>
79872>>>>> send add_crit_and_value to arr# label# mrg# type# comp# val1# val2# file# field#
79873>>>>> end_procedure
79874>>>>>
79874>>>>> procedure do_one_value
79877>>>>> integer obj# crit# base# row# type# comp# mrg# CritDialogArr# liFile liField
79877>>>>> string val1# val2# label#
79877>>>>> if (item_count(self)) begin
79879>>>>> move (oDefault_Selection_Values(self)) to obj#
79880>>>>> move (oCritDialogArray(self)) to CritDialogArr#
79881>>>>> get base_item to base#
79882>>>>> move (base#/3) to row#
79883>>>>> send delete_data to CritDialogArr#
79884>>>>> send add_criteria_to_CritDialogArray row#
79885>>>>> get psLabel.i of CritDialogArr# item 0 to label#
79886>>>>> get piMargin.i of CritDialogArr# item 0 to mrg#
79887>>>>> get piType.i of CritDialogArr# item 0 to type#
79888>>>>> get piComp.i of CritDialogArr# item 0 to comp#
79889>>>>> get psVal1.i of CritDialogArr# item 0 to val1#
79890>>>>> get psVal2.i of CritDialogArr# item 0 to val2#
79891>>>>> get piFile.i of CritDialogArr# item 0 to liFile
79892>>>>> get piField.i of CritDialogArr# item 0 to liField
79893>>>>> // label# mrg# type# comp# val1# val2#
79893>>>>> CREATE_OBJECT_GROUP OG_QuerySingleCrit PARENT (parent(aps_PanelID(self))) (label#+":") mrg# type# comp# val1# val2# liFile liField
79910>>>>> send popup_modal to OG_Current_Object#
79911>>>>>
79911>>>>> if (pReturnValue(OG_Current_Object#)) begin
79913>>>>> if (pReturnValue(OG_Current_Object#)) eq 1 begin
79915>>>>> get value_from of OG_Current_Object# to val1#
79916>>>>> get value_to of OG_Current_Object# to val2#
79917>>>>> get row_crit row# to crit#
79918>>>>> ifnot crit# get qry_new_criteria of obj# to crit#
79921>>>>> send qry_change_criteria to obj# crit# val1# val2#
79922>>>>> set aux_value item (base#+2) to crit#
79923>>>>> set value item (base#+2) to (DfQuery_CritText(self,type#,comp#,val1#,val2#))
79924>>>>> end
79924>>>>>>
79924>>>>> else begin // reset
79925>>>>> set aux_value item (base#+2) to 0
79926>>>>> set value item (base#+2) to ""
79927>>>>> end
79927>>>>>>
79927>>>>> end
79927>>>>>>
79927>>>>> set dynamic_update_state to true
79928>>>>> send request_destroy_object to OG_Current_Object#
79929>>>>> end
79929>>>>>>
79929>>>>> end_procedure
79930>>>>>
79930>>>>> procedure load_global_crit_array
79933>>>>> integer row# CritDialogArr# max#
79933>>>>> move (oCritDialogArray(self)) to CritDialogArr#
79934>>>>> send delete_data to CritDialogArr#
79935>>>>>
79935>>>>> get item_count to max#
79936>>>>> move (max#/3) to max#
79937>>>>> for row# from 0 to (max#-1)
79943>>>>>>
79943>>>>> send add_criteria_to_CritDialogArray row#
79944>>>>> loop
79945>>>>>>
79945>>>>> end_procedure
79946>>>>>
79946>>>>> procedure do_all_values
79949>>>>> integer CritDialogArr# max# oDefault_Selection_Values# crit# row#
79949>>>>> integer base# comp# type#
79949>>>>> string val1# val2#
79949>>>>> send load_global_crit_array
79950>>>>> move (oDefault_Selection_Values(self)) to oDefault_Selection_Values#
79951>>>>> move (oCritDialogArray(self)) to CritDialogArr#
79952>>>>> CREATE_OBJECT_GROUP OG_QuerySelectDialog PARENT (parent(aps_PanelID(self))) (report_title(self)) CritDialogArr#
79963>>>>> send popup_modal to OG_Current_Object#
79964>>>>> if (pReturnValue(OG_Current_Object#)) begin
79966>>>>> // User pressed OK. Let's get our values back:
79966>>>>> get row_count of CritDialogArr# to max#
79967>>>>> for row# from 0 to (max#-1)
79973>>>>>>
79973>>>>> move (row#*3) to base#
79974>>>>> get row_crit row# to crit#
79975>>>>> ifnot crit# get qry_new_criteria of oDefault_Selection_Values# to crit#
79978>>>>> set aux_value item (base#+2) to crit#
79979>>>>> move (psVal1.i(CritDialogArr#,row#)) to val1#
79980>>>>> move (psVal2.i(CritDialogArr#,row#)) to val2#
79981>>>>> move (piType.i(CritDialogArr#,row#)) to Type#
79982>>>>> move (piComp.i(CritDialogArr#,row#)) to Comp#
79983>>>>> send qry_change_criteria to oDefault_Selection_Values# crit# val1# val2#
79984>>>>> set value item (base#+2) to (DfQuery_CritText(self,type#,comp#,val1#,val2#))
79985>>>>> loop
79986>>>>>>
79986>>>>> end
79986>>>>>>
79986>>>>> send request_destroy_object to OG_Current_Object#
79987>>>>> end_procedure
79988>>>>>
79988>>>>> Procedure Header_Mouse_Click Integer Item#
79991>>>>> integer comp# base# fieldtype#
79991>>>>> forward send Header_Mouse_Click Item#
79993>>>>> if (item_count(self)) begin
79995>>>>> if item# eq 1 begin
79997>>>>> get base_item to base#
79998>>>>> get aux_value item (base#+1) to comp#
79999>>>>> get row_field_type (base#/3) to fieldtype#
80000>>>>> get VdfQuery_SelectCompMode fieldtype# comp# to comp#
80001>>>>> set aux_value item (base#+1) to comp#
80002>>>>> set value item (base#+1) to (DfQuery_CompModeTxt_Short(comp#))
80003>>>>> end
80003>>>>>>
80003>>>>> if item# eq 2 send do_one_value
80006>>>>> end
80006>>>>>>
80006>>>>> end_procedure
80007>>>>> procedure Request_Header_Mouse_Click
80010>>>>> integer base#
80010>>>>> get base_item to base#
80011>>>>> send Header_Mouse_Click (current_item(self)-base#)
80012>>>>> end_procedure
80013>>>>> on_key kprompt send Request_Header_Mouse_Click
80014>>>>> on_key kenter send Request_Header_Mouse_Click
80015>>>>> end_object // oGrd
80016>>>>> send aps_goto_max_row
80017>>>>> if giVdfQuery_Expressions_State begin
80019>>>>> object oExpressionIndicator is a Form
80021>>>>> set peAnchors to (anLeft+anBottom)
80022>>>>> set size to 10 100
80023>>>>> set TextColor to clBlue
80024>>>>> set Enabled_State to False
80025>>>>> set Form_Border item 0 to Border_None
80026>>>>> end_object
80027>>>>> send aps_auto_locate_control (oExpressionIndicator(self))
80028>>>>> send aps_align_by_sizing (oExpressionIndicator(self)) (oGrd(self)) SL_ALIGN_RIGHT
80029>>>>> end
80029>>>>>>
80029>>>>> procedure UpdateExpressionIndicatorText
80032>>>>> integer liExprRow
80032>>>>> if giVdfQuery_Expressions_State begin
80034>>>>> get piExprRow to liExprRow
80035>>>>> if (liExprRow<>-1) set value of (oExpressionIndicator(self)) to t.DfQuery.ExprCritAdded
80038>>>>> else set value of (oExpressionIndicator(self)) to ""
80040>>>>> end
80040>>>>>>
80040>>>>> end_procedure
80041>>>>>
80041>>>>> set multi_button_size to 14 40
80042>>>>> object oBtn1 is a aps.Multi_Button
80044>>>>> set peAnchors to (anRight+anBottom)
80045>>>>> on_item t.DfQuery.LblAddField send do_add_field
80046>>>>> end_object
80047>>>>> object oBtn2 is a aps.Multi_Button
80049>>>>> set peAnchors to (anRight+anBottom)
80050>>>>> on_item t.DfQuery.LblInsertField send do_insert_field
80051>>>>> end_object
80052>>>>> object oBtn3 is a aps.Multi_Button
80054>>>>> set peAnchors to (anRight+anBottom)
80055>>>>> on_item t.DfQuery.LblDeleteField send delete_row to (oGrd(self))
80056>>>>> end_object
80057>>>>> if giVdfQuery_Expressions_State begin
80059>>>>> object oBtn4 is a aps.Multi_Button
80061>>>>> set peAnchors to (anRight+anBottom)
80062>>>>> on_item t.DfQuery.Expression send DoCritExpression
80063>>>>> end_object
80064>>>>> end
80064>>>>>>
80064>>>>> object oBtn5 is a aps.Multi_Button
80066>>>>> set peAnchors to (anRight+anBottom)
80067>>>>> set multi_button_size to 14 50
80068>>>>> on_item t.DfQuery.LblDefaultValue send do_all_values to (oGrd(self))
80069>>>>> end_object
80070>>>>> send aps_locate_multi_buttons
80071>>>>> end_object
80072>>>>> procedure do_add_field
80075>>>>> integer file# field#
80075>>>>> get current_aux of (oDBMS_Files(self)) to file#
80076>>>>> get current_aux of (oDBMS_Fields(self)) to field#
80077>>>>> send add_field to (oGrd(oGrp(self))) file# field#
80078>>>>> send activate to (oGrd(oGrp(self)))
80079>>>>> end_procedure
80080>>>>> procedure do_insert_field
80083>>>>> integer file# field#
80083>>>>> get current_aux of (oDBMS_Files(self)) to file#
80084>>>>> get current_aux of (oDBMS_Fields(self)) to field#
80085>>>>> send insert_field to (oGrd(oGrp(self))) file# field#
80086>>>>> send activate to (oGrd(oGrp(self)))
80087>>>>> end_procedure
80088>>>>> end_object
80089>>>>> object oTab3 is a aps.TabPage label t.DfQuery.LblTab3
80092>>>>> set p_auto_column to 1
80093>>>>>
80093>>>>> object oFrm is a vdq.ComboFormAux label t.DfQuery.LblPrintOrder abstract aft_ascii50
80097>>>>> set peAnchors to (anTop+anLeft+anRight)
80098>>>>> set entry_state item 0 to false
80099>>>>> set combo_sort_state to false
80100>>>>> on_key kswitch_back send activate to (oTitle(self))
80101>>>>> send aps_tab_column_define 1 60 55 jmode_right
80102>>>>> procedure OnChangeMainFile
80105>>>>> integer obj# idx# forced_index# row# max#
80105>>>>> string str# default_index#
80105>>>>> move (oVdfQuery_IndexAnalyzer(self)) to obj#
80106>>>>> send read_file_definition to obj# (pMainfile(self))
80107>>>>> send idx_translate_overlaps_all to obj#
80108>>>>> move (og_param(1)) to forced_index#
80109>>>>> if forced_index# ge 0 begin
80111>>>>> get idx_field_names of obj# forced_index# 1 0 to default_index#
80112>>>>> set pOrdering to forced_index#
80113>>>>> end
80113>>>>>>
80113>>>>>
80113>>>>> move "" to default_index#
80114>>>>> send Combo_Delete_Data
80115>>>>> send combo_add_item "Recnum" 0
80116>>>>> for idx# from 1 to 15
80122>>>>>>
80122>>>>> get idx_field_names of obj# idx# 1 0 to str#
80123>>>>> if str# ne "" begin
80125>>>>> send combo_add_item str# idx#
80126>>>>> if default_index# eq "" begin
80128>>>>> move str# to default_index#
80129>>>>> set pOrdering to idx#
80130>>>>> end
80130>>>>>>
80130>>>>> end
80130>>>>>>
80130>>>>> loop
80131>>>>>>
80131>>>>>
80131>>>>> get FieldInf_VirtualIndices_Object (pMainFile(self)) to obj#
80132>>>>> if obj# begin
80134>>>>> get row_count of obj# to max#
80135>>>>> for idx# from 0 to (max#-1)
80141>>>>>>
80141>>>>> send combo_add_item (psIndexName.i(obj#,idx#)) (idx#+256)
80142>>>>> loop
80143>>>>>>
80143>>>>> end
80143>>>>>>
80143>>>>> send combo_add_item "Ad hoc index" 1023
80144>>>>>
80144>>>>> if default_index# ne "" set value item 0 to default_index#
80147>>>>> else set value item 0 to "Recnum"
80149>>>>> end_procedure
80150>>>>> procedure OnChange
80153>>>>> integer idx#
80153>>>>> get Combo_Current_Aux_Value to idx#
80154>>>>> set pOrdering to idx#
80155>>>>> send fill_break_list
80156>>>>> end_procedure
80157>>>>> end_object
80158>>>>> object oAdHoc is a aps.Button snap SL_RIGHT_SPACE
80161>>>>> set peAnchors to (anTop+anRight)
80162>>>>> set size to 14 40
80163>>>>> on_item "Ad hoc" send DoAdHoc
80164>>>>> end_object
80165>>>>> procedure DoAdHoc
80168>>>>> integer lhQueryOrderExpression liFile liRval
80168>>>>> move (oQueryOrderExpression(self)) to lhQueryOrderExpression
80169>>>>> get pMainFile to liFile
80170>>>>> get iPopup.ii of (oQueryDefineAdhocIndexPn(self)) liFile lhQueryOrderExpression to liRval
80171>>>>> if liRval send fill_break_list
80174>>>>> end_procedure
80175>>>>> send aps_goto_max_row
80176>>>>> send aps_make_row_space 4
80177>>>>> object oGrd is a aps.Grid
80179>>>>> set peResizeColumn to rcAll
80180>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
80181>>>>> set Size to 100 0
80182>>>>> set Line_Width to 2 0
80183>>>>> set Form_Margin item 0 to 2
80184>>>>> set Form_Margin item 1 to 30
80185>>>>> set Form_Datatype item 0 to ascii_window
80186>>>>> set Form_Datatype item 1 to ascii_window
80187>>>>> set Header_Label item 0 to t.DfQuery.LblGrdBreak1
80188>>>>> set Header_Label item 1 to t.DfQuery.LblGrdBreak2
80189>>>>> set Status_Help item 0 to t.DfQuery.SthGrdBreak0
80190>>>>> set Status_Help item 1 to t.DfQuery.SthGrdBreak1
80191>>>>> set Highlight_Row_State to DFTRUE
80192>>>>> //set Highlight_Row_Color to (rgb(0,255,255))
80192>>>>> set CurrentCellColor to clHighlight
80193>>>>> set CurrentCellTextColor to clHighlightText
80194>>>>> set CurrentRowColor to clHighlight
80195>>>>> set CurrentRowTextColor to clHighlightText
80196>>>>>
80196>>>>>
80196>>>>> set Select_Mode to multi_select
80197>>>>> set Auto_Top_Item_State to DFFALSE
80198>>>>> on_key kswitch send switch
80199>>>>> on_key kswitch_back send switch_back
80200>>>>> procedure fill_list
80203>>>>> integer idx# seg# max# obj# field# file# base#
80203>>>>> move (oVdfQuery_IndexAnalyzer(self)) to obj#
80204>>>>> send delete_data
80205>>>>> get pMainFile to file#
80206>>>>> set dynamic_update_state to DFFALSE
80207>>>>> get pOrdering to idx#
80208>>>>> if idx# lt 256 begin
80210>>>>> get idx_max_segment of obj# idx# to max#
80211>>>>> for seg# from 1 to (max#-1) // Exclude the least significant segment
80217>>>>>>
80217>>>>> get idx_segment of obj# idx# seg# to field#
80218>>>>> get item_count to base#
80219>>>>> send add_item MSG_none ""
80220>>>>> set aux_value item base# to (file#*65536+field#)
80221>>>>> set checkbox_item_state item base# to DFTRUE
80222>>>>> send add_item MSG_none (FieldInf_FieldLabel_Long(file#,field#)+": ")
80223>>>>> loop
80224>>>>>>
80224>>>>> end
80224>>>>>>
80224>>>>> else begin
80225>>>>> if (idx#=1023) begin // Ad hoc
80227>>>>> move (oQueryOrderExpression(self)) to obj#
80228>>>>> get row_count of obj# to max#
80229>>>>> for seg# from 0 to (max#-1) // Do not exclude the least significant segment
80235>>>>>>
80235>>>>> get piFile.i of obj# seg# to file#
80236>>>>> get piField.i of obj# seg# to field#
80237>>>>> get item_count to base#
80238>>>>> send add_item msg_none ""
80239>>>>> set aux_value item base# to (file#*65536+field#)
80240>>>>> set checkbox_item_state item base# to DFTRUE
80241>>>>> send add_item msg_none (sSegmentName(obj#,seg#)+": ")
80242>>>>> loop
80243>>>>>>
80243>>>>> end
80243>>>>>>
80243>>>>> else begin
80244>>>>> move (idx#-256) to idx#
80245>>>>> get FieldInf_VirtualIndex_Object file# idx# to obj#
80246>>>>> if obj# begin
80248>>>>> get row_count of obj# to max#
80249>>>>> for seg# from 0 to (max#-2) // Exclude the least significant segment
80255>>>>>>
80255>>>>> get piField.i of obj# seg# to field#
80256>>>>> get item_count to base#
80257>>>>> send add_item msg_none ""
80258>>>>> set aux_value item base# to (file#*65536+field#)
80259>>>>> set checkbox_item_state item base# to DFTRUE
80260>>>>> send add_item msg_none (sSegmentName(obj#,seg#)+": ")
80261>>>>> loop
80262>>>>>>
80262>>>>> end
80262>>>>>>
80262>>>>> end
80262>>>>>>
80262>>>>> end
80262>>>>>>
80262>>>>> set dynamic_update_state to DFTRUE
80263>>>>> end_procedure
80264>>>>> procedure OnChangeMainFile
80267>>>>> set object_shadow_state of (oAdHoc(self)) to DFTRUE
80268>>>>> send fill_list
80269>>>>> end_procedure
80270>>>>> end_object
80271>>>>> send aps_goto_max_row
80272>>>>> send aps_make_row_space 4
80273>>>>> object oFrm2 is a vdq.ComboFormAux label t.DfQuery.LblSearchOrder abstract aft_ascii50
80277>>>>> set peAnchors to (anLeft+anRight+anBottom)
80278>>>>> set entry_state item 0 to false
80279>>>>> set combo_sort_state to false
80280>>>>> send aps_tab_column_define 1 60 55 jmode_right
80281>>>>> procedure OnChangeMainFile
80284>>>>> integer obj# idx# forced_index# row# max#
80284>>>>> string str# default_index#
80284>>>>> move (oVdfQuery_IndexAnalyzer(self)) to obj#
80285>>>>> send read_file_definition to obj# (pMainfile(self))
80286>>>>> send idx_translate_overlaps_all to obj#
80287>>>>> move (og_param(1)) to forced_index#
80288>>>>> if forced_index# ge 0 begin
80290>>>>> get idx_field_names of obj# forced_index# 1 0 to default_index#
80291>>>>> set pOrdering to forced_index#
80292>>>>> end
80292>>>>>>
80292>>>>>
80292>>>>> move "" to default_index#
80293>>>>> send Combo_Delete_Data
80294>>>>> send combo_add_item "Recnum" 0
80295>>>>> for idx# from 1 to 15
80301>>>>>>
80301>>>>> get idx_field_names of obj# idx# 1 0 to str#
80302>>>>> if str# ne "" begin
80304>>>>> send combo_add_item str# idx#
80305>>>>> if default_index# eq "" begin
80307>>>>> move str# to default_index#
80308>>>>> set pOrdering to idx#
80309>>>>> end
80309>>>>>>
80309>>>>> end
80309>>>>>>
80309>>>>> loop
80310>>>>>>
80310>>>>> if default_index# ne "" set value item 0 to default_index#
80313>>>>> else set value item 0 to "Recnum"
80315>>>>> set object_shadow_state to DFTRUE
80316>>>>> end_procedure
80317>>>>> function iIndex returns integer
80320>>>>> integer idx#
80320>>>>> get Combo_Current_Aux_Value to idx#
80321>>>>> function_return idx#
80322>>>>> end_function
80323>>>>> end_object // oFrm
80324>>>>> procedure fill_break_list
80327>>>>> integer order#
80327>>>>> get pOrdering to order#
80328>>>>> set object_shadow_state of (oFrm2(self)) to (order#<256)
80329>>>>> send fill_list to (oGrd(self))
80330>>>>> set object_shadow_state of (oAdHoc(self)) to (order#<>1023)
80331>>>>> end_procedure
80332>>>>> procedure load_report_info // Index and breaks
80335>>>>> integer row# max# itm# obj# new_max# index# file# field# lhExprArr
80335>>>>> get pMainFile to file#
80336>>>>> set pMainFile of oReport_Info# to file#
80337>>>>> move (oQuery_ExprArray(self)) to lhExprArr
80338>>>>> move (pOrdering(self)) to index#
80339>>>>> if index# ge 256 begin
80341>>>>> set pCustom_Sort_State of oReport_Info# to true
80342>>>>> if index# eq 1023 set pCustom_Sort_Object of oReport_Info# to (oQueryOrderExpression(self))
80345>>>>> else set pCustom_Sort_Object of oReport_Info# to (FieldInf_VirtualIndex_Object(file#,index#-256))
80347>>>>> set pOrdering of oReport_Info# to (iIndex(oFrm2(self)))
80348>>>>> end
80348>>>>>>
80348>>>>> else begin
80349>>>>> set pCustom_Sort_State of oReport_Info# to false
80350>>>>> set pCustom_Sort_Object of oReport_Info# to 0
80351>>>>> set pOrdering of oReport_Info# to index#
80352>>>>> end
80352>>>>>>
80352>>>>> move (oGrd(self)) to obj#
80353>>>>> move (item_count(obj#)/2) to max#
80354>>>>> move -1 to new_max#
80355>>>>> for row# from 0 to (max#-1)
80361>>>>>>
80361>>>>> move (row#*2) to itm#
80362>>>>> if (select_state(obj#,itm#)) move row# to new_max#
80365>>>>> loop
80366>>>>>>
80366>>>>>
80366>>>>> for row# from 0 to new_max#
80372>>>>>>
80372>>>>> move (row#*2) to itm#
80373>>>>> get aux_value of obj# item itm# to file#
80374>>>>> move (low(file#)) to field#
80375>>>>> move (hi(file#)) to file#
80376>>>>> send define_break_level to oReport_Info# file# field# (aux_value(obj#,itm#+1)) lhExprArr (select_state(obj#,itm#)) (value(obj#,itm#+1))
80377>>>>> loop
80378>>>>>>
80378>>>>> end_procedure
80379>>>>> procedure aps_beautify
80382>>>>> send aps_align_inside_container_by_moving (oGrd(self)) SL_ALIGN_CENTER
80383>>>>> end_procedure
80384>>>>> end_object
80385>>>>> object oTab4 is a aps.TabPage label t.DfQuery.Texts
80388>>>>> set p_auto_column to 0
80389>>>>> object oLblTopText is a aps.TextBox
80391>>>>> set peAnchors to (anTop+anLeft)
80392>>>>> set fixed_size to 10 50
80393>>>>> set justification_mode to JMODE_RIGHT
80394>>>>> set label to (t.DfQuery.TextBefore+":")
80395>>>>> end_object
80396>>>>> object oEditTop is a aps.Edit
80398>>>>> set peAnchors to (anTop+anLeft+anRight)
80399>>>>> set size to 67 100
80400>>>>> end_object
80401>>>>> send aps_goto_max_row
80402>>>>> object oLblButtomText is a aps.TextBox
80404>>>>> set peAnchors to (anTop+anLeft)
80405>>>>> set fixed_size to 10 50
80406>>>>> set justification_mode to JMODE_RIGHT
80407>>>>> set label to (t.DfQuery.TextAfter+":")
80408>>>>> end_object
80409>>>>> object oEditBottom is a aps.Edit
80411>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
80412>>>>> set size to 67 100
80413>>>>> end_object
80414>>>>> procedure aps_beautify
80417>>>>> send aps_align_inside_container_by_sizing (oEditTop(self)) SL_ALIGN_RIGHT
80418>>>>> send aps_align_inside_container_by_sizing (oEditBottom(self)) SL_ALIGN_RIGHT
80419>>>>> end_procedure
80420>>>>> end_object
80421>>>>> object oTab5 is a aps.TabPage label t.DfQuery.LblTab5
80424>>>>> set p_auto_column to 1
80425>>>>> on_key kswitch_back send activate to (oTitle(self))
80426>>>>> send aps_tab_column_define 1 60 55 jmode_right
80427>>>>> send aps_tab_column_define 2 220 55 jmode_right
80428>>>>> object oFont is a aps.ComboForm label t.DfQuery.LblFont abstract aft_ascii25
80432>>>>> set combo_sort_state to false
80433>>>>> set entry_state item 0 to false
80434>>>>> send Combo_Add_Item "Arial"
80435>>>>> send Combo_Add_Item "Courier New"
80436>>>>> send Combo_Add_Item "Times New Roman"
80437>>>>> set value item 0 to "Times New Roman"
80438>>>>> set pFont to "Times New Roman"
80439>>>>> procedure OnChange
80442>>>>> string str#
80442>>>>> move (value(self,0)) to str#
80443>>>>> set pFont to str#
80444>>>>> end_procedure
80445>>>>> end_object
80446>>>>> object oFontSize is a aps.ComboForm abstract aft_numeric2.0 snap sl_right
80450>>>>> set combo_sort_state to false
80451>>>>> set entry_state item 0 to false
80452>>>>> send Combo_Add_Item "8"
80453>>>>> send Combo_Add_Item "10"
80454>>>>> send Combo_Add_Item "12"
80455>>>>> send Combo_Add_Item "14"
80456>>>>> set value item 0 to 12
80457>>>>> set pFontSize to 12
80458>>>>> procedure OnChange
80461>>>>> integer sz#
80461>>>>> move (value(self,0)) to sz#
80462>>>>> set pFontSize to sz#
80463>>>>> end_procedure
80464>>>>> end_object
80465>>>>> object oPrintCriteria is a aps.CheckBox label t.DfQuery.LblIncludeCrit
80468>>>>> set select_state item 0 to true
80469>>>>> end_object
80470>>>>> object oUseAnsiCharacters is a aps.CheckBox label t.DfQuery.UseAnsi snap 2
80474>>>>> set object_shadow_state to true
80475>>>>> end_object
80476>>>>> object oPrintTotalsOnly is a aps.CheckBox label t.DfQuery.LblPrintTotals
80479>>>>> end_object
80480>>>>> object oIncludeLabels is a aps.CheckBox label t.DfQuery.InclNames snap 2
80484>>>>> set object_shadow_state to true
80485>>>>> end_object
80486>>>>> object oOrientation is a aps.CheckBox label t.DfQuery.LblLandscape
80489>>>>> end_object
80490>>>>> object oSemiColon is a aps.CheckBox label t.DfQuery.Semicolon snap 2
80494>>>>> set object_shadow_state to true
80495>>>>> end_object
80496>>>>> set p_auto_column to 0
80497>>>>> send aps_goto_max_row
80498>>>>> object oGrp1 is a aps.Group label t.DfQuery.ReportDest
80501>>>>> set peAnchors to (anTop+anLeft+anRight)
80502>>>>> set p_auto_column to 0
80503>>>>> object oRad is a aps.RadioContainer
80505>>>>> object oRad1 is a aps.Radio label t.DfQuery.Dest_Printer
80508>>>>> end_object
80509>>>>> object oRad2 is a aps.Radio label t.DfQuery.Dest_Preview snap sl_right
80513>>>>> end_object
80514>>>>> object oRad3 is a aps.Radio label t.DfQuery.Dest_File snap sl_right
80518>>>>> end_object
80519>>>>> set current_radio to 1 // Preview
80520>>>>> procedure notify_select_state integer to# integer from#
80523>>>>> send auto_shade_objects
80524>>>>> end_procedure
80525>>>>> end_object
80526>>>>> object oFrm1 is a aps.Form snap SL_RIGHT_SPACE abstract AFT_ASCII80
80530>>>>> set peAnchors to (anTop+anLeft+anRight)
80531>>>>> set p_extra_internal_width to -250 // We don't want the form to be 80 characters wide
80532>>>>> set form_button item 0 to 1 // Manually add a prompt button
80533>>>>> set form_button_value item 0 to "..." // "
80534>>>>> set object_shadow_state to true
80535>>>>> on_key kprompt send form_button_notification
80536>>>>> procedure form_button_notification integer itm#
80539>>>>> integer obj#
80539>>>>> string str# lsStartDir
80539>>>>> move (oVdfQuery_SaveAs(self)) to obj#
80540>>>>> get Query_Folder QRYFOLD_CURRENT_USER_OUT to lsStartDir
80541>>>>> set Initial_Folder of obj# to lsStartDir
80542>>>>> if (Show_Dialog(obj#)) set value item 0 to (File_Name(obj#))
80545>>>>> end_procedure
80546>>>>> end_object
80547>>>>> object oCf1 is a vdq.ComboFormAux snap SL_RIGHT
80550>>>>> set peAnchors to (anTop+anRight)
80551>>>>> set form_margin item 0 to 12
80552>>>>> set entry_state item 0 to false
80553>>>>> send combo_add_item t.DfQuery.FileFormatCD DFQ.FORMAT.CD
80554>>>>> send combo_add_item t.DfQuery.FileFormatLD DFQ.FORMAT.LD
80555>>>>> send combo_add_item t.DfQuery.FileFormatPR DFQ.FORMAT.PRINT
80556>>>>> send combo_add_item "HTML" DFQ.FORMAT.HTML
80557>>>>> send combo_add_item "XML" DFQ.FORMAT.XML
80558>>>>> set object_shadow_state to true
80559>>>>> procedure OnChange
80562>>>>> send auto_shade_objects
80563>>>>> end_procedure
80564>>>>> end_object
80565>>>>> procedure auto_shade_objects
80568>>>>> integer rad# format# print_or_html# print_or_xml#
80568>>>>> get current_radio of (oRad(self)) to rad#
80569>>>>> move (rad#<>2) to rad# // Not file!
80570>>>>> set object_shadow_state of (oCf1(self)) to rad#
80571>>>>> set object_shadow_state of (oFrm1(self)) to rad#
80572>>>>> set object_shadow_state of (oFont(self)) to (not(rad#))
80573>>>>> set object_shadow_state of (oFontSize(self)) to (not(rad#))
80574>>>>> get Combo_Current_Aux_Value of (oCf1(self)) to format#
80575>>>>> move (format#=DFQ.FORMAT.PRINT or format#=DFQ.FORMAT.HTML) to print_or_html# //
80576>>>>> move (format#=DFQ.FORMAT.XML) to print_or_xml# //
80577>>>>> set object_shadow_state of (oPrintCriteria(self)) to (not(print_or_html# or rad#))
80578>>>>> set object_shadow_state of (oPrintTotalsOnly(self)) to (not(print_or_html# or rad#))
80579>>>>> set object_shadow_state of (oOrientation(self)) to (not(rad#)) // (not(print_or_html# or rad#))
80580>>>>> set object_shadow_state of (oUseAnsiCharacters(self)) to (rad# or (format#=DFQ.FORMAT.HTML))
80581>>>>> set object_shadow_state of (oIncludeLabels(self)) to (rad# or print_or_html# or print_or_xml#)
80582>>>>> set object_shadow_state of (oSemiColon(self)) to (rad# or not(format#=DFQ.FORMAT.CD))
80583>>>>> end_procedure
80584>>>>> end_object // oGrp1
80585>>>>> procedure load_report_info // Destination, totals only, and much more
80588>>>>> string lsOutFileName lsStartDir
80588>>>>> set pPrintCriteria of oReport_Info# to (select_state(oPrintCriteria(self),0))
80589>>>>> set pTotalsOnly of oReport_Info# to (select_state(oPrintTotalsOnly(self),0))
80590>>>>> set pLandscape of oReport_Info# to (select_state(oOrientation(self),0))
80591>>>>> set pDestination of oReport_Info# to (current_radio(oRad(oGrp1(self))))
80592>>>>> set pFileFormat of oReport_Info# to (Combo_Current_Aux_Value(oCf1(oGrp1(self))))
80593>>>>> //set pOutFileName of oReport_Info# to (value(oFrm1(oGrp1(self)),0))
80593>>>>>
80593>>>>> get value of (oFrm1(oGrp1(self))) item 0 to lsOutFileName
80594>>>>> if (lsOutFileName<>"") begin
80596>>>>> ifnot (lsOutFileName contains sysconf(SYSCONF_DIR_SEPARATOR) or lsOutFileName contains ":") begin
80598>>>>> get Query_Folder QRYFOLD_CURRENT_USER_OUT to lsStartDir
80599>>>>> if (lsStartDir<>"") get Files_AppendPath lsStartDir lsOutFileName to lsOutFileName
80602>>>>> end
80602>>>>>>
80602>>>>> end
80602>>>>>>
80602>>>>> set pOutFileName of oReport_Info# to lsOutFileName
80603>>>>>
80603>>>>> set pSemiColon of oReport_Info# to (select_state(oSemiColon(self),0))
80604>>>>> set pIncludeLabels of oReport_Info# to (select_state(oIncludeLabels(self),0))
80605>>>>> set pUseAnsiCharacters of oReport_Info# to (not(object_shadow_state(oUseAnsiCharacters(self))) and select_state(oUseAnsiCharacters(self),0))
80606>>>>> if (pFileFormat(oReport_Info#)=DFQ.FORMAT.HTML) set pUseAnsiCharacters of oReport_Info# to DFTRUE
80609>>>>> set psTextTop of oReport_Info# to (Text_EditObjectValue(oEditTop(oTab4(oTabs(self)))))
80610>>>>> set psTextBottom of oReport_Info# to (Text_EditObjectValue(oEditBottom(oTab4(oTabs(self)))))
80611>>>>> end_procedure
80612>>>>> procedure DoWinPrintSetup
80615>>>>> integer lbOk
80615>>>>> get DFPrintSetupDialog of oWinPrintReport# to lbOk
80616>>>>> end_procedure
80617>>>>>
80617>>>>> object oPrinterSelect_Button is a aps.Multi_Button
80619>>>>> set peAnchors to (anBottom+anRight)
80620>>>>> on_item t.DfQuery.Dest_Printer send DoWinPrintSetup
80621>>>>> end_object
80622>>>>> send aps_locate_multi_buttons
80623>>>>> //object oOpen_Button is a aps.Multi_Button
80623>>>>> // set peAnchors to (anBottom+anRight)
80623>>>>> // on_item t.btn.open send read_report_definition
80623>>>>> //end_object
80623>>>>> //object oSave_Button is a aps.Multi_Button
80623>>>>> // set peAnchors to (anBottom+anRight)
80623>>>>> // set object_shadow_state to (og_param(2))
80623>>>>> // on_item t.btn.save send write_report_definition
80623>>>>> //end_object
80623>>>>> //send aps_locate_multi_buttons
80623>>>>> procedure aps_beautify
80626>>>>> send aps_align_inside_container_by_sizing (oGrp1(self)) sl_align_right
80627>>>>> send aps_auto_locate_control (oPrinterSelect_Button(self)) SL_LOWER_RIGHT_CORNER
80628>>>>> // send aps_auto_locate_control (oSave_Button(self)) SL_LOWER_RIGHT_CORNER
80628>>>>> // send aps_auto_locate_control (oOpen_Button(self)) SL_LEFT (oSave_Button(self))
80628>>>>> end_procedure
80629>>>>> end_object // oTab5
80630>>>>> procedure new_main_file
80633>>>>> send OnChangeMainFile
80634>>>>> if (pMainFile(self)) begin
80636>>>>> set object_shadow_state of (oTabs(self)) to false
80637>>>>> set object_shadow_state of (oRun_Button(self)) to false
80638>>>>> send OnChangeMainFile to (oGrd(oGrp(oTab1(self))))
80639>>>>> send OnChangeMainFile to (oGrd(oGrp(oTab2(self))))
80640>>>>> send OnChangeMainFile to (oDBMS_Files(oTab1(self)))
80641>>>>> send OnChangeMainFile to (oDBMS_Files(oTab2(self)))
80642>>>>> send OnChangeMainFile to (oFrm(oTab3(self)))
80643>>>>> send OnChangeMainFile to (oFrm2(oTab3(self)))
80644>>>>> send OnChangeMainFile to (oGrd(oTab3(self)))
80645>>>>> end
80645>>>>>>
80645>>>>> else begin
80646>>>>> set object_shadow_state of (oTabs(self)) to true
80647>>>>> set object_shadow_state of (oRun_Button(self)) to true
80648>>>>> end
80648>>>>>>
80648>>>>> end_procedure
80649>>>>> function anything_to_lose returns integer
80652>>>>> integer rval#
80652>>>>> function_return 1
80653>>>>> end_function
80654>>>>> end_object // oTabs
80655>>>>>
80655>>>>> procedure Add_Field integer iFile integer iField
80658>>>>> send add_field to (oGrd(oGrp(oTab1(oTabs(self))))) iFile iField
80659>>>>> end_procedure
80660>>>>>
80660>>>>> procedure force_DD integer lhDD
80663>>>>> set phForcedDD to lhDD
80664>>>>> send DoSetFile of oMainFile (main_file(lhDD)) 1
80665>>>>> set enabled_state of oMainFile to FALSE
80666>>>>> set Button_Shadow_State of (oTab2(oTabs(self))) to TRUE
80667>>>>> set Button_Shadow_State of (oTab3(oTabs(self))) to TRUE
80668>>>>> end_procedure
80669>>>>>
80669>>>>> function report_font returns string
80672>>>>> function_return (pFont(self))
80673>>>>> end_function
80674>>>>> function report_fontsize returns integer
80677>>>>> function_return (pFontSize(self))
80678>>>>> end_function
80679>>>>>
80679>>>>> function Current_Destination returns integer
80682>>>>> function_return (current_radio(oRad(oGrp1(oTab5(oTabs(self))))))
80683>>>>> end_function
80684>>>>>
80684>>>>> function Current_FileFormat returns integer
80687>>>>> function_return (Combo_Current_Aux_Value(oCf1(oGrp1(oTab5(oTabs(self))))))
80688>>>>> end_function
80689>>>>>
80689>>>>> procedure go_tab1
80692>>>>> send Request_Switch_to_Tab to (oTabs(self)) 0 3
80693>>>>> end_procedure
80694>>>>> procedure go_tab2
80697>>>>> send Request_Switch_to_Tab to (oTabs(self)) 1 3
80698>>>>> end_procedure
80699>>>>> procedure go_tab3
80702>>>>> send Request_Switch_to_Tab to (oTabs(self)) 2 3
80703>>>>> end_procedure
80704>>>>> procedure go_Tab4
80707>>>>> send Request_Switch_to_Tab to (oTabs(self)) 3 3
80708>>>>> end_procedure
80709>>>>> procedure go_Tab5
80712>>>>> send Request_Switch_to_Tab to (oTabs(self)) 4 3
80713>>>>> end_procedure
80714>>>>>
80714>>>>> procedure DoCritValueDialog
80717>>>>> send do_all_values to (oGrd(oGrp(oTab2(oTabs(self)))))
80718>>>>> end_procedure
80719>>>>>
80719>>>>> procedure request_run_report
80722>>>>> integer lhExprArr lbInterpretOK
80722>>>>> if (pMainFile(self)) begin
80724>>>>> send reset to oReport_Info#
80725>>>>> send CleanUpExpressions // Remove expressions not used
80726>>>>>
80726>>>>> send DoInformExpressionThingAboutAllowedTables to (oDBMS_Files(oTab1(oTabs(self))))
80727>>>>> move (oQuery_ExprArray(self)) to lhExprArr
80728>>>>> get iInterpretAll of lhExprArr to lbInterpretOK
80729>>>>>
80729>>>>> if lbInterpretOK begin
80731>>>>> send load_report_info to (oGrd(oGrp(oTab1(oTabs(self)))))
80732>>>>> send load_report_info to (oGrd(oGrp(oTab2(oTabs(self)))))
80733>>>>> send load_report_info to (oTab3(oTabs(self)))
80734>>>>> send load_report_info to (oTab5(oTabs(self)))
80735>>>>> set phDataSetObject of oReport_Info# to (phForcedDD(self))
80736>>>>> send run to oReport_Info#
80737>>>>> set phDataSetObject of oReport_Info# to 0
80738>>>>> end
80738>>>>>>
80738>>>>> else send DisplayErrors to lhExprArr
80740>>>>> end
80740>>>>>>
80740>>>>> end_procedure
80741>>>>>
80741>>>>> object oRun_Button is a aps.Multi_Button
80743>>>>> set peAnchors to (anBottom+anRight)
80744>>>>> on_item t.DfQuery.Run send request_run_report
80745>>>>> end_object
80746>>>>> object oBtn2 is a aps.Multi_Button
80748>>>>> set peAnchors to (anBottom+anRight)
80749>>>>> on_item t.btn.close send close_panel
80750>>>>> end_object
80751>>>>> send aps_locate_multi_buttons
80752>>>>>
80752>>>>> procedure aps_beautify
80755>>>>> send aps_beautify to (oTab3(oTabs(self)))
80756>>>>> send aps_beautify to (oTab4(oTabs(self)))
80757>>>>> send aps_beautify to (oTab5(oTabs(self)))
80758>>>>> send aps_align_inside_container_by_moving (oToolButton(self)) sl_align_right
80759>>>>> end_procedure
80760>>>>>
80760>>>>> procedure Close_Panel
80763>>>>> forward send Close_Panel
80765>>>>> if (pDestroyOnClose(self)) send Deferred_Request_Destroy_Object
80768>>>>> end_procedure
80769>>>>>
80769>>>>> procedure Close_Query_View // Meant to be broadcasted by somebody that needs to close all queries
80772>>>>> set delegation_mode to DELEGATE_TO_PARENT
80773>>>>> send close_panel
80774>>>>> end_procedure
80775>>>>>
80775>>>>> procedure CleanUpExpressions // Remove expressions not used
80778>>>>> integer lhExprArr
80778>>>>> move (oQuery_ExprArray(self)) to lhExprArr
80779>>>>> send CleanUp_Prepare to lhExprArr
80780>>>>> send MarkUsedExpressions to (oGrd(oGrp(oTab1(oTabs(self)))))
80781>>>>> send MarkUsedExpressions to (oTab2(oTabs(self)))
80782>>>>> send MarkUsedExpressions to (oQueryOrderExpression(self))
80783>>>>> send CleanUp_CalcNewRow to lhExprArr
80784>>>>> send GetNewExpressionIDs to (oGrd(oGrp(oTab1(oTabs(self)))))
80785>>>>> send GetNewExpressionIDs to (oTab2(oTabs(self)))
80786>>>>> send GetNewExpressionIDs to (oQueryOrderExpression(self))
80787>>>>> send CleanUp_Purge to lhExprArr
80788>>>>> end_procedure
80789>>>>>
80789>>>>> procedure write_deffile_channel integer liChannel
80792>>>>> integer liFile liIndex liFontSize
80792>>>>> integer liIndex2 // 07/07/2004
80792>>>>> integer lbPrintCriteria lbTotalsOnly
80792>>>>> integer liDestination liFileFormat lhTab5 orientation# lbAnsi lbPrintLabels lbSemicolon
80792>>>>> string lsFileName lsTitle lsFont lsValue
80792>>>>> send CleanUpExpressions // Remove expressions not used
80793>>>>> move (oTab5(oTabs(self))) to lhTab5
80794>>>>> writeln channel liChannel "QDF2.0"
80797>>>>> get pMainFile to liFile
80798>>>>> get value of (oTitle(self)) item 0 to lsTitle
80799>>>>> move (Combo_Current_Aux_Value(oFrm(oTab3(oTabs(self))))) to liIndex
80800>>>>> move (Combo_Current_Aux_Value(oFrm2(oTab3(oTabs(self))))) to liIndex2 // 07/07/2004
80801>>>>> move (Value(oFont(oTab5(oTabs(self))),0)) to lsFont
80802>>>>> move (Value(oFontSize(oTab5(oTabs(self))),0)) to liFontSize
80803>>>>> move (select_state(oPrintCriteria(lhTab5),0)) to lbPrintCriteria
80804>>>>> move (select_state(oPrintTotalsOnly(lhTab5),0)) to lbTotalsOnly
80805>>>>> move (select_state(oOrientation(lhTab5),0)) to orientation#
80806>>>>> move (select_state(oUseAnsiCharacters(lhTab5),0)) to lbAnsi
80807>>>>> move (select_state(oIncludeLabels(lhTab5),0)) to lbPrintLabels
80808>>>>> move (select_state(oSemicolon(lhTab5),0)) to lbSemicolon
80809>>>>> move (current_radio(oRad(oGrp1(lhTab5)))) to liDestination
80810>>>>> move (Combo_Current_Aux_Value(oCf1(oGrp1(lhTab5)))) to liFileFormat
80811>>>>> move (value(oFrm1(oGrp1(lhTab5)),0)) to lsFileName
80812>>>>> writeln liFile
80814>>>>> writeln lsTitle
80816>>>>>// 07/07/2004
80816>>>>>// writeln liIndex
80816>>>>> if (liIndex < 256) move liIndex to liIndex2 // AdHoc is 1023, 256+ are virtual indices
80819>>>>> writeln liIndex "," liIndex2
80823>>>>>// 07/07/2004 end
80823>>>>> writeln lsFont
80825>>>>> writeln liFontSize
80827>>>>> writeln lbPrintCriteria
80829>>>>> writeln lbTotalsOnly
80831>>>>> writeln orientation#
80833>>>>> writeln lbAnsi
80835>>>>> writeln lbPrintLabels
80837>>>>> writeln lbSemicolon
80839>>>>> writeln liDestination
80841>>>>> writeln liFileFormat
80843>>>>> writeln lsFileName
80845>>>>> send SEQ_WriteGridItems liChannel (oGrd(oGrp(oTab1(oTabs(self)))))
80846>>>>> send SEQ_WriteGridItems liChannel (oGrd(oGrp(oTab2(oTabs(self)))))
80847>>>>> send SEQ_WriteArrayItems liChannel (oDefault_Selection_Values(self))
80848>>>>> send SEQ_WriteGridItems liChannel (oGrd(oTab3(oTabs(self))))
80849>>>>> move (Text_EditObjectValue(oEditTop(oTab4(oTabs(self))))) to lsValue
80850>>>>> writeln (length(lsValue))
80852>>>>> write lsValue
80853>>>>> move (Text_EditObjectValue(oEditBottom(oTab4(oTabs(self))))) to lsValue
80854>>>>> writeln (length(lsValue))
80856>>>>> write lsValue
80857>>>>> writeln (piExprRow(oTab2(oTabs(self))))
80859>>>>> send SEQ_Write to (oQuery_ExprArray(self)) liChannel
80860>>>>> send SEQ_Write to (oQueryOrderExpression(self)) liChannel
80861>>>>> end_procedure
80862>>>>>
80862>>>>> procedure Write_Report_Definition
80865>>>>> integer liChannel
80865>>>>> string lsFileName lsStartDir
80865>>>>> if giVdfQuery_OldFolders_State get Query_Folder QRYFOLD_PUBLIC_DEF to lsStartDir
80868>>>>> else get Query_Folder QRYFOLD_CURRENT_USER_DEF to lsStartDir
80870>>>>> if (lsStartDir<>"") ; get SEQ_SelectOutFileStartDir t.DfQuery.SaveFileCaption t.DfQuery.FileFilter lsStartDir to lsFileName
80873>>>>> else get SEQ_SelectOutFile t.DfQuery.SaveFileCaption t.DfQuery.FileFilter to lsFileName
80875>>>>>
80875>>>>> //move (SEQ_SelectOutFile(t.DfQuery.SaveFileCaption,t.DfQuery.FileFilter)) to lsFileName
80875>>>>> if lsFileName ne "" begin
80877>>>>> get SEQ_DirectOutput lsFileName to liChannel
80878>>>>> if (liChannel>-1) begin
80880>>>>> send write_deffile_channel liChannel
80881>>>>> send SEQ_CloseOutput liChannel
80882>>>>> end
80882>>>>>>
80882>>>>> end
80882>>>>>>
80882>>>>> end_procedure
80883>>>>>
80883>>>>> procedure load_deffile_channel integer channel#
80886>>>>> integer file# ordering# font_size# ansi# labels# len# semicolon#
80886>>>>> integer SearchOrder# // 07/07/2004
80886>>>>> integer crit_in_report# totals_only#
80886>>>>> integer liDestination file_format# oTab5# open# orientation#
80886>>>>> string title# font# str# version# fn#
80886>>>>> readln str#
80887>>>>> if (str#="QDF1.0" or str#="QDF1.1" or str#="QDF1.3" or str#="QDF1.4" or str#="QDF2.0") begin
80889>>>>> move str# to version#
80890>>>>> move (oTab5(oTabs(self))) to oTab5#
80891>>>>> readln channel channel# file#
80893>>>>> move (DBMS_IsOpenFile(file#)) to open#
80894>>>>> ifnot open# begin
80896>>>>> if (DBMS_CanOpenFile(file#)) move (DBMS_OpenFile(file#,DF_SHARE,0)) to open#
80899>>>>> else error 200 "File could not be opened"
80901>>>>> end
80901>>>>>>
80901>>>>> if open# begin
80903>>>>> set pMainFile to file#
80904>>>>> send new_main_file to (oTabs(self))
80905>>>>> readln title#
80906>>>>>// 07/07/2004
80906>>>>>// readln ordering#
80906>>>>> readln ordering# SearchOrder#
80908>>>>> if (ordering# = 1023) begin // 1023 is AdHoc index
80910>>>>> if (SearchOrder# = 0) move 1 to SearchOrder#
80913>>>>> end
80913>>>>>>
80913>>>>> if (ordering# < 256) begin // 256+ are virtual indices
80915>>>>> if (SearchOrder# = 0) move ordering# to SearchOrder#
80918>>>>> end
80918>>>>>>
80918>>>>>// 07/07/2004 end
80918>>>>> readln font# // eg Times Roman
80919>>>>> readln font_size#
80920>>>>> readln crit_in_report#
80921>>>>> readln totals_only#
80922>>>>> if version# ne "QDF1.0" readln orientation#
80925>>>>> else move 0 to orientation#
80927>>>>> if version# ge "QDF1.4" begin
80929>>>>> readln ansi#
80930>>>>> readln labels#
80931>>>>> readln semicolon#
80932>>>>> end
80932>>>>>>
80932>>>>> else begin
80933>>>>> move 0 to ansi#
80934>>>>> move 0 to labels#
80935>>>>> end
80935>>>>>>
80935>>>>> readln liDestination
80936>>>>> readln file_format#
80937>>>>> readln fn#
80938>>>>> set Combo_Current_Aux_Value of (oMainFile(self)) to file#
80939>>>>> send SEQ_ReadGridItems channel# (oGrd(oGrp(oTab1(oTabs(self)))))
80940>>>>> send SEQ_ReadGridItems channel# (oGrd(oGrp(oTab2(oTabs(self)))))
80941>>>>> send SEQ_ReadArrayItems channel# (oDefault_Selection_Values(self))
80942>>>>> set value of (oTitle(self)) item 0 to title#
80943>>>>> set Combo_Current_Aux_Value of (oFrm(oTab3(oTabs(self)))) to ordering#
80944>>>>> send OnChange to (oFrm(oTab3(oTabs(self))))
80945>>>>>// 07/07/2004
80945>>>>> set Combo_Current_Aux_Value of (oFrm2(oTab3(oTabs(self)))) to SearchOrder#
80946>>>>> send OnChange to (oFrm2(oTab3(oTabs(self))))
80947>>>>>// 07/07/2004 end
80947>>>>> set value of (oFont(oTab5#)) to font#
80948>>>>> send onchange to (oFont(oTab5#))
80949>>>>> set value of (oFontSize(oTab5#)) to font_size#
80950>>>>> send onchange to (oFontSize(oTab5#))
80951>>>>> set select_state of (oPrintCriteria(oTab5#)) item 0 to crit_in_report#
80952>>>>> set select_state of (oPrintTotalsOnly(oTab5#)) item 0 to totals_only#
80953>>>>> set select_state of (oOrientation(oTab5#)) item 0 to orientation#
80954>>>>> set select_state of (oUseAnsiCharacters(oTab5#)) item 0 to ansi#
80955>>>>> set select_state of (oIncludeLabels(oTab5#)) item 0 to labels#
80956>>>>> set select_state of (oSemiColon(oTab5#)) item 0 to semicolon#
80957>>>>> set current_radio of (oRad(oGrp1(oTab5#))) to liDestination
80958>>>>> set Combo_Current_Aux_Value of (oCf1(oGrp1(oTab5#))) to file_format#
80959>>>>> set value of (oFrm1(oGrp1(oTab5#))) item 0 to fn#
80960>>>>> send auto_shade_objects to (oGrp1(oTab5#))
80961>>>>> if version# ge "QDF1.3" send SEQ_ReadGridItems channel# (oGrd(oTab3(oTabs(self))))
80964>>>>> if version# ge "QDF2.0" begin
80966>>>>> readln len#
80967>>>>> read_block str# len#
80968>>>>> send Text_SetEditObjectValue (oEditTop(oTab4(oTabs(self)))) str#
80969>>>>> readln len#
80970>>>>> read_block str# len#
80971>>>>> send Text_SetEditObjectValue (oEditBottom(oTab4(oTabs(self)))) str#
80972>>>>> set piExprRow of (oTab2(oTabs(self))) to (SEQ_ReadLn(channel#))
80973>>>>> send SEQ_Read to (oQuery_ExprArray(self)) channel#
80974>>>>> send SEQ_Read to (oQueryOrderExpression(self)) channel#
80975>>>>>// send OnChange to (oFrm(oTab3(oTabs(self))))
80975>>>>> end
80975>>>>>>
80975>>>>> send UpdateExpressionIndicatorText to (oGrp(oTab2(oTabs(self))))
80976>>>>> end
80976>>>>>>
80976>>>>> end
80976>>>>>>
80976>>>>> else send obs t.DfQuery.IncompDefFile
80978>>>>> end_procedure
80979>>>>>
80979>>>>> procedure load_deffile string lsFileName
80982>>>>> integer liChannel
80982>>>>> if lsFileName ne "" begin
80984>>>>> get SEQ_DirectInput lsFileName to liChannel
80985>>>>> if (liChannel>=0) begin
80987>>>>> send load_deffile_channel liChannel
80988>>>>> send SEQ_CloseInput liChannel
80989>>>>> end
80989>>>>>>
80989>>>>> else send obs "Query definition file not found" ("("+lsFileName+")")
80991>>>>> end
80991>>>>>>
80991>>>>> end_procedure
80992>>>>>
80992>>>>> procedure Read_Report_Definition
80995>>>>> string lsDefFile lsStartDir
80995>>>>> if giVdfQuery_OldFolders_State get Query_Folder QRYFOLD_PUBLIC_DEF to lsStartDir
80998>>>>> else get Query_Folder QRYFOLD_CURRENT_USER_DEF to lsStartDir
81000>>>>> if (lsStartDir<>"") ; get SEQ_SelectFileStartDir t.DfQuery.OpenFileCaption t.DfQuery.FileFilter lsStartDir to lsDefFile
81003>>>>> else get SEQ_SelectFile t.DfQuery.OpenFileCaption t.DfQuery.FileFilter to lsDefFile
81005>>>>> if lsDefFile ne "" send load_deffile lsDefFile
81008>>>>> end_procedure
81009>>>>>
81009>>>>> procedure NewQuery
81012>>>>> send Activate_Query_Vw
81013>>>>> end_procedure
81014>>>>>
81014>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
81015>>>>> send new_main_file to (oTabs(self))
81016>>>>> move self to OG_Current_Object#
81017>>>>>
81017>>>>> end_object // oVDFQuery_View
81018>>>>> set piMinSize of OG_Current_Object# to (hi(size(OG_Current_Object#))) (low(size(OG_Current_Object#)))
81019>>>>>END_DEFINE_OBJECT_GROUP // OG_QueryView
81020>>>>>
81020>>>>>procedure CreateNewQuery integer tmpfile# string tmp_deffile#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
81022>>>>> integer File# Self# Client_ID#
81022>>>>> string deffile#
81022>>>>> move self to Self#
81023>>>>> move (Client_ID(Self#)) to Client_ID#
81024>>>>> if num_arguments begin
81026>>>>> move tmpfile# to file#
81027>>>>> if num_arguments gt 1 move tmp_deffile# to deffile#
81030>>>>> else move "" to deffile#
81032>>>>> end
81032>>>>>>
81032>>>>> else begin
81033>>>>> move 0 to file#
81034>>>>> move "" to deffile#
81035>>>>> end
81035>>>>>>
81035>>>>> if Client_ID# begin
81037>>>>> CREATE_OBJECT_GROUP OG_QueryView PARENT Client_ID# file# -1 0
81049>>>>> send popup to OG_Current_Object#
81050>>>>> if (not(file#) and deffile#<>"") send load_deffile to OG_Current_Object# deffile#
81053>>>>> end
81053>>>>>>
81053>>>>> else error 666 "ClientArea not found!"
81055>>>>>end_procedure
81056>>>>>
81056>>>>>procedure Activate_Query_Vw string tmp_deffile#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
81058>>>>> string deffile#
81058>>>>> if num_arguments move tmp_deffile# to deffile#
81061>>>>> else move "" to deffile#
81063>>>>> send CreateNewQuery 0 deffile# // 0 means: create view with no file selected
81064>>>>>end_procedure
81065>>>>>
81065>>>>>procedure Request_CreateNewQuery
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
81067>>>>> integer file# focus# dm# svr# Self# Client_ID#
81067>>>>> move self to Self#
81068>>>>> move (Client_ID(Self#)) to Client_ID#
81069>>>>> if Client_ID# begin
81071>>>>> move (focus(desktop)) to focus#
81072>>>>> //JK - 2000/05/22:
81072>>>>> // Changed following line to disallow access from modal panels
81072>>>>> if ((focus# > desktop) and not(modal_state(focus#))) begin
81074>>>>> get delegation_mode of focus# to dm#
81075>>>>> set delegation_mode of focus# to no_delegate_or_error
81076>>>>> get server of focus# to svr#
81077>>>>> set delegation_mode of focus# to dm#
81078>>>>> if svr# get main_file of svr# to file#
81081>>>>> CREATE_OBJECT_GROUP OG_QueryView PARENT Client_ID# file# -1 0
81093>>>>> send popup to OG_Current_Object#
81094>>>>> end
81094>>>>>>
81094>>>>> //JK - 2000/05/22:
81094>>>>> // Added following line
81094>>>>> else send stop_box "VdfQuery is not available from here!"
81096>>>>> end
81096>>>>>>
81096>>>>> else error 666 "ClientArea not found!"
81098>>>>>end_procedure
81099>>>>>
81099>>>>>function iCreateSubQueryView global integer file# integer ordering# returns integer
81101>>>>> integer self# Client_ID# rval#
81101>>>>> move self to Self#
81102>>>>> move (Client_ID(Self#)) to Client_ID#
81103>>>>> if Client_ID# begin
81105>>>>> CREATE_OBJECT_GROUP OG_QueryView PARENT Client_ID# file# ordering# 1
81117>>>>> move OG_Current_Object# to rval#
81118>>>>> end
81118>>>>>>
81118>>>>> else error 666 "ClientArea not found!"
81120>>>>> function_return rval#
81121>>>>>end_function
81122>>>>>
81122>>>>>function iCreateQueryView global returns integer
81124>>>>> integer self# Client_ID# rval#
81124>>>>> move self to Self#
81125>>>>> move (Client_ID(Self#)) to Client_ID#
81126>>>>> if Client_ID# begin
81128>>>>> CREATE_OBJECT_GROUP OG_QueryView PARENT Client_ID# 0 -1 0
81140>>>>> move OG_Current_Object# to rval#
81141>>>>> end
81141>>>>>>
81141>>>>> else error 666 "ClientArea not found!"
81143>>>>> function_return rval#
81144>>>>>end_function
81145>>>>>
81145>>>>>class cVdfQueryLauncher is a cArray
81146>>>>> procedure construct_object
81148>>>>> forward send construct_object
81150>>>>> property integer piVDFQueryObject public 0
81151>>>>> end_procedure
81152>>>>> procedure DoCreateQuery
81154>>>>> set piVDFQueryObject to (iCreateQueryView())
81155>>>>> end_procedure
81156>>>>> procedure DoSaveDefinition string fn#
81158>>>>> integer liChannel
81158>>>>> get SEQ_DirectOutput fn# to liChannel
81159>>>>> if (liChannel>=0) begin
81161>>>>> send write_deffile_channel to (piVDFQueryObject(self)) liChannel
81162>>>>> send SEQ_CloseOutput liChannel
81163>>>>> end
81163>>>>>>
81163>>>>> end_procedure
81164>>>>> procedure DoReadDefinition string fn#
81166>>>>> send load_deffile to (piVDFQueryObject(self)) fn#
81167>>>>> end_procedure
81168>>>>> procedure DoRunQuery
81170>>>>> send request_run_report to (piVDFQueryObject(self))
81171>>>>> end_procedure
81172>>>>> procedure DoSelectionDialog
81174>>>>> send DoCritValueDialog to (piVDFQueryObject(self))
81175>>>>> end_procedure
81176>>>>> procedure DoPopup
81178>>>>> send popup to (piVDFQueryObject(self))
81179>>>>> end_procedure
81180>>>>> procedure DoDestroyQuery
81182>>>>> send request_destroy_object to (piVDFQueryObject(self))
81183>>>>> set piVDFQueryObject to 0
81184>>>>> end_procedure
81185>>>>> procedure DoAddField integer iFile integer iField
81187>>>>> send Add_Field of (piVDFQueryObject(self)) iFile iField
81188>>>>> end_procedure
81189>>>>> procedure DoSetLandscape integer lbState
81191>>>>> integer hObj
81191>>>>> get piVDFQueryObject to hObj
81192>>>>> set select_state of (oOrientation(oTab5(oTabs(hObj)))) item 0 to lbState
81193>>>>> end_procedure
81194>>>>> procedure set CriteriaValue integer row# string value1# string value2#
81196>>>>> integer obj#
81196>>>>> string tmp#
81196>>>>> get row_crit of (oGrd(oGrp(oTab2(oTabs(piVDFQueryObject(self)))))) row# to row#
81197>>>>> move (oDefault_Selection_Values(piVDFQueryObject(self))) to obj#
81198>>>>> if num_arguments eq 2 move "" to tmp#
81201>>>>> else move value2# to tmp#
81203>>>>> set value of obj# item (row#*2) to value1#
81204>>>>> set value of obj# item (row#*2+1) to tmp#
81205>>>>> end_procedure
81206>>>>> procedure set QueryTitle string str#
81208>>>>> set value of (oTitle(piVDFQueryObject(self))) item 0 to str#
81209>>>>> end_procedure
81210>>>>> // Pepe
81210>>>>> procedure AutoSetup_dbGrid
81212>>>>> boolean lbModal
81212>>>>> integer lhDD lhDEO liMax liColumn liFile liField
81212>>>>> send Focus_Analyze_Focus
81213>>>>> get Focus_Info FOCUS_DEO_MODAL to lbModal
81214>>>>> ifnot lbModal begin
81216>>>>> get Focus_Info FOCUS_DD to lhDD
81217>>>>> if lhDD begin
81219>>>>> get Focus_Info FOCUS_DEO_ID to lhDEO
81220>>>>> if (base_class(lhDEO)=LIST_CLASS) begin
81222>>>>> send DoCreateQuery
81223>>>>> send force_DD of (piVDFQueryObject(self)) lhDD
81224>>>>> set QueryTitle to ""
81225>>>>> get Grid_Columns lhDEO to liMax
81226>>>>> decrement liMax
81227>>>>> for liColumn from 0 to liMax
81233>>>>>>
81233>>>>> get data_file of lhDEO liColumn to liFile
81234>>>>> if (liFile<>0) begin
81236>>>>> get data_field of lhDEO liColumn to liField
81237>>>>> send DoAddField liFile liField
81238>>>>> end
81238>>>>>>
81238>>>>> loop
81239>>>>>>
81239>>>>> send DoSetLandscape TRUE // <---Pepe's line
81240>>>>> send DoPopup
81241>>>>> send DoRunQuery
81242>>>>> end
81242>>>>>>
81242>>>>> else error 203 "Only works with dbList and dbGrid classes"
81244>>>>> end
81244>>>>>>
81244>>>>> else error 202 "DD object not found"
81246>>>>> end
81246>>>>>>
81246>>>>> else error 201 "Not available from within a modal panel"
81248>>>>> end_procedure
81249>>>>>end_class // cVdfQueryLauncher
81250>>>>>
81250>>>>>//procedure AutoLaunchGridQuery
81250>>>>>//end_procedure
81250>>>>>
81250>>>>>register_object oGridQueryLauncher
81250>>>>>procedure AutoLaunchGridQuery for AppClientArea
81252>>>>> ifnot (oGridQueryLauncher(self)) begin
81254>>>>> object oGridQueryLauncher is a cVdfQueryLauncher
81256>>>>> end_object
81257>>>>> end
81257>>>>>>
81257>>>>> send AutoSetup_dbGrid of oGridQueryLauncher
81258>>>>>end_procedure
81259>>>
81259>>>// If you use VPE:
81259>>>//define VPE_USE_EMBEDDED_PREVIEW for 0
81259>>>//Use VpeQuery.utl // DFQUERY for Visual DataFlex (VPE version)
81259>>>// ****************************************************************************
81259>>>// ****************************************************************************
81259>>>// ****************************************************************************
81259>>>
81259>>>Use VDFSort.utl // Sort utility
Including file: vdfsort.utl (C:\Apps\VDFQuery\AppSrc\vdfsort.utl)
81259>>>>>//**********************************************************************
81259>>>>>// use VdfSort.utl // DFSORT for Visual DataFlex
81259>>>>>//
81259>>>>>// By Sture Andersen & Finn Kristensen
81259>>>>>//
81259>>>>>// Create: Sat 29-11-1997
81259>>>>>// Update: Thu 18-12-1997 - Argument for Info_Box is now gradually built, to
81259>>>>>// avoid violation of maximum line length (DFCOMP).
81259>>>>>// Mon 22-12-1997 - Changed to work with files opened with the AS
81259>>>>>// clause.
81259>>>>>// Mon 03-08-1998 - Now possible to specify reindex options
81259>>>>>// Wed 20-01-1999 - Now displays file definitions if filedef.pkg
81259>>>>>// was used prior to using this package.
81259>>>>>// Mon 15-03-1999 - Message VdfSort_RestoreOpenFiles is sent to
81259>>>>>// all objects after VdfSort is finished.
81259>>>>>// Sun 18-04-1999 - 'chain wait "dbbldr noworkspace"' changed to
81259>>>>>// 'runprogram wait "dfrun dbbldr"'.
81259>>>>>// Wed 05-05-1999 - CleanUp code added
81259>>>>>// - Tampering with profile string "DEFAULTS"
81259>>>>>// "dbAdminMode" has been removed from the code.
81259>>>>>// Thu 13-05-1999 - Cleanup code finished. Call to dbbldr removed.
81259>>>>>// Mon 13-12-1999 - Changed the calling of procedure
81259>>>>>// DBMS_Callback_FilelistEntries according to
81259>>>>>// directions given by Bo Lincoln
81259>>>>>// Wed 01-02-2000 - Define instead of #REPLACE
81259>>>>>//**********************************************************************
81259>>>>>
81259>>>>>Use Language.pkg // Default language setup
81259>>>>>//Use FileList.utl // Filelist.cfg utilities
81259>>>>>Use Output.utl // Basic sequential output service
81259>>>>>Use Files.utl // Utilities for handling file related stuff
81259>>>>>Use Strings.nui // String manipulation for VDF
81259>>>>>Use OpenStat.pkg // Call DFMatrix, Display open tables ...
Including file: openstat.pkg (C:\Apps\VDFQuery\AppSrc\openstat.pkg)
81259>>>>>>>// Use OpenStat.pkg // Call DFMatrix, Display open tables ...
81259>>>>>>>
81259>>>>>>>Use OpenStat.nui // cTablesOpenStatus class (formely cFileAllFiles)
81259>>>>>>>Use Files.nui // Utilities for handling file related stuff
81259>>>>>>>Use MsgBox.utl // obs procedure
81259>>>>>>>Use GridUtil.utl // Grid and List utilities
81259>>>>>>>Use Version.nui
81259>>>>>>>Use DBMS.nui // Basic DBMS functions (No User Interface)
81259>>>>>>>Use FieldInf // Global field info objects and abstract field types
81259>>>>>>>
81259>>>>>>>
81259>>>>>>> define OpenStat.PrgExt for "exe" // VDF 8 and on
81259>>>>>>>
81259>>>>>>>procedure OpenStat.Chain_Wait global string program# string parameters# integer lbDontWait
81261>>>>>>> string path# prg_fn#
81261>>>>>>> move (program#+"."+OpenStat.PrgExt) to prg_fn#
81262>>>>>>> get SEQ_FindFileAlongDFPath prg_fn# to path#
81263>>>>>>> if path# ne "" begin
81265>>>>>>> move (SEQ_ComposeAbsoluteFileName(prg_fn#,path#)) to program#
81266>>>>>>> send OpenStat_RegisterFiles
81267>>>>>>> send OpenStat_CloseAllFiles
81268>>>>>>>
81268>>>>>>> runprogram background (trim(prg_fn#*parameters#))
81269>>>>>>> send OpenStat_RestoreFiles
81270>>>>>>> end
81270>>>>>>>>
81270>>>>>>> else send obs (replace("#",t.OpenStat.PrgNotFound,prg_fn#))
81272>>>>>>>end_procedure
81273>>>>>>>
81273>>>>>>>procedure OpenStat.Chain_DFMatrix global
81275>>>>>>> send OpenStat.Chain_Wait "Dfm" "" DFFALSE
81276>>>>>>>end_procedure
81277>>>>>>>
81277>>>>>>>procedure OpenStat.Chain_DbExplor global
81279>>>>>>> send OpenStat.Chain_Wait "DbExplor" "noworkspace" DFFALSE
81280>>>>>>>end_procedure
81281>>>>>>>
81281>>>>>>>procedure OpenStat.Chain_DbBuilder global
81283>>>>>>> send OpenStat.Chain_Wait "DbBldr" "" DFTRUE
81284>>>>>>>end_procedure
81285>>>>>>>
81285>>>>>>>object oOpenStatTableLocations is a aps.ModalPanel label t.OpenStat.LocOpenFiles
81288>>>>>>> set locate_mode to center_on_screen
81289>>>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
81290>>>>>>> set pMinimumSize to 80 0
81291>>>>>>> on_key kcancel send close_panel
81292>>>>>>> object oGrd is a aps.grid
81294>>>>>>> set size to 205 0
81295>>>>>>> set gridline_mode to GRID_VISIBLE_NONE
81296>>>>>>> send GridPrepare_AddColumn "#" AFT_ASCII3
81297>>>>>>> send GridPrepare_AddColumn t.OpenStat.UserName AFT_ASCII20
81298>>>>>>> send GridPrepare_AddColumn t.OpenStat.Location AFT_ASCII50
81299>>>>>>> send GridPrepare_AddColumn t.OpenStat.Driver AFT_ASCII12
81300>>>>>>> send GridPrepare_Apply self
81301>>>>>>> set select_mode to no_select
81302>>>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
81303>>>>>>> Set peResizeColumn to rcSelectedColumn // make sure mode is correct
81304>>>>>>> Set piResizeColumn to 2
81305>>>>>>>
81305>>>>>>> procedure fill_list
81308>>>>>>> integer file# itm# max# type# lbIsOpenedAs
81308>>>>>>> string str# cur_dir# driver#
81308>>>>>>> get_current_directory to cur_dir#
81309>>>>>>> send cursor_wait to (cursor_control(self))
81310>>>>>>> send delete_data
81311>>>>>>> move 0 to file#
81312>>>>>>> repeat
81312>>>>>>>>
81312>>>>>>> get_attribute DF_FILE_NEXT_OPENED of file# to file#
81315>>>>>>> if file# begin
81317>>>>>>> send add_item msg_none (string(file#))
81318>>>>>>> send add_item msg_none (File_Display_Name(file#))
81319>>>>>>> get_attribute DF_FILE_DRIVER of file# to driver#
81322>>>>>>> get DBMS_DriverNameToType driver# to type#
81323>>>>>>> get DBMS_TablePath file# to str#
81324>>>>>>> send add_item msg_none (uppercase(str#))
81325>>>>>>> send add_item msg_none ("("+DBMS_Driver_UserName(type#)+")")
81326>>>>>>> end
81326>>>>>>>>
81326>>>>>>> until file# eq 0
81328>>>>>>> get item_count to max#
81329>>>>>>> for itm# from 0 to (max#-1)
81335>>>>>>>>
81335>>>>>>> set entry_state item itm# to false
81336>>>>>>> loop
81337>>>>>>>>
81337>>>>>>> send cursor_ready to (cursor_control(self))
81338>>>>>>> end_procedure
81339>>>>>>> end_object
81340>>>>>>> object oBtn is a aps.Multi_Button
81342>>>>>>> set peAnchors to (anRight+anBottom)
81343>>>>>>> on_item t.btn.close send close_panel
81344>>>>>>> end_object
81345>>>>>>> send aps_locate_multi_buttons
81346>>>>>>> procedure popup
81349>>>>>>> send fill_list to (oGrd(self))
81350>>>>>>> forward send popup
81352>>>>>>> end_procedure
81353>>>>>>>end_object // oOpenStatTableLocations
81354>>>>>>>send aps_SetMinimumDialogSize (oOpenStatTableLocations(self))
81355>>>>>>>
81355>>>>>>>
81355>>>>>>>procedure OpenStat.DisplayFileLocations global
81357>>>>>>> send popup to (oOpenStatTableLocations(self))
81358>>>>>>>end_procedure
81359>>>>>>>
81359>>>>>Use OpenStat.nui // cTablesOpenStatus class (formely cFileAllFiles) (No User Interface)
81359>>>>>Use Fdx3.utl // FDX aware cFileList_List selector class
Including file: fdx3.utl (C:\Apps\VDFQuery\AppSrc\fdx3.utl)
81359>>>>>>>//**********************************************************************
81359>>>>>>>// Use Fdx3.utl // FDX aware cFileList_List selector class
81359>>>>>>>//
81359>>>>>>>// By Sture Andersen
81359>>>>>>>//
81359>>>>>>>// Create: Sun 16-01-2000
81359>>>>>>>// Update:
81359>>>>>>>//
81359>>>>>>>//**********************************************************************
81359>>>>>>>
81359>>>>>>>Use Fdx_Attr.nui // FDX compatible attribute functions
81359>>>>>>>Use DBMS.utl // Basic DBMS functions
81359>>>>>>>Use Strings.nui // String manipulation for VDF
81359>>>>>>>Use FieldInf // Global field info objects
81359>>>>>>>Use Fdx2.utl // FDX aware object for displaying a table definiton
81359>>>>>>>Use Files.utl // Utilities for handling file related stuff
81359>>>>>>>Use FDX.nui // cFDX class
Including file: fdx.nui (C:\Apps\VDFQuery\AppSrc\fdx.nui)
81359>>>>>>>>>//**********************************************************************
81359>>>>>>>>>// Use FDX.nui // cFDX class
81359>>>>>>>>>//
81359>>>>>>>>>// By Sture Andersen
81359>>>>>>>>>//
81359>>>>>>>>>// Create: Mon 13-12-1999
81359>>>>>>>>>// Update: Sun 16-01-2000
81359>>>>>>>>>// Tue 08-02-2000 - cFdxFileRelations class added
81359>>>>>>>>>// Sat 18-03-2000 - Added function iNextFileThatCanOpen
81359>>>>>>>>>// Wed 28-02-2001 - Added function sAliasFiles.i
81359>>>>>>>>>//
81359>>>>>>>>>//**********************************************************************
81359>>>>>>>>>
81359>>>>>>>>>Use API_Attr.nui // Database API attribute characteristics
81359>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
81359>>>>>>>>>Use Files.nui // Utilities for handling file related stuff
81359>>>>>>>>>Use DBMS.nui // Basic DBMS functions
81359>>>>>>>>>Use Dates.nui // Date manipulation for VDF and DF3.2
81359>>>>>>>>>Use Strings.nui // String manipulation for VDF
81359>>>>>>>>>Use Mapper.nui // Classes for (field) mapping
Including file: mapper.nui (C:\Apps\VDFQuery\AppSrc\mapper.nui)
81359>>>>>>>>>>>// Use Mapper.nui // Classes for (field) mapping
81359>>>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
81359>>>>>>>>>>>
81359>>>>>>>>>>>class cMapObject is a cArray
81360>>>>>>>>>>> procedure construct_object integer liImage
81362>>>>>>>>>>> forward send construct_object liImage
81364>>>>>>>>>>> property string psTitle public ""
81365>>>>>>>>>>> end_procedure
81366>>>>>>>>>>> item_property_list
81366>>>>>>>>>>> item_property integer piIdentifier.i
81366>>>>>>>>>>> item_property string psName.i
81366>>>>>>>>>>> item_property string psExtraInfo.i
81366>>>>>>>>>>> end_item_property_list cMapObject
#REM 81401 DEFINE FUNCTION PSEXTRAINFO.I INTEGER LIROW RETURNS STRING
#REM 81405 DEFINE PROCEDURE SET PSEXTRAINFO.I INTEGER LIROW STRING VALUE
#REM 81409 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 81413 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
#REM 81417 DEFINE FUNCTION PIIDENTIFIER.I INTEGER LIROW RETURNS INTEGER
#REM 81421 DEFINE PROCEDURE SET PIIDENTIFIER.I INTEGER LIROW INTEGER VALUE
81426>>>>>>>>>>> procedure DoAddItem integer liIdentifier string lsName string lsExtraInfo
81428>>>>>>>>>>> integer liRow
81428>>>>>>>>>>> get row_count to liRow
81429>>>>>>>>>>> set piIdentifier.i liRow to liIdentifier
81430>>>>>>>>>>> set psName.i liRow to lsName
81431>>>>>>>>>>> set psExtraInfo.i liRow to lsExtraInfo
81432>>>>>>>>>>> end_procedure
81433>>>>>>>>>>> function iFindName.s string lsName returns integer
81435>>>>>>>>>>> integer liMax liRow
81435>>>>>>>>>>> get row_count to liMax
81436>>>>>>>>>>> move (uppercase(lsName)) to lsName
81437>>>>>>>>>>> decrement liMax
81438>>>>>>>>>>> for liRow from 0 to liMax
81444>>>>>>>>>>>>
81444>>>>>>>>>>> if (uppercase(psName.i(self,liRow))=lsName) function_return liRow
81447>>>>>>>>>>> loop
81448>>>>>>>>>>>>
81448>>>>>>>>>>> function_return -1
81449>>>>>>>>>>> end_function
81450>>>>>>>>>>> function iFindIdentifier.i integer liIdent returns integer
81452>>>>>>>>>>> integer liMax liRow
81452>>>>>>>>>>> get row_count to liMax
81453>>>>>>>>>>> decrement liMax
81454>>>>>>>>>>> for liRow from 0 to liMax
81460>>>>>>>>>>>>
81460>>>>>>>>>>> if (piIdentifier.i(self,liRow)=liIdent) function_return liRow
81463>>>>>>>>>>> loop
81464>>>>>>>>>>>>
81464>>>>>>>>>>> function_return -1
81465>>>>>>>>>>> end_function
81466>>>>>>>>>>> procedure DoReset
81468>>>>>>>>>>> send delete_data
81469>>>>>>>>>>> end_procedure
81470>>>>>>>>>>>end_class // cMapObject
81471>>>>>>>>>>>
81471>>>>>>>>>>>class cMapper is a cArray
81472>>>>>>>>>>> procedure construct_object integer liImage
81474>>>>>>>>>>> forward send construct_object liImage
81476>>>>>>>>>>> property integer piMapMode public 0 // 0=Random, 1=Sequential
81477>>>>>>>>>>> property integer phObject1 public 0
81478>>>>>>>>>>> property integer phObject2 public 0
81479>>>>>>>>>>> property string psTitle1 public ""
81480>>>>>>>>>>> property string psTitle2 public ""
81481>>>>>>>>>>> property string psTitle3 public ""
81482>>>>>>>>>>> object oTmpArray is a cArray
81484>>>>>>>>>>> end_object
81485>>>>>>>>>>> object oPushStatus is a cArray
81487>>>>>>>>>>> end_object
81488>>>>>>>>>>> object oFastMap is a cArray
81490>>>>>>>>>>> end_object
81491>>>>>>>>>>> property integer pbFastMapState public DFFALSE
81492>>>>>>>>>>> end_procedure
81493>>>>>>>>>>> procedure DoPushStatus
81495>>>>>>>>>>> send Clone_Array self (oPushStatus(self))
81496>>>>>>>>>>> end_procedure
81497>>>>>>>>>>> procedure DoPopStatus
81499>>>>>>>>>>> send Clone_Array (oPushStatus(self)) self
81500>>>>>>>>>>> end_procedure
81501>>>>>>>>>>> item_property_list
81501>>>>>>>>>>> item_property integer piItem1.i
81501>>>>>>>>>>> item_property integer piItem2.i
81501>>>>>>>>>>> end_item_property_list cMapper
#REM 81533 DEFINE FUNCTION PIITEM2.I INTEGER LIROW RETURNS INTEGER
#REM 81537 DEFINE PROCEDURE SET PIITEM2.I INTEGER LIROW INTEGER VALUE
#REM 81541 DEFINE FUNCTION PIITEM1.I INTEGER LIROW RETURNS INTEGER
#REM 81545 DEFINE PROCEDURE SET PIITEM1.I INTEGER LIROW INTEGER VALUE
81550>>>>>>>>>>> function piIdent1.i integer liRow returns integer
81552>>>>>>>>>>> function_return (piIdentifier.i(phObject1(self),piItem1.i(self,liRow)))
81553>>>>>>>>>>> end_function
81554>>>>>>>>>>> function piIdent2.i integer liRow returns integer
81556>>>>>>>>>>> function_return (piIdentifier.i(phObject2(self),piItem2.i(self,liRow)))
81557>>>>>>>>>>> end_function
81558>>>>>>>>>>> procedure DoReset
81560>>>>>>>>>>> send delete_data
81561>>>>>>>>>>> set pbFastMapState to DFFALSE
81562>>>>>>>>>>> end_procedure
81563>>>>>>>>>>> function iFindItem2Row integer liItem2 returns integer
81565>>>>>>>>>>> integer liMax liRow
81565>>>>>>>>>>> get row_count to liMax
81566>>>>>>>>>>> decrement liMax
81567>>>>>>>>>>> for liRow from 0 to liMax
81573>>>>>>>>>>>>
81573>>>>>>>>>>> if (piItem2.i(self,liRow)=liItem2) function_return liRow
81576>>>>>>>>>>> loop
81577>>>>>>>>>>>>
81577>>>>>>>>>>> function_return -1
81578>>>>>>>>>>> end_function
81579>>>>>>>>>>> procedure DoBuildFastMap
81581>>>>>>>>>>> integer lhFastMap liRow liMax liIdent1 liIdent2
81581>>>>>>>>>>> move (oFastMap(self)) to lhFastMap
81582>>>>>>>>>>> send delete_data to lhFastMap
81583>>>>>>>>>>> get row_count to liMax
81584>>>>>>>>>>> decrement liMax
81585>>>>>>>>>>> for liRow from 0 to liMax
81591>>>>>>>>>>>>
81591>>>>>>>>>>> get piItem1.i liRow to liIdent1
81592>>>>>>>>>>> get piItem2.i liRow to liIdent2
81593>>>>>>>>>>> set value of lhFastMap liIdent1 to (liIdent2+1)
81594>>>>>>>>>>> loop
81595>>>>>>>>>>>>
81595>>>>>>>>>>> set pbFastMapState to DFTRUE
81596>>>>>>>>>>> end_procedure
81597>>>>>>>>>>> function iIdent1MapsTo.i integer liIdent1 returns integer
81599>>>>>>>>>>> function_return (integer(value(oFastMap(self),liIdent1))-1)
81600>>>>>>>>>>> end_function
81601>>>>>>>>>>> procedure DoAddMap integer liIdent1 integer liIdent2
81603>>>>>>>>>>> integer liRow liRow1 liRow2
81603>>>>>>>>>>>
81603>>>>>>>>>>> get iFindIdentifier.i of (phObject1(self)) liIdent1 to liRow1
81604>>>>>>>>>>> get iFindIdentifier.i of (phObject2(self)) liIdent2 to liRow2
81605>>>>>>>>>>>
81605>>>>>>>>>>> get iFindItem2Row liRow2 to liRow
81606>>>>>>>>>>> if liRow eq -1 get row_count to liRow
81609>>>>>>>>>>>
81609>>>>>>>>>>> set piItem1.i liRow to liRow1
81610>>>>>>>>>>> set piItem2.i liRow to liRow2
81611>>>>>>>>>>> set pbFastMapState to DFFALSE
81612>>>>>>>>>>> end_procedure
81613>>>>>>>>>>> procedure DoClearMap integer liIdent2
81615>>>>>>>>>>> integer liRow liRow2
81615>>>>>>>>>>> get iFindIdentifier.i of (phObject2(self)) liIdent2 to liRow2
81616>>>>>>>>>>> get iFindItem2Row liRow2 to liRow
81617>>>>>>>>>>> if liRow ne -1 begin
81619>>>>>>>>>>> send delete_row liRow
81620>>>>>>>>>>> set pbFastMapState to DFFALSE
81621>>>>>>>>>>> end
81621>>>>>>>>>>>>
81621>>>>>>>>>>> end_procedure
81622>>>>>>>>>>> // Puts a 1 in each position in oTmpArray that is mapped
81622>>>>>>>>>>> procedure MarkMappedItems1
81624>>>>>>>>>>> integer lhTmpArray liRow liMax
81624>>>>>>>>>>> move (oTmpArray(self)) to lhTmpArray
81625>>>>>>>>>>> send delete_data to lhTmpArray
81626>>>>>>>>>>> get row_count to liMax
81627>>>>>>>>>>> decrement liMax
81628>>>>>>>>>>> for liRow from 0 to liMax
81634>>>>>>>>>>>>
81634>>>>>>>>>>> set value of lhTmpArray item (piItem1.i(self,liRow)) to (piItem2.i(self,liRow)+1)
81635>>>>>>>>>>> loop
81636>>>>>>>>>>>>
81636>>>>>>>>>>> end_procedure
81637>>>>>>>>>>> // Puts a 1 in each position in oTmpArray that is mapped
81637>>>>>>>>>>> procedure MarkMappedItems2
81639>>>>>>>>>>> integer lhTmpArray liRow liMax
81639>>>>>>>>>>> move (oTmpArray(self)) to lhTmpArray
81640>>>>>>>>>>> send delete_data to lhTmpArray
81641>>>>>>>>>>> get row_count to liMax
81642>>>>>>>>>>> decrement liMax
81643>>>>>>>>>>> for liRow from 0 to liMax
81649>>>>>>>>>>>>
81649>>>>>>>>>>> set value of lhTmpArray item (piItem2.i(self,liRow)) to (piItem1.i(self,liRow)+1)
81650>>>>>>>>>>> loop
81651>>>>>>>>>>>>
81651>>>>>>>>>>> end_procedure
81652>>>>>>>>>>> procedure DoCallback_UnmappedItems1 integer liMsg integer lhObj
81654>>>>>>>>>>> integer lhTmpArray liRow liMax lhObj1
81654>>>>>>>>>>> send MarkMappedItems1
81655>>>>>>>>>>> move (oTmpArray(self)) to lhTmpArray
81656>>>>>>>>>>> get phObject1 to lhObj1
81657>>>>>>>>>>> get row_count of lhObj1 to liMax
81658>>>>>>>>>>> decrement liMax
81659>>>>>>>>>>> for liRow from 0 to liMax
81665>>>>>>>>>>>>
81665>>>>>>>>>>> ifnot (integer(value(lhTmpArray,liRow))) send liMsg to lhObj (piIdentifier.i(lhObj1,liRow)) (psName.i(lhObj1,liRow)) (psExtraInfo.i(lhObj1,liRow))
81668>>>>>>>>>>> loop
81669>>>>>>>>>>>>
81669>>>>>>>>>>> end_procedure
81670>>>>>>>>>>> procedure DoCallback_UnmappedItems2 integer liMsg integer lhObj
81672>>>>>>>>>>> integer lhTmpArray liRow liMax lhObj2
81672>>>>>>>>>>> send MarkMappedItems2
81673>>>>>>>>>>> move (oTmpArray(self)) to lhTmpArray
81674>>>>>>>>>>> get phObject2 to lhObj2
81675>>>>>>>>>>> get row_count of lhObj2 to liMax
81676>>>>>>>>>>> decrement liMax
81677>>>>>>>>>>> for liRow from 0 to liMax
81683>>>>>>>>>>>>
81683>>>>>>>>>>> ifnot (integer(value(lhTmpArray,liRow))) send liMsg to lhObj (piIdentifier.i(lhObj2,liRow)) (psName.i(lhObj2,liRow)) (psExtraInfo.i(lhObj2,liRow))
81686>>>>>>>>>>> loop
81687>>>>>>>>>>>>
81687>>>>>>>>>>> end_procedure
81688>>>>>>>>>>> procedure DoCallback_AllItems1 integer liMsg integer lhObj
81690>>>>>>>>>>> integer lhTmpArray liRow liMax lhObj1 lhObj2 liMapRow
81690>>>>>>>>>>> send MarkMappedItems1
81691>>>>>>>>>>> move (oTmpArray(self)) to lhTmpArray
81692>>>>>>>>>>> get phObject1 to lhObj1
81693>>>>>>>>>>> get phObject2 to lhObj2
81694>>>>>>>>>>> get row_count of lhObj1 to liMax
81695>>>>>>>>>>> decrement liMax
81696>>>>>>>>>>> for liRow from 0 to liMax
81702>>>>>>>>>>>>
81702>>>>>>>>>>> get value of lhTmpArray liRow to liMapRow
81703>>>>>>>>>>> ifnot liMapRow send liMsg to lhObj (piIdentifier.i(lhObj1,liRow)) (psName.i(lhObj1,liRow)) (psExtraInfo.i(lhObj1,liRow)) DFFALSE 0 "" ""
81706>>>>>>>>>>> else begin
81707>>>>>>>>>>> decrement liMapRow
81708>>>>>>>>>>> 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))
81709>>>>>>>>>>> end
81709>>>>>>>>>>>>
81709>>>>>>>>>>> loop
81710>>>>>>>>>>>>
81710>>>>>>>>>>> end_procedure
81711>>>>>>>>>>> procedure DoCallback_AllItems2 integer liMsg integer lhObj
81713>>>>>>>>>>> integer lhTmpArray liRow liMax lhObj1 lhObj2 liMapRow
81713>>>>>>>>>>> send MarkMappedItems2
81714>>>>>>>>>>> move (oTmpArray(self)) to lhTmpArray
81715>>>>>>>>>>> get phObject1 to lhObj1
81716>>>>>>>>>>> get phObject2 to lhObj2
81717>>>>>>>>>>> get row_count of lhObj2 to liMax
81718>>>>>>>>>>> decrement liMax
81719>>>>>>>>>>> for liRow from 0 to liMax
81725>>>>>>>>>>>>
81725>>>>>>>>>>> get value of lhTmpArray liRow to liMapRow
81726>>>>>>>>>>> ifnot liMapRow send liMsg to lhObj (piIdentifier.i(lhObj2,liRow)) (psName.i(lhObj2,liRow)) (psExtraInfo.i(lhObj2,liRow)) DFFALSE 0 "" ""
81729>>>>>>>>>>> else begin
81730>>>>>>>>>>> decrement liMapRow
81731>>>>>>>>>>> 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))
81732>>>>>>>>>>> end
81732>>>>>>>>>>>>
81732>>>>>>>>>>> loop
81733>>>>>>>>>>>>
81733>>>>>>>>>>> end_procedure
81734>>>>>>>>>>> procedure DoAutoMapName_Help integer liIdent2 string lsName string lsExtra
81736>>>>>>>>>>> integer lhObj1 liIdent1 liRow1
81736>>>>>>>>>>> get phObject1 to lhObj1
81737>>>>>>>>>>> get iFindName.s of lhObj1 lsName to liRow1
81738>>>>>>>>>>> if (liRow1=-1) begin
81740>>>>>>>>>>> // If we didn't find a match, we try one more time by
81740>>>>>>>>>>> // replacing _ characters for spaces:
81740>>>>>>>>>>> move (replaces("_",lsName," ")) to lsName
81741>>>>>>>>>>> get iFindName.s of lhObj1 lsName to liRow1
81742>>>>>>>>>>> end
81742>>>>>>>>>>>>
81742>>>>>>>>>>> if (liRow1>-1) begin
81744>>>>>>>>>>> get piIdentifier.i of lhObj1 liRow1 to liIdent1
81745>>>>>>>>>>> send DoAddMap liIdent1 liIdent2
81746>>>>>>>>>>> end
81746>>>>>>>>>>>>
81746>>>>>>>>>>> end_procedure
81747>>>>>>>>>>> procedure DoAutoMapName
81749>>>>>>>>>>> send DoCallback_UnmappedItems2 msg_DoAutoMapName_Help self
81750>>>>>>>>>>> end_procedure
81751>>>>>>>>>>>end_class // cMapper
81752>>>>>>>>>
81752>>>>>>>>>define FILELIST_MAX_ENTRY for 4095
81752>>>>>>>>>define t.fdx.attr_not_avail for "ATTRIBUTE NOT AVAILABLE"
81752>>>>>>>>>
81752>>>>>>>>>class cFdxMonitoredAttributes is a cArray
81753>>>>>>>>> procedure construct_object integer liImage
81755>>>>>>>>> forward send construct_object liImage
81757>>>>>>>>> property integer piLowIndex public 65536
81758>>>>>>>>> property integer piHighIndex public -1
81759>>>>>>>>> end_procedure
81760>>>>>>>>> item_property_list
81760>>>>>>>>> item_property integer piMonitored.i // Is the attribute monitored?
81760>>>>>>>>> item_property integer piAttrIndex.i // Translate to index used in the subset of attributes
81760>>>>>>>>> end_item_property_list cFdxMonitoredAttributes
#REM 81792 DEFINE FUNCTION PIATTRINDEX.I INTEGER LIROW RETURNS INTEGER
#REM 81796 DEFINE PROCEDURE SET PIATTRINDEX.I INTEGER LIROW INTEGER VALUE
#REM 81800 DEFINE FUNCTION PIMONITORED.I INTEGER LIROW RETURNS INTEGER
#REM 81804 DEFINE PROCEDURE SET PIMONITORED.I INTEGER LIROW INTEGER VALUE
81809>>>>>>>>> procedure add_attribute integer liAttr
81811>>>>>>>>> set piMonitored.i liAttr to 1
81812>>>>>>>>> if liAttr lt (piLowIndex(self)) set piLowIndex to liAttr
81815>>>>>>>>> if liAttr gt (piHighIndex(self)) set piHighIndex to liAttr
81818>>>>>>>>> end_procedure
81819>>>>>>>>> procedure CalcAttrIndices // Sent by end_construct_object
81821>>>>>>>>> integer liAttr liMin liMax liIndex
81821>>>>>>>>> move 0 to liIndex
81822>>>>>>>>> get piLowIndex to liMin
81823>>>>>>>>> get piHighIndex to liMax
81824>>>>>>>>> for liAttr from liMin to liMax
81830>>>>>>>>>>
81830>>>>>>>>> if (piMonitored.i(self,liAttr)) begin
81832>>>>>>>>> set piAttrIndex.i liAttr to liIndex
81833>>>>>>>>> increment liIndex
81834>>>>>>>>> end
81834>>>>>>>>>>
81834>>>>>>>>> loop
81835>>>>>>>>>>
81835>>>>>>>>> end_procedure
81836>>>>>>>>> procedure end_construct_object
81838>>>>>>>>> forward send end_construct_object
81840>>>>>>>>> send CalcAttrIndices
81841>>>>>>>>> end_procedure
81842>>>>>>>>>end_class // cFdxMonitoredAttributes
81843>>>>>>>>>
81843>>>>>>>>>desktop_section // Make sure object is instantiated on desktop level
81848>>>>>>>>> object oMonitoredGlobalAttributes is a cFdxMonitoredAttributes no_image
81850>>>>>>>>> send add_attribute DF_ALL_FILES_TOUCHED
81851>>>>>>>>> send add_attribute DF_API_DISABLED
81852>>>>>>>>> send add_attribute DF_API_DISABLED_ERROR
81853>>>>>>>>> send add_attribute DF_DATE_FORMAT
81854>>>>>>>>> send add_attribute DF_DATE_SEPARATOR
81855>>>>>>>>> send add_attribute DF_DECIMAL_SEPARATOR
81856>>>>>>>>> send add_attribute DF_FILELIST_NAME
81857>>>>>>>>> send add_attribute DF_HIGH_DATA_INTEGRITY
81858>>>>>>>>> send add_attribute DF_LOCK_DELAY
81859>>>>>>>>> send add_attribute DF_LOCK_TIMEOUT
81860>>>>>>>>> send add_attribute DF_NUMBER_DRIVERS
81861>>>>>>>>> send add_attribute DF_OPEN_PATH
81862>>>>>>>>> send add_attribute DF_REREAD_REQUIRED
81863>>>>>>>>> send add_attribute DF_STRICT_ATTRIBUTES
81864>>>>>>>>> send add_attribute DF_THOUSANDS_SEPARATOR
81865>>>>>>>>> send add_attribute DF_TRANSACTION_ABORT
81866>>>>>>>>> send add_attribute DF_TRAN_COUNT
81867>>>>>>>>> end_object // oMonitoredGlobalAttributes
81868>>>>>>>>> object oMonitoredFileAttributes is a cFdxMonitoredAttributes no_image
81870>>>>>>>>> send add_attribute DF_FILE_COMPRESSION
81871>>>>>>>>> send add_attribute DF_FILE_DISPLAY_NAME // Type: FILELIST
81872>>>>>>>>> send add_attribute DF_FILE_DRIVER
81873>>>>>>>>> send add_attribute DF_FILE_INTEGRITY_CHECK
81874>>>>>>>>> send add_attribute DF_FILE_IS_SYSTEM_FILE
81875>>>>>>>>> send add_attribute DF_FILE_LAST_INDEX_NUMBER
81876>>>>>>>>> send add_attribute DF_FILE_LOCK_TYPE
81877>>>>>>>>> send add_attribute DF_FILE_LOGICAL_NAME // Type: FILELIST
81878>>>>>>>>> send add_attribute DF_FILE_MAX_RECORDS
81879>>>>>>>>> send add_attribute DF_FILE_MULTIUSER
81880>>>>>>>>> send add_attribute DF_FILE_NUMBER_FIELDS
81881>>>>>>>>> send add_attribute DF_FILE_RECORDS_USED
81882>>>>>>>>> send add_attribute DF_FILE_RECORD_LENGTH
81883>>>>>>>>> send add_attribute DF_FILE_RECORD_LENGTH_USED
81884>>>>>>>>> send add_attribute DF_FILE_REUSE_DELETED
81885>>>>>>>>> send add_attribute DF_FILE_REVISION
81886>>>>>>>>> send add_attribute DF_FILE_ROOT_NAME // Type: FILELIST
81887>>>>>>>>> send add_attribute DF_FILE_TRANSACTION
81888>>>>>>>>> send add_attribute DF_FILE_PHYSICAL_NAME
81889>>>>>>>>> send add_attribute DF_FILE_RECORD_IDENTITY
81890>>>>>>>>> send add_attribute DF_FILE_TYPE
81891>>>>>>>>> end_object // oMonitoredFileAttributes
81892>>>>>>>>>end_desktop_section
81897>>>>>>>>>
81897>>>>>>>>>enumeration_list // File list read modes
81897>>>>>>>>> define FDX_ALL_OPEN // All files currently open
81897>>>>>>>>> define FDX_ALL_FILES // All files
81897>>>>>>>>> define FDX_FROM_SET // From pre-specified set of files (not implemented)
81897>>>>>>>>>end_enumeration_list
81897>>>>>>>>>
81897>>>>>>>>>enumeration_list // Data origin modes
81897>>>>>>>>> define FDX_EMPTY // The FDX object is empty
81897>>>>>>>>> define FDX_REAL_WORLD // Definitions have been read from current filelist
81897>>>>>>>>> define FDX_READ_FROM_FILE // Definitions have been read from a sequential file
81897>>>>>>>>>end_enumeration_list
81897>>>>>>>>>
81897>>>>>>>>>enumeration_list // Relation origins for cFdxFileRelations
81897>>>>>>>>> define FDX_RELORIG_ALL
81897>>>>>>>>> define FDX_RELORIG_GENERIC
81897>>>>>>>>>end_enumeration_list
81897>>>>>>>>>
81897>>>>>>>>>//> An object of this class is inside a FDX object, but it is really just an
81897>>>>>>>>>//> appendix to the FDX object. It only holds redundant information about
81897>>>>>>>>>//> relations between file tables and is therefore not written to the .FDX
81897>>>>>>>>>//> files.
81897>>>>>>>>>class cFdxFileRelations is a cArray
81898>>>>>>>>> procedure construct_object integer liImage
81900>>>>>>>>> forward send construct_object liImage
81902>>>>>>>>> property integer piArray_Filled public 0
81903>>>>>>>>> property string psTmpString public ""
81904>>>>>>>>> end_procedure
81905>>>>>>>>> item_property_list
81905>>>>>>>>> item_property integer piType.i
81905>>>>>>>>> item_property integer piFileFrom.i
81905>>>>>>>>> item_property integer piFieldFrom.i
81905>>>>>>>>> item_property integer piFileTo.i
81905>>>>>>>>> item_property integer piFieldTo.i
81905>>>>>>>>> end_item_property_list cFdxFileRelations
#REM 81946 DEFINE FUNCTION PIFIELDTO.I INTEGER LIROW RETURNS INTEGER
#REM 81950 DEFINE PROCEDURE SET PIFIELDTO.I INTEGER LIROW INTEGER VALUE
#REM 81954 DEFINE FUNCTION PIFILETO.I INTEGER LIROW RETURNS INTEGER
#REM 81958 DEFINE PROCEDURE SET PIFILETO.I INTEGER LIROW INTEGER VALUE
#REM 81962 DEFINE FUNCTION PIFIELDFROM.I INTEGER LIROW RETURNS INTEGER
#REM 81966 DEFINE PROCEDURE SET PIFIELDFROM.I INTEGER LIROW INTEGER VALUE
#REM 81970 DEFINE FUNCTION PIFILEFROM.I INTEGER LIROW RETURNS INTEGER
#REM 81974 DEFINE PROCEDURE SET PIFILEFROM.I INTEGER LIROW INTEGER VALUE
#REM 81978 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 81982 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
81987>>>>>>>>> //>
81987>>>>>>>>> procedure aux_callback.iiiii integer liMsg integer liObj integer liSelectType integer liSelectToFile integer liSelectToField
81989>>>>>>>>> integer liMax liRow liOK
81989>>>>>>>>> ifnot (piArray_Filled(self)) send fill_array
81992>>>>>>>>> get row_count to liMax
81993>>>>>>>>> for liRow from 0 to (liMax-1)
81999>>>>>>>>>>
81999>>>>>>>>> move 1 to liOK
82000>>>>>>>>> if liSelectType if (piType.i(self,liRow)) ne liSelectType move 0 to liOK
82005>>>>>>>>> if liOK if (piFileTo.i(self,liRow)) ne liSelectToFile move 0 to liOK
82010>>>>>>>>> if liOK if (piFieldTo.i(self,liRow)) ne liSelectToField move 0 to liOK
82015>>>>>>>>> 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))
82018>>>>>>>>> loop
82019>>>>>>>>>>
82019>>>>>>>>> end_procedure
82020>>>>>>>>> procedure callback.iiiii integer liMsg integer liObj integer liSelectType integer liSelectFrom integer liSelectTo
82022>>>>>>>>> integer liMax liRow liOK
82022>>>>>>>>> ifnot (piArray_Filled(self)) send fill_array
82025>>>>>>>>> get row_count to liMax
82026>>>>>>>>> for liRow from 0 to (liMax-1)
82032>>>>>>>>>>
82032>>>>>>>>> move 1 to liOK
82033>>>>>>>>> if liSelectType if (piType.i(self,liRow)) ne liSelectType move 0 to liOK
82038>>>>>>>>> if (liOK and liSelectFrom) if (piFileFrom.i(self,liRow)) ne liSelectFrom move 0 to liOK
82043>>>>>>>>> if (liOK and liSelectTo) if (piFileTo.i(self,liRow)) ne liSelectTo move 0 to liOK
82048>>>>>>>>> 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))
82051>>>>>>>>> loop
82052>>>>>>>>>>
82052>>>>>>>>> end_procedure
82053>>>>>>>>> procedure add_relation.iiiii integer liType integer liFile1 integer liField1 integer liFile2 integer liField2
82055>>>>>>>>> integer liRow
82055>>>>>>>>> get row_count to liRow
82056>>>>>>>>> set piType.i liRow to liType
82057>>>>>>>>> set piFileFrom.i liRow to liFile1
82058>>>>>>>>> set piFieldFrom.i liRow to liField1
82059>>>>>>>>> set piFileTo.i liRow to liFile2
82060>>>>>>>>> set piFieldTo.i liRow to liField2
82061>>>>>>>>> end_procedure
82062>>>>>>>>> procedure reset
82064>>>>>>>>> send delete_data
82065>>>>>>>>> set piArray_Filled to false
82066>>>>>>>>> end_procedure
82067>>>>>>>>> procedure fill_array
82069>>>>>>>>> integer liFile liField liToFile liToField liMax liParent liAvailable
82069>>>>>>>>> send reset
82070>>>>>>>>> move (parent(self)) to liParent // Save time delegation
82071>>>>>>>>> move 0 to liFile
82072>>>>>>>>> repeat
82072>>>>>>>>>>
82072>>>>>>>>> get AttrValue_FLSTNAV of liParent DF_FILE_NEXT_USED liFile to liFile
82073>>>>>>>>> if liFile begin
82075>>>>>>>>> get iCanOpen.i liFile to liAvailable
82076>>>>>>>>> if liAvailable begin
82078>>>>>>>>> get AttrValue_FILE of liParent DF_FILE_NUMBER_FIELDS liFile to liMax
82079>>>>>>>>> for liField from 1 to liMax
82085>>>>>>>>>>
82085>>>>>>>>> get AttrValue_FIELD of liParent DF_FIELD_RELATED_FILE liFile liField to liToFile
82086>>>>>>>>> if liToFile begin
82088>>>>>>>>> get AttrValue_FIELD of liParent DF_FIELD_RELATED_FIELD liFile liField to liToField
82089>>>>>>>>> send add_relation.iiiii FDX_RELORIG_GENERIC liFile liField liToFile liToField
82090>>>>>>>>> end
82090>>>>>>>>>>
82090>>>>>>>>> loop
82091>>>>>>>>>>
82091>>>>>>>>> end
82091>>>>>>>>>>
82091>>>>>>>>> end
82091>>>>>>>>>>
82091>>>>>>>>> until (not(liFile))
82093>>>>>>>>> set piArray_Filled to true
82094>>>>>>>>> end_procedure
82095>>>>>>>>> procedure ParentFilesHelp integer liType integer liFile integer liFld integer liRFile integer liRFld
82097>>>>>>>>> string lsStr
82097>>>>>>>>> get psTmpString to lsStr
82098>>>>>>>>> ifnot (IsIntegerPresent(lsStr,liRFile)) begin
82100>>>>>>>>> move (AddIntegerToString(lsStr,liRFile)) to lsStr
82101>>>>>>>>> set psTmpString to lsStr
82102>>>>>>>>> send callback.iiiii msg_ParentFilesHelp self FDX_RELORIG_ALL liRFile 0
82103>>>>>>>>> end
82103>>>>>>>>>>
82103>>>>>>>>> end_procedure
82104>>>>>>>>> function sParentFiles.i integer liFile returns string
82106>>>>>>>>> set psTmpString to ""
82107>>>>>>>>> send callback.iiiii msg_ParentFilesHelp self FDX_RELORIG_ALL liFile 0
82108>>>>>>>>> function_return (psTmpString(self))
82109>>>>>>>>> end_function
82110>>>>>>>>> procedure ChildFilesHelp integer liType integer liFile integer liFld integer liRFile integer liRFld
82112>>>>>>>>> string lsStr
82112>>>>>>>>> get psTmpString to lsStr
82113>>>>>>>>> ifnot (IsIntegerPresent(lsStr,liFile)) begin
82115>>>>>>>>> move (AddIntegerToString(lsStr,liFile)) to lsStr
82116>>>>>>>>> set psTmpString to lsStr
82117>>>>>>>>> send callback.iiiii msg_ChildFilesHelp self FDX_RELORIG_ALL 0 liFile
82118>>>>>>>>> end
82118>>>>>>>>>>
82118>>>>>>>>> end_procedure
82119>>>>>>>>> function sChildFiles.i integer liFile returns string
82121>>>>>>>>> set psTmpString to ""
82122>>>>>>>>> send callback.iiiii msg_ChildFilesHelp self FDX_RELORIG_ALL 0 liFile
82123>>>>>>>>> function_return (psTmpString(self))
82124>>>>>>>>> end_function
82125>>>>>>>>>end_class // cFdxFileRelations
82126>>>>>>>>>
82126>>>>>>>>>class cFdxFileDef_IndexAttr is a cArray
82127>>>>>>>>> item_property_list
82127>>>>>>>>> item_property integer piType.i
82127>>>>>>>>> item_property integer piSegments.i
82127>>>>>>>>> item_property integer piBuffers.i
82127>>>>>>>>> item_property integer piKey_Length.i
82127>>>>>>>>> item_property integer piLevels.i
82127>>>>>>>>> item_property string psFields.i
82127>>>>>>>>> item_property string psUppercase.i
82127>>>>>>>>> item_property string psDirection.i
82127>>>>>>>>> end_item_property_list cFdxFileDef_IndexAttr // Repeat class name here!
#REM 82177 DEFINE FUNCTION PSDIRECTION.I INTEGER LIROW RETURNS STRING
#REM 82181 DEFINE PROCEDURE SET PSDIRECTION.I INTEGER LIROW STRING VALUE
#REM 82185 DEFINE FUNCTION PSUPPERCASE.I INTEGER LIROW RETURNS STRING
#REM 82189 DEFINE PROCEDURE SET PSUPPERCASE.I INTEGER LIROW STRING VALUE
#REM 82193 DEFINE FUNCTION PSFIELDS.I INTEGER LIROW RETURNS STRING
#REM 82197 DEFINE PROCEDURE SET PSFIELDS.I INTEGER LIROW STRING VALUE
#REM 82201 DEFINE FUNCTION PILEVELS.I INTEGER LIROW RETURNS INTEGER
#REM 82205 DEFINE PROCEDURE SET PILEVELS.I INTEGER LIROW INTEGER VALUE
#REM 82209 DEFINE FUNCTION PIKEY_LENGTH.I INTEGER LIROW RETURNS INTEGER
#REM 82213 DEFINE PROCEDURE SET PIKEY_LENGTH.I INTEGER LIROW INTEGER VALUE
#REM 82217 DEFINE FUNCTION PIBUFFERS.I INTEGER LIROW RETURNS INTEGER
#REM 82221 DEFINE PROCEDURE SET PIBUFFERS.I INTEGER LIROW INTEGER VALUE
#REM 82225 DEFINE FUNCTION PISEGMENTS.I INTEGER LIROW RETURNS INTEGER
#REM 82229 DEFINE PROCEDURE SET PISEGMENTS.I INTEGER LIROW INTEGER VALUE
#REM 82233 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 82237 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
82242>>>>>>>>> procedure reset
82244>>>>>>>>> send delete_data
82245>>>>>>>>> end_procedure
82246>>>>>>>>>end_class // cFdxFileDef_IndexAttr
82247>>>>>>>>>class cFdxFileDef_FileAttr is a cArray
82248>>>>>>>>> procedure add_attr_value string lsValue
82250>>>>>>>>> set value item (item_count(self)) to lsValue
82251>>>>>>>>> end_procedure
82252>>>>>>>>> procedure reset
82254>>>>>>>>> send delete_data
82255>>>>>>>>> end_procedure
82256>>>>>>>>>end_class // cFdxFileDef_FileAttr
82257>>>>>>>>>
82257>>>>>>>>>class cFdxFileDef_DataAndConfigurationFilesHelp is a cArray
82258>>>>>>>>> procedure construct_object integer liImage
82260>>>>>>>>> forward send construct_object liImage
82262>>>>>>>>> property integer pbFileNotFound public DFTRUE
82263>>>>>>>>> property string psFileName public ""
82264>>>>>>>>> property string psFilePath public ""
82265>>>>>>>>> property number pnFileTime public 0
82266>>>>>>>>> property number pnFileSize public 0
82267>>>>>>>>> end_procedure
82268>>>>>>>>> procedure Reset
82270>>>>>>>>> send delete_data
82271>>>>>>>>> set pbFileNotFound to DFTRUE
82272>>>>>>>>> set psFileName to ""
82273>>>>>>>>> set psFilePath to ""
82274>>>>>>>>> set pnFileTime to 0
82275>>>>>>>>> set pnFileSize to 0
82276>>>>>>>>> end_procedure
82277>>>>>>>>> procedure Read_FileFromDisk string lsFileName
82279>>>>>>>>> integer liChannel lbSeqEof
82279>>>>>>>>> string lsLine
82279>>>>>>>>> send Reset
82280>>>>>>>>> if (SEQ_FileExists(lsFileName)=SEQIT_FILE) begin
82282>>>>>>>>> set pbFileNotFound to DFFALSE
82283>>>>>>>>> set psFileName to lsFileName
82284>>>>>>>>> set psFilePath to (SEQ_FindFileAlongDFPath(lsFileName))
82285>>>>>>>>> set pnFileTime to (SEQ_FileModTime(lsFileName))
82286>>>>>>>>> set pnFileSize to (SEQ_FileSize(lsFileName))
82287>>>>>>>>> get SEQ_DirectInput lsFileName to liChannel
82288>>>>>>>>> if (liChannel>=0) begin
82290>>>>>>>>> repeat
82290>>>>>>>>>>
82290>>>>>>>>> readln channel liChannel lsLine
82292>>>>>>>>> move (seqeof) to lbSeqEof
82293>>>>>>>>> ifnot lbSeqEof set value item (item_count(self)) to lsLine
82296>>>>>>>>> until lbSeqEof
82298>>>>>>>>> send SEQ_CloseInput liChannel
82299>>>>>>>>> end
82299>>>>>>>>>>
82299>>>>>>>>> end
82299>>>>>>>>>>
82299>>>>>>>>> end_procedure
82300>>>>>>>>> procedure Seq_Read integer liChannel
82302>>>>>>>>> set pbFileNotFound to (SEQ_ReadLn(liChannel))
82303>>>>>>>>> set psFileName to (SEQ_ReadLn(liChannel))
82304>>>>>>>>> set psFilePath to (SEQ_ReadLn(liChannel))
82305>>>>>>>>> set pnFileTime to (SEQ_ReadLn(liChannel))
82306>>>>>>>>> set pnFileSize to (SEQ_ReadLn(liChannel))
82307>>>>>>>>> send SEQ_ReadArrayItems liChannel self
82308>>>>>>>>> end_procedure
82309>>>>>>>>> procedure Seq_Write integer liChannel
82311>>>>>>>>> writeln channel liChannel (pbFileNotFound(self))
82314>>>>>>>>> writeln (psFileName(self))
82316>>>>>>>>> writeln (psFilePath(self))
82318>>>>>>>>> writeln (pnFileTime(self))
82320>>>>>>>>> writeln (pnFileSize(self))
82322>>>>>>>>> send SEQ_WriteArrayItems liChannel self
82323>>>>>>>>> end_procedure
82324>>>>>>>>>end_class // cFdxFileDef_DataAndConfigurationFilesHelp
82325>>>>>>>>>
82325>>>>>>>>>class cFdxFileDef_DataAndConfigurationFiles is a cArray
82326>>>>>>>>> procedure construct_object integer liImage
82328>>>>>>>>> forward send construct_object liImage
82330>>>>>>>>> property integer pbDataIncluded public DFFALSE
82331>>>>>>>>> property integer pbDataByteOffset public 0
82332>>>>>>>>> object oTagFile is a cFdxFileDef_DataAndConfigurationFilesHelp
82334>>>>>>>>> end_object
82335>>>>>>>>> object oFdFile is a cFdxFileDef_DataAndConfigurationFilesHelp
82337>>>>>>>>> end_object
82338>>>>>>>>> object oIntFile is a cFdxFileDef_DataAndConfigurationFilesHelp
82340>>>>>>>>> end_object
82341>>>>>>>>> object oFutureUse is a cFdxFileDef_DataAndConfigurationFilesHelp
82343>>>>>>>>> end_object
82344>>>>>>>>> property number priv.pnOffset public 0
82345>>>>>>>>> end_procedure
82346>>>>>>>>> procedure Reset
82348>>>>>>>>> send Reset to (oTagFile(self))
82349>>>>>>>>> send Reset to (oFdFile(self))
82350>>>>>>>>> send Reset to (oIntFile(self))
82351>>>>>>>>> send Reset to (oFutureUse(self))
82352>>>>>>>>> end_procedure
82353>>>>>>>>> procedure Read_AuxillaryFiles string lsRoot
82355>>>>>>>>> send Read_FileFromDisk to (oTagFile(self)) (lsRoot+".tag")
82356>>>>>>>>> send Read_FileFromDisk to (oFdFile(self)) (lsRoot+".fd")
82357>>>>>>>>> send Read_FileFromDisk to (oIntFile(self)) (lsRoot+".int")
82358>>>>>>>>>// send Read_FileFromDisk to (oFutureUse(self)) (lsRoot+".")
82358>>>>>>>>> end_procedure
82359>>>>>>>>> procedure Seq_Read integer liChannel
82361>>>>>>>>> set pbDataIncluded to (Seq_ReadLn(liChannel))
82362>>>>>>>>> set pbDataByteOffset to (Seq_ReadLn(liChannel))
82363>>>>>>>>> send Seq_Read to (oTagFile(self)) liChannel
82364>>>>>>>>> send Seq_Read to (oFdFile(self)) liChannel
82365>>>>>>>>> send Seq_Read to (oIntFile(self)) liChannel
82366>>>>>>>>> send Seq_Read to (oFutureUse(self)) liChannel
82367>>>>>>>>> end_procedure
82368>>>>>>>>> procedure Seq_Write integer liChannel
82370>>>>>>>>> number lnChannelPos
82370>>>>>>>>> writeln channel liChannel (pbDataIncluded(self))
82373>>>>>>>>> get_channel_position liChannel to lnChannelPos
82374>>>>>>>>>>
82374>>>>>>>>> set priv.pnOffset to lnChannelPos
82375>>>>>>>>> writeln (repeat(" ",20))
82377>>>>>>>>> send Seq_Write to (oTagFile(self)) liChannel
82378>>>>>>>>> send Seq_Write to (oFdFile(self)) liChannel
82379>>>>>>>>> send Seq_Write to (oIntFile(self)) liChannel
82380>>>>>>>>> send Seq_Write to (oFutureUse(self)) liChannel
82381>>>>>>>>> end_procedure
82382>>>>>>>>> procedure Write_DataOffset integer liChannel number lnOffset
82384>>>>>>>>> number lnChannelPos
82384>>>>>>>>> get_channel_position liChannel to lnChannelPos
82385>>>>>>>>>>
82385>>>>>>>>> set_channel_position liChannel to (priv.pnOffset(self))
82386>>>>>>>>>>
82386>>>>>>>>> write channel liChannel lnOffset
82388>>>>>>>>> set_channel_position liChannel to lnChannelPos
82389>>>>>>>>>>
82389>>>>>>>>> end_procedure
82390>>>>>>>>>end_class // cFdxFileDef_DataAndConfigurationFiles
82391>>>>>>>>>
82391>>>>>>>>>
82391>>>>>>>>>class cFdxFileDef is a cArray
82392>>>>>>>>> procedure construct_object integer liImage
82394>>>>>>>>> forward send construct_object liImage
82396>>>>>>>>> property integer piMainFile public 0
82397>>>>>>>>> object oFileAttr is a cFdxFileDef_FileAttr NO_IMAGE
82399>>>>>>>>> end_object
82400>>>>>>>>> object oIndexAttr is a cFdxFileDef_IndexAttr NO_IMAGE
82402>>>>>>>>> end_object
82403>>>>>>>>> object oDatAndConf is a cFdxFileDef_DataAndConfigurationFiles NO_IMAGE
82405>>>>>>>>> end_object
82406>>>>>>>>> property string psDatPath public "" // Where is the dat file?
82407>>>>>>>>> property number pnTimeStamp public 0 // How old is it?
82408>>>>>>>>> // Property piReadDuringRestruct should always be false. Except when
82408>>>>>>>>> // a cFdxFileDef object is used to read a file definition during a
82408>>>>>>>>> // restructure operation.
82408>>>>>>>>> property integer piReadDuringRestruct public DFFALSE //
82409>>>>>>>>> property integer piDataOrigin public FDX_EMPTY // 0=empty 1=Read from current 2=Read from file
82410>>>>>>>>> end_procedure
82411>>>>>>>>> function iCanOpen.i integer liFile returns integer
82413>>>>>>>>> integer liDelegate liRval
82413>>>>>>>>> if liFile eq (piMainFile(self)) function_return 1
82416>>>>>>>>> get iFdxIsEncapsulated to liDelegate
82417>>>>>>>>> if liDelegate delegate get iCanOpen.i liFile to liRval
82421>>>>>>>>> else move 0 to liRval
82423>>>>>>>>> function_return liRval
82424>>>>>>>>> end_function
82425>>>>>>>>>
82425>>>>>>>>> function AttrValue_IsEmpty integer liFile returns integer
82427>>>>>>>>> function_return 0
82428>>>>>>>>> end_function
82429>>>>>>>>>
82429>>>>>>>>> item_property_list // Field parameters
82429>>>>>>>>> item_property string psName.i // DF_FIELD_NAME
82429>>>>>>>>> item_property integer piNumber.i // DF_FIELD_NUMBER
82429>>>>>>>>> item_property integer piOldNumber.i // DF_FIELD_OLD_NUMBER
82429>>>>>>>>> item_property integer piType.i // DF_FIELD_TYPE
82429>>>>>>>>> item_property integer piLen.i // DF_FIELD_LENGTH
82429>>>>>>>>> item_property integer piNative_len.i // DF_FIELD_NATIVE_LENGTH
82429>>>>>>>>> item_property integer piPrec.i // DF_FIELD_PRECISION
82429>>>>>>>>> item_property integer piRfile.i // DF_FIELD_RELATED_FILE
82429>>>>>>>>> item_property integer piRfld.i // DF_FIELD_RELATED_FIELD
82429>>>>>>>>> item_property integer piIdx.i // DF_FIELD_INDEX
82429>>>>>>>>> item_property integer piOffset.i // DF_FIELD_OFFSET
82429>>>>>>>>> end_item_property_list cFdxFileDef
#REM 82488 DEFINE FUNCTION PIOFFSET.I INTEGER LIROW RETURNS INTEGER
#REM 82492 DEFINE PROCEDURE SET PIOFFSET.I INTEGER LIROW INTEGER VALUE
#REM 82496 DEFINE FUNCTION PIIDX.I INTEGER LIROW RETURNS INTEGER
#REM 82500 DEFINE PROCEDURE SET PIIDX.I INTEGER LIROW INTEGER VALUE
#REM 82504 DEFINE FUNCTION PIRFLD.I INTEGER LIROW RETURNS INTEGER
#REM 82508 DEFINE PROCEDURE SET PIRFLD.I INTEGER LIROW INTEGER VALUE
#REM 82512 DEFINE FUNCTION PIRFILE.I INTEGER LIROW RETURNS INTEGER
#REM 82516 DEFINE PROCEDURE SET PIRFILE.I INTEGER LIROW INTEGER VALUE
#REM 82520 DEFINE FUNCTION PIPREC.I INTEGER LIROW RETURNS INTEGER
#REM 82524 DEFINE PROCEDURE SET PIPREC.I INTEGER LIROW INTEGER VALUE
#REM 82528 DEFINE FUNCTION PINATIVE_LEN.I INTEGER LIROW RETURNS INTEGER
#REM 82532 DEFINE PROCEDURE SET PINATIVE_LEN.I INTEGER LIROW INTEGER VALUE
#REM 82536 DEFINE FUNCTION PILEN.I INTEGER LIROW RETURNS INTEGER
#REM 82540 DEFINE PROCEDURE SET PILEN.I INTEGER LIROW INTEGER VALUE
#REM 82544 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 82548 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 82552 DEFINE FUNCTION PIOLDNUMBER.I INTEGER LIROW RETURNS INTEGER
#REM 82556 DEFINE PROCEDURE SET PIOLDNUMBER.I INTEGER LIROW INTEGER VALUE
#REM 82560 DEFINE FUNCTION PINUMBER.I INTEGER LIROW RETURNS INTEGER
#REM 82564 DEFINE PROCEDURE SET PINUMBER.I INTEGER LIROW INTEGER VALUE
#REM 82568 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 82572 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
82577>>>>>>>>>
82577>>>>>>>>> procedure Reset
82579>>>>>>>>> send delete_data
82580>>>>>>>>> send delete_data to (oFileAttr(self))
82581>>>>>>>>> send delete_data to (oIndexAttr(self))
82582>>>>>>>>> send Reset to (oDatAndConf(self))
82583>>>>>>>>> set psDatPath to ""
82584>>>>>>>>> set pnTimeStamp to 0
82585>>>>>>>>> set piDataOrigin to FDX_EMPTY
82586>>>>>>>>> end_procedure
82587>>>>>>>>>
82587>>>>>>>>> procedure DoTransferToMapableObject integer lhMapObject
82589>>>>>>>>> integer liMax liRow
82589>>>>>>>>> send DoReset to lhMapObject
82590>>>>>>>>> get row_count to liMax
82591>>>>>>>>> decrement liMax
82592>>>>>>>>> for liRow from 1 to liMax
82598>>>>>>>>>>
82598>>>>>>>>> if (piType.i(self,liRow)<>DF_OVERLAP) ; send DoAddItem to lhMapObject liRow (psName.i(self,liRow)) ""
82601>>>>>>>>> loop
82602>>>>>>>>>>
82602>>>>>>>>> end_procedure
82603>>>>>>>>>
82603>>>>>>>>> procedure Seq_Write integer liChannel
82605>>>>>>>>> writeln channel liChannel "*** File definition: **********************"
82608>>>>>>>>> writeln channel liChannel (piMainFile(self))
82611>>>>>>>>> writeln channel liChannel "--- Field data ----------------------------"
82614>>>>>>>>> send SEQ_WriteArrayItems liChannel self
82615>>>>>>>>> writeln channel liChannel "--- File data -----------------------------"
82618>>>>>>>>> send SEQ_WriteArrayItems liChannel (oFileAttr(self))
82619>>>>>>>>> writeln channel liChannel "--- Index data ----------------------------"
82622>>>>>>>>> send SEQ_WriteArrayItems liChannel (oIndexAttr(self))
82623>>>>>>>>> writeln channel liChannel "-------------------------------------------"
82626>>>>>>>>> writeln channel liChannel (psDatPath(self))
82629>>>>>>>>> writeln channel liChannel (pnTimeStamp(self))
82632>>>>>>>>>// send Seq_Write to (oDatAndConf(self)) liChannel
82632>>>>>>>>> writeln channel liChannel "*** End of file definition ****************"
82635>>>>>>>>> end_procedure
82636>>>>>>>>>
82636>>>>>>>>> //> Read definition from sequential file
82636>>>>>>>>> procedure Seq_Read integer liChannel
82638>>>>>>>>> integer liMainFile
82638>>>>>>>>> string lsThrowAway
82638>>>>>>>>> set piDataOrigin to FDX_READ_FROM_FILE
82639>>>>>>>>> readln channel liChannel lsThrowAway
82641>>>>>>>>> readln liMainFile
82642>>>>>>>>> set piMainFile to liMainFile
82643>>>>>>>>> readln lsThrowAway
82644>>>>>>>>> send SEQ_ReadArrayItems liChannel self
82645>>>>>>>>> readln lsThrowAway
82646>>>>>>>>> send SEQ_ReadArrayItems liChannel (oFileAttr(self))
82647>>>>>>>>> readln lsThrowAway
82648>>>>>>>>> send SEQ_ReadArrayItems liChannel (oIndexAttr(self))
82649>>>>>>>>> readln lsThrowAway
82650>>>>>>>>> set psDatPath to (SEQ_ReadLn(liChannel))
82651>>>>>>>>> set pnTimeStamp to (SEQ_ReadLn(liChannel))
82652>>>>>>>>>// send Seq_Read to (oDatAndConf(self)) liChannel
82652>>>>>>>>> readln lsThrowAway
82653>>>>>>>>> end_procedure
82654>>>>>>>>>
82654>>>>>>>>> procedure Read_File_Attr integer liFile // Get monitored file(list) attributes from record buffer
82656>>>>>>>>> integer liMin liMax liAttr liReadDuringRestruct
82656>>>>>>>>> integer liFileAttrObj liMonitoredFileAttributesObj
82656>>>>>>>>> string lsValue
82656>>>>>>>>> move (oFileAttr(self)) to liFileAttrObj
82657>>>>>>>>> move (oMonitoredFileAttributes(self)) to liMonitoredFileAttributesObj
82658>>>>>>>>> get piReadDuringRestruct to liReadDuringRestruct
82659>>>>>>>>> send reset to liFileAttrObj
82660>>>>>>>>> get piLowIndex of liMonitoredFileAttributesObj to liMin
82661>>>>>>>>> get piHighIndex of liMonitoredFileAttributesObj to liMax
82662>>>>>>>>> for liAttr from liMin to liMax
82668>>>>>>>>>>
82668>>>>>>>>> if (piMonitored.i(liMonitoredFileAttributesObj,liAttr)) begin // If it's monitored
82670>>>>>>>>> if (not(liReadDuringRestruct) or API_AttrType(liAttr)<>ATTRTYPE_FILELIST) ; get_attribute liAttr of liFile to lsValue
82675>>>>>>>>> else move "" to lsValue
82677>>>>>>>>> send add_attr_value to liFileAttrObj lsValue
82678>>>>>>>>> end
82678>>>>>>>>>>
82678>>>>>>>>> loop
82679>>>>>>>>>>
82679>>>>>>>>> end_procedure
82680>>>>>>>>> procedure Read_Field_Attr integer liFile // Get field attributes from record buffer
82682>>>>>>>>> integer liField liMax liRestruct
82682>>>>>>>>> get piReadDuringRestruct to liRestruct
82683>>>>>>>>> get_attribute DF_FILE_NUMBER_FIELDS of liFile to liMax
82686>>>>>>>>> for liField from 1 to liMax
82692>>>>>>>>>>
82692>>>>>>>>> set psName.i liField to (API_AttrValue_FIELD(DF_FIELD_NAME,liFile,liField))
82693>>>>>>>>> set piNumber.i liField to (API_AttrValue_FIELD(DF_FIELD_NUMBER,liFile,liField))
82694>>>>>>>>> if liRestruct set piOldNumber.i liField to (API_AttrValue_FIELD(DF_FIELD_OLD_NUMBER,liFile,liField))
82697>>>>>>>>> else set piOldNumber.i liField to liField
82699>>>>>>>>> set piType.i liField to (API_AttrValue_FIELD(DF_FIELD_TYPE,liFile,liField))
82700>>>>>>>>> set piLen.i liField to (API_AttrValue_FIELD(DF_FIELD_LENGTH,liFile,liField))
82701>>>>>>>>> set piNative_Len.i liField to (API_AttrValue_FIELD(DF_FIELD_NATIVE_LENGTH,liFile,liField))
82702>>>>>>>>> set piPrec.i liField to (API_AttrValue_FIELD(DF_FIELD_PRECISION,liFile,liField))
82703>>>>>>>>> set piRfile.i liField to (API_AttrValue_FIELD(DF_FIELD_RELATED_FILE,liFile,liField))
82704>>>>>>>>> set piRfld.i liField to (API_AttrValue_FIELD(DF_FIELD_RELATED_FIELD,liFile,liField))
82705>>>>>>>>> set piIdx.i liField to (API_AttrValue_FIELD(DF_FIELD_INDEX,liFile,liField))
82706>>>>>>>>> set piOffset.i liField to (API_AttrValue_FIELD(DF_FIELD_OFFSET,liFile,liField))
82707>>>>>>>>> loop
82708>>>>>>>>>>
82708>>>>>>>>> end_procedure
82709>>>>>>>>> procedure Read_Index_Attr integer liFile
82711>>>>>>>>> integer liIndexAttrObj liSegment liMax liIndex liRestruct
82711>>>>>>>>> string lsFields lsUppercases lsDirections
82711>>>>>>>>> move (oIndexAttr(self)) to liIndexAttrObj
82712>>>>>>>>> send reset to liIndexAttrObj
82713>>>>>>>>> get piReadDuringRestruct to liRestruct
82714>>>>>>>>> for liIndex from 1 to 15
82720>>>>>>>>>>
82720>>>>>>>>> get_attribute DF_INDEX_NUMBER_SEGMENTS of liFile liIndex to liMax
82723>>>>>>>>> if liMax begin // If there's an index at all
82725>>>>>>>>> set piType.i of liIndexAttrObj liIndex to (API_AttrValue_INDEX(DF_INDEX_TYPE,liFile,liIndex))
82726>>>>>>>>> set piSegments.i of liIndexAttrObj liIndex to liMax
82727>>>>>>>>> ifnot liRestruct set piBuffers.i of liIndexAttrObj liIndex to (API_AttrValue_INDEX(DF_INDEX_NUMBER_BUFFERS,liFile,liIndex))
82730>>>>>>>>> set piKey_Length.i of liIndexAttrObj liIndex to (API_AttrValue_INDEX(DF_INDEX_KEY_LENGTH,liFile,liIndex))
82731>>>>>>>>> set piLevels.i of liIndexAttrObj liIndex to (API_AttrValue_INDEX(DF_INDEX_LEVELS,liFile,liIndex))
82732>>>>>>>>> move "" to lsFields
82733>>>>>>>>> move "" to lsUppercases
82734>>>>>>>>> move "" to lsDirections
82735>>>>>>>>> for liSegment from 1 to liMax
82741>>>>>>>>>>
82741>>>>>>>>> move (lsFields +pad(API_AttrValue_IDXSEG(DF_INDEX_SEGMENT_FIELD ,liFile,liIndex,liSegment),4)) to lsFields
82742>>>>>>>>> move (lsUppercases+pad(API_AttrValue_IDXSEG(DF_INDEX_SEGMENT_CASE ,liFile,liIndex,liSegment),4)) to lsUppercases
82743>>>>>>>>> move (lsDirections+pad(API_AttrValue_IDXSEG(DF_INDEX_SEGMENT_DIRECTION,liFile,liIndex,liSegment),4)) to lsDirections
82744>>>>>>>>> loop
82745>>>>>>>>>>
82745>>>>>>>>> set psFields.i of liIndexAttrObj liIndex to lsFields
82746>>>>>>>>> set psUppercase.i of liIndexAttrObj liIndex to lsUppercases
82747>>>>>>>>> set psDirection.i of liIndexAttrObj liIndex to lsDirections
82748>>>>>>>>> end
82748>>>>>>>>>>
82748>>>>>>>>> loop
82749>>>>>>>>>>
82749>>>>>>>>> end_procedure
82750>>>>>>>>>
82750>>>>>>>>> //> Read definition from table
82750>>>>>>>>> procedure Read_File_Definition.i integer liFile
82752>>>>>>>>> string lsDriver lsExt lsPhysFileName lsPath
82752>>>>>>>>> set piDataOrigin to FDX_REAL_WORLD
82753>>>>>>>>> set piMainFile to liFile
82754>>>>>>>>> send Read_File_Attr liFile
82755>>>>>>>>> send Read_Field_Attr liFile
82756>>>>>>>>> send Read_Index_Attr liFile
82757>>>>>>>>> get AttrValue_FILE DF_FILE_DRIVER liFile to lsDriver
82758>>>>>>>>> if lsDriver eq "DATAFLEX" move ".DAT" to lsExt
82761>>>>>>>>> else move ".INT" to lsExt
82763>>>>>>>>> get AttrValue_FILE DF_FILE_PHYSICAL_NAME liFile to lsPhysFileName
82764>>>>>>>>> ifnot "." in (SEQ_RemovePathFromFileName(lsPhysFileName)) move (lsPhysFileName+lsExt) to lsPhysFileName
82767>>>>>>>>>
82767>>>>>>>>>// send Read_AuxillaryFiles to (oDatAndConf(self)) (StringLeftBut(lsPhysFileName,4))
82767>>>>>>>>>
82767>>>>>>>>> if (SEQ_ExtractPathFromFileName(lsPhysFileName)) eq "" begin
82769>>>>>>>>> move (SEQ_FindFileAlongDFPath(lsPhysFileName)) to lsPath
82770>>>>>>>>> move (SEQ_ComposeAbsoluteFileName(lsPath,lsPhysFileName)) to lsPhysFileName
82771>>>>>>>>> end
82771>>>>>>>>>>
82771>>>>>>>>> set psDatPath to lsPhysFileName
82772>>>>>>>>> set pnTimeStamp to (SEQ_FileModTime(lsPhysFileName))
82773>>>>>>>>> end_procedure
82774>>>>>>>>>
82774>>>>>>>>> // *************************************************************************
82774>>>>>>>>> // *** These attribute value functions are used by the cFdx class ******
82774>>>>>>>>> //> Call back for every entry with a rootname
82774>>>>>>>>> function sAttrValueFile.i integer liAttr returns string
82776>>>>>>>>> integer liMonitoredFileAttributesObj
82776>>>>>>>>> move (oMonitoredFileAttributes(self)) to liMonitoredFileAttributesObj
82777>>>>>>>>> if (piMonitored.i(liMonitoredFileAttributesObj,liAttr)) begin
82779>>>>>>>>> get piAttrIndex.i of liMonitoredFileAttributesObj liAttr to liAttr
82780>>>>>>>>> function_return (value(oFileAttr(self),liAttr))
82781>>>>>>>>> end
82781>>>>>>>>>>
82781>>>>>>>>> function_return t.fdx.attr_not_avail
82782>>>>>>>>> end_function
82783>>>>>>>>> function sAttrValueField.ii integer liAttr integer liField returns string
82785>>>>>>>>> if liAttr eq DF_FIELD_NAME function_return (psName.i(self,liField))
82788>>>>>>>>> if liAttr eq DF_FIELD_NUMBER function_return (piNumber.i(self,liField))
82791>>>>>>>>> if liAttr eq DF_FIELD_OLD_NUMBER function_return (piOldNumber.i(self,liField))
82794>>>>>>>>> if liAttr eq DF_FIELD_TYPE function_return (piType.i(self,liField))
82797>>>>>>>>> if liAttr eq DF_FIELD_LENGTH function_return (piLen.i(self,liField))
82800>>>>>>>>> if liAttr eq DF_FIELD_NATIVE_LENGTH function_return (piNative_Len.i(self,liField))
82803>>>>>>>>> if liAttr eq DF_FIELD_PRECISION function_return (piPrec.i(self,liField))
82806>>>>>>>>> if liAttr eq DF_FIELD_RELATED_FILE function_return (piRfile.i(self,liField))
82809>>>>>>>>> if liAttr eq DF_FIELD_RELATED_FIELD function_return (piRfld.i(self,liField))
82812>>>>>>>>> if liAttr eq DF_FIELD_INDEX function_return (piIdx.i(self,liField))
82815>>>>>>>>> if liAttr eq DF_FIELD_OFFSET function_return (piOffset.i(self,liField))
82818>>>>>>>>> function_return t.fdx.attr_not_avail
82819>>>>>>>>> end_function
82820>>>>>>>>> function sAttrValueIndex.ii integer liAttr integer liIndex returns string
82822>>>>>>>>> integer liObj
82822>>>>>>>>> move (oIndexAttr(self)) to liObj
82823>>>>>>>>> if liAttr eq DF_INDEX_NUMBER_SEGMENTS function_return (piSegments.i(liObj,liIndex))
82826>>>>>>>>> if liAttr eq DF_INDEX_NUMBER_BUFFERS function_return (piBuffers.i(liObj,liIndex))
82829>>>>>>>>> if liAttr eq DF_INDEX_TYPE function_return (piType.i(liObj,liIndex))
82832>>>>>>>>> if liAttr eq DF_INDEX_LEVELS function_return (piLevels.i(liObj,liIndex))
82835>>>>>>>>> if liAttr eq DF_INDEX_KEY_LENGTH function_return (piKey_Length.i(liObj,liIndex))
82838>>>>>>>>> function_return t.fdx.attr_not_avail
82839>>>>>>>>> end_function
82840>>>>>>>>> function sAttrValueIndexSegment.iii integer liAttr integer liIndex integer liSegment returns string
82842>>>>>>>>> integer liObj
82842>>>>>>>>> string lsStr
82842>>>>>>>>> move (oIndexAttr(self)) to liObj
82843>>>>>>>>> if liAttr eq DF_INDEX_SEGMENT_FIELD move (psFields.i(liObj,liIndex)) to lsStr
82846>>>>>>>>> if liAttr eq DF_INDEX_SEGMENT_CASE move (psUppercase.i(liObj,liIndex)) to lsStr
82849>>>>>>>>> if liAttr eq DF_INDEX_SEGMENT_DIRECTION move (psDirection.i(liObj,liIndex)) to lsStr
82852>>>>>>>>> function_return (mid(lsStr,4,liSegment-1*4+1))
82853>>>>>>>>> end_function
82854>>>>>>>>> function sAttrValueSpecial1.iii integer liAttr integer liField1 integer liField2 returns string
82856>>>>>>>>> integer liStart1 liEnd1 liStart2 liEnd2 liFile
82856>>>>>>>>> get piMainFile to liFile // The liFile parameter is ignored whe called from in here.
82857>>>>>>>>> get AttrValue_FIELD DF_FIELD_OFFSET liFile liField1 to liStart1
82858>>>>>>>>> get AttrValue_FIELD DF_FIELD_OFFSET liFile liField2 to liStart2
82859>>>>>>>>> get AttrValue_FIELD DF_FIELD_NATIVE_LENGTH liFile liField1 to liEnd1 // overload
82860>>>>>>>>> get AttrValue_FIELD DF_FIELD_NATIVE_LENGTH liFile liField2 to liEnd2 // overload
82861>>>>>>>>> move (liStart1+liEnd1-1) to liEnd1
82862>>>>>>>>> move (liStart2+liEnd2-1) to liEnd2
82863>>>>>>>>> //send obs (string(liStart1)+"<="+string(liEnd2)+"and"+string(liStart2)+"<="+string(liEnd1)) (liStart1<=liEnd2 and liStart2<=liEnd1)
82863>>>>>>>>> function_return (liStart1<=liEnd2 and liStart2<=liEnd1)
82864>>>>>>>>> end_function
82865>>>>>>>>>
82865>>>>>>>>> function AttrValue_FILE integer liAttr integer liFile returns string
82867>>>>>>>>> integer liDelegate
82867>>>>>>>>> string lsRval
82867>>>>>>>>> if liFile eq (piMainFile(self)) function_return (sAttrValueFile.i(self,liAttr))
82870>>>>>>>>> get iFdxIsEncapsulated to liDelegate
82871>>>>>>>>> if liDelegate delegate get AttrValue_FILE liAttr liFile to lsRval
82875>>>>>>>>> else move "Not available" to lsRval
82877>>>>>>>>> function_return lsRval
82878>>>>>>>>> end_function
82879>>>>>>>>>
82879>>>>>>>>> procedure set AttrValue_FILE integer liAttr integer liFile string lsValue
82881>>>>>>>>> integer liMonitoredFileAttributesObj
82881>>>>>>>>> if (liFile=piMainFile(self)) begin
82883>>>>>>>>> move (oMonitoredFileAttributes(self)) to liMonitoredFileAttributesObj
82884>>>>>>>>> if (piMonitored.i(liMonitoredFileAttributesObj,liAttr)) begin
82886>>>>>>>>> get piAttrIndex.i of liMonitoredFileAttributesObj liAttr to liAttr
82887>>>>>>>>> set value of (oFileAttr(self)) item liAttr to lsValue
82888>>>>>>>>> end
82888>>>>>>>>>>
82888>>>>>>>>> end
82888>>>>>>>>>>
82888>>>>>>>>> else error 666 "Illegal file number"
82890>>>>>>>>> end_procedure
82891>>>>>>>>>
82891>>>>>>>>> function AttrValue_FILELIST integer liAttr integer liFile returns string
82893>>>>>>>>> integer liDelegate
82893>>>>>>>>> string lsRval
82893>>>>>>>>> get iFdxIsEncapsulated to liDelegate
82894>>>>>>>>> if liDelegate delegate get AttrValue_FILELIST liAttr liFile to lsRval
82898>>>>>>>>> else begin
82899>>>>>>>>> move t.fdx.attr_not_avail to lsRval
82900>>>>>>>>> if liAttr eq DF_FILE_ROOT_NAME move ("FILE"+string(liFile)) to lsRval
82903>>>>>>>>> if liAttr eq DF_FILE_LOGICAL_NAME move ("DFFILE"+string(liFile)) to lsRval
82906>>>>>>>>> if liAttr eq DF_FILE_DISPLAY_NAME move ("File"+string(liFile)) to lsRval
82909>>>>>>>>> move (rtrim(lsRval)) to lsRval
82910>>>>>>>>> end
82910>>>>>>>>>>
82910>>>>>>>>> function_return lsRval
82911>>>>>>>>> end_function
82912>>>>>>>>>
82912>>>>>>>>> function AttrValue_FIELD integer liAttr integer liFile integer liField returns string
82914>>>>>>>>> integer liDelegate
82914>>>>>>>>> string lsRval
82914>>>>>>>>> if liFile eq (piMainFile(self)) function_return (sAttrValueField.ii(self,liAttr,liField))
82917>>>>>>>>> get iFdxIsEncapsulated to liDelegate
82918>>>>>>>>> if liDelegate delegate get AttrValue_FIELD liAttr liFile liField to lsRval
82922>>>>>>>>> else begin
82923>>>>>>>>> move "Not available" to lsRval
82924>>>>>>>>> if liAttr eq DF_FIELD_NAME move ("FIELD"+string(liField)) to lsRval
82927>>>>>>>>> end
82927>>>>>>>>>>
82927>>>>>>>>> function_return lsRval
82928>>>>>>>>> end_function
82929>>>>>>>>>
82929>>>>>>>>> procedure set AttrValue_FIELD integer liAttr integer liFile integer liField string lsValue
82931>>>>>>>>> if (liFile=piMainFile(self)) begin
82933>>>>>>>>> if liAttr eq DF_FIELD_NAME set psName.i liField to lsValue
82936>>>>>>>>> if liAttr eq DF_FIELD_NUMBER set piNumber.i liField to lsValue
82939>>>>>>>>> if liAttr eq DF_FIELD_OLD_NUMBER set piOldNumber.i liField to lsValue
82942>>>>>>>>> if liAttr eq DF_FIELD_TYPE set piType.i liField to lsValue
82945>>>>>>>>> if liAttr eq DF_FIELD_LENGTH set piLen.i liField to lsValue
82948>>>>>>>>> if liAttr eq DF_FIELD_NATIVE_LENGTH set piNative_Len.i liField to lsValue
82951>>>>>>>>> if liAttr eq DF_FIELD_PRECISION set piPrec.i liField to lsValue
82954>>>>>>>>> if liAttr eq DF_FIELD_RELATED_FILE set piRfile.i liField to lsValue
82957>>>>>>>>> if liAttr eq DF_FIELD_RELATED_FIELD set piRfld.i liField to lsValue
82960>>>>>>>>> if liAttr eq DF_FIELD_INDEX set piIdx.i liField to lsValue
82963>>>>>>>>> if liAttr eq DF_FIELD_OFFSET set piOffset.i liField to lsValue
82966>>>>>>>>> end
82966>>>>>>>>>>
82966>>>>>>>>> else error 666 "Illegal file number"
82968>>>>>>>>> end_procedure
82969>>>>>>>>>
82969>>>>>>>>> function AttrValue_INDEX integer liAttr integer liFile integer liIndex returns string
82971>>>>>>>>> integer liDelegate
82971>>>>>>>>> string lsRval
82971>>>>>>>>> if liFile eq (piMainFile(self)) function_return (sAttrValueIndex.ii(self,liAttr,liIndex))
82974>>>>>>>>> get iFdxIsEncapsulated to liDelegate
82975>>>>>>>>> if liDelegate delegate get AttrValue_INDEX liAttr liFile liIndex to lsRval
82979>>>>>>>>> else move "Not available" to lsRval
82981>>>>>>>>> function_return lsRval
82982>>>>>>>>> end_function
82983>>>>>>>>>
82983>>>>>>>>> procedure set AttrValue_INDEX integer liAttr integer liFile integer liIndex string lsValue
82985>>>>>>>>> integer liObj
82985>>>>>>>>> if (liFile=piMainFile(self)) begin
82987>>>>>>>>> move (oIndexAttr(self)) to liObj
82988>>>>>>>>> if liAttr eq DF_INDEX_NUMBER_SEGMENTS set piSegments.i of liObj liIndex to lsValue
82991>>>>>>>>> if liAttr eq DF_INDEX_NUMBER_BUFFERS set piBuffers.i of liObj liIndex to lsValue
82994>>>>>>>>> if liAttr eq DF_INDEX_TYPE set piType.i of liObj liIndex to lsValue
82997>>>>>>>>> if liAttr eq DF_INDEX_LEVELS set piLevels.i of liObj liIndex to lsValue
83000>>>>>>>>> if liAttr eq DF_INDEX_KEY_LENGTH set piKey_Length.i of liObj liIndex to lsValue
83003>>>>>>>>> end
83003>>>>>>>>>>
83003>>>>>>>>> else error 666 "Illegal file number"
83005>>>>>>>>> end_procedure
83006>>>>>>>>>
83006>>>>>>>>> function AttrValue_IDXSEG integer liAttr integer liFile integer liIndex integer liSegment returns string
83008>>>>>>>>> integer liDelegate
83008>>>>>>>>> string lsRval
83008>>>>>>>>> if liFile eq (piMainFile(self)) function_return (sAttrValueIndexSegment.iii(self,liAttr,liIndex,liSegment))
83011>>>>>>>>> get iFdxIsEncapsulated to liDelegate
83012>>>>>>>>> if liDelegate delegate get AttrValue_IDXSEG liAttr liFile liIndex liSegment to lsRval
83016>>>>>>>>> else move "Not available" to lsRval
83018>>>>>>>>> function_return lsRval
83019>>>>>>>>> end_function
83020>>>>>>>>>
83020>>>>>>>>> procedure set AttrValue_IDXSEG integer liAttr integer liFile integer liIndex integer liSegment string lsValue
83022>>>>>>>>> integer liObj
83022>>>>>>>>> string lsStr
83022>>>>>>>>> if (liFile=piMainFile(self)) begin
83024>>>>>>>>> move (oIndexAttr(self)) to liObj
83025>>>>>>>>> if liAttr eq DF_INDEX_SEGMENT_FIELD get psFields.i of liObj liIndex to lsStr
83028>>>>>>>>> if liAttr eq DF_INDEX_SEGMENT_CASE get psUppercase.i of liObj liIndex to lsStr
83031>>>>>>>>> if liAttr eq DF_INDEX_SEGMENT_DIRECTION get psDirection.i of liObj liIndex to lsStr
83034>>>>>>>>>
83034>>>>>>>>> move (overstrike(pad(trim(lsValue),4),lsStr,liSegment-1*4+1)) to lsStr
83035>>>>>>>>>
83035>>>>>>>>> if liAttr eq DF_INDEX_SEGMENT_FIELD set psFields.i of liObj liIndex to lsStr
83038>>>>>>>>> if liAttr eq DF_INDEX_SEGMENT_CASE set psUppercase.i of liObj liIndex to lsStr
83041>>>>>>>>> if liAttr eq DF_INDEX_SEGMENT_DIRECTION set psDirection.i of liObj liIndex to lsStr
83044>>>>>>>>> end
83044>>>>>>>>>>
83044>>>>>>>>> else error 666 "Illegal file number"
83046>>>>>>>>> end_procedure
83047>>>>>>>>>
83047>>>>>>>>> function AttrValue_SPECIAL1 integer liAttr integer liFile integer liField1 integer liField2 returns string
83049>>>>>>>>> integer liDelegate
83049>>>>>>>>> string lsRval
83049>>>>>>>>> if liFile eq (piMainFile(self)) function_return (sAttrValueSpecial1.iii(self,liAttr,liField1,liField2))
83052>>>>>>>>> get iFdxIsEncapsulated to liDelegate
83053>>>>>>>>> if liDelegate delegate get AttrValue_SPECIAL1 liAttr liFile liField1 liField2 to lsRval
83057>>>>>>>>> else move "Not available" to lsRval
83059>>>>>>>>> function_return lsRval
83060>>>>>>>>> end_function
83061>>>>>>>>> function sDatPath.i integer liFile returns string
83063>>>>>>>>> if liFile eq (piMainFile(self)) function_return (psDatPath(self))
83066>>>>>>>>> function_return ""
83067>>>>>>>>> end_function
83068>>>>>>>>> function nTimeStamp.i integer liFile returns number
83070>>>>>>>>> if liFile eq (piMainFile(self)) function_return (pnTimeStamp(self))
83073>>>>>>>>> function_return 0
83074>>>>>>>>> end_function
83075>>>>>>>>>
83075>>>>>>>>> function psFileName returns string
83077>>>>>>>>> integer lbDelegate
83077>>>>>>>>> string lsRval
83077>>>>>>>>> get iFdxIsEncapsulated to lbDelegate
83078>>>>>>>>> if lbDelegate delegate get psFileName to lsRval
83082>>>>>>>>> else move "" to lsRval
83084>>>>>>>>> function_return lsRval
83085>>>>>>>>> end_function
83086>>>>>>>>>
83086>>>>>>>>> function AttrValue_IsEmpty integer liFile returns integer
83088>>>>>>>>> string lsStr
83088>>>>>>>>> get psRootName.i liFile to lsStr
83089>>>>>>>>> function_return (lsStr="")
83090>>>>>>>>> end_function
83091>>>>>>>>>
83091>>>>>>>>>
83091>>>>>>>>> function iFdxIsEncapsulated returns integer
83093>>>>>>>>> integer liRval
83093>>>>>>>>> delegate get iFdxIsEncapsulated to liRval
83095>>>>>>>>> function_return liRval
83096>>>>>>>>> end_function
83097>>>>>>>>>end_class // cFdxFileDef
83098>>>>>>>>>
83098>>>>>>>>>define FDX_FILE_VERSION for "FDX2.0"
83098>>>>>>>>>
83098>>>>>>>>>class cFdx is a cArray
83099>>>>>>>>> procedure construct_object integer liImage
83101>>>>>>>>> forward send construct_object liImage
83103>>>>>>>>> property integer piFileDefClass public U_cFdxFileDef // Class ID for FileDefObject
83104>>>>>>>>> property string psVersion public FDX_FILE_VERSION
83105>>>>>>>>> property integer piReadMode public -1 // All files, open files or custom selection?
83106>>>>>>>>> property string psIdTag public "" // For future use
83107>>>>>>>>> property number pnTS_Time public 0 // Date of snapshot (TS format)
83108>>>>>>>>> property string psTitle public ""
83109>>>>>>>>> property string psFileName public "Un-known"
83110>>>>>>>>> property integer piDataOrigin public FDX_EMPTY // 0=empty 1=Read from current 2=Read from file
83111>>>>>>>>>
83111>>>>>>>>> property integer pbIncludeFDTAGINT public DFFALSE
83112>>>>>>>>>
83112>>>>>>>>> object oGlobalAttributes is a cArray no_image
83114>>>>>>>>> end_object
83115>>>>>>>>> object oOtherAttributes is a cArray no_image
83117>>>>>>>>> end_object
83118>>>>>>>>> object oFdxFileRelations is a cFdxFileRelations no_image
83120>>>>>>>>> end_object
83121>>>>>>>>> property integer piReadResult public 0 // Was last Seq_Read operation successful?
83122>>>>>>>>> end_procedure
83123>>>>>>>>>
83123>>>>>>>>> function sOriginAsText returns string
83125>>>>>>>>> if (piDataOrigin(self)) eq FDX_EMPTY function_return "Empty"
83128>>>>>>>>> if (piDataOrigin(self)) eq FDX_REAL_WORLD function_return "Current"
83131>>>>>>>>> function_return (SEQ_RemovePathFromFileName(psFileName(self)))
83132>>>>>>>>> end_function
83133>>>>>>>>>
83133>>>>>>>>> item_property_list
83133>>>>>>>>> item_property string psRootName.i
83133>>>>>>>>> item_property string psDFName.i
83133>>>>>>>>> item_property string psDisplayName.i
83133>>>>>>>>> item_property integer piFileDefObject.i
83133>>>>>>>>> item_property integer piAuxArray.i
83133>>>>>>>>> item_property integer aux_value
83133>>>>>>>>> end_item_property_list cFdx
#REM 83177 DEFINE FUNCTION AUX_VALUE INTEGER LIROW RETURNS INTEGER
#REM 83181 DEFINE PROCEDURE SET AUX_VALUE INTEGER LIROW INTEGER VALUE
#REM 83185 DEFINE FUNCTION PIAUXARRAY.I INTEGER LIROW RETURNS INTEGER
#REM 83189 DEFINE PROCEDURE SET PIAUXARRAY.I INTEGER LIROW INTEGER VALUE
#REM 83193 DEFINE FUNCTION PIFILEDEFOBJECT.I INTEGER LIROW RETURNS INTEGER
#REM 83197 DEFINE PROCEDURE SET PIFILEDEFOBJECT.I INTEGER LIROW INTEGER VALUE
#REM 83201 DEFINE FUNCTION PSDISPLAYNAME.I INTEGER LIROW RETURNS STRING
#REM 83205 DEFINE PROCEDURE SET PSDISPLAYNAME.I INTEGER LIROW STRING VALUE
#REM 83209 DEFINE FUNCTION PSDFNAME.I INTEGER LIROW RETURNS STRING
#REM 83213 DEFINE PROCEDURE SET PSDFNAME.I INTEGER LIROW STRING VALUE
#REM 83217 DEFINE FUNCTION PSROOTNAME.I INTEGER LIROW RETURNS STRING
#REM 83221 DEFINE PROCEDURE SET PSROOTNAME.I INTEGER LIROW STRING VALUE
83226>>>>>>>>>
83226>>>>>>>>> function iCanOpen.i integer liFile returns integer
83228>>>>>>>>> function_return (piFileDefObject.i(self,liFile))
83229>>>>>>>>> end_function
83230>>>>>>>>>
83230>>>>>>>>> procedure AttrType_Callback integer liAttrType integer liMsg integer liObj
83232>>>>>>>>> integer liMin liMax liSelf liMonAttrObj liAttr
83232>>>>>>>>> move (oMonitoredGlobalAttributes(self)) to liMonAttrObj
83233>>>>>>>>> move self to liSelf
83234>>>>>>>>> if liAttrType eq ATTRTYPE_GLOBAL begin
83236>>>>>>>>> get piLowIndex of liMonAttrObj to liMin
83237>>>>>>>>> get piHighIndex of liMonAttrObj to liMax
83238>>>>>>>>> for liAttr from liMin to liMax
83244>>>>>>>>>>
83244>>>>>>>>> if (piMonitored.i(liMonAttrObj,liAttr)) send liMsg to liObj liSelf liAttr
83247>>>>>>>>> loop
83248>>>>>>>>>>
83248>>>>>>>>> end
83248>>>>>>>>>>
83248>>>>>>>>> end_procedure
83249>>>>>>>>>
83249>>>>>>>>> procedure Wait_SetText string lsStr
83251>>>>>>>>> end_procedure
83252>>>>>>>>> procedure Wait_SetText2 string lsStr
83254>>>>>>>>> end_procedure
83255>>>>>>>>>
83255>>>>>>>>> procedure Reset
83257>>>>>>>>> integer liMax liRow liObj
83257>>>>>>>>> get row_count to liMax
83258>>>>>>>>> for liRow from 0 to (liMax-1)
83264>>>>>>>>>>
83264>>>>>>>>> get piFileDefObject.i liRow to liObj
83265>>>>>>>>> if liObj send request_destroy_object to liObj
83268>>>>>>>>> get piAuxArray.i liRow to liObj
83269>>>>>>>>> if liObj send request_destroy_object to liObj
83272>>>>>>>>> loop
83273>>>>>>>>>>
83273>>>>>>>>> send delete_data
83274>>>>>>>>> send delete_data to (oGlobalAttributes(self))
83275>>>>>>>>> send delete_data to (oOtherAttributes(self))
83276>>>>>>>>> send reset to (oFdxFileRelations(self))
83277>>>>>>>>> set piDataOrigin to FDX_EMPTY
83278>>>>>>>>> set psTitle to ""
83279>>>>>>>>> set psFileName to ""
83280>>>>>>>>> end_procedure
83281>>>>>>>>>
83281>>>>>>>>> procedure Callback_RelationsToField integer liMsg integer liObj integer liSelectType integer liSelectToFile integer liSelectToField
83283>>>>>>>>> send aux_callback.iiiii to (oFdxFileRelations(self)) liMsg liObj liSelectType liSelectToFile liSelectToField
83284>>>>>>>>> end_procedure
83285>>>>>>>>> procedure Callback_Relations integer liMsg integer liObj integer liSelectType integer liSelectFrom integer liSelectTo
83287>>>>>>>>> send callback.iiiii to (oFdxFileRelations(self)) liMsg liObj liSelectType liSelectFrom liSelectTo
83288>>>>>>>>> end_procedure
83289>>>>>>>>> function sChildFiles.i integer liFile returns string
83291>>>>>>>>> function_return (sChildFiles.i(oFdxFileRelations(self),liFile))
83292>>>>>>>>> end_function
83293>>>>>>>>> function sParentFiles.i integer liFile returns string
83295>>>>>>>>> function_return (sParentFiles.i(oFdxFileRelations(self),liFile))
83296>>>>>>>>> end_function
83297>>>>>>>>>
83297>>>>>>>>> function iCreate_FileDef_Object returns integer
83299>>>>>>>>> integer liRval liCurrentObject liClass
83299>>>>>>>>> get piFileDefClass to liClass
83300>>>>>>>>> if liClass begin
83302>>>>>>>>> name liClass U_aps_class
83302>>>>>>>>> move self to liCurrentObject
83303>>>>>>>>> object dynamo_object is a aps_class
83305>>>>>>>>> move self to liRval
83306>>>>>>>>> end_object
83307>>>>>>>>> move liCurrentObject to self
83308>>>>>>>>> end
83308>>>>>>>>>>
83308>>>>>>>>> else move 0 to liRval
83310>>>>>>>>> function_return liRval
83311>>>>>>>>> end_function
83312>>>>>>>>>
83312>>>>>>>>> procedure OnFileAdded integer liFile
83314>>>>>>>>> send Wait_SetText2 (psDisplayName.i(self,liFile))
83315>>>>>>>>> end_procedure
83316>>>>>>>>>
83316>>>>>>>>> procedure Read_Global_Attributes
83318>>>>>>>>> integer liGlobalAttributesObj liAttr liMin liMax liMonGlAttrObj
83318>>>>>>>>> move (oMonitoredGlobalAttributes(self)) to liMonGlAttrObj
83319>>>>>>>>> move (oGlobalAttributes(self)) to liGlobalAttributesObj
83320>>>>>>>>> get piLowIndex of liMonGlAttrObj to liMin
83321>>>>>>>>> get piHighIndex of liMonGlAttrObj to liMax
83322>>>>>>>>> for liAttr from liMin to liMax
83328>>>>>>>>>>
83328>>>>>>>>> if (piMonitored.i(liMonGlAttrObj,liAttr)) set value of liGlobalAttributesObj item (piAttrIndex.i(liMonGlAttrObj,liAttr)) to (API_AttrValue_GLOBAL(liAttr))
83331>>>>>>>>> loop
83332>>>>>>>>>>
83332>>>>>>>>> end_procedure
83333>>>>>>>>> procedure Read_Other_Attributes
83335>>>>>>>>> integer liAttr liMax liOtherAttributesObj
83335>>>>>>>>> move (oOtherAttributes(self)) to liOtherAttributesObj
83336>>>>>>>>> for liAttr from 0 to (OA_MAX-1) // OA_MAX is a constant (API_ATTR.UTL)
83342>>>>>>>>>>
83342>>>>>>>>> set value of liOtherAttributesObj item liAttr to (API_OtherAttr_Value(liAttr))
83343>>>>>>>>> loop
83344>>>>>>>>>>
83344>>>>>>>>> end_procedure
83345>>>>>>>>> procedure Read_Driver_Information // We currently don't do drivers
83347>>>>>>>>> end_procedure
83348>>>>>>>>>
83348>>>>>>>>> procedure Read_File_Definition integer liFile
83350>>>>>>>>> integer liOpen liWasOpen liObj
83350>>>>>>>>> set psRootName.i liFile to (DBMS_Rootname(liFile))
83351>>>>>>>>> set psDFName.i liFile to (DBMS_DFName(liFile))
83352>>>>>>>>> set psDisplayName.i liFile to (DBMS_DisplayName(liFile))
83353>>>>>>>>> get_attribute DF_FILE_OPENED of liFile to liWasOpen
83356>>>>>>>>> ifnot liWasOpen move (DBMS_OpenFile(liFile,DF_SHARE,0)) to liOpen
83359>>>>>>>>> else move 1 to liOpen
83361>>>>>>>>> if liOpen begin
83363>>>>>>>>> get iCreate_FileDef_Object to liObj
83364>>>>>>>>> send Read_File_Definition.i to liObj liFile
83365>>>>>>>>> set piFileDefObject.i liFile to liObj
83366>>>>>>>>> end
83366>>>>>>>>>>
83366>>>>>>>>> send OnFileAdded liFile
83367>>>>>>>>> if (liOpen and not(liWasOpen)) close liFile
83370>>>>>>>>> end_procedure
83371>>>>>>>>>
83371>>>>>>>>> //> This is used for rereading a definition after
83371>>>>>>>>> //> it has been restructured
83371>>>>>>>>> procedure Read_File_Definition_Again integer liFile
83373>>>>>>>>> integer liObj
83373>>>>>>>>> get piFileDefObject.i liFile to liObj
83374>>>>>>>>> if liObj begin
83376>>>>>>>>> send request_destroy_object to liObj
83377>>>>>>>>> set piFileDefObject.i liFile to 0
83378>>>>>>>>> end
83378>>>>>>>>>>
83378>>>>>>>>> send Read_File_Definition liFile
83379>>>>>>>>> end_procedure
83380>>>>>>>>>
83380>>>>>>>>> procedure Read_File_RootName_Again string lsRootName
83382>>>>>>>>> integer liFile
83382>>>>>>>>> move (uppercase(lsRootName)) to lsRootName
83383>>>>>>>>> move 0 to liFile
83384>>>>>>>>> repeat
83384>>>>>>>>>>
83384>>>>>>>>> get_attribute DF_FILE_NEXT_USED of liFile to liFile
83387>>>>>>>>> if liFile begin
83389>>>>>>>>> if lsRootName eq (uppercase(API_AttrValue_FILELIST(DF_FILE_ROOT_NAME,liFile))) send Read_File_Definition_Again liFile
83392>>>>>>>>> end
83392>>>>>>>>>>
83392>>>>>>>>> until liFile eq 0
83394>>>>>>>>> end_procedure
83395>>>>>>>>>
83395>>>>>>>>> procedure Read_Current_Filelist integer liReadMode // FDX_ALL_OPEN FDX_ALL_FILES FDX_FROM_SET
83397>>>>>>>>> integer liFile
83397>>>>>>>>> send Wait_SetText "Reading current table definitions"
83398>>>>>>>>> send Reset
83399>>>>>>>>> set psVersion to FDX_FILE_VERSION
83400>>>>>>>>> set piReadMode to liReadMode
83401>>>>>>>>> set psIdTag to "Un-tagged"
83402>>>>>>>>> set pnTS_Time to (TS_SysTime())
83403>>>>>>>>> set psTitle to ""
83404>>>>>>>>> send Read_Global_Attributes
83405>>>>>>>>> send Read_Other_Attributes
83406>>>>>>>>> if liReadMode eq FDX_ALL_OPEN begin
83408>>>>>>>>> move 0 to liFile
83409>>>>>>>>> repeat
83409>>>>>>>>>>
83409>>>>>>>>> get_attribute DF_FILE_NEXT_OPENED of liFile to liFile
83412>>>>>>>>> if liFile send Read_File_Definition liFile
83415>>>>>>>>> until liFile eq 0
83417>>>>>>>>> end
83417>>>>>>>>>>
83417>>>>>>>>> if liReadMode eq FDX_ALL_FILES begin
83419>>>>>>>>> move 0 to liFile
83420>>>>>>>>> repeat
83420>>>>>>>>>>
83420>>>>>>>>> get_attribute DF_FILE_NEXT_USED of liFile to liFile
83423>>>>>>>>> if liFile send Read_File_Definition liFile
83426>>>>>>>>> until liFile eq 0
83428>>>>>>>>> end
83428>>>>>>>>>>
83428>>>>>>>>> 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
83429>>>>>>>>> set piDataOrigin to FDX_REAL_WORLD
83430>>>>>>>>> end_procedure
83431>>>>>>>>>
83431>>>>>>>>> // *************************************************************************
83431>>>>>>>>> // *** Sequential read/write methods ***************************************
83431>>>>>>>>> procedure OnFileRead integer liChannel integer liFile
83433>>>>>>>>> end_procedure
83434>>>>>>>>> procedure OnFileWrite integer liChannel integer liFile
83436>>>>>>>>> end_procedure
83437>>>>>>>>>
83437>>>>>>>>> procedure Seq_Read_AuxArray integer liChannel integer liFile
83439>>>>>>>>> integer liDo liObj
83439>>>>>>>>> readln channel liChannel liDo
83441>>>>>>>>> if liDo begin
83443>>>>>>>>> object oArray is a cArray
83445>>>>>>>>> move self to liObj
83446>>>>>>>>> end_object
83447>>>>>>>>> send SEQ_ReadArrayItems liChannel liObj
83448>>>>>>>>> set piAuxArray.i liFile to liObj
83449>>>>>>>>> end
83449>>>>>>>>>>
83449>>>>>>>>> end_procedure
83450>>>>>>>>>
83450>>>>>>>>> procedure Seq_Read_FileDefObject integer liChannel integer liFile
83452>>>>>>>>> integer liDo liObj
83452>>>>>>>>> readln channel liChannel liDo
83454>>>>>>>>> if liDo begin
83456>>>>>>>>> get iCreate_FileDef_Object to liObj
83457>>>>>>>>> if liObj begin
83459>>>>>>>>> send Seq_Read to liObj liChannel liFile
83460>>>>>>>>> set piFileDefObject.i liFile to liObj
83461>>>>>>>>> end
83461>>>>>>>>>>
83461>>>>>>>>> else error 666 "File definition class has not been specified in cFDX_Container object"
83463>>>>>>>>> end
83463>>>>>>>>>>
83463>>>>>>>>> end_procedure
83464>>>>>>>>>
83464>>>>>>>>> procedure Seq_Read integer liChannel
83466>>>>>>>>> integer liSeqEof liFile
83466>>>>>>>>> string lsDisplayName lsDFName lsRootName lsTemp
83466>>>>>>>>> send Wait_SetText "Importing table definitions"
83467>>>>>>>>> send Wait_SetText2 ""
83468>>>>>>>>> move (SEQ_ReadLn(liChannel)) to lsTemp
83469>>>>>>>>> set piReadResult to 0
83470>>>>>>>>> if lsTemp eq (psVersion(self)) begin
83472>>>>>>>>> send reset
83473>>>>>>>>> set piReadMode to (SEQ_ReadLn(liChannel))
83474>>>>>>>>> set psIdTag to (SEQ_ReadLn(liChannel))
83475>>>>>>>>> set pnTS_Time to (SEQ_ReadLn(liChannel))
83476>>>>>>>>> set psTitle to (SEQ_ReadLn(liChannel))
83477>>>>>>>>> send SEQ_ReadArrayItems liChannel (oGlobalAttributes(self))
83478>>>>>>>>> send SEQ_ReadArrayItems liChannel (oOtherAttributes(self))
83479>>>>>>>>> move 0 to liSeqEof
83480>>>>>>>>> repeat
83480>>>>>>>>>>
83480>>>>>>>>> readln channel liChannel lsTemp
83482>>>>>>>>> if lsTemp eq "END.OF.FILELIST.CFG" move 1 to liSeqEof
83485>>>>>>>>> else begin
83486>>>>>>>>> move lsTemp to liFile
83487>>>>>>>>> readln lsRootName
83488>>>>>>>>> readln lsDFName
83489>>>>>>>>> readln lsDisplayName
83490>>>>>>>>> end
83490>>>>>>>>>>
83490>>>>>>>>> if (seqeof) move 1 to liSeqEof
83493>>>>>>>>> ifnot liSeqEof begin
83495>>>>>>>>> set psRootName.i liFile to lsRootName
83496>>>>>>>>> set psDFName.i liFile to lsDFName
83497>>>>>>>>> set psDisplayName.i liFile to lsDisplayName
83498>>>>>>>>> send Seq_Read_AuxArray liChannel liFile
83499>>>>>>>>> send Seq_Read_FileDefObject liChannel liFile
83500>>>>>>>>> send OnFileRead liChannel liFile
83501>>>>>>>>> send OnFileAdded liFile
83502>>>>>>>>> end
83502>>>>>>>>>>
83502>>>>>>>>> until liSeqEof
83504>>>>>>>>> set piDataOrigin to FDX_READ_FROM_FILE
83505>>>>>>>>> set piReadResult to 1
83506>>>>>>>>> end
83506>>>>>>>>>>
83506>>>>>>>>> else error 736 "Incompatible FDX file!"
83508>>>>>>>>>// else send obs "Incompatible FDX file!" "Reading abandoned." ("Version in file: "+lsTemp) ("This program reads only: "+psVersion(self))
83508>>>>>>>>> end_procedure
83509>>>>>>>>>
83509>>>>>>>>> procedure Seq_Write_AuxArray integer liChannel integer liFile
83511>>>>>>>>> integer liObj
83511>>>>>>>>> get piAuxArray.i liFile to liObj
83512>>>>>>>>> if liObj begin
83514>>>>>>>>> writeln channel liChannel 1
83517>>>>>>>>> send SEQ_WriteArrayItems liChannel liObj
83518>>>>>>>>> end
83518>>>>>>>>>>
83518>>>>>>>>> else writeln channel liChannel 0
83522>>>>>>>>> end_procedure
83523>>>>>>>>>
83523>>>>>>>>> procedure Seq_Write_FileDefObject integer liChannel integer liFile
83525>>>>>>>>> integer liObj
83525>>>>>>>>> get piFileDefObject.i liFile to liObj
83526>>>>>>>>> if liObj begin
83528>>>>>>>>> writeln channel liChannel 1
83531>>>>>>>>> send Seq_Write to liObj liChannel liFile
83532>>>>>>>>> end
83532>>>>>>>>>>
83532>>>>>>>>> else writeln channel liChannel 0
83536>>>>>>>>> end_procedure
83537>>>>>>>>>
83537>>>>>>>>> procedure Seq_Write integer liChannel
83539>>>>>>>>> integer liFile liMax
83539>>>>>>>>> string lsRootName
83539>>>>>>>>> writeln channel liChannel (psVersion(self))
83542>>>>>>>>> writeln (piReadMode(self))
83544>>>>>>>>> writeln (psIdTag(self))
83546>>>>>>>>> writeln (pnTS_Time(self))
83548>>>>>>>>> writeln (psTitle(self))
83550>>>>>>>>> send SEQ_WriteArrayItems liChannel (oGlobalAttributes(self))
83551>>>>>>>>> send SEQ_WriteArrayItems liChannel (oOtherAttributes(self))
83552>>>>>>>>> get row_count to liMax
83553>>>>>>>>> for liFile from 1 to (liMax-1)
83559>>>>>>>>>>
83559>>>>>>>>> move (psRootName.i(self,liFile)) to lsRootName
83560>>>>>>>>> if lsRootName ne "" begin
83562>>>>>>>>> writeln channel liChannel (string(liFile))
83565>>>>>>>>> writeln (psRootName.i(self,liFile))
83567>>>>>>>>> writeln (psDFName.i(self,liFile))
83569>>>>>>>>> writeln (psDisplayName.i(self,liFile))
83571>>>>>>>>> send Seq_Write_AuxArray liChannel liFile
83572>>>>>>>>> send Seq_Write_FileDefObject liChannel liFile
83573>>>>>>>>> send OnFileWrite liChannel liFile
83574>>>>>>>>> end
83574>>>>>>>>>>
83574>>>>>>>>> loop
83575>>>>>>>>>>
83575>>>>>>>>> writeln channel liChannel "END.OF.FILELIST.CFG"
83578>>>>>>>>> end_procedure
83579>>>>>>>>>
83579>>>>>>>>> // *************************************************************************
83579>>>>>>>>> // *** Call back methods ***************************************************
83579>>>>>>>>>
83579>>>>>>>>> //
83579>>>>>>>>> // Procedure called back should be defined like this
83579>>>>>>>>> // procedure HandleTable integer liFile string lsRoot string lsDFName string lsUserName
83579>>>>>>>>> //
83579>>>>>>>>>
83579>>>>>>>>> //> Call back for every entry with a rootname
83579>>>>>>>>> procedure Callback.ii integer liMsg integer liObj
83581>>>>>>>>> integer liFile liMax
83581>>>>>>>>> string lsRootName
83581>>>>>>>>> get row_count to liMax
83582>>>>>>>>> for liFile from 1 to (liMax-1)
83588>>>>>>>>>>
83588>>>>>>>>> move (psRootName.i(self,liFile)) to lsRootName
83589>>>>>>>>> if lsRootName ne "" send liMsg to liObj liFile lsRootName (psDFName.i(self,liFile)) (psDisplayName.i(self,liFile)) (aux_value(self,liFile))
83592>>>>>>>>> loop
83593>>>>>>>>>>
83593>>>>>>>>> end_procedure
83594>>>>>>>>> //> Call back for one specified file
83594>>>>>>>>> procedure Callback_File.iii integer liFile integer liMsg integer liObj
83596>>>>>>>>> send liMsg to liObj liFile (psRootName.i(self,liFile)) (psDFName.i(self,liFile)) (psDisplayName.i(self,liFile)) (aux_value(self,liFile))
83597>>>>>>>>> end_procedure
83598>>>>>>>>> //> Call a function for one specified file
83598>>>>>>>>> function iCallback_File.iii integer liFile integer liGet integer liObj returns integer
83600>>>>>>>>> integer liRval
83600>>>>>>>>> get liGet of liObj liFile (psRootName.i(self,liFile)) (psDFName.i(self,liFile)) (psDisplayName.i(self,liFile)) (aux_value(self,liFile)) to liRval
83601>>>>>>>>> function_return liRval
83602>>>>>>>>> end_function
83603>>>>>>>>>
83603>>>>>>>>> // *************************************************************************
83603>>>>>>>>> // *** Attribute value access **********************************************
83603>>>>>>>>> function AttrValue_GLOBAL integer liAttr returns string
83605>>>>>>>>> integer liMonitoredGlobalAttributesObj
83605>>>>>>>>> move (oMonitoredGlobalAttributes(self)) to liMonitoredGlobalAttributesObj
83606>>>>>>>>> if (piMonitored.i(liMonitoredGlobalAttributesObj,liAttr)) begin
83608>>>>>>>>> get piAttrIndex.i of liMonitoredGlobalAttributesObj liAttr to liAttr
83609>>>>>>>>> function_return (value(oGlobalAttributes(self),liAttr))
83610>>>>>>>>> end
83610>>>>>>>>>>
83610>>>>>>>>> function_return t.fdx.attr_not_avail
83611>>>>>>>>> end_function
83612>>>>>>>>> function AttrValue_FILELIST integer liAttr integer liFile returns string
83614>>>>>>>>> string lsStr
83614>>>>>>>>> move "" to lsStr
83615>>>>>>>>> if liAttr eq DF_FILE_ROOT_NAME move (psRootName.i(self,liFile)) to lsStr
83618>>>>>>>>> if liAttr eq DF_FILE_LOGICAL_NAME move (psDFName.i(self,liFile)) to lsStr
83621>>>>>>>>> if liAttr eq DF_FILE_DISPLAY_NAME move (psDisplayName.i(self,liFile)) to lsStr
83624>>>>>>>>> move (rtrim(lsStr)) to lsStr
83625>>>>>>>>> if lsStr ne "" function_return lsStr
83628>>>>>>>>> if liAttr eq DF_FILE_ROOT_NAME function_return ("FILE"+string(liFile))
83631>>>>>>>>> if liAttr eq DF_FILE_LOGICAL_NAME function_return ("DFFILE"+string(liFile))
83634>>>>>>>>> if liAttr eq DF_FILE_DISPLAY_NAME function_return ("File"+string(liFile))
83637>>>>>>>>> function_return t.fdx.attr_not_avail
83638>>>>>>>>> end_function
83639>>>>>>>>> function AttrValue_IsEmpty integer liFile returns integer
83641>>>>>>>>> string lsStr
83641>>>>>>>>> get psRootName.i liFile to lsStr
83642>>>>>>>>> function_return (lsStr="")
83643>>>>>>>>> end_function
83644>>>>>>>>> function AttrValue_FILE integer liAttr integer liFile returns string
83646>>>>>>>>> integer liObj
83646>>>>>>>>> get piFileDefObject.i liFile to liObj
83647>>>>>>>>> if liObj function_return (sAttrValueFile.i(liObj,liAttr))
83650>>>>>>>>> function_return t.fdx.attr_not_avail
83651>>>>>>>>> end_function
83652>>>>>>>>> function AttrValue_FIELD integer liAttr integer liFile integer liField returns string
83654>>>>>>>>> integer liObj
83654>>>>>>>>> get piFileDefObject.i liFile to liObj
83655>>>>>>>>> if liObj function_return (sAttrValueField.ii(liObj,liAttr,liField))
83658>>>>>>>>> if liAttr eq DF_FIELD_NAME function_return ("FIELD"+string(liField))
83661>>>>>>>>> function_return t.fdx.attr_not_avail
83662>>>>>>>>> end_function
83663>>>>>>>>> function AttrValue_INDEX integer liAttr integer liFile integer liIndex returns string
83665>>>>>>>>> integer liObj
83665>>>>>>>>> get piFileDefObject.i liFile to liObj
83666>>>>>>>>> if liObj function_return (sAttrValueIndex.ii(liObj,liAttr,liIndex))
83669>>>>>>>>> function_return t.fdx.attr_not_avail
83670>>>>>>>>> end_function
83671>>>>>>>>> function AttrValue_IDXSEG integer liAttr integer liFile integer liIndex integer liSegment returns string
83673>>>>>>>>> integer liObj
83673>>>>>>>>> get piFileDefObject.i liFile to liObj
83674>>>>>>>>> if liObj function_return (sAttrValueIndexSegment.iii(liObj,liAttr,liIndex,liSegment))
83677>>>>>>>>> function_return t.fdx.attr_not_avail
83678>>>>>>>>> end_function
83679>>>>>>>>> function AttrValue_SPECIAL1 integer liAttr integer liFile integer liField1 integer liField2 returns string
83681>>>>>>>>> integer liObj
83681>>>>>>>>> get piFileDefObject.i liFile to liObj
83682>>>>>>>>> if liObj function_return (sAttrValueSpecial1.iii(liObj,liAttr,liField1,liField2))
83685>>>>>>>>> function_return t.fdx.attr_not_avail
83686>>>>>>>>> end_function
83687>>>>>>>>> function sDatPath.i integer liFile returns string
83689>>>>>>>>> integer liObj
83689>>>>>>>>> get piFileDefObject.i liFile to liObj
83690>>>>>>>>> if liObj function_return (psDatPath(liObj))
83693>>>>>>>>> function_return ""
83694>>>>>>>>> end_function
83695>>>>>>>>> function nTimeStamp.i integer liFile returns number
83697>>>>>>>>> integer liObj
83697>>>>>>>>> get piFileDefObject.i liFile to liObj
83698>>>>>>>>> if liObj function_return (pnTimeStamp(liObj))
83701>>>>>>>>> function_return 0
83702>>>>>>>>> end_function
83703>>>>>>>>> function AttrValue_FLSTNAV integer liAttr integer liFile returns string
83705>>>>>>>>> if liAttr eq DF_FILE_NEXT_OPENED function_return t.fdx.attr_not_avail
83708>>>>>>>>> if liAttr eq DF_FILE_NEXT_USED begin
83710>>>>>>>>> repeat
83710>>>>>>>>>>
83710>>>>>>>>> increment liFile
83711>>>>>>>>> if (psRootName.i(self,liFile)) ne "" function_return liFile
83714>>>>>>>>> until (liFile>FILELIST_MAX_ENTRY)
83716>>>>>>>>> function_return 0
83717>>>>>>>>> end
83717>>>>>>>>>>
83717>>>>>>>>> if liAttr eq DF_FILE_NEXT_EMPTY begin
83719>>>>>>>>> repeat
83719>>>>>>>>>>
83719>>>>>>>>> increment liFile
83720>>>>>>>>> if (psRootName.i(self,liFile)) eq "" function_return liFile
83723>>>>>>>>> until (liFile>FILELIST_MAX_ENTRY)
83725>>>>>>>>> function_return 0
83726>>>>>>>>> end
83726>>>>>>>>>>
83726>>>>>>>>> end_function
83727>>>>>>>>> function AttrValue_DRIVER integer liAttr integer liDriver returns string
83729>>>>>>>>> function_return t.fdx.attr_not_avail
83730>>>>>>>>> end_function
83731>>>>>>>>> function AttrValue_DRVSRV integer liAttr integer liDriver integer liServer returns string
83733>>>>>>>>> function_return t.fdx.attr_not_avail
83734>>>>>>>>> end_function
83735>>>>>>>>> function OtherAttr_Value integer liAttr returns string
83737>>>>>>>>> function_return (value(oOtherAttributes(self),liAttr))
83738>>>>>>>>> end_function
83739>>>>>>>>>
83739>>>>>>>>> function iNextFileThatCanOpen integer liFile returns integer
83741>>>>>>>>> repeat
83741>>>>>>>>>>
83741>>>>>>>>> move (AttrValue_FLSTNAV(self,DF_FILE_NEXT_USED,liFile)) to liFile
83742>>>>>>>>> if liFile if (iCanOpen.i(self,liFile)) function_return liFile
83747>>>>>>>>> until (not(liFile))
83749>>>>>>>>> //function_return 0
83749>>>>>>>>> end_function
83750>>>>>>>>>
83750>>>>>>>>> //> Function iFindRootName.sii goes through the table definitions and looks
83750>>>>>>>>> //> for an entry with root name as specified in the lsRootName parameter. The
83750>>>>>>>>> //> search is not case sensitive.
83750>>>>>>>>> //> Parameter root_of_root# is a boolean. If TRUE path and driver
83750>>>>>>>>> //> information is stripped from the root name before the comparison is
83750>>>>>>>>> //> made.
83750>>>>>>>>> //> The search starts at entry liFile+1
83750>>>>>>>>> function iFindRootName.sii string lsRootName integer liFile integer liRootOfRoot returns integer
83752>>>>>>>>> string lsTestRoot
83752>>>>>>>>> move (uppercase(lsRootName)) to lsRootName
83753>>>>>>>>>// increment liFile
83753>>>>>>>>> if liRootOfRoot get DBMS_StripPathAndDriver lsRootName to lsRootName
83756>>>>>>>>> repeat
83756>>>>>>>>>>
83756>>>>>>>>> get AttrValue_FLSTNAV DF_FILE_NEXT_USED liFile to liFile
83757>>>>>>>>> if liFile begin
83759>>>>>>>>> get AttrValue_FILELIST DF_FILE_ROOT_NAME liFile to lsTestRoot
83760>>>>>>>>> move (uppercase(lsTestRoot)) to lsTestRoot
83761>>>>>>>>> if liRootOfRoot get DBMS_StripPathAndDriver lsTestRoot to lsTestRoot
83764>>>>>>>>> if lsTestRoot eq lsRootName function_return liFile
83767>>>>>>>>> end
83767>>>>>>>>>>
83767>>>>>>>>> until (not(liFile))
83769>>>>>>>>> //function_return 0
83769>>>>>>>>> end_function
83770>>>>>>>>>
83770>>>>>>>>> //> Function iFindLogicalName.s goes through the table definitions and looks
83770>>>>>>>>> //> for an entry with loagical name as specified in the ln# parameter. The
83770>>>>>>>>> //> search is not case sensitive.
83770>>>>>>>>> function iFindLogicalName.si string lsLogicalName integer liFile returns integer
83772>>>>>>>>> string lsTestLogicalName
83772>>>>>>>>> move (uppercase(lsLogicalName)) to lsLogicalName
83773>>>>>>>>> repeat
83773>>>>>>>>>>
83773>>>>>>>>> get AttrValue_FLSTNAV DF_FILE_NEXT_USED liFile to liFile
83774>>>>>>>>> if liFile begin
83776>>>>>>>>> get AttrValue_FILELIST DF_FILE_LOGICAL_NAME liFile to lsTestLogicalName
83777>>>>>>>>> move (uppercase(lsTestLogicalName)) to lsTestLogicalName
83778>>>>>>>>> if lsTestLogicalName eq lsLogicalName function_return liFile
83781>>>>>>>>> end
83781>>>>>>>>>>
83781>>>>>>>>> until (not(liFile))
83783>>>>>>>>> //function_return 0
83783>>>>>>>>> end_function
83784>>>>>>>>>
83784>>>>>>>>> //> This function returns a list of files with identical rootname
83784>>>>>>>>> //> to that of the liFile passed. The list of files will exclude
83784>>>>>>>>> //> the passed file itself.
83784>>>>>>>>> function sAliasFiles.i integer liFile returns string
83786>>>>>>>>> integer liExcludeFile
83786>>>>>>>>> string lsRval lsRootName
83786>>>>>>>>> move "" to lsRval
83787>>>>>>>>> get AttrValue_FILELIST DF_FILE_ROOT_NAME liFile to lsRootName
83788>>>>>>>>> move liFile to liExcludeFile
83789>>>>>>>>> move 0 to liFile
83790>>>>>>>>> repeat
83790>>>>>>>>>>
83790>>>>>>>>> get iFindRootName.sii lsRootName liFile 0 to liFile
83791>>>>>>>>> if (liFile<>0 and liFile<>liExcludeFile) move (AddIntegerToString(lsRval,liFile)) to lsRval
83794>>>>>>>>> until liFile eq 0
83796>>>>>>>>> function_return lsRval
83797>>>>>>>>> end_function
83798>>>>>>>>>end_class // cFDX
83799>>>>>>>>>
83799>>>>>>>>>function iFdxIsEncapsulated for Desktop returns integer
83801>>>>>>>>> function_return DFFALSE
83802>>>>>>>>>end_function
83803>>>>>>>>>
83803>>>>>>>>>function iFdxIsEncapsulated for cFdx returns integer
83805>>>>>>>>> function_return DFTRUE
83806>>>>>>>>>end_function
83807>>>>>>>>>
83807>>>>>>>>>function NewFdxObject global integer liTable returns integer
83809>>>>>>>>> integer lhObj
83809>>>>>>>>> object oFdxObject is a cFdxFileDef
83811>>>>>>>>> move self to lhObj
83812>>>>>>>>> if liTable send Read_File_Definition.i liTable
83815>>>>>>>>> end_object
83816>>>>>>>>> function_return lhObj
83817>>>>>>>>>end_function
83818>>>>>>>
83818>>>>>>> define t.FDX.Btn.SelectOpen for "Auto select"
83818>>>>>>> define t.FDX.Btn.SelectAll for "Select all"
83818>>>>>>> define t.FDX.Btn.SelectNone for "Clear selection"
83818>>>>>>> define t.FDX.Btn.SelectInvert for "Invert selection"
83818>>>>>>> define t.FDX.Btn.SelectPhys for "Select master"
83818>>>>>>> define t.FDX.Btn.SelectParent for "Select parent"
83818>>>>>>> define t.FDX.Btn.SelectChild for "Select children"
83818>>>>>>> define t.FDX.UserName for "User name"
83818>>>>>>> define t.FDX.DFname for "Logical name"
83818>>>>>>> define t.FDX.RootName for "File name"
83818>>>>>>> define t.FDX.Selected for "Selected:"
83818>>>>>>>
83818>>>>>>>enumeration_list
83818>>>>>>> define BAD_ENTRIES_NO_CHECK // This one also defers check for DB-Driver
83818>>>>>>> define BAD_ENTRIES_SHADOW
83818>>>>>>> define BAD_ENTRIES_EXCLUDE
83818>>>>>>>end_enumeration_list
83818>>>>>>>
83818>>>>>>>class cFdxFileMultiSelector is a aps.Grid
83819>>>>>>> procedure DoHeaderLabels integer by#
83821>>>>>>> set header_label item 1 to "#"
83822>>>>>>> set header_label item 2 to t.FDX.UserName
83823>>>>>>> set header_label item 3 to t.FDX.DFname
83824>>>>>>> set header_label item 4 to t.FDX.RootName
83825>>>>>>> set header_label item by# to ("*"+header_label(self,by#)+"*")
83826>>>>>>> end_procedure
83827>>>>>>> procedure construct_object
83829>>>>>>> forward send construct_object
83831>>>>>>> set line_width to 5 0
83832>>>>>>> on_key key_ctrl+key_a send select_all_not_bad
83833>>>>>>> set form_margin item 0 to 2
83834>>>>>>> set form_margin item 1 to 3
83835>>>>>>> set form_margin item 2 to 30
83836>>>>>>> set form_margin item 3 to 15
83837>>>>>>> set form_margin item 4 to 15
83838>>>>>>> set highlight_row_state to true
83839>>>>>>> set CurrentCellColor to clHighlight
83840>>>>>>> set CurrentCellTextColor to clHighlightText
83841>>>>>>> set CurrentRowColor to clHighlight
83842>>>>>>> set CurrentRowTextColor to clHighlightText
83843>>>>>>>// set highlight_row_color to (rgb(0,255,255))
83843>>>>>>>// set current_item_color to (rgb(0,255,255))
83843>>>>>>> on_key knext_item send switch
83844>>>>>>> on_key kprevious_item send switch_back
83845>>>>>>> on_key kswitch send switch
83846>>>>>>> on_key kswitch_back send switch_back
83847>>>>>>> set auto_top_item_state to false // Does not work!
83848>>>>>>> send DoHeaderLabels 1
83849>>>>>>> set select_mode to multi_select
83850>>>>>>> object oSortArray is an cArray no_image
83852>>>>>>> // Sort value fil ÄSelect?
83852>>>>>>> // ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÅÄ´
83852>>>>>>> // 30 3 1
83852>>>>>>> // The first 30 characters of each item in this array will be used for
83852>>>>>>> // sorting the values.
83852>>>>>>> end_object
83853>>>>>>> object oRootNames is a cSet no_image
83855>>>>>>> end_object
83856>>>>>>> property integer piNo_Alias_State public false
83857>>>>>>> property integer piBad_Entries_State public BAD_ENTRIES_SHADOW
83858>>>>>>> property integer piGeneric_Display_Name_State public false
83859>>>>>>> property integer piDriverFilter_State public false
83860>>>>>>> property integer piFDX_Server public 0
83861>>>>>>> object oDriversIncluded is a cArray no_image
83863>>>>>>> end_object
83864>>>>>>> on_key key_ctrl+key_d send display_file_things
83865>>>>>>> on_key key_ctrl+key_l send display_file_location
83866>>>>>>> on_key key_ctrl+key_w send DoWriteToFile
83867>>>>>>> end_procedure
83868>>>>>>> procedure DoWriteToFile
83870>>>>>>> send Grid_DoWriteToFile self
83871>>>>>>> end_procedure
83872>>>>>>> procedure wait_on
83874>>>>>>> send cursor_wait to (cursor_control(self))
83875>>>>>>> end_procedure
83876>>>>>>> procedure wait_off
83878>>>>>>> send cursor_ready to (cursor_control(self))
83879>>>>>>> end_procedure
83880>>>>>>> procedure DriverFilter_Add integer driver_type#
83882>>>>>>> set piDriverFilter_State to true
83883>>>>>>> set value of (oDriversIncluded(self)) item driver_type# to 1
83884>>>>>>> end_procedure
83885>>>>>>> procedure DriverFilter_Reset
83887>>>>>>> send delete_data to (oDriversIncluded(self))
83888>>>>>>> set piDriverFilter_State to false
83889>>>>>>> end_procedure
83890>>>>>>> function DriverFilter_Include integer driver_type# returns integer
83892>>>>>>> if (piDriverFilter_State(self)) function_return (value(oDriversIncluded(self),driver_type#))
83895>>>>>>> function_return 1
83896>>>>>>> end_function
83897>>>>>>> procedure update_select_display // Intended for augmentation
83899>>>>>>> // Called everytime the number of selected entries changes.
83899>>>>>>> end_procedure
83900>>>>>>> function Row_Count returns integer
83902>>>>>>> function_return (item_count(self)/5)
83903>>>>>>> end_function
83904>>>>>>> function Row_Shadow_State integer row# returns integer
83906>>>>>>> integer select#
83906>>>>>>> get shadow_state item (row#*5) to select#
83907>>>>>>> function_return select#
83908>>>>>>> end_function
83909>>>>>>> procedure set File_Select_State integer file# integer select#
83911>>>>>>> integer row# max#
83911>>>>>>> get Row_Count to max#
83912>>>>>>> for row# from 0 to (max#-1)
83918>>>>>>>>
83918>>>>>>> ifnot (Row_Shadow_State(self,row#)) if (integer(value(self,row#*5+1))=file#) set select_state item (row#*5) to select#
83923>>>>>>> loop
83924>>>>>>>>
83924>>>>>>> set dynamic_update_state to true // Force repaint
83925>>>>>>> end_procedure
83926>>>>>>> function File_Select_State integer file# returns integer
83928>>>>>>> integer row# max# select#
83928>>>>>>> get Row_Count to max#
83929>>>>>>> for row# from 0 to (max#-1)
83935>>>>>>>>
83935>>>>>>> if (integer(value(self,row#*5+1))=file#) begin
83937>>>>>>> get select_state item (row#*5) to select#
83938>>>>>>> function_return select#
83939>>>>>>> end
83939>>>>>>>>
83939>>>>>>> loop
83940>>>>>>>>
83940>>>>>>> end_function
83941>>>>>>> function Row_Select_State integer row# returns integer
83943>>>>>>> integer select#
83943>>>>>>> get select_state item (row#*5) to select#
83944>>>>>>> function_return select#
83945>>>>>>> end_function
83946>>>>>>> procedure set Row_Select_State integer row# integer select#
83948>>>>>>> ifnot (item_shadow_state(self,row#*5)) set select_state item (row#*5) to select#
83951>>>>>>> end_procedure
83952>>>>>>> function Row_File integer row# returns integer
83954>>>>>>> function_return (value(self,row#*5+1))
83955>>>>>>> end_function
83956>>>>>>> function Row_DisplayName integer row# returns string
83958>>>>>>> function_return (value(self,row#*5+2))
83959>>>>>>> end_function
83960>>>>>>> function Row_DfName integer row# returns string
83962>>>>>>> function_return (value(self,row#*5+3))
83963>>>>>>> end_function
83964>>>>>>> function Row_RootName integer row# returns string
83966>>>>>>> function_return (value(self,row#*5+4))
83967>>>>>>> end_function
83968>>>>>>> function Current_Row returns integer
83970>>>>>>> integer itm#
83970>>>>>>> get current_item to itm#
83971>>>>>>> function_return (itm#/5)
83972>>>>>>> end_function
83973>>>>>>> function Current_Column returns integer
83975>>>>>>> function_return (current_item(self)-(current_row(self)*5))
83976>>>>>>> end_function
83977>>>>>>> function Current_File returns integer
83979>>>>>>> function_return (Row_File(self,Current_Row(self)))
83980>>>>>>> end_function
83981>>>>>>> function File_Select_Count returns integer
83983>>>>>>> integer row# max# rval#
83983>>>>>>> move 0 to rval#
83984>>>>>>> get row_count to max#
83985>>>>>>> for row# from 0 to (max#-1)
83991>>>>>>>>
83991>>>>>>> if (Row_Select_State(self,row#)) increment rval#
83994>>>>>>> loop
83995>>>>>>>>
83995>>>>>>> function_return rval#
83996>>>>>>> end_function
83997>>>>>>> procedure sort.i integer by# // 1:Number 2:Display 3:DF 4:Root
83999>>>>>>> integer row# max# arr# file# select#
83999>>>>>>> string str#
83999>>>>>>> if by# begin
84001>>>>>>> send wait_on
84002>>>>>>> move (oSortArray(self)) to arr#
84003>>>>>>> send delete_data to arr#
84004>>>>>>> get Row_Count to max#
84005>>>>>>> for row# from 0 to (max#-1)
84011>>>>>>>>
84011>>>>>>> move (value(self,row#*5+by#)) to str#
84012>>>>>>> if by# eq 1 move (IntToStrR(str#,4)) to str#
84015>>>>>>> move (integer(value(self,row#*5+1))) to file#
84016>>>>>>> move (select_state(self,row#*5)) to select#
84017>>>>>>> move (pad(str#,30)+IntToStrR(file#,4)+IntToStrR(select#,1)) to str#
84018>>>>>>> set value of arr# item row# to str#
84019>>>>>>> loop
84020>>>>>>>>
84020>>>>>>> send sort_items to arr#
84021>>>>>>> send DoHeaderLabels by#
84022>>>>>>> send fill_list_from_sort_array
84023>>>>>>> send delete_data to arr#
84024>>>>>>> send wait_off
84025>>>>>>> end
84025>>>>>>>>
84025>>>>>>> end_procedure
84026>>>>>>> procedure header_mouse_click integer itm#
84028>>>>>>> send sort.i itm#
84029>>>>>>> forward send header_mouse_click itm#
84031>>>>>>> end_procedure
84032>>>>>>> procedure add_row.isssi integer file# string dn# string ln# string rn# integer shade#
84034>>>>>>> integer base#
84034>>>>>>> get item_count to base#
84035>>>>>>> send add_item msg_none ""
84036>>>>>>> set checkbox_item_state item base# to true
84037>>>>>>> send add_item msg_none (string(file#))
84038>>>>>>> send add_item msg_none dn#
84039>>>>>>> send add_item msg_none ln#
84040>>>>>>> send add_item msg_none rn#
84041>>>>>>> set entry_state item (base#+1) to false
84042>>>>>>> set entry_state item (base#+2) to false
84043>>>>>>> set entry_state item (base#+3) to false
84044>>>>>>> set entry_state item (base#+4) to false
84045>>>>>>> if shade# begin
84047>>>>>>> set item_shadow_state item base# to true
84048>>>>>>> set item_shadow_state item (base#+1) to true
84049>>>>>>> set item_shadow_state item (base#+2) to true
84050>>>>>>> set item_shadow_state item (base#+3) to true
84051>>>>>>> set item_shadow_state item (base#+4) to true
84052>>>>>>> end
84052>>>>>>>>
84052>>>>>>> end_procedure
84053>>>>>>> register_function iFile_loaded.i integer file# returns integer
84053>>>>>>> function iFileAvailable.i integer file# returns integer
84055>>>>>>> integer oFDX#
84055>>>>>>> get piFDX_Server to oFDX#
84056>>>>>>> function_return (FDX_CanOpenFile(oFDX#,file#))
84057>>>>>>> end_function
84058>>>>>>> procedure add_file.i integer file#
84060>>>>>>> integer base# piNo_Alias_State# AddFile# bad# piBad_Entries_State# driver_type#
84060>>>>>>> string dn# ln# rootname#
84060>>>>>>> get piNo_Alias_State to piNo_Alias_State#
84061>>>>>>> move (FDX_AttrValue_FILELIST(piFDX_Server(self),DF_FILE_ROOT_NAME,file#)) to RootName#
84062>>>>>>> move 0 to bad#
84063>>>>>>> get piBad_Entries_State to piBad_Entries_State#
84064>>>>>>>
84064>>>>>>> if (piNo_Alias_State# and element_find(oRootNames(self),uppercase(RootName#))<>-1) move 0 to AddFile#
84067>>>>>>> else begin
84068>>>>>>> if piBad_Entries_State# ne BAD_ENTRIES_NO_CHECK begin
84070>>>>>>> move (iFileAvailable.i(self,file#)) to driver_type#
84071>>>>>>> move (not(driver_type#)) to bad#
84072>>>>>>> ifnot bad# move (not(DriverFilter_Include(self,driver_type#))) to bad#
84075>>>>>>> end
84075>>>>>>>>
84075>>>>>>>
84075>>>>>>> if (bad# and piBad_Entries_State#=BAD_ENTRIES_EXCLUDE) move 0 to AddFile#
84078>>>>>>> else move 1 to AddFile#
84080>>>>>>> end
84080>>>>>>>>
84080>>>>>>>
84080>>>>>>> if AddFile# begin
84082>>>>>>> if (piGeneric_Display_Name_State(self)) move (rtrim(FDX_AttrValue_FILELIST(piFDX_Server(self),DF_FILE_DISPLAY_NAME,file#))) to dn#
84085>>>>>>> else move (File_Display_Name(file#)) to dn#
84087>>>>>>> //get_attribute DF_FILE_LOGICAL_NAME of file# to ln#
84087>>>>>>> move (FDX_AttrValue_FILELIST(piFDX_Server(self),DF_FILE_LOGICAL_NAME,file#)) to ln#
84088>>>>>>> if piNo_Alias_State# send element_add to (oRootNames(self)) (uppercase(rootname#))
84091>>>>>>> send add_row.isssi file# dn# ln# rootname# (bad# and piBad_Entries_State#=BAD_ENTRIES_SHADOW)
84092>>>>>>> end
84092>>>>>>>>
84092>>>>>>> end_procedure // add_file.i
84093>>>>>>> procedure row_change integer row_from# integer row_to#
84095>>>>>>> end_procedure
84096>>>>>>> procedure item_change integer i1# integer i2# returns integer
84098>>>>>>> integer rval# row_from# row_to#
84098>>>>>>> forward get msg_item_change i1# i2# to rval#
84100>>>>>>> if (i1#/5) ne (i2#/5) send row_change (i1#/5) (i2#/5)
84103>>>>>>> procedure_return rval#
84104>>>>>>> end_procedure
84105>>>>>>> procedure select_toggling integer itm# integer i#
84107>>>>>>> integer ci#
84107>>>>>>> get current_item to ci#
84108>>>>>>> move ((ci#/5)*5) to ci# // Redirect to first column
84109>>>>>>> forward send select_toggling ci# i#
84111>>>>>>> send update_select_display
84112>>>>>>> end_procedure
84113>>>>>>> procedure fill_list_all_files
84115>>>>>>> integer file# oFDX#
84115>>>>>>> set dynamic_update_state to false
84116>>>>>>> get piFDX_Server to oFDX#
84117>>>>>>> send delete_data
84118>>>>>>> send delete_data to (oRootNames(self))
84119>>>>>>> move 0 to file#
84120>>>>>>> send wait_on
84121>>>>>>> repeat
84121>>>>>>>>
84121>>>>>>> move (FDX_AttrValue_FLSTNAV(oFDX#,DF_FILE_NEXT_USED,file#)) to file#
84122>>>>>>> if file# send add_file.i file#
84125>>>>>>> until file# eq 0
84127>>>>>>> send update_select_display
84128>>>>>>> set dynamic_update_state to true
84129>>>>>>> send wait_off
84130>>>>>>> end_procedure
84131>>>>>>> procedure fill_list_all_open // Only if we are working on real data
84133>>>>>>> integer file# oFDX#
84133>>>>>>> get piFDX_Server to oFDX#
84134>>>>>>> set dynamic_update_state to false
84135>>>>>>> ifnot oFDX# begin
84137>>>>>>> send wait_on
84138>>>>>>> send delete_data
84139>>>>>>> send delete_data to (oRootNames(self))
84140>>>>>>> move 0 to file#
84141>>>>>>> repeat
84141>>>>>>>>
84141>>>>>>> move (FDX_AttrValue_FLSTNAV(oFDX#,DF_FILE_NEXT_OPENED,file#)) to file#
84142>>>>>>> if file# send add_file.i file#
84145>>>>>>> until file# eq 0
84147>>>>>>> send update_select_display
84148>>>>>>> send wait_off
84149>>>>>>> end
84149>>>>>>>>
84149>>>>>>> end_procedure
84150>>>>>>> procedure fill_list_from_sort_array
84152>>>>>>> integer file# arr# itm# max# select# piNo_Alias_State#
84152>>>>>>> string str#
84152>>>>>>> set dynamic_update_state to false
84153>>>>>>> get piNo_Alias_State to piNo_Alias_State#
84154>>>>>>> set piNo_Alias_State to false
84155>>>>>>> send delete_data
84156>>>>>>> send delete_data to (oRootNames(self))
84157>>>>>>> move (oSortArray(self)) to arr#
84158>>>>>>> get item_count of arr# to max#
84159>>>>>>> for itm# from 0 to (max#-1)
84165>>>>>>>>
84165>>>>>>> get value of arr# item itm# to str#
84166>>>>>>> move (integer(mid(str#,4,31))) to file#
84167>>>>>>> move (integer(mid(str#,1,35))) to select#
84168>>>>>>> send add_file.i file#
84169>>>>>>> if select# set select_state item (item_count(self)-5) to true
84172>>>>>>> loop
84173>>>>>>>>
84173>>>>>>> set piNo_Alias_State to piNo_Alias_State# // Restore
84174>>>>>>> set dynamic_update_state to true
84175>>>>>>> end_procedure
84176>>>>>>> procedure select_all
84178>>>>>>> integer itm# max# row#
84178>>>>>>> get Row_Count to max#
84179>>>>>>> for row# from 0 to (max#-1)
84185>>>>>>>>
84185>>>>>>> set Row_Select_State Row# to true
84186>>>>>>> loop
84187>>>>>>>>
84187>>>>>>> send update_select_display
84188>>>>>>> set dynamic_update_state to true
84189>>>>>>> end_procedure
84190>>>>>>> procedure select_all_not_bad
84192>>>>>>> integer itm# max# row# bad# file#
84192>>>>>>> send wait_on
84193>>>>>>> get Row_Count to max#
84194>>>>>>> for row# from 0 to (max#-1)
84200>>>>>>>>
84200>>>>>>> if (uppercase(Row_RootName(self,row#))<>"FLEXERRS") begin
84202>>>>>>> get Row_File row# to file#
84203>>>>>>> move (not(iFileAvailable.i(self,file#))) to bad#
84204>>>>>>> if (not(bad#)) set Row_Select_State Row# to true
84207>>>>>>> end
84207>>>>>>>>
84207>>>>>>> loop
84208>>>>>>>>
84208>>>>>>> send update_select_display
84209>>>>>>> send wait_off
84210>>>>>>> set dynamic_update_state to true
84211>>>>>>> end_procedure
84212>>>>>>> procedure select_none
84214>>>>>>> integer itm# max# row#
84214>>>>>>> get Row_Count to max#
84215>>>>>>> for row# from 0 to (max#-1)
84221>>>>>>>>
84221>>>>>>> set Row_Select_State Row# to false
84222>>>>>>> loop
84223>>>>>>>>
84223>>>>>>> send update_select_display
84224>>>>>>> set dynamic_update_state to true
84225>>>>>>> end_procedure
84226>>>>>>> procedure select_invert
84228>>>>>>> integer max# row# st#
84228>>>>>>> get Row_Count to max#
84229>>>>>>> for row# from 0 to (max#-1)
84235>>>>>>>>
84235>>>>>>> ifnot (Row_Shadow_State(self,row#)) begin
84237>>>>>>> get Row_Select_State Row# to st#
84238>>>>>>> if (st# or uppercase(Row_RootName(self,row#))<>"FLEXERRS") set Row_Select_State Row# to (not(st#))
84241>>>>>>> end
84241>>>>>>>>
84241>>>>>>> loop
84242>>>>>>>>
84242>>>>>>> send update_select_display
84243>>>>>>> set dynamic_update_state to true
84244>>>>>>> end_procedure
84245>>>>>>>
84245>>>>>>> register_function sChildFiles.i integer file# returns string
84245>>>>>>> register_function sParentFiles.i integer file# returns string
84245>>>>>>> procedure select_parents
84247>>>>>>> integer oFDX# itm# max# file#
84247>>>>>>> string str#
84247>>>>>>> get piFDX_Server to oFDX#
84248>>>>>>> if oFDX# begin
84250>>>>>>> ifnot (Row_Shadow_State(self,current_row(self))) begin
84252>>>>>>> get sParentFiles.i of oFDX# (Current_File(self)) to str#
84253>>>>>>> move (HowManyIntegers(str#)) to max#
84254>>>>>>> for itm# from 1 to max#
84260>>>>>>>>
84260>>>>>>> set File_Select_State (ExtractInteger(str#,itm#)) to true
84261>>>>>>> loop
84262>>>>>>>>
84262>>>>>>> set File_Select_State (Current_File(self)) to true
84263>>>>>>> send update_select_display
84264>>>>>>> set dynamic_update_state to true
84265>>>>>>> end
84265>>>>>>>>
84265>>>>>>> end
84265>>>>>>>>
84265>>>>>>> end_procedure
84266>>>>>>> procedure select_children
84268>>>>>>> integer oFDX# itm# max# file#
84268>>>>>>> string str#
84268>>>>>>> get piFDX_Server to oFDX#
84269>>>>>>> if oFDX# begin
84271>>>>>>> ifnot (Row_Shadow_State(self,current_row(self))) begin
84273>>>>>>> get sChildFiles.i of oFDX# (Current_File(self)) to str#
84274>>>>>>> move (HowManyIntegers(str#)) to max#
84275>>>>>>> for itm# from 1 to max#
84281>>>>>>>>
84281>>>>>>> set File_Select_State (ExtractInteger(str#,itm#)) to true
84282>>>>>>> loop
84283>>>>>>>>
84283>>>>>>> set File_Select_State (Current_File(self)) to true
84284>>>>>>> send update_select_display
84285>>>>>>> set dynamic_update_state to true
84286>>>>>>> end
84286>>>>>>>>
84286>>>>>>> end
84286>>>>>>>>
84286>>>>>>> end_procedure
84287>>>>>>> procedure select_master
84289>>>>>>> integer itm# max# row#
84289>>>>>>> string rn# str#
84289>>>>>>> get Row_Count to max#
84290>>>>>>> move "³" to str#
84291>>>>>>> for row# from 0 to (max#-1)
84297>>>>>>>>
84297>>>>>>> get Row_RootName row# to rn#
84298>>>>>>> ifnot (uppercase(rn#)) eq "FLEXERRS" begin
84300>>>>>>> ifnot ("³"+uppercase(rn#)+"³") in str# begin
84302>>>>>>> set Row_Select_State Row# to true
84303>>>>>>> move (str#+uppercase(rn#)+"³") to str#
84304>>>>>>> end
84304>>>>>>>>
84304>>>>>>> end
84304>>>>>>>>
84304>>>>>>> loop
84305>>>>>>>>
84305>>>>>>> send update_select_display
84306>>>>>>> set dynamic_update_state to true
84307>>>>>>> end_procedure
84308>>>>>>> procedure select_bad
84310>>>>>>> integer max# row# file# bad#
84310>>>>>>> set dynamic_update_state to false
84311>>>>>>> send wait_on
84312>>>>>>> get Row_Count to max#
84313>>>>>>> for row# from 0 to (max#-1)
84319>>>>>>>>
84319>>>>>>> get Row_File row# to file#
84320>>>>>>> move (not(iFileAvailable.i(self,file#))) to bad#
84321>>>>>>> if bad# set Row_Select_State Row# to true
84324>>>>>>> loop
84325>>>>>>>>
84325>>>>>>> set dynamic_update_state to true
84326>>>>>>> send update_select_display
84327>>>>>>> send wait_off
84328>>>>>>> end_procedure
84329>>>>>>> procedure select_open
84331>>>>>>> integer max# row# open# file#
84331>>>>>>> ifnot (piFDX_Server(self)) begin
84333>>>>>>> get Row_Count to max#
84334>>>>>>> for row# from 0 to (max#-1)
84340>>>>>>>>
84340>>>>>>> get Row_File row# to file#
84341>>>>>>> if (DBMS_IsOpenFile(file#)) set Row_Select_State Row# to true
84344>>>>>>> loop
84345>>>>>>>>
84345>>>>>>> send update_select_display
84346>>>>>>> set dynamic_update_state to true
84347>>>>>>> end
84347>>>>>>>>
84347>>>>>>> end_procedure
84348>>>>>>>
84348>>>>>>> procedure Callback_Selected_Files integer msg# integer tmp_obj#
84350>>>>>>> integer obj# max# row# open# file#
84350>>>>>>> if num_arguments gt 1 move tmp_obj# to obj#
84353>>>>>>> else move self to obj#
84355>>>>>>> get Row_Count to max#
84356>>>>>>> for row# from 0 to (max#-1)
84362>>>>>>>>
84362>>>>>>> if (Row_Select_State(self,row#)) begin
84364>>>>>>> move (Row_File(self,row#)) to file#
84365>>>>>>> send msg# to obj# file# (Row_DisplayName(self,row#)) (Row_DfName(self,row#)) (Row_RootName(self,row#))
84366>>>>>>> end
84366>>>>>>>>
84366>>>>>>> loop
84367>>>>>>>>
84367>>>>>>> end_procedure
84368>>>>>>>
84368>>>>>>> procedure Callback_All_Files integer msg# integer tmp_obj#
84370>>>>>>> integer obj# max# row# open# file#
84370>>>>>>> if num_arguments gt 1 move tmp_obj# to obj#
84373>>>>>>> else move self to obj#
84375>>>>>>> get Row_Count to max#
84376>>>>>>> for row# from 0 to (max#-1)
84382>>>>>>>>
84382>>>>>>> move (Row_File(self,row#)) to file#
84383>>>>>>> send msg# to obj# file# (Row_DisplayName(self,row#)) (Row_DfName(self,row#)) (Row_RootName(self,row#))
84384>>>>>>> loop
84385>>>>>>>>
84385>>>>>>> end_procedure
84386>>>>>>>
84386>>>>>>> //> Procedure Callback_General are used for calling back
84386>>>>>>> //>
84386>>>>>>> //> Selected# = 0 => Only files not selected are called back
84386>>>>>>> //> Selected# = 1 => Only files that are selected are called back
84386>>>>>>> //> Selected# = -1 => Files are called back whether they are selected or not
84386>>>>>>> //>
84386>>>>>>> //> Shaded# = 0 => Only files not shaded are called back
84386>>>>>>> //> Shaded# = 1 => Only shaded files are called back
84386>>>>>>> //> Shaded# = -1 => Files are called back whether they are shaded or not
84386>>>>>>> //>
84386>>>>>>> //> Master# = 0 => All entries fulfilling the above are called back
84386>>>>>>> //> Master# = 1 => If more entries have identical root names they are only called back once.
84386>>>>>>> procedure Callback_General integer msg# integer obj# integer selected# integer shaded# integer master_tmp#
84388>>>>>>> integer row# max# file# is_selected# is_shaded# master# ok#
84388>>>>>>> string check# root#
84388>>>>>>> if num_arguments lt 5 move 0 to master#
84391>>>>>>> else move master_tmp# to master#
84393>>>>>>> move ";" to check#
84394>>>>>>> get Row_Count to max#
84395>>>>>>> for row# from 0 to (max#-1)
84401>>>>>>>>
84401>>>>>>> move (Row_Select_State(self,row#)) to is_selected#
84402>>>>>>> move (Row_Shadow_State(self,row#)) to is_shaded#
84403>>>>>>> if ((selected#=-1 or selected#=is_selected#) and (shaded#=-1 or shaded#=is_shaded#)) begin
84405>>>>>>> if master# begin
84407>>>>>>> move (trim(lowercase(Row_RootName(self,row#)))) to root#
84408>>>>>>> if (";"+root#+";") in check# move 0 to ok#
84411>>>>>>> else begin
84412>>>>>>> move (check#+root#+";") to check#
84413>>>>>>> move 1 to ok#
84414>>>>>>> end
84414>>>>>>>>
84414>>>>>>> end
84414>>>>>>>>
84414>>>>>>> else move 1 to ok#
84416>>>>>>> if ok# begin
84418>>>>>>> get Row_File row# to file#
84419>>>>>>> send msg# to obj# file# is_selected# is_shaded#
84420>>>>>>> end
84420>>>>>>>>
84420>>>>>>> end
84420>>>>>>>>
84420>>>>>>> loop
84421>>>>>>>>
84421>>>>>>> end_procedure
84422>>>>>>>
84422>>>>>>> // Returns true if the function is completed
84422>>>>>>> register_function iCallback_File.iii integer file# integer get# integer obj# returns integer
84422>>>>>>> function iCallback_Selected_Files_Server integer get# integer obj# returns integer
84424>>>>>>> integer max# row# open# file# rval# svr#
84424>>>>>>> get piFDX_Server to svr#
84425>>>>>>> get Row_Count to max#
84426>>>>>>> move 1 to rval#
84427>>>>>>> for row# from 0 to (max#-1)
84433>>>>>>>>
84433>>>>>>> if rval# begin
84435>>>>>>> if (Row_Select_State(self,row#)) get iCallback_File.iii of svr# (Row_File(self,row#)) get# obj# to rval#
84438>>>>>>> end
84438>>>>>>>>
84438>>>>>>> else function_return 0
84440>>>>>>> loop
84441>>>>>>>>
84441>>>>>>> function_return 1
84442>>>>>>> end_function
84443>>>>>>> procedure load_current_selection string fn#
84445>>>>>>> integer ch# row# max# file# st# fin#
84445>>>>>>> string str#
84445>>>>>>> get Seq_New_Channel to ch#
84446>>>>>>> direct_input channel ch# fn#
84448>>>>>>> if [~seqeof] begin
84450>>>>>>> send wait_on
84451>>>>>>> readln str#
84452>>>>>>> ifnot str# eq "LFSELECT1.0" send obs "Incompatible format"
84455>>>>>>> else begin
84456>>>>>>> repeat
84456>>>>>>>>
84456>>>>>>> readln file#
84457>>>>>>> readln st#
84458>>>>>>> move (seqeof) to fin#
84459>>>>>>> ifnot fin# if st# set file_select_state file# to st#
84464>>>>>>> until fin#
84466>>>>>>> end
84466>>>>>>>>
84466>>>>>>> send wait_off
84467>>>>>>> end
84467>>>>>>>>
84467>>>>>>> else send obs "File not found"
84469>>>>>>> close_input channel ch#
84471>>>>>>> send Seq_Release_Channel ch#
84472>>>>>>> send update_select_display
84473>>>>>>> end_procedure
84474>>>>>>> procedure load_current_selection.browse
84476>>>>>>> string fn#
84476>>>>>>> move (SEQ_SelectFile("Load filelist selection","Filelist selections (*.fsl)|*.FSL")) to fn#
84477>>>>>>> if fn# ne "" send load_current_selection fn#
84480>>>>>>> end_procedure
84481>>>>>>> procedure save_current_selection string fn#
84483>>>>>>> integer ch# row# max# file# st#
84483>>>>>>> send wait_on
84484>>>>>>> get Seq_New_Channel to ch#
84485>>>>>>> direct_output channel ch# fn#
84487>>>>>>> writeln "LFSELECT1.0"
84489>>>>>>> get Row_Count to max#
84490>>>>>>> for row# from 0 to (max#-1)
84496>>>>>>>>
84496>>>>>>> get Row_File row# to file#
84497>>>>>>> get Row_Select_state row# to st#
84498>>>>>>> writeln file#
84500>>>>>>> writeln st#
84502>>>>>>> loop
84503>>>>>>>>
84503>>>>>>> close_output channel ch#
84505>>>>>>> send Seq_Release_Channel ch#
84506>>>>>>> send wait_off
84507>>>>>>> end_procedure
84508>>>>>>> procedure save_current_selection.browse
84510>>>>>>> string fn#
84510>>>>>>> move (SEQ_SelectOutFile("Save filelist selection","Filelist selections (*.fsl)|*.FSL")) to fn#
84511>>>>>>> if fn# ne "" send save_current_selection fn#
84514>>>>>>> end_procedure
84515>>>>>>> procedure display_file_things
84517>>>>>>> if (item_count(self)) ifnot (Row_Shadow_State(self,Current_Row(self))) send FDX_ModalDisplayFileAttributes (piFDX_Server(self)) (Current_File(self))
84522>>>>>>> end_procedure
84523>>>>>>> procedure display_file_location
84525>>>>>>> integer fdx# file#
84525>>>>>>> number ts#
84525>>>>>>> string path#
84525>>>>>>> ifnot (Row_Shadow_State(self,Current_Row(self))) begin
84527>>>>>>> get piFDX_Server to fdx#
84528>>>>>>> get Current_File to file#
84529>>>>>>> get sDatPath.i of fdx# file# to path#
84530>>>>>>> get nTimeStamp.i of fdx# file# to ts#
84531>>>>>>> send obs "Data path:" path# "Table data last modified:" (TS_ConvertToString(ts#))
84532>>>>>>> end
84532>>>>>>>>
84532>>>>>>> end_procedure
84533>>>>>>>end_class // cFdxFileMultiSelector
84534>>>>>Use Version.nui
84534>>>>>
84534>>>>>define VDFSORT$INCLUDE_VDFCLEAN for 1
84534>>>>>
84534>>>>>define hlpid.VdfSort_Select for 5001
84534>>>>>define hlpid.VdfSort_Properties for 5002
84534>>>>>define hlpid.VdfSort_Result for 5003
84534>>>>>
84534>>>>> define t.VdfSort.Caption for "Select file(s) to sort"
84534>>>>> define t.VdfSort.Btn.Reindex for "Sort"
84534>>>>> define t.VdfSort.Btn.CleanUp for "Cleanup"
84534>>>>> define t.VdfSort.Wait.Caption for "Reindex, status"
84534>>>>> define t.VdfSort.Wait.Status for "History"
84534>>>>> define t.VdfSort.Wait.History for "Action"
84534>>>>> define t.VdfSort.Wait.Error for "Error"
84534>>>>> define t.VdfSort.Wait.Of for " of "
84534>>>>> define t.VdfSort.Err.Exclusive1 for "The sort routine could not obtain exclusive access."
84534>>>>> define t.VdfSort.Err.Exclusive2 for "Make sure noone else is using the system and that"
84534>>>>> define t.VdfSort.Err.Exclusive3 for "you are not running a copy of this program in the"
84534>>>>> define t.VdfSort.Err.Exclusive4 for "background. Then try again."
84534>>>>> define t.VdfSort.Prop_Caption for "Sort properties"
84534>>>>> define t.VdfSort.Prop_BadData for "Bad data"
84534>>>>> define t.VdfSort.Prop_BD_NoCheck for "No check"
84534>>>>> define t.VdfSort.Prop_BD_SpaceFill for "Fill with spaces"
84534>>>>> define t.VdfSort.Prop_BD_WriteFile for "Write to file"
84534>>>>> define t.VdfSort.Prop_BD_Abort for "Abort on bad data"
84534>>>>> define t.VdfSort.Prop_Duplicates for "Duplicate records"
84534>>>>> define t.VdfSort.Prop_DD_WriteFile for "Write to file"
84534>>>>> define t.VdfSort.Prop_DD_Abort for "Abort on duplicates"
84534>>>>> define t.VdfSort.Prop_SortBuffer for "Sort buffer size (Kb)"
84534>>>>> define t.VdfSort.Done for "Re-index done"
84534>>>>> define t.VdfSort.NoErrors for "No errors during sort operation"
84534>>>>> define t.VdfSort.FileLocations for "File locations"
84534>>>>> define t.VdfSort.ReindexHistory for "Re-index, history"
84534>>>>> define t.VdfSort.ReindexErrors for "Re-index, errors"
84534>>>>> define t.VdfSort.NoFilesToClean for "No files to clean up"
84534>>>>> define t.VdfSort.CleanFile for "Clean up file"
84534>>>>> define t.VdfSort.Btn.Skip for "Skip set"
84534>>>>> define t.VdfSort.Btn.Auto for "Auto clean set"
84534>>>>> define t.VdfSort.Lbl.SetNo for "Set of duplicate records (set: #/#)"
84534>>>>> define t.VdfSort.Lbl.SelectRec for "Select record to keep:"
84534>>>>> define t.VdfSort.LoadingSet for "Loading set..."
84534>>>>> define t.VdfSort.DeletingRecs for "Deleting records..."
84534>>>>> define t.VdfSort.CountingSets for "Counting number of sets..."
84534>>>>> define t.VdfSort.RecordsInSet for " records in set"
84534>>>>> define t.VdfSort.DoReindexAgain for "You must re-index the file again"
84534>>>>> define t.VdfSort.SelectError for "You have not selected the record to keep!"
84534>>>>> define t.VdfSort.Lbl.FieldName for "Field name"
84534>>>>> define t.VdfSort.Lbl.CurrentRec for "Current record"
84534>>>>> define t.VdfSort.Lbl.RecordToKeep for "Record to keep"
84534>>>>> define t.VdfSort.Lbl.FieldType for "Field type"
84534>>>>> define t.VdfSort.SelectFileToClean for "Select file to clean up"
84534>>>>> define t.VdfSort.Lbl.UserName for "User name"
84534>>>>> define t.VdfSort.Lbl.DataFileLoc for "Data file location"
84534>>>>> define t.VdfSort.Lbl.BadFileLoc for "Bad file location"
84534>>>>> define t.VdfSort.Lbl.SizeAndTime for "Size and time"
84534>>>>> define t.VdfSort.BadErr.Txt1 for "In the .BAD file there were more"
84534>>>>> define t.VdfSort.BadErr.Txt2 for "errors than just duplicate records."
84534>>>>> define t.VdfSort.BadErr.Txt3 for "Re-index file again and clean"
84534>>>>> define t.VdfSort.BadErr.Txt4 for "with regular clean up program"
84534>>>>> define t.VdfSort.BadErr.Txt5 for "(A component called 'DataBase Builder')"
84534>>>>> define t.VdfSort.Lbl.DataFile for "Data file:"
84534>>>>> define t.VdfSort.Lbl.BadFile for "BAD file:"
84534>>>>> define t.VdfSort.CantGainExcl for "Can not get (exclusive) access to data file"
84534>>>>> define t.VdfSort.Definition for "Definition"
84534>>>>> define t.VdfSort.WriteFDX for "Write FDX"
84534>>>>>
84534>>>>>function VdfSort_field_length_string global integer file# integer field# returns string
84536>>>>> integer fieldtype# len# dec# obj#
84536>>>>> string rval#
84536>>>>> get_attribute DF_FIELD_TYPE of file# field# to fieldtype#
84539>>>>> get_attribute DF_FIELD_LENGTH of file# field# to len#
84542>>>>> if fieldtype# eq DF_DATE move 3 to len#
84545>>>>> move len# to rval#
84546>>>>> if fieldtype# eq DF_BCD begin
84548>>>>> get gl_effective_form_datatype file# field# to dec#
84549>>>>> move "#.#" to rval#
84550>>>>> replace "#" in rval# with (string(len#-dec#))
84552>>>>> replace "#" in rval# with (string(dec#))
84554>>>>> end
84554>>>>>>
84554>>>>> function_return rval#
84555>>>>>end_function
84556>>>>>
84556>>>>>function VdfSort_field_status_help global integer file# integer field# returns string
84558>>>>> integer fieldtype# obj#
84558>>>>> string rval# str#
84558>>>>> move "# (#)" to rval#
84559>>>>> move (FieldInf_FieldType(file#,field#)) to fieldtype#
84560>>>>> if fieldtype# eq DF_ASCII move "Ascii" to str#
84563>>>>> if fieldtype# eq DF_DATE move "Date" to str#
84566>>>>> if fieldtype# eq DF_TEXT move "Text" to str#
84569>>>>> if fieldtype# eq DF_BCD move "Number" to str#
84572>>>>> if fieldtype# eq DF_BINARY move "Binary" to str#
84575>>>>> if str# eq "" move "Unknown" to str#
84578>>>>> replace "#" in rval# with str#
84580>>>>> replace "#" in rval# with (VdfSort_field_length_string(file#,field#))
84582>>>>> function_return rval#
84583>>>>>end_function
84584>>>>>
84584>>>>>Use APS // Auto Positioning and Sizing classes for VDF
84584>>>>>Use ObjGroup.utl // Defining groups of objects
84584>>>>>Use MsgBox // DAC class
84584>>>>>register_object oList
84584>>>>>register_object oCont
84584>>>>>register_object oVdfSort
84584>>>>>
84584>>>>>integer oVdfSort_Callback_vw# oVdfSort#
84584>>>>>
84584>>>>>integer oVdfSort_SortOptions#
84584>>>>>move (DF_SORT_OPTION_BAD_DATA_FILE+DF_SORT_OPTION_DUP_DATA_FILE) to oVdfSort_SortOptions#
84585>>>>>//move (DF_SORT_OPTION_NO_DATA_CHECK+DF_SORT_OPTION_DUP_DATA_FILE) to oVdfSort_SortOptions#
84585>>>>>
84585>>>>>DEFINE_OBJECT_GROUP OG_VdfSort_Callback_vw
84586>>>>>
84586>>>>> object oVdfSort_Callback_vw is a aps.View label t.VdfSort.Wait.Caption
84589>>>>> on_key kcancel send close_panel
84590>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
84591>>>>> property integer pCount public 0
84593>>>>> property integer pCount2 public 0
84595>>>>> set help_id to hlpid.VdfSort_Result
84596>>>>>
84596>>>>> object oCnt is a aps.Container3D
84598>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
84599>>>>> object Sort_Progress_List is a aps.Edit Label t.VdfSort.Wait.History
84602>>>>> set peAnchors to (anTop+anLeft+anRight)
84603>>>>> set size to 75 250
84604>>>>> end_object
84605>>>>> Send Aps_Goto_Max_Row
84606>>>>> object Sort_Warning is a aps.Edit Label t.VdfSort.Wait.Error
84609>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
84610>>>>> set size to 50 250
84611>>>>> end_object
84612>>>>> Send Aps_Goto_Max_Row
84613>>>>> Send Make_Row_Space 3
84614>>>>> object Sort_Progress_Title is a aps.Form Label t.VdfSort.Wait.Status Abstract AFT_ASCII20
84618>>>>> set object_shadow_state to true
84619>>>>> set peAnchors to (anLeft+anBottom)
84620>>>>> end_object
84621>>>>> object Sort_Progress_Value is a aps.Form Abstract AFT_ASCII25 snap SL_RIGHT
84625>>>>> set object_shadow_state to true
84626>>>>> set peAnchors to (anLeft+anRight+anBottom)
84627>>>>> end_object
84628>>>>> send aps_align_by_sizing (Sort_Progress_Value(self)) (Sort_Warning(self)) sl_align_right
84629>>>>> procedure Print_History
84632>>>>> integer obj# itm# max#
84632>>>>> if (iDirect_Output_Title(seq.object#,t.VdfSort.ReindexHistory)) begin
84634>>>>> seq.writeln t.VdfSort.ReindexHistory
84636>>>>> send make_horizontal_line to seq.object#
84637>>>>> seq.writeln ""
84639>>>>> move (Sort_Progress_List(self)) to obj#
84640>>>>> get pCount to max#
84641>>>>> for itm# from 0 to max#
84647>>>>>>
84647>>>>> seq.writeln (value(obj#,itm#))
84649>>>>> loop
84650>>>>>>
84650>>>>> seq.writeln ""
84652>>>>> seq.writeln ""
84654>>>>> seq.writeln t.VdfSort.ReindexErrors
84656>>>>> send make_horizontal_line to seq.object#
84657>>>>> move (Sort_Warning(self)) to obj#
84658>>>>> get pCount2 to max#
84659>>>>> for itm# from 0 to max#
84665>>>>>>
84665>>>>> seq.writeln (value(obj#,itm#))
84667>>>>> loop
84668>>>>>>
84668>>>>> seq.close_output
84669>>>>> end
84669>>>>>>
84669>>>>> end_procedure
84670>>>>> end_object
84671>>>>>
84671>>>>> procedure Print_Report
84674>>>>> send Print_History to (oCnt(self))
84675>>>>> end_procedure
84676>>>>>
84676>>>>> object oBtn1 is a aps.multi_button
84678>>>>> set peAnchors to (anRight+anBottom)
84679>>>>> on_item t.btn.print send Print_History to (oCnt(self))
84680>>>>> end_object
84681>>>>> object oBtn2 is a aps.multi_button
84683>>>>> set peAnchors to (anRight+anBottom)
84684>>>>> on_item t.VdfSort.Btn.CleanUp send SelectBadFile to (oList(oCont(oVdfSort(self))))
84685>>>>> end_object
84686>>>>> object oBtn3 is a aps.multi_button
84688>>>>> set peAnchors to (anRight+anBottom)
84689>>>>> on_item t.btn.close send close_panel
84690>>>>> end_object
84691>>>>> send aps_locate_multi_buttons
84692>>>>>
84692>>>>> function callback string txt# integer typ# returns integer
84695>>>>> if (typ# ge DF_MESSAGE_HEADING_1 and typ# le DF_MESSAGE_HEADING_5) begin
84697>>>>> set value of (Sort_Progress_List(oCnt(self))) item (pcount(self)) to txt#
84698>>>>> send paint to (Sort_Progress_List(oCnt(self)))
84699>>>>> set pcount to (pcount(self) + 1)
84700>>>>> end
84700>>>>>>
84700>>>>> else if typ# eq DF_MESSAGE_PROGRESS_TITLE begin
84703>>>>> set value of (sort_progress_title(oCnt(self))) item 0 to txt#
84704>>>>> send paint to (sort_progress_title(oCnt(self)))
84705>>>>> end
84705>>>>>>
84705>>>>> else if typ# eq DF_MESSAGE_PROGRESS_VALUE begin
84708>>>>> replace ',' in txt# with t.VdfSort.Wait.Of
84710>>>>> set value of (sort_progress_value(oCnt(self))) item 0 to txt#
84711>>>>> send paint to (sort_progress_value(oCnt(self)))
84712>>>>> end
84712>>>>>>
84712>>>>> else if typ# eq DF_MESSAGE_WARNING begin
84715>>>>> set value of (sort_warning(oCnt(self))) item (pcount2(self)) to txt#
84716>>>>> send paint to (sort_warning(oCnt(self)))
84717>>>>> set pcount2 to (pcount2(self)+1)
84718>>>>> set value of (Sort_Progress_List(oCnt(self))) item (pcount(self)) to txt#
84719>>>>> send paint to (Sort_Progress_List(oCnt(self)))
84720>>>>> set pcount to (pcount(self)+1)
84721>>>>> end
84721>>>>>>
84721>>>>> function_return 0
84722>>>>> end_function
84723>>>>> procedure popup
84726>>>>> set pcount to 0
84727>>>>> set pcount2 to 0
84728>>>>> send delete_data to (Sort_Progress_List(oCnt(self)))
84729>>>>> send delete_data to (Sort_Warning(oCnt(self)))
84730>>>>> set value of (Sort_Progress_Title(oCnt(self))) item 0 to ""
84731>>>>> set value of (Sort_Progress_Value(oCnt(self))) item 0 to ""
84732>>>>> set object_shadow_state of (oBtn1(self)) to true
84733>>>>> set object_shadow_state of (oBtn2(self)) to true
84734>>>>> set object_shadow_state of (oBtn3(self)) to true
84735>>>>> forward send popup
84737>>>>> end_procedure
84738>>>>> procedure ending_sort
84741>>>>> set value of (Sort_Progress_List(oCnt(self))) item (pcount(self)) to t.VdfSort.Done
84742>>>>> ifnot (pcount2(self)) ; set value of (Sort_Warning(oCnt(self))) item 0 to t.VdfSort.NoErrors
84745>>>>> set object_shadow_state of (oBtn1(self)) to false
84746>>>>> set object_shadow_state of (oBtn2(self)) to false
84747>>>>> set object_shadow_state of (oBtn3(self)) to false
84748>>>>> send activate to (oBtn3(self))
84749>>>>> end_procedure
84750>>>>>
84750>>>>> move self to oVdfSort_Callback_vw#
84751>>>>> end_object
84752>>>>> set piMinSize of oVdfSort_Callback_vw# to (hi(size(oVdfSort_Callback_vw#))) (low(size(oVdfSort_Callback_vw#)))
84753>>>>>END_DEFINE_OBJECT_GROUP
84754>>>>>
84754>>>>>DEFINE_OBJECT_GROUP OG_VdfSort
84755>>>>> object VdfSort_oFileAllFiles is a cTablesOpenStatus
84757>>>>> end_object
84758>>>>>
84758>>>>> class cBadFileReader is an array
84759>>>>> procedure construct_object
84761>>>>> forward send construct_object
84763>>>>> set delegation_mode to DELEGATE_TO_PARENT
84764>>>>> property string pBadFileName public ""
84765>>>>> property integer pCurrentPosition public 0
84766>>>>> property integer pChannel public 0
84767>>>>> property integer pBadDataInFile public 0 // Something other than duplicate records in file?
84768>>>>> property integer pMainFile public 0
84769>>>>> property integer private.pFirstRec public 0
84770>>>>> property integer private.pRecCount public 0
84771>>>>> end_procedure
84772>>>>>
84772>>>>> function iCountSetsInFile returns integer
84774>>>>> integer rval# ch# prev_rec# current_rec# fin#
84774>>>>> string str#
84774>>>>> get Seq_New_Channel to ch#
84775>>>>> move 0 to rval#
84776>>>>> move 0 to fin#
84777>>>>> direct_input channel ch# (pBadFileName(self))
84779>>>>> move -1 to prev_rec#
84780>>>>> repeat
84780>>>>>>
84780>>>>> readln str#
84781>>>>> move (seqeof) to fin#
84782>>>>> ifnot fin# begin
84784>>>>> if (StringBeginsWith(str#,"DUPLICATE,")) begin
84786>>>>> move (ExtractInteger(str#,1)) to current_rec#
84787>>>>> if current_rec# ne prev_rec# increment rval#
84790>>>>> move (ExtractInteger(str#,2)) to prev_rec#
84791>>>>> end
84791>>>>>>
84791>>>>> end
84791>>>>>>
84791>>>>> until fin#
84793>>>>> close_input channel ch#
84795>>>>> send Seq_Release_Channel ch#
84796>>>>> function_return rval#
84797>>>>> end_function
84798>>>>>
84798>>>>> procedure DeleteBadFile
84800>>>>> string str1# str2# str3# str4# str5#
84800>>>>> if (pBadDataInFile(self)) begin
84802>>>>> move t.VdfSort.BadErr.Txt1 to str1#
84803>>>>> move t.VdfSort.BadErr.Txt2 to str2#
84804>>>>> move t.VdfSort.BadErr.Txt3 to str3#
84805>>>>> move t.VdfSort.BadErr.Txt4 to str4#
84806>>>>> move t.VdfSort.BadErr.Txt5 to str5#
84807>>>>> send obs str1# str2# "" str3# str4# str5#
84808>>>>> end
84808>>>>>>
84808>>>>> erasefile (pBadFileName(self))
84809>>>>>>
84809>>>>> end_procedure
84810>>>>> procedure reset
84812>>>>> set pCurrentPosition to 0
84813>>>>> set pBadDataInFile to 0
84814>>>>> end_procedure
84815>>>>> // function sReadLnDuplicate.i will return the empty string only if an EOF
84815>>>>> // marker has been reached
84815>>>>> function sReadLnDuplicate.i integer ch# returns string
84817>>>>> integer fin# pos#
84817>>>>> string rval#
84817>>>>> repeat
84817>>>>>>
84817>>>>> get_channel_position ch# to pos# // Always keep pCurrentPosition pointing
84818>>>>>>
84818>>>>> set pCurrentPosition to pos# // to the beginning of the line just read.
84819>>>>> readln channel ch# rval#
84821>>>>> if (seqeof) function_return ""
84824>>>>> if (StringBeginsWith(rval#,"DUPLICATE,")) move 1 to fin#
84827>>>>> else if rval# ne "" set pBadDataInFile to true
84831>>>>> until fin#
84833>>>>> function_return rval#
84834>>>>> end_function
84835>>>>>
84835>>>>> enumeration_list // Return values of call back function (iCallBack_Next_Set)
84835>>>>> define CBNS_CANCELLED // The reading operation was cancelled by operator
84835>>>>> define CBNS_END_OF_FILE // The file is empty
84835>>>>> define CBNS_OK // The reading of the set was completed
84835>>>>> define CBNS_ERROR // Some error occurred
84835>>>>> define CBNS_ONE_OR_NONE_IN_SET // One or no records in set, but we're not done...
84835>>>>> end_enumeration_list
84835>>>>>
84835>>>>> function iExistsRecord.i integer rec# returns integer
84837>>>>> integer file#
84837>>>>> get pMainFile to file#
84838>>>>> clear file#
84839>>>>> set_field_value file# 0 to rec#
84842>>>>> vfind file# 0 EQ
84844>>>>> function_return (found)
84845>>>>> end_function
84846>>>>>
84846>>>>> function iCallBack_Next_Set_Help integer get# integer obj# integer rec# returns integer
84848>>>>> integer rval#
84848>>>>> if (iExistsRecord.i(self,rec#)) begin
84850>>>>> if (private.pRecCount(self)) begin
84852>>>>> get get# of obj# rec# to rval#
84853>>>>> set private.pRecCount to (private.pRecCount(self)+1)
84854>>>>> end
84854>>>>>>
84854>>>>> else begin
84855>>>>> if (private.pFirstRec(self)) begin
84857>>>>> // Only call back when we have at least two
84857>>>>> get get# of obj# (private.pFirstRec(self)) to rval#
84858>>>>> if rval# get get# of obj# rec# to rval#
84861>>>>> set private.pRecCount to 2
84862>>>>> end
84862>>>>>>
84862>>>>> else begin
84863>>>>> set private.pFirstRec to rec#
84864>>>>> move 1 to rval# // 1 means continue...
84865>>>>> end
84865>>>>>>
84865>>>>> end
84865>>>>>>
84865>>>>> end
84865>>>>>>
84865>>>>> else move 1 to rval#
84867>>>>> function_return rval#
84868>>>>> end_function
84869>>>>>
84869>>>>> function iCallBack_Next_Set integer get# integer tmp_obj# returns integer
84871>>>>> integer obj# ch# rval# pos# continue# fin#
84871>>>>> integer prev_rec# current_rec#
84871>>>>> string str#
84871>>>>> if num_arguments gt 1 move tmp_obj# to obj#
84874>>>>> else move self to obj#
84876>>>>> get Seq_New_Channel to ch#
84877>>>>>
84877>>>>> move CBNS_OK to rval# // Default return value
84878>>>>> set private.pFirstRec to 0
84879>>>>> set private.pRecCount to 0
84880>>>>>
84880>>>>> get pCurrentPosition to pos#
84881>>>>> direct_input channel ch# (pBadFileName(self))
84883>>>>> ifnot (seqeof) begin
84885>>>>> set_channel_position ch# to (pCurrentPosition(self))
84886>>>>>>
84886>>>>>
84886>>>>> get sReadLnDuplicate.i ch# to str# // Get first line
84887>>>>> if str# eq "" move CBNS_END_OF_FILE to rval#
84890>>>>>
84890>>>>> if rval# ne CBNS_END_OF_FILE begin
84892>>>>> move (ExtractInteger(str#,1)) to current_rec#
84893>>>>> move (ExtractInteger(str#,2)) to prev_rec#
84894>>>>> get iCallBack_Next_Set_Help get# obj# current_rec# to continue#
84895>>>>> if continue# get iCallBack_Next_Set_Help get# obj# prev_rec# to continue#
84898>>>>> if continue# begin
84900>>>>> move 0 to fin#
84901>>>>> repeat
84901>>>>>>
84901>>>>> get sReadLnDuplicate.i ch# to str# // Get first line
84902>>>>> if str# eq "" move 1 to fin#
84905>>>>> else begin
84906>>>>> move (ExtractInteger(str#,1)) to current_rec#
84907>>>>> if current_rec# eq prev_rec# begin // still part of current set
84909>>>>> move (ExtractInteger(str#,2)) to prev_rec#
84910>>>>> get iCallBack_Next_Set_Help get# obj# prev_rec# to continue#
84911>>>>> ifnot continue# begin
84913>>>>> move 1 to fin#
84914>>>>> move CBNS_CANCELLED to fin#
84915>>>>> end
84915>>>>>>
84915>>>>> end
84915>>>>>>
84915>>>>> else move 1 to fin#
84917>>>>> end
84917>>>>>>
84917>>>>> until fin#
84919>>>>> end
84919>>>>>>
84919>>>>> else move CBNS_CANCELLED to rval#
84921>>>>> end
84921>>>>>>
84921>>>>>
84921>>>>> if (rval#=CBNS_OK and not(private.pRecCount(self))) ; move CBNS_ONE_OR_NONE_IN_SET to rval#
84924>>>>> end
84924>>>>>>
84924>>>>> else move CBNS_ERROR to rval#
84926>>>>> close_input channel ch#
84928>>>>> send Seq_Release_Channel ch#
84929>>>>> function_return rval#
84930>>>>> end_procedure
84931>>>>> end_class // iCallBack_Next_Set
84932>>>>>
84932>>>>> class cDisplayRecordsGrid is a aps.Grid
84933>>>>> procedure construct_object
84935>>>>> forward send construct_object
84937>>>>> property integer pMainFile public 0
84938>>>>> //> The embedded array oFields contains a list of fields in file
84938>>>>> //> pMainFile that should be displayed by the grid.
84938>>>>> object oFields is an array
84940>>>>> end_object
84941>>>>> object oColors is an array
84943>>>>> end_object
84944>>>>> end_procedure
84945>>>>>
84945>>>>> function iColumns returns integer
84947>>>>> integer ms#
84947>>>>> get matrix_size to ms#
84948>>>>> function_return (low(ms#))
84949>>>>> end_function
84950>>>>>
84950>>>>> procedure set column_color integer column# integer color#
84952>>>>> set value of (oColors(self)) item column# to color#
84953>>>>> end_procedure
84954>>>>>
84954>>>>> procedure read_fields
84956>>>>> integer file# fld# itm# obj# type# max#
84956>>>>> get pMainFile to file#
84957>>>>> move (oFields(self)) to obj#
84958>>>>> send delete_data to obj#
84959>>>>> move 0 to itm#
84960>>>>> get_attribute DF_FILE_NUMBER_FIELDS of file# to max#
84963>>>>> for fld# from 0 to max#
84969>>>>>>
84969>>>>> get_attribute DF_FIELD_TYPE of file# fld# to type#
84972>>>>> if type# ne DF_OVERLAP begin
84974>>>>> set value of obj# item itm# to fld#
84975>>>>> increment itm#
84976>>>>> end
84976>>>>>>
84976>>>>> loop
84977>>>>>>
84977>>>>> end_procedure
84978>>>>>
84978>>>>> procedure initialize_items
84980>>>>> integer max# itm# file# columns# rows# column# row# color# oColors#
84980>>>>> get pMainFile to file#
84981>>>>> move (oColors(self)) to oColors#
84982>>>>> get item_count of (oFields(self)) to rows#
84983>>>>> get icolumns to columns#
84984>>>>> send delete_data
84985>>>>> for row# from 0 to (rows#-1)
84991>>>>>>
84991>>>>> for column# from 0 to (columns#-1)
84997>>>>>>
84997>>>>> move (row#*columns#+column#) to itm#
84998>>>>> send add_item msg_none ""
84999>>>>> set entry_state item itm# to dfFalse
85000>>>>> get value of oColors# item column# to color#
85001>>>>> if color# set item_color item itm# to color#
85004>>>>> loop
85005>>>>>>
85005>>>>> loop
85006>>>>>>
85006>>>>> end_procedure
85007>>>>>
85007>>>>> procedure fill_list_field_names integer col#
85009>>>>> integer fld# max# itm# step_size# file# obj#
85009>>>>> string str#
85009>>>>> move (oFields(self)) to obj#
85010>>>>> get iColumns to step_size#
85011>>>>> get item_count of obj# to max#
85012>>>>> get pMainFile to file#
85013>>>>> for itm# from 0 to (max#-1)
85019>>>>>>
85019>>>>> get value of obj# item itm# to fld#
85020>>>>> move (FieldInf_FieldLabel_Long(file#,fld#)) to str#
85021>>>>> set value item col# to str#
85022>>>>> move (col#+step_size#) to col#
85023>>>>> loop
85024>>>>>>
85024>>>>> set dynamic_update_state to true // Otherwise nothing will display
85025>>>>> end_procedure
85026>>>>>
85026>>>>> procedure fill_list_field_types integer col#
85028>>>>> integer fld# max# itm# step_size# file# obj#
85028>>>>> string str#
85028>>>>> move (oFields(self)) to obj#
85029>>>>> get iColumns to step_size#
85030>>>>> get item_count of obj# to max#
85031>>>>> get pMainFile to file#
85032>>>>> for itm# from 0 to (max#-1)
85038>>>>>>
85038>>>>> get value of obj# item itm# to fld#
85039>>>>> move (VdfSort_field_status_help(file#,fld#)) to str#
85040>>>>> set value item col# to str#
85041>>>>> move (col#+step_size#) to col#
85042>>>>> loop
85043>>>>>>
85043>>>>> set dynamic_update_state to true // Otherwise nothing will display
85044>>>>> end_procedure
85045>>>>>
85045>>>>> procedure fill_list_field_data integer col# // Uses current record
85047>>>>> integer fld# max# itm# step_size# file# obj#
85047>>>>> string str#
85047>>>>> move (oFields(self)) to obj#
85048>>>>> get iColumns to step_size#
85049>>>>> get item_count of obj# to max#
85050>>>>> get pMainFile to file#
85051>>>>> for itm# from 0 to (max#-1)
85057>>>>>>
85057>>>>> get value of obj# item itm# to fld#
85058>>>>> get_field_value file# fld# to str#
85061>>>>> set value item col# to str#
85062>>>>> move (col#+step_size#) to col#
85063>>>>> loop
85064>>>>>>
85064>>>>> set dynamic_update_state to true // Otherwise nothing will display
85065>>>>> end_procedure
85066>>>>>
85066>>>>> procedure clear_column integer col#
85068>>>>> integer fld# max# itm# step_size# file#
85068>>>>> get iColumns to step_size#
85069>>>>> get item_count of (oFields(self)) to max#
85070>>>>> get pMainFile to file#
85071>>>>> for itm# from 0 to (max#-1)
85077>>>>>>
85077>>>>> set value item col# to ""
85078>>>>> move (col#+step_size#) to col#
85079>>>>> loop
85080>>>>>>
85080>>>>> set dynamic_update_state to true // Otherwise nothing will display
85081>>>>> end_procedure
85082>>>>>
85082>>>>> procedure fill_list.i integer file#
85084>>>>> set pMainFile to file#
85085>>>>> send read_fields
85086>>>>> send initialize_items
85087>>>>> send fill_list_field_names 0
85088>>>>> send fill_list_field_types 3
85089>>>>> end_procedure
85090>>>>> end_class // cDisplayRecordsGrid
85091>>>>>
85091>>>>> object oCleanUp_Panel is a aps.ModalPanel
85093>>>>> set p_Auto_Column to true
85094>>>>> set locate_mode to center_on_screen
85095>>>>> on_key kcancel send close_panel
85096>>>>> property integer pChanged_State public 0
85098>>>>> property integer pRecordToKeep public 0
85100>>>>> property integer pMainFile public 0
85102>>>>> property integer pDeleteBadOnEOF public 0
85104>>>>> object oBadFileReader is an cBadFileReader
85106>>>>> end_object
85107>>>>> object oDataFileName is a aps.Form label t.VdfSort.Lbl.DataFile abstract aft_ascii80
85111>>>>> set object_shadow_state to true
85112>>>>> end_object
85113>>>>> object oBadFileName is a aps.Form label t.VdfSort.Lbl.BadFile abstract aft_ascii80
85117>>>>> set object_shadow_state to true
85118>>>>> end_object
85119>>>>> procedure DeleteBadFile
85122>>>>> if (pDeleteBadOnEOF(self)) send DeleteBadFile to (oBadFileReader(self))
85125>>>>> end_procedure
85126>>>>>
85126>>>>> set p_Auto_Column to false
85127>>>>> send aps_goto_max_row
85128>>>>> send aps_make_row_space
85129>>>>>
85129>>>>> object oGrp is a aps.Group
85131>>>>> set p_Auto_Column to false
85132>>>>> property integer pSetNumber public 0
85134>>>>> property integer pMaxSet public 0
85136>>>>> procedure display_set_no
85139>>>>> string str#
85139>>>>> move t.VdfSort.Lbl.SetNo to str#
85140>>>>> replace "#" in str# with (string(pSetNumber(self)))
85142>>>>> replace "#" in str# with (string(pMaxSet(self)))
85144>>>>> set label to str#
85145>>>>> end_procedure
85146>>>>> procedure increment_set_no
85149>>>>> set pSetNumber to (pSetNumber(self)+1)
85150>>>>> send display_set_no
85151>>>>> end_procedure
85152>>>>> procedure reset_set_no
85155>>>>> set pSetNumber to 0
85156>>>>> send display_set_no
85157>>>>> end_procedure
85158>>>>> object oLst is a aps.List label t.VdfSort.Lbl.SelectRec
85161>>>>> set size to 150 65
85162>>>>> set label_justification_mode to jmode_top
85163>>>>> set select_mode to multi_select // Makes it single select (???)
85164>>>>> function add_recnum integer rec# returns integer
85167>>>>> send add_item msg_none rec# //(string(rec#))
85168>>>>> function_return 1 // makes it continue
85169>>>>> end_function
85170>>>>> function iFill_List returns integer
85173>>>>> integer rval# get# self# max#
85173>>>>> send cursor_wait to (cursor_control(self))
85174>>>>> send update_form t.VdfSort.LoadingSet
85175>>>>> send clear_record_grid
85176>>>>> send delete_data
85177>>>>> move self to self#
85178>>>>> move get_add_recnum to get#
85179>>>>> repeat
85179>>>>>>
85179>>>>> get iCallBack_Next_Set of (oBadFileReader(self)) get# self# to rval#
85180>>>>> if (rval#=CBNS_OK or rval#=CBNS_ONE_OR_NONE_IN_SET) send increment_set_no
85183>>>>> until (rval#<>CBNS_ONE_OR_NONE_IN_SET)
85185>>>>> get item_count to max#
85186>>>>> send update_form (string(max#)+t.VdfSort.RecordsInSet)
85187>>>>> send cursor_ready to (cursor_control(self))
85188>>>>> function_return rval#
85189>>>>> end_function
85190>>>>> procedure fill_list
85193>>>>> integer rval#
85193>>>>> get iFill_List to rval#
85194>>>>> if rval# eq CBNS_END_OF_FILE begin
85196>>>>> send obs t.VdfSort.DoReindexAgain
85197>>>>> send DeleteBadFile // Delete .BAD file if file is cleaned
85198>>>>> send close_panel
85199>>>>> end
85199>>>>>>
85199>>>>> end_procedure
85200>>>>> procedure select_first
85203>>>>> integer rec#
85203>>>>> set current_item to 0
85204>>>>> set select_state item 0 to true
85205>>>>> get value item 0 to rec#
85206>>>>> set pRecordToKeep to rec#
85207>>>>> end_procedure
85208>>>>> procedure initialize_set_count
85211>>>>> send cursor_wait to (cursor_control(self))
85212>>>>> send update_form t.VdfSort.CountingSets
85213>>>>> set pMaxSet to (iCountSetsInFile(oBadFileReader(self)))
85214>>>>> send cursor_ready to (cursor_control(self))
85215>>>>> end_procedure
85216>>>>> procedure auto_clean
85219>>>>> integer fin# keep_rec# rval#
85219>>>>> move 0 to fin#
85220>>>>> repeat
85220>>>>>>
85220>>>>> get iRecordSelected to keep_rec#
85221>>>>> ifnot keep_rec# begin
85223>>>>> send select_first
85224>>>>> get iRecordSelected to keep_rec#
85225>>>>> end
85225>>>>>>
85225>>>>> ifnot keep_rec# move 1 to fin#
85228>>>>> ifnot fin# begin
85230>>>>> send delete_records keep_rec#
85231>>>>> get iFill_List to rval#
85232>>>>> if rval# eq CBNS_END_OF_FILE begin
85234>>>>> send obs t.VdfSort.DoReindexAgain
85235>>>>> send DeleteBadFile // Delete .BAD file if file is cleaned
85236>>>>> move 1 to fin#
85237>>>>> end
85237>>>>>>
85237>>>>> end
85237>>>>>>
85237>>>>> until fin#
85239>>>>> send close_panel
85240>>>>> end_procedure
85241>>>>> // This function will serve as a boolean test that it is indeed
85241>>>>> // OK to delete all the records (but one) in the set. And it will
85241>>>>> // in fact return the record number of the record to be kept
85241>>>>> function iRecordSelected returns integer
85244>>>>> integer rec# file#
85244>>>>> // First we will check that a record has been selected:
85244>>>>> get pRecordToKeep to rec#
85245>>>>> if rec# begin
85247>>>>> // OK! Now we know that a record has been selected. But we
85247>>>>> // have to make sure that it actually still exists. It may
85247>>>>> // have been wiped by a previous attempt to clean the file
85247>>>>> // or indeed as a result of cleaning a previous set of identical
85247>>>>> // records (according to another index).
85247>>>>> // If this situation arises (un-likely) the best the operator
85247>>>>> // can do is to re-index the file again to generate a new up-
85247>>>>> // to-date BAD file. Well, that's enough talking:
85247>>>>> get pMainFile to file#
85248>>>>> clear file#
85249>>>>> set_field_value file# 0 to rec#
85252>>>>> vfind file# 0 EQ
85254>>>>> ifnot (found) move 0 to rec#
85257>>>>> end
85257>>>>>>
85257>>>>> function_return rec#
85258>>>>> end_function
85259>>>>> procedure delete_records integer keep_rec#
85262>>>>> integer itm# max# rec# file#
85262>>>>> send cursor_wait to (cursor_control(self))
85263>>>>> send update_form t.VdfSort.DeletingRecs
85264>>>>> get pMainFile to file#
85265>>>>> get item_count to max#
85266>>>>> lock
85267>>>>>>
85267>>>>> for itm# from 0 to (max#-1)
85273>>>>>>
85273>>>>> get value item itm# to rec#
85274>>>>> if rec# ne keep_rec# begin // If it's not the record we want to keep
85276>>>>> clear file#
85277>>>>> set_field_value file# 0 to rec#
85280>>>>> vfind file# 0 EQ
85282>>>>> if (found) delete file#
85285>>>>> end
85285>>>>>>
85285>>>>> loop
85286>>>>>>
85286>>>>> unlock
85287>>>>>>
85287>>>>> send cursor_ready to (cursor_control(self))
85288>>>>> end_procedure
85289>>>>> procedure delete_records_and_fill_list // Delete all records not selected and get next set
85292>>>>> integer keep_rec#
85292>>>>> get iRecordSelected to keep_rec#
85293>>>>> if keep_rec# begin
85295>>>>> send delete_records keep_rec#
85296>>>>> send fill_list
85297>>>>> end
85297>>>>>>
85297>>>>> else send obs t.VdfSort.SelectError
85299>>>>> end_procedure
85300>>>>> procedure item_change integer i1# integer i2# returns integer
85303>>>>> integer rec#
85303>>>>> forward get msg_item_change i1# i2# to i2#
85305>>>>> get value item i2# to rec#
85306>>>>> send display_current_record rec#
85307>>>>> procedure_return i2#
85308>>>>> end_procedure
85309>>>>> procedure select_toggling integer itm# integer st#
85312>>>>> integer rec#
85312>>>>> forward send select_toggling itm# st#
85314>>>>> if st# begin
85316>>>>> get value item itm# to rec#
85317>>>>> send display_keep_record rec#
85318>>>>> end
85318>>>>>>
85318>>>>> end_procedure
85319>>>>> end_object
85320>>>>> object oFrm1 is a aps.form abstract aft_ascii25 snap sl_down
85324>>>>> set object_shadow_state to true
85325>>>>> end_object
85326>>>>> send aps_size_identical_max (oLst(self)) (oFrm1(self)) sl_horizontal
85327>>>>> procedure update_form string str#
85330>>>>> set value of (oFrm1(self)) item 0 to str#
85331>>>>> set dynamic_update_state of (oFrm1(self)) to true
85332>>>>> end_procedure
85333>>>>> end_object // oGrp
85334>>>>>
85334>>>>> object oRecordValues is a cDisplayRecordsGrid
85336>>>>> set size to 100 0
85337>>>>> set highlight_row_state to true
85338>>>>>// set highlight_row_color to (rgb(0,255,255))
85338>>>>>// set current_item_color to (rgb(0,255,255))
85338>>>>> set CurrentCellColor to clHighlight
85339>>>>> set CurrentCellTextColor to clHighlightText
85340>>>>> set CurrentRowColor to clHighlight
85341>>>>> set CurrentRowTextColor to clHighlightText
85342>>>>> set line_width to 4 0
85343>>>>> set form_margin item 0 to 3
85344>>>>> set form_margin item 1 to 25
85345>>>>> set form_margin item 2 to 25
85346>>>>> set form_margin item 3 to 10
85347>>>>> set header_label item 0 to t.VdfSort.Lbl.FieldName
85348>>>>> set header_label item 1 to t.VdfSort.Lbl.CurrentRec
85349>>>>> set header_label item 2 to t.VdfSort.Lbl.RecordToKeep
85350>>>>> set header_label item 3 to t.VdfSort.Lbl.FieldType
85351>>>>> set select_mode to no_select
85352>>>>> set column_color item 0 to clLtGray
85353>>>>> set column_color item 2 to |CI$0000FF00 // Light green
85354>>>>> set column_color item 3 to clLtGray
85355>>>>> on_key knext_item send switch
85356>>>>> on_key kprevious_item send switch_back
85357>>>>> on_key kswitch send switch
85358>>>>> on_key kswitch_back send switch_back
85359>>>>> procedure clear_column integer col#
85362>>>>> if col# eq 2 set pRecordToKeep to 0
85365>>>>> forward send clear_column col#
85367>>>>> end_procedure
85368>>>>> procedure fill_list.i integer file#
85371>>>>> set pRecordToKeep to 0
85372>>>>> forward send fill_list.i file#
85374>>>>> end_procedure
85375>>>>> procedure display_current_record integer rec#
85378>>>>> integer file#
85378>>>>> get pMainFile to file#
85379>>>>> if rec# begin
85381>>>>> clear file#
85382>>>>> set_field_value file# 0 to rec#
85385>>>>> vfind file# 0 EQ
85387>>>>> send fill_list_field_data 1
85388>>>>> end
85388>>>>>>
85388>>>>> else send clear_column 1
85390>>>>> end_procedure
85391>>>>> procedure display_keep_record integer rec#
85394>>>>> integer file#
85394>>>>> get pMainFile to file#
85395>>>>> set pRecordToKeep to rec#
85396>>>>> if rec# begin
85398>>>>> clear file#
85399>>>>> set_field_value file# 0 to rec#
85402>>>>> vfind file# 0 EQ
85404>>>>> send fill_list_field_data 2
85405>>>>> end
85405>>>>>>
85405>>>>> else send clear_column 2
85407>>>>> end_procedure
85408>>>>> end_object // oRecordValues
85409>>>>> send aps_align_by_sizing (oRecordValues(self)) (oGrp(self)) sl_align_bottom
85410>>>>> procedure display_current_record integer rec#
85413>>>>> send display_current_record to (oRecordValues(self)) rec#
85414>>>>> end_procedure
85415>>>>> procedure display_keep_record integer rec#
85418>>>>> send display_keep_record to (oRecordValues(self)) rec#
85419>>>>> end_procedure
85420>>>>> procedure clear_record_grid
85423>>>>> send clear_column to (oRecordValues(self)) 1
85424>>>>> send clear_column to (oRecordValues(self)) 2
85425>>>>> end_procedure
85426>>>>> procedure skip_set
85429>>>>> set pDeleteBadOnEOF to false
85430>>>>> send fill_list to (oLst(oGrp(self)))
85431>>>>> end_procedure
85432>>>>> on_key ksave_record send delete_records_and_fill_list to (oLst(oGrp(self)))
85433>>>>> object oBtn1 is a aps.Multi_Button
85435>>>>> on_item t.btn.ok send delete_records_and_fill_list to (oLst(oGrp(self)))
85436>>>>> end_object
85437>>>>> object oBtn2 is a aps.Multi_Button
85439>>>>> on_item t.VdfSort.Btn.Skip send skip_set
85440>>>>> end_object
85441>>>>> object oBtn3 is a aps.Multi_Button
85443>>>>> on_item t.VdfSort.Btn.Auto send auto_clean to (oLst(oGrp(self)))
85444>>>>> end_object
85445>>>>> object oBtn4 is a aps.Multi_Button
85447>>>>> on_item t.btn.cancel send close_panel
85448>>>>> end_object
85449>>>>> send aps_locate_multi_buttons
85450>>>>> function sBadFileInfo string badfile# returns string
85453>>>>> string rval#
85453>>>>> number ts#
85453>>>>> if (SEQ_FileExists(badfile#)) begin
85455>>>>> move "# bytes, generated: #" to rval#
85456>>>>> replace "#" in rval# with (string(SEQ_FileSize(badfile#)))
85458>>>>> move (SEQ_FileModTime(badfile#)) to ts#
85459>>>>> replace "#" in rval# with (TS_ConvertToString(ts#))
85461>>>>> end
85461>>>>>>
85461>>>>> else move "File not found" to rval#
85463>>>>> function_return rval#
85464>>>>> end_function
85465>>>>> procedure run.isss integer file# string caption# string rn# string bad#
85468>>>>> integer wasopen# open# type#
85468>>>>> move (DBMS_IsOpenFile(file#)) to wasopen#
85469>>>>> move (DBMS_OpenFile(file#,DF_EXCLUSIVE,0)) to open#
85470>>>>> if open# begin
85472>>>>> set pChanged_State to false
85473>>>>> set pBadFileName of (oBadFileReader(self)) to bad#
85474>>>>> send reset to (oBadFileReader(self))
85475>>>>> set pMainFile of (oBadFileReader(self)) to file#
85476>>>>> send reset_set_no to (oGrp(self))
85477>>>>> send fill_list.i to (oRecordValues(self)) file#
85478>>>>> set value of (oDataFileName(self)) to (rn#+" ("+string(DBMS_FileInfo(file#,1))+" records in file)")
85479>>>>> set value of (oBadFileName(self)) to (bad#+" ("+sBadFileInfo(self,bad#)+")")
85480>>>>> set label to ("Clean up, "+caption#)
85481>>>>> set pMainFile to file#
85482>>>>> send deferred_message msg_initialize_set_count (oLst(oGrp(self)))
85483>>>>> send deferred_message msg_fill_list (oLst(oGrp(self)))
85484>>>>> set pDeleteBadOnEOF to true
85485>>>>> send popup
85486>>>>> end
85486>>>>>>
85486>>>>> else send obs t.VdfSort.CantGainExcl
85488>>>>> if wasopen# move (DBMS_OpenFile(file#,DF_SHARE,0)) to open# // Switch back to shared mode
85491>>>>> else close file#
85493>>>>> end_procedure
85494>>>>> set pMinimumSize to 160 0
85495>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
85496>>>>> procedure aps_onResize integer delta_rw# integer delta_cl#
85499>>>>> send aps_init to (oGrp(self))
85500>>>>> send aps_resize (oLst(oGrp(self))) delta_rw# 0
85501>>>>> send aps_auto_locate_control to (oGrp(self)) (oFrm1(oGrp(self))) sl_down (oLst(oGrp(self)))
85502>>>>> send aps_auto_size_container to (oGrp(self))
85503>>>>> send aps_align_by_sizing (oRecordValues(self)) (oGrp(self)) sl_align_bottom
85504>>>>> send aps_register_max_rc (oRecordValues(self))
85505>>>>> send aps_register_multi_button (oBtn1(self))
85506>>>>> send aps_register_multi_button (oBtn2(self))
85507>>>>> send aps_register_multi_button (oBtn3(self))
85508>>>>> send aps_register_multi_button (oBtn4(self))
85509>>>>> send aps_locate_multi_buttons
85510>>>>> send aps_auto_size_container
85511>>>>> end_procedure
85512>>>>> end_object
85513>>>>>
85513>>>>> procedure DoCleanupFile integer file# string caption# string rn# string bad#
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
85515>>>>> send run.isss to (oCleanUp_Panel(self)) file# caption# rn# bad#
85516>>>>> end_procedure
85517>>>>>
85517>>>>> object oSelectBadFile is a aps.ModalPanel label t.VdfSort.SelectFileToClean
85520>>>>> set locate_mode to center_on_screen
85521>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
85522>>>>> on_key kCancel send close_panel
85523>>>>> on_key kSave_Record send CleanUp_File
85524>>>>> object oGrd is a aps.Grid
85526>>>>> set size to 200 0
85527>>>>> set highlight_row_state to true
85528>>>>> set CurrentCellColor to clHighlight
85529>>>>> set CurrentCellTextColor to clHighlightText
85530>>>>> set CurrentRowColor to clHighlight
85531>>>>> set CurrentRowTextColor to clHighlightText
85532>>>>> //set highlight_row_color to (rgb(0,255,255))
85532>>>>> //set current_item_color to (rgb(0,255,255))
85532>>>>> set line_width to 5 0
85533>>>>> set form_margin item 0 to 3
85534>>>>> set form_margin item 1 to 17
85535>>>>> set form_margin item 2 to 30
85536>>>>> set form_margin item 3 to 30
85537>>>>> set form_margin item 4 to 25
85538>>>>> set header_label item 0 to "#"
85539>>>>> set header_label item 1 to t.VdfSort.Lbl.UserName
85540>>>>> set header_label item 2 to t.VdfSort.Lbl.DataFileLoc
85541>>>>> set header_label item 3 to t.VdfSort.Lbl.BadFileLoc
85542>>>>> set header_label item 4 to t.VdfSort.Lbl.SizeAndTime
85543>>>>> set select_mode to no_select
85544>>>>> on_key kenter send CleanUp_File
85545>>>>> on_key kSave_Record send CleanUp_File
85546>>>>>
85546>>>>> object oValues is an array
85548>>>>> end_object
85549>>>>>
85549>>>>> procedure add_item_value string value#
85552>>>>> integer arr#
85552>>>>> move (oValues(self)) to arr#
85553>>>>> set value of arr# item (item_count(arr#)) to value#
85554>>>>> end_procedure
85555>>>>>
85555>>>>> procedure add_bad_file integer file# string dn# string rn_path# string badfile#
85558>>>>> string str#
85558>>>>> move (TS_ConvertToString(SEQ_FileModTime(badfile#))+", ("+InsertThousandsSep(string(SEQ_FileSize(badfile#)))+" bytes)") to str#
85559>>>>> send add_item msg_none (string(file#))
85560>>>>> send add_item msg_none dn#
85561>>>>> send add_item msg_none (lowercase(rn_path#))
85562>>>>> send add_item msg_none badfile#
85563>>>>> send add_item msg_none str#
85564>>>>> send add_item_value (string(file#))
85565>>>>> send add_item_value dn#
85566>>>>> send add_item_value (lowercase(rn_path#))
85567>>>>> send add_item_value badfile#
85568>>>>> send add_item_value str#
85569>>>>> end_procedure
85570>>>>>
85570>>>>> object oBadFiles is a set
85572>>>>> set delegation_mode to delegate_to_parent
85573>>>>> procedure dump_items integer file# string dn# string rn_path#
85576>>>>> integer max# itm#
85576>>>>> get item_count to max#
85577>>>>> for itm# from 0 to (max#-1)
85583>>>>>>
85583>>>>> send add_bad_file file# dn# rn_path# (value(self,itm#))
85584>>>>> loop
85585>>>>>>
85585>>>>> end_procedure
85586>>>>> procedure add_element_lowercase string file#
85589>>>>> move (SEQ_TranslatePathToAbsolute(file#)) to file#
85590>>>>> send add_element (lowercase(file#))
85591>>>>> end_procedure
85592>>>>> procedure fill_list_help2 integer file# string dn# string rn# string rn_path#
85595>>>>> string badfile# path#
85595>>>>> send delete_data
85596>>>>>
85596>>>>> // First test if there is a .BAD file next to the .DAT file:
85596>>>>> uppercase rn_path#
85597>>>>>>
85597>>>>> move (StripFromLastOccurance(rn_path#,".DAT")) to badfile#
85598>>>>> move (badfile#+".BAD") to badfile#
85599>>>>> if (SEQ_FileExists(badfile#)) send add_element_lowercase badfile#
85602>>>>>
85602>>>>> // Then we check to see if there are any bad files in other directories along dfpath
85602>>>>> get SEQ_DfPath to path#
85603>>>>> send SEQ_CallBack_FileInPath (rn#+".bad") path# msg_add_element_lowercase self
85604>>>>> send dump_items file# dn# rn_path#
85605>>>>> send delete_data
85606>>>>> end_procedure
85607>>>>> end_object // oBadFiles
85608>>>>> procedure fill_list1 integer file#
85611>>>>> integer wasopen# type#
85611>>>>> string str# rn# bad_name#
85611>>>>> if file# begin
85613>>>>> move (DBMS_IsOpenFile(file#)) to wasopen#
85614>>>>> if wasopen# move (DBMS_FileDriverType(file#)) to type#
85617>>>>> else move (DBMS_OpenFile(file#,DF_SHARE,0)) to type#
85619>>>>> if type# eq DBMS_DRIVER_DATAFLEX begin // OK! We're dealing with a DF file that can be opened:
85621>>>>> // Now, is there a BAD file present on the system?:
85621>>>>> get_attribute DF_FILE_ROOT_NAME of file# to rn#
85624>>>>> send fill_list_help2 to (oBadFiles(self)) file# (File_Display_Name(file#)) rn# (DBMS_Rootname_Path(file#))
85625>>>>> end
85625>>>>>>
85625>>>>> if (DBMS_IsOpenFile(file#) and not(wasopen#)) close file#
85628>>>>> end
85628>>>>>>
85628>>>>> end_procedure
85629>>>>> procedure fill_list
85632>>>>> integer itm# max# self#
85632>>>>> send cursor_wait to (cursor_control(self))
85633>>>>> send delete_data
85634>>>>> send delete_data to (oValues(self))
85635>>>>> move self to self#
85636>>>>> send DBMS_Callback_FilelistEntries (FLEC_ALL+FLEC_NO_ALIAS) msg_fill_list1 self#
85637>>>>> get item_count to max#
85638>>>>> for itm# from 0 to (max#-1)
85644>>>>>>
85644>>>>> set entry_state item itm# to false
85645>>>>> loop
85646>>>>>>
85646>>>>> send cursor_ready to (cursor_control(self))
85647>>>>> end_procedure
85648>>>>> procedure CleanUp_File
85651>>>>> integer base# tmp# file#
85651>>>>> string caption# rn# bad_file#
85651>>>>> if (item_count(self)) begin
85653>>>>> get current_item to base#
85654>>>>> move ((base#/5)*5) to base#
85655>>>>> get value of (oValues(self)) item base# to file#
85656>>>>> get value of (oValues(self)) item (base#+1) to caption#
85657>>>>> get value of (oValues(self)) item (base#+2) to rn#
85658>>>>> get value of (oValues(self)) item (base#+3) to bad_file#
85659>>>>> send DoCleanupFile file# caption# rn# bad_file#
85660>>>>> ifnot (SEQ_FileExists(bad_file#)) send fill_list
85663>>>>> end
85663>>>>>>
85663>>>>> end_procedure
85664>>>>> end_object // oGrd
85665>>>>> procedure CleanUp_File
85668>>>>> send CleanUp_File to (oGrd(self))
85669>>>>> end_procedure
85670>>>>> register_object oBtn2
85670>>>>> procedure empty_warning
85673>>>>> send obs t.VdfSort.NoFilesToClean
85674>>>>> send activate to (oBtn2(self))
85675>>>>> end_procedure
85676>>>>> procedure popup
85679>>>>> send fill_list to (oGrd(self))
85680>>>>> ifnot (item_count(oGrd(self))) send deferred_message msg_empty_warning
85683>>>>> forward send popup
85685>>>>> end_procedure
85686>>>>> object oBtn1 is a aps.Multi_Button
85688>>>>> on_item t.VdfSort.CleanFile send CleanUp_File
85689>>>>> end_object
85690>>>>> object oBtn2 is a aps.Multi_Button
85692>>>>> on_item t.btn.close send close_panel
85693>>>>> end_object
85694>>>>> send aps_locate_multi_buttons
85695>>>>> procedure aps_onResize integer delta_rw# integer delta_cl#
85698>>>>> send aps_resize (oGrd(self)) delta_rw# 0
85699>>>>> send aps_register_multi_button (oBtn1(self))
85700>>>>> send aps_register_multi_button (oBtn2(self))
85701>>>>> send aps_locate_multi_buttons
85702>>>>> send aps_auto_size_container
85703>>>>> end_procedure
85704>>>>> end_object
85705>>>>> register_object oBtn2
85705>>>>> register_object oSortBufferSize
85705>>>>>
85705>>>>> object oVdfSort_Properties is a aps.ModalPanel label t.VdfSort.Prop_Caption
85708>>>>> set help_id to hlpid.VdfSort_Properties
85709>>>>> property integer pResult public 0
85711>>>>> set locate_mode to center_on_screen
85712>>>>> on_key kcancel send close_panel
85713>>>>> procedure activate_next
85716>>>>> send activate to (oSortBufferSize(self))
85717>>>>> end_procedure
85718>>>>> procedure activate_previous
85721>>>>> send activate to (oBtn2(self))
85722>>>>> end_procedure
85723>>>>> object oRadio1 is a aps.RadioGroup label t.VdfSort.Prop_BadData
85726>>>>> on_key knext_item send activate_next
85727>>>>> on_key kprevious_item send activate_previous
85728>>>>> object oRad1 is a aps.Radio label t.VdfSort.Prop_BD_NoCheck
85731>>>>> end_object
85732>>>>> object oRad2 is a aps.Radio label t.VdfSort.Prop_BD_SpaceFill
85735>>>>> end_object
85736>>>>> object oRad3 is a aps.Radio label t.VdfSort.Prop_BD_WriteFile
85739>>>>> end_object
85740>>>>> object oRad4 is a aps.Radio label t.VdfSort.Prop_BD_Abort
85743>>>>> set object_shadow_state to true
85744>>>>> end_object
85745>>>>> end_object
85746>>>>> object oRadio2 is a aps.RadioGroup label t.VdfSort.Prop_Duplicates
85749>>>>> object oRad1 is a aps.Radio label t.VdfSort.Prop_DD_WriteFile
85752>>>>> set object_shadow_state to true
85753>>>>> end_object
85754>>>>> object oRad2 is a aps.Radio label t.VdfSort.Prop_DD_Abort
85757>>>>> set object_shadow_state to true
85758>>>>> end_object
85759>>>>> end_object
85760>>>>> send aps_size_identical_max (oRadio1(self)) (oRadio2(self)) sl_vertical
85761>>>>> send aps_goto_max_row
85762>>>>> object oSortBufferSize is a aps.Form label (t.VdfSort.Prop_SortBuffer+":") abstract aft_numeric6.0
85766>>>>> procedure switch_back
85769>>>>> send activate to (oRadio1(self))
85770>>>>> end_procedure
85771>>>>> on_key kprevious_item send switch_back
85772>>>>> end_object
85773>>>>> send aps_align_by_moving (oSortBufferSize(self)) (oRadio2(self)) sl_align_left
85774>>>>> object oBtn1 is a aps.Multi_Button
85776>>>>> on_item t.btn.ok send close_panel_ok
85777>>>>> end_object
85778>>>>> object oBtn2 is a aps.Multi_Button
85780>>>>> on_item t.btn.cancel send close_panel
85781>>>>> end_object
85782>>>>> send aps_locate_multi_buttons
85783>>>>> procedure close_panel_ok
85786>>>>> set pResult to true
85787>>>>> send close_panel
85788>>>>> end_procedure
85789>>>>> procedure popup
85792>>>>> integer itm# grb# buffer#
85792>>>>> integer iNull
85792>>>>> string sNull
85792>>>>> move 0 to iNull
85793>>>>> move "" to sNull
85794>>>>> move 0 to itm#
85795>>>>> if (oVdfSort_SortOptions# iand DF_SORT_OPTION_NO_DATA_CHECK ) move 0 to itm#
85798>>>>> if (oVdfSort_SortOptions# iand DF_SORT_OPTION_BAD_DATA_FIXUP) move 1 to itm#
85801>>>>> if (oVdfSort_SortOptions# iand DF_SORT_OPTION_BAD_DATA_FILE ) move 2 to itm#
85804>>>>> if (oVdfSort_SortOptions# iand DF_SORT_OPTION_BAD_DATA_ABORT) move 3 to itm#
85807>>>>> set current_radio of (oRadio1(self)) to itm#
85808>>>>> move 0 to itm#
85809>>>>> if (oVdfSort_SortOptions# iand DF_SORT_OPTION_DUP_DATA_FILE ) move 0 to itm#
85812>>>>> if (oVdfSort_SortOptions# iand DF_SORT_OPTION_DUP_DATA_ABORT) move 1 to itm#
85815>>>>> set current_radio of (oRadio2(self)) to itm#
85816>>>>>
85816>>>>> call_driver iNull "DATAFLEX" function FLEX_GET_MAX_SORT_BUFFER callback iNull passing sNull iNull iNull result buffer#
85821>>>>> set value of (oSortBufferSize(self)) item 0 to buffer#
85822>>>>>
85822>>>>> set pResult to false
85823>>>>> forward send popup
85825>>>>> if (pResult(self)) begin
85827>>>>> move 0 to oVdfSort_SortOptions#
85828>>>>> get current_radio of (oRadio1(self)) to itm#
85829>>>>> if itm# eq 0 move DF_SORT_OPTION_NO_DATA_CHECK to oVdfSort_SortOptions#
85832>>>>> if itm# eq 1 move DF_SORT_OPTION_BAD_DATA_FIXUP to oVdfSort_SortOptions#
85835>>>>> if itm# eq 2 move DF_SORT_OPTION_BAD_DATA_FILE to oVdfSort_SortOptions#
85838>>>>> if itm# eq 3 move DF_SORT_OPTION_BAD_DATA_ABORT to oVdfSort_SortOptions#
85841>>>>> get current_radio of (oRadio2(self)) to itm#
85842>>>>> if itm# eq 0 move (DF_SORT_OPTION_DUP_DATA_FILE +oVdfSort_SortOptions#) to oVdfSort_SortOptions#
85845>>>>> if itm# eq 1 move (DF_SORT_OPTION_DUP_DATA_ABORT+oVdfSort_SortOptions#) to oVdfSort_SortOptions#
85848>>>>>
85848>>>>> get value of (oSortBufferSize(self)) item 0 to buffer#
85849>>>>> call_driver iNull "DATAFLEX" function FLEX_SET_MAX_SORT_BUFFER callback iNull passing sNull iNull buffer# result grb#
85854>>>>> end
85854>>>>>>
85854>>>>> end_procedure
85855>>>>> end_object //oVdfSort_Properties
85856>>>>>
85856>>>>> procedure popup_sort_properties
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
85858>>>>> send popup to (oVdfSort_Properties(self))
85859>>>>> end_procedure
85860>>>>>
85860>>>>> object oVdfSort is a aps.View label t.VdfSort.Caption
85863>>>>> on_key kCancel send close_panel
85864>>>>> set help_id to hlpid.VdfSort_Select
85865>>>>> procedure Print_Report
85868>>>>> // Cancel ToolBar message
85868>>>>> end_procedure
85869>>>>> object oCont is a aps.Container3D
85871>>>>> set p_auto_column to false
85872>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
85873>>>>> object oList is a cFdxFileMultiSelector // cFileListMultiSelectorGrid
85875>>>>> set size to 180 0
85876>>>>> set piNo_Alias_State to true // Exclude alias files
85877>>>>> set piBad_Entries_State to BAD_ENTRIES_SHADOW // Shade un-available entries
85878>>>>> send DriverFilter_Add DBMS_DRIVER_DATAFLEX
85879>>>>> set peResizeColumn to rcAll
85880>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
85881>>>>> object oExclusiveError is an Array
85883>>>>> end_object
85884>>>>> function sExclusiveErrorText returns string
85887>>>>> integer obj# itm# max#
85887>>>>> string rval#
85887>>>>> move (oExclusiveError(self)) to obj#
85888>>>>> get item_count of obj# to max#
85889>>>>> move (max# min 5) to max#
85890>>>>> for itm# from 0 to (max#-1)
85896>>>>>>
85896>>>>> move (rval#+DBMS_Rootname_Path(value(obj#,itm#))) to rval#
85897>>>>> if itm# ne (max#-1) move (rval#+character(10)) to rval#
85900>>>>> loop
85901>>>>>>
85901>>>>> if (item_count(obj#)) gt max# move (rval#+character(10)+"...") to rval#
85904>>>>> function_return rval#
85905>>>>> end_function
85906>>>>>
85906>>>>> procedure add_file.i integer file#
85909>>>>> if file# ne 50 forward send add_file.i file# // Skip FLEXERRS
85913>>>>> end_procedure
85914>>>>>
85914>>>>> procedure SortFile integer file#
85917>>>>> sort File# '' oVdfSort_SortOptions# oVdfSort_Callback_vw#
85919>>>>> end_procedure
85920>>>>>
85920>>>>> procedure OpenFileExclusive integer file#
85923>>>>> ifnot (iOpen_file.ii(VdfSort_oFileAllFiles(self),file#,DF_EXCLUSIVE)) ; set value of (oExclusiveError(self)) ; item (item_count(oExclusiveError(self))) to file#
85926>>>>> end_procedure
85927>>>>>
85927>>>>> procedure VdfSort_RestoreOpenFiles
85930>>>>> //send obs "VdfSort_RestoreOpenFiles was called"
85930>>>>> end_procedure
85931>>>>>
85931>>>>> procedure CustomizedRestore
85934>>>>> broadcast recursive send VdfSort_RestoreOpenFiles to desktop
85936>>>>> end_procedure
85937>>>>>
85937>>>>> procedure WS_OnCloseWorkSpace string lsOldWS
85940>>>>> send delete_data
85941>>>>> end_procedure
85942>>>>>
85942>>>>> procedure DoReindex_Help
85945>>>>> send Callback_Selected_Files msg_SortFile
85946>>>>> send Ending_Sort to oVdfSort_Callback_vw#
85947>>>>> send RestoreFiles to (VdfSort_oFileAllFiles(self))
85948>>>>> send CustomizedRestore
85949>>>>> send Cursor_Ready to (cursor_control(self))
85950>>>>> end_procedure
85951>>>>>
85951>>>>> procedure DoReindex
85954>>>>> integer Self# Client_ID#
85954>>>>> string str#
85954>>>>> move self to Self#
85955>>>>> ifnot oVdfSort_Callback_vw# begin
85957>>>>> // If oVdfSort_Callback_vw has not yet been created we do it here:
85957>>>>> move (Client_ID(Self#)) to Client_ID#
85958>>>>> if Client_ID# CREATE_OBJECT_GROUP OG_VdfSort_Callback_vw PARENT Client_ID#
85969>>>>> else error 666 "ClientArea not found!"
85971>>>>> end
85971>>>>>>
85971>>>>> if oVdfSort_Callback_vw# begin
85973>>>>> send Cursor_Wait to (cursor_control(self))
85974>>>>> send RegisterCurrentOpenFiles to (VdfSort_oFileAllFiles(self))
85975>>>>> send CloseAllFiles to (VdfSort_oFileAllFiles(self))
85976>>>>> send Delete_Data to (oExclusiveError(self))
85977>>>>> send Callback_Selected_Files msg_OpenFileExclusive
85978>>>>> ifnot (item_count(oExclusiveError(self))) begin
85980>>>>> send Popup to oVdfSort_Callback_vw#
85981>>>>> // The below message makes sure that procedure DoReindex_Help
85981>>>>> // is not executed until the previous message has finished
85981>>>>> // 100%. It's a way of bypassing screen paint optimization.
85981>>>>> send deferred_message msg_DoReindex_Help
85982>>>>> end
85982>>>>>>
85982>>>>> else begin // Exclusive access could not be obtained
85983>>>>> send CloseAllFiles to (VdfSort_oFileAllFiles(self))
85984>>>>> send RestoreFiles to (VdfSort_oFileAllFiles(self))
85985>>>>> send CustomizedRestore
85986>>>>> send Cursor_Ready to (cursor_control(self))
85987>>>>> move (t.VdfSort.Err.Exclusive1+character(10)) to str#
85988>>>>> move (str#+t.VdfSort.Err.Exclusive2+character(10)) to str#
85989>>>>> move (str#+t.VdfSort.Err.Exclusive3+character(10)) to str#
85990>>>>> move (str#+t.VdfSort.Err.Exclusive4) to str#
85991>>>>> move (str#+character(10)+character(10)+sExclusiveErrorText(self)) to str#
85992>>>>> send Info_Box str# t.VdfSort.Wait.Error
85993>>>>> end
85993>>>>>>
85993>>>>> end
85993>>>>>>
85993>>>>> end_procedure
85994>>>>> send fill_list_all_files
85995>>>>> procedure Conditional_FillList
85998>>>>> ifnot (item_count(self)) send fill_list_all_files
86001>>>>> end_procedure
86002>>>>> procedure SelectBadFile
86005>>>>> send popup to (oSelectBadFile(self))
86006>>>>> end_procedure
86007>>>>> procedure update_select_display // This is called automatically by the class
86010>>>>> integer selected# total#
86010>>>>> get File_Select_Count to selected#
86011>>>>> get Row_Count to total#
86012>>>>> send select_display selected# total#
86013>>>>> end_procedure
86014>>>>> register_procedure cleanup_file integer file# string dn# string fn# string bad#
86014>>>>> end_object // oList
86015>>>>> object oBtn1 is a aps.multi_button
86017>>>>> set peAnchors to (anTop+anRight)
86018>>>>> on_item t.FDX.Btn.SelectOpen send select_open to (oList(self))
86019>>>>> end_object
86020>>>>> object oBtn2 is a aps.multi_button
86022>>>>> set peAnchors to (anTop+anRight)
86023>>>>> on_item t.FDX.Btn.SelectAll send select_all_not_bad to (oList(self))
86024>>>>> end_object
86025>>>>> object oBtn3 is a aps.multi_button
86027>>>>> set peAnchors to (anTop+anRight)
86028>>>>> on_item t.FDX.Btn.SelectNone send select_none to (oList(self))
86029>>>>> end_object
86030>>>>> object oBtn4 is a aps.multi_button
86032>>>>> set peAnchors to (anTop+anRight)
86033>>>>> on_item t.FDX.Btn.SelectInvert send select_invert to (oList(self))
86034>>>>> end_object
86035>>>>> object oBtn6 is a aps.multi_button
86037>>>>> set peAnchors to (anTop+anRight)
86038>>>>> on_item t.VdfSort.FileLocations send OpenStat.DisplayFileLocations
86039>>>>> end_object
86040>>>>> send aps_register_multi_button (oBtn6(self))
86041>>>>> object oBtn7 is a aps.multi_button
86043>>>>> set peAnchors to (anTop+anRight)
86044>>>>> on_item "DFMatrix" send OpenStat.Chain_DFMatrix
86045>>>>> end_object
86046>>>>> send aps_locate_multi_buttons SL_VERTICAL
86047>>>>> object oSelectTxt is a aps.TextBox snap sl_right relative_to (oList(self))
86055>>>>> set fixed_size to 10 50
86056>>>>> set peAnchors to (anBottom+anRight)
86057>>>>> end_object
86058>>>>> send aps_align_by_moving (oSelectTxt(self)) (oList(self)) SL_ALIGN_BOTTOM
86059>>>>> procedure select_display integer selected# integer total#
86062>>>>> set value of (oSelectTxt(self)) to (t.FDX.Selected+" "+string(selected#))
86063>>>>> end_procedure
86064>>>>> end_object
86065>>>>> on_key ksave_record send DoReindex to (oList(oCont(self)))
86066>>>>> object oBtn1 is a aps.multi_button
86068>>>>> set peAnchors to (anBottom+anRight)
86069>>>>> on_item t.VdfSort.Btn.Reindex send DoReindex to (oList(oCont(self)))
86070>>>>> end_object
86071>>>>> object oBtn2 is a aps.multi_button
86073>>>>> set peAnchors to (anBottom+anRight)
86074>>>>> on_item t.btn.properties send popup_sort_properties
86075>>>>> end_object
86076>>>>> object oBtn3 is a aps.multi_button
86078>>>>> set peAnchors to (anBottom+anRight)
86079>>>>> on_item t.btn.close send close_panel
86080>>>>> end_object
86081>>>>> send aps_locate_multi_buttons
86082>>>>>
86082>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
86083>>>>> set Window_Style to WS_MAXIMIZEBOX 1
86084>>>>> move self to oVdfSort#
86085>>>>> procedure Close_Query_View
86088>>>>> send close_panel
86089>>>>> end_procedure
86090>>>>> procedure popup
86093>>>>> send Conditional_FillList to (oList(oCont(self)))
86094>>>>> forward send popup
86096>>>>> end_procedure
86097>>>>>
86097>>>>> procedure DoDefaultSortBuffer
86100>>>>> integer liGrb iNull
86100>>>>> string sNull
86100>>>>> call_driver iNull "DATAFLEX" function FLEX_SET_MAX_SORT_BUFFER callback iNull passing sNull iNull 65536 result liGrb
86105>>>>> end_procedure
86106>>>>> send DoDefaultSortBuffer
86107>>>>>
86107>>>>> end_object
86108>>>>> set piMinSize of oVdfSort# to (hi(size(oVdfSort#))) (low(size(oVdfSort#)))
86109>>>>>END_DEFINE_OBJECT_GROUP // OG_VdfSort
86110>>>>>
86110>>>>>procedure Activate_Sort_Vw
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
86112>>>>> integer Self# Client_ID# DbBldr#
86112>>>>> ifnot oVdfSort# begin
86114>>>>> // If oVdfSort view has not yet been created we do it here:
86114>>>>> move self to Self#
86115>>>>> move (Client_ID(Self#)) to Client_ID#
86116>>>>> if Client_ID# CREATE_OBJECT_GROUP OG_VdfSort PARENT Client_ID# //DbBldr#
86127>>>>> else error 666 "ClientArea not found!"
86129>>>>> end
86129>>>>>>
86129>>>>> if oVdfSort# send popup to oVdfSort#
86132>>>>>end_procedure
86133>>>>>
86133>>>>>
86133>>>>>// Use DBMS.utl // Basic DBMS functions
86133>>>>>// Use Files.utl // Utilities for handling file related stuff
86133>>>>>//
86133>>>>>// procedure reindex_one
86133>>>>>// integer open#
86133>>>>>// string file_name#
86133>>>>>//
86133>>>>>// get SEQ_SelectFile "Locate data file to reindex" ;
86133>>>>>// "Datafiles (*.dat)|*.DAT" to file_name#
86133>>>>>// if file_name# ne "" begin
86133>>>>>// get DBMS_OpenFileAs file_name# 249 DF_EXCLUSIVE 0 to open#
86133>>>>>// if open# begin
86133>>>>>// sort 249 // Vi foruds‘tter at 249 er ledig
86133>>>>>// close 249
86133>>>>>// end
86133>>>>>// end
86133>>>>>// end_procedure
86133>>>on_key key_ctrl+key_d send Request_Popup_Calendar
86134>>>
86134>>>Use cApplication.pkg
86134>>>Object oApplication is a cApplication
86136>>> Set psAutoOpenWorkspace to "" // Do not attempt to open "config.ws"
86137>>> set pbEnterKeyAsTabKey to DFTRUE
86138>>>End_Object // oApplication
86139>>>integer ghoWorkSpace
86139>>>get phoWorkspace of ghoApplication to ghoWorkSpace
86140>>>
86140>>>
86140>>>use OpenStat.pkg
86140>>>Use Login.utl
Including file: login.utl (C:\Apps\VDFQuery\AppSrc\login.utl)
86140>>>>>// Use Login.utl // DBMS_GetDriverLogin function
86140>>>>>Use Driver.nui // This package is used to load a driver DLL
Including file: driver.nui (C:\Apps\VDFQuery\AppSrc\driver.nui)
86140>>>>>>>// Use Driver.nui // This package is used to load a driver DLL
86140>>>>>>>
86140>>>>>>>Use Files.nui // Utilities for handling file related stuff (No User Interface)
86140>>>>>>>Use DBMS.nui // Basic DBMS functions (No User Interface)
86140>>>>>>>Use API_Attr.nui // Functions for querying API attributes (No User Interface)
86140>>>>>>>
86140>>>>>>>function DRV_LoadDriverByName global string lsDriverName returns integer
86142>>>>>>> string lsDriverFile lsDir
86142>>>>>>> move (lsDriverName+".DLL") to lsDriverFile
86143>>>>>>> if (SEQ_FileExists(lsDriverFile)<>SEQIT_FILE) begin
86145>>>>>>> // What? Driver not found? We'll have to look for it then:
86145>>>>>>> move (SEQ_FindFileAlongDFPath(lsDriverFile)) to lsDir
86146>>>>>>> // What? Not found again? We'll look along the EXE search path then:
86146>>>>>>> if lsDir eq "" move (SEQ_FindFileAlongPath(API_OtherAttr_Value(OA_PATH),lsDriverFile)) to lsDir
86149>>>>>>> if lsDir eq "" function_return 0 // If we didn't find it it doesn't exist! Goodbye!
86152>>>>>>> move (SEQ_ComposeAbsoluteFileName(lsDir,lsDriverName)) to lsDriverName
86153>>>>>>> end
86153>>>>>>>>
86153>>>>>>> load_driver lsDriverName
86154>>>>>>> function_return 1
86155>>>>>>>end_function // DRV_LoadDriverByName
86156>>>>>>>
86156>>>>>>>function DRV_LoadDriverByType global integer liType returns integer
86158>>>>>>> string lsDriverName
86158>>>>>>> get DBMS_TypeToDriverName liType to lsDriverName
86159>>>>>>> function_return (DRV_LoadDriverByName(lsDriverName))
86160>>>>>>>end_function // DRV_LoadDriverByType
86161>>>>>// Marcelo Nachbar da Silva [nachbar@mertechdata.com]
86161>>>>>
86161>>>>>Use Language // Set default languange if not set by compiler command line
86161>>>>>Use Seq_Chnl // Defines global sequential device management operations (DAW)
86161>>>>>use buttons.utl
86161>>>>>use dbms.utl
86161>>>>>use files.utl
86161>>>>>
86161>>>>>
86161>>>>>use aps
86161>>>>>class cDriverComboForm is a aps.ComboFormAux
86162>>>>> procedure construct_object integer img#
86164>>>>> forward send construct_object img#
86166>>>>> set p_abstract to aft_ascii20
86167>>>>> set entry_state item 0 to false
86168>>>>> on_key kenter send next
86169>>>>> end_procedure
86170>>>>> procedure fill_list
86172>>>>> integer id#
86172>>>>> send Combo_Delete_Data
86173>>>>> for id# from (DBMS_DRIVER_DATAFLEX+1) to (DBMS_DRIVER_MAX-1)
86179>>>>>>
86179>>>>> if (DBMS_TypeToDriverName(id#)) ne "Unknown" begin
86181>>>>> send combo_add_item (DBMS_Driver_UserName(id#)) id#
86182>>>>> end
86182>>>>>>
86182>>>>> loop
86183>>>>>>
86183>>>>> end_procedure
86184>>>>> procedure end_construct_object
86186>>>>> send fill_list
86187>>>>> forward send end_construct_object
86189>>>>> end_procedure
86190>>>>>end_class // cDriverComboForm
86191>>>>>
86191>>>>>object oDriverLogin is a aps.TopMostModalPanel label "Login"
86194>>>>> set p_left_margin to 5
86195>>>>> set p_right_margin to 20
86196>>>>> set p_top_margin to 10
86197>>>>> set p_bottom_margin to 10
86198>>>>> set locate_mode to CENTER_ON_SCREEN
86199>>>>> on_key ksave_record send close_panel_ok
86200>>>>> on_key kcancel send close_panel
86201>>>>> on_key kuser send DoLoadDriver
86202>>>>> property integer piResult public 0
86204>>>>> property string psDriverFileName public ""
86206>>>>> send aps_init
86207>>>>> set p_auto_column to 1
86208>>>>> send tab_column_define 1 50 45 jmode_right // Default column setting
86209>>>>> object oFrm0 is a cDriverComboForm label "Driver:"
86212>>>>> end_object
86213>>>>> object oFrm1 is a aps.Form label "Server:" abstract aft_ascii20
86217>>>>> on_key kenter send next
86218>>>>> end_object
86219>>>>> object oFrm2 is a aps.Form label "User:" abstract aft_ascii20
86223>>>>> on_key kenter send next
86224>>>>> end_object
86225>>>>> object oFrm3 is a aps.Form label "Password:" abstract aft_ascii20
86229>>>>> set password_state item 0 to true
86230>>>>> on_key kenter send next
86231>>>>> end_object
86232>>>>> object oSavePW is a aps.checkbox label "Save password"
86235>>>>> on_key kenter send next
86236>>>>> end_object
86237>>>>> object oBtn1 is a aps.Multi_Button
86239>>>>> on_item t.btn.ok send close_panel_ok
86240>>>>> end_object
86241>>>>> object oBtn2 is a aps.Multi_Button
86243>>>>> on_item t.btn.cancel send close_panel
86244>>>>> end_object
86245>>>>> procedure DoLoadDriver
86248>>>>> integer liDriverType
86248>>>>> move (Combo_Current_Aux_Value(oFrm0(self))) to liDriverType
86249>>>>> if (DRV_LoadDriverByType(liDriverType)) send obs "Driver loaded"
86252>>>>> else send obs "Driver could not be found." "(and therefore it could not be loaded)"
86254>>>>> end_procedure
86255>>>>> send aps_locate_multi_buttons
86256>>>>> procedure close_panel_ok
86259>>>>> integer ch#
86259>>>>> string fn#
86259>>>>> get psDriverFileName to fn#
86260>>>>> get SEQ_DirectOutput fn# to ch#
86261>>>>> if (ch#>=0) begin
86263>>>>> writeln (value(oFrm1(self),0))
86265>>>>> writeln (value(oFrm2(self),0))
86267>>>>> if (select_state(oSavePW(self),0)) writeln (value(oFrm3(self),0))
86271>>>>> else writeln ""
86274>>>>> close_output channel ch#
86276>>>>> send Seq_Release_Channel ch#
86277>>>>> set piResult to 1
86278>>>>> send close_panel
86279>>>>> end
86279>>>>>>
86279>>>>> end_procedure
86280>>>>> procedure reset
86283>>>>> integer ch#
86283>>>>> string fn# str#
86283>>>>> set value of (oFrm1(self)) item 0 to ""
86284>>>>> set value of (oFrm2(self)) item 0 to ""
86285>>>>> set value of (oFrm3(self)) item 0 to ""
86286>>>>> set select_state of (oSavePW(self)) item 0 to 0
86287>>>>> get psDriverFileName to fn#
86288>>>>> get SEQ_DirectInput fn# to ch#
86289>>>>> if (ch#>=0) begin
86291>>>>> readln str#
86292>>>>> set value of (oFrm1(self)) item 0 to str#
86293>>>>> readln str#
86294>>>>> set value of (oFrm2(self)) item 0 to str#
86295>>>>> readln str#
86296>>>>> set value of (oFrm3(self)) item 0 to str#
86297>>>>> if str# ne "" set select_state of (oSavePW(self)) item 0 to 1
86300>>>>> close_input channel ch#
86302>>>>> send Seq_Release_Channel ch#
86303>>>>> //nd close_panel
86303>>>>> end
86303>>>>>>
86303>>>>> end_procedure
86304>>>>> function iLogin.i integer driver# returns integer
86307>>>>> string username# filename#
86307>>>>> set piResult to 0
86308>>>>> if driver# begin
86310>>>>> get DBMS_TypeToDriverName driver# to filename#
86311>>>>> get DBMS_Driver_UserName driver# to username#
86312>>>>> end
86312>>>>>>
86312>>>>> else move "drvlogin" to filename#
86314>>>>> set psDriverFileName to (lowercase(filename#+".ini"))
86315>>>>> if driver# begin
86317>>>>> set object_shadow_state of (oFrm0(self)) to true
86318>>>>> set value of (oFrm0(self)) to (DBMS_Driver_UserName(driver#))
86319>>>>> end
86319>>>>>>
86319>>>>> else set object_shadow_state of (oFrm0(self)) to false
86321>>>>> set label to ("Login: "+username#)
86322>>>>> send reset
86323>>>>> send popup
86324>>>>> function_return (piResult(self))
86325>>>>> end_function
86326>>>>>end_object
86327>>>>>
86327>>>>>function DBMS_GetDriverLogin global integer driver# returns integer
86329>>>>> integer rval#
86329>>>>> get iLogin.i of (oDriverLogin(self)) driver# to rval#
86330>>>>> function_return rval#
86331>>>>>end_function
86332>>>>>
86332>>>>>function DBMS_GetDriverLoginDriverID global returns integer
86334>>>>> function_return (Combo_Current_Aux_Value(oFrm0(oDriverLogin(self))))
86335>>>>>end_function
86336>>>>>function DBMS_GetDriverLoginServer global returns string
86338>>>>> function_return (value(oFrm1(oDriverLogin(self)),0))
86339>>>>>end_function
86340>>>>>function DBMS_GetDriverLoginUserID global returns string
86342>>>>> function_return (value(oFrm2(oDriverLogin(self)),0))
86343>>>>>end_function
86344>>>>>function DBMS_GetDriverLoginPassWord global returns string
86346>>>>> function_return (value(oFrm3(oDriverLogin(self)),0))
86347>>>>>end_function
86348>>>>>
86348>>>>>//get DBMS_GetDriverLogin DBMS_DRIVER_ORACLE to windowindex
86348>>>>>//get DBMS_GetDriverLogin 0 to windowindex
86348>>>>>//if windowindex begin
86348>>>>>// showln (DBMS_GetDriverLoginServer())
86348>>>>>// showln (DBMS_GetDriverLoginUserID())
86348>>>>>// showln (DBMS_GetDriverLoginPassWord())
86348>>>>>// inkey windowindex
86348>>>>>//end
86348>>>
86348>>>Use SelectWorkspace.dg
Including file: SelectWorkspace.dg (c:\VDF12\Pkg\SelectWorkspace.dg)
86348>>>>>// Register all objects
86348>>>>>Register_Object oBrowse
86348>>>>>Register_Object oCancel
86348>>>>>Register_Object oCurrentWorkspace
86348>>>>>Register_Object oCurrentWorkspace_lb
86348>>>>>Register_Object oDescription
86348>>>>>Register_Object oHelp
86348>>>>>Register_Object oImages
86348>>>>>Register_Object oIni
86348>>>>>Register_Object oLineControl2
86348>>>>>Register_Object oName
86348>>>>>Register_Object oOpenDialog
86348>>>>>Register_Object oOrderBy
86348>>>>>Register_Object oSections
86348>>>>>Register_Object oSelect
86348>>>>>Register_Object oSelectedWorkspace
86348>>>>>Register_Object oSelectNewWorkspace_lb
86348>>>>>Register_Object oSelectWorkspace
86348>>>>>Register_Object oWorkspaces
86348>>>>>Register_Object oWorkspacesList
86348>>>>>
86348>>>>>
86348>>>>>
86348>>>>>// Returns 0 if user press cancel
86348>>>>>// Returns 1 if a new WS was created
86348>>>>>//
86348>>>>>External_Function32 StartDFWSWizard "StartDFWSWizard" DFWSWIZ.DLL Handle MyHnd Returns Integer
86349>>>>>
86349>>>>>// Change types Supported.
86349>>>>>Enum_list
86349>>>>> Define WSNotChanged // no change that we know of
86349>>>>> Define WSNewWorkSpace // selected New WS, No known editing
86349>>>>> Define WSModified // We may have edited, should be reinitialized
86349>>>>>End_Enum_list
86349>>>>>
86349>>>>>Procedure SetCurrentUserWorkspace GLOBAL String sWorkspace
86351>>>>> Handle hoRegistry
86351>>>>> Integer iError
86351>>>>>
86351>>>>> Get Create U_cRegistry To hoRegistry
86352>>>>>
86352>>>>> Get CreateKey of hoRegistry "SOFTWARE\Data Access Worldwide\Visual DataFlex\12.0\Workspaces" To iError
86353>>>>> If (iError =0) Begin
86355>>>>> Send WriteString of hoRegistry "Current Workspace" sWorkspace
86356>>>>> Send CloseKey of hoRegistry
86357>>>>> End
86357>>>>>>
86357>>>>>
86357>>>>> Send Destroy of hoRegistry
86358>>>>>End_Procedure
86359>>>>>
86359>>>>>Function GetCurrentUserWorkspace GLOBAL Returns String
86361>>>>> Handle hoRegistry
86361>>>>> String sWorkspace
86361>>>>> Boolean bOpened
86361>>>>>
86361>>>>> Get Create U_cRegistry To hoRegistry
86362>>>>>
86362>>>>> Get OpenKey of hoRegistry "SOFTWARE\Data Access Worldwide\Visual DataFlex\12.0\Workspaces" To bOpened
86363>>>>> If bOpened Begin
86365>>>>> If (ValueExists(hoRegistry, "Current Workspace")) Get ReadString of hoRegistry "Current Workspace" To sWorkspace
86368>>>>> Send CloseKey of hoRegistry
86369>>>>> End
86369>>>>>>
86369>>>>>
86369>>>>> Send Destroy of hoRegistry
86370>>>>> Function_Return sWorkspace
86371>>>>>End_Function
86372>>>>>
86372>>>>>
86372>>>>>Use Windows.pkg
86372>>>>>Use DfTreeVw.pkg
86372>>>>>Use dfRadio.pkg
Including file: Dfradio.pkg (c:\VDF12\Pkg\Dfradio.pkg)
86372>>>>>>>Use windows.pkg // this now lives here. (you don't need to ever use this).
86372>>>>>>>
86372>>>>>Use DfLine.Pkg
86372>>>>>Use File_dlg.Pkg
86372>>>>>
86372>>>>>
86372>>>>>
86372>>>>>Object oSelectWorkspace is a ModalPanel
86374>>>>>
86374>>>>> On_Key kCancel Send Close_Panel
86375>>>>> Property Integer pbSortByName True
86377>>>>>
86377>>>>> Property String psWorkspaceSelected // what is the Name of the newly-selected Workspace
86379>>>>> Property String psOriginalWorkspace // what was the Name of Workspace when the dialog was displayed?
86381>>>>> Property Boolean pbChangeSystemCurrent
86383>>>>> Property Boolean pbResult
86385>>>>> Property String psCurrentWorkspaceDescription // description of Current Workspace at start of dialog
86387>>>>>
86387>>>>> Set Locate_Mode To CENTER_ON_SCREEN
86388>>>>>
86388>>>>> Object oWorkspacesList is an Array
86390>>>>> Procedure DoAddWorkspace String sName String sDescription String sPath
86393>>>>> Set Value (Item_Count(self)) To sName
86394>>>>> Set Value (Item_Count(self)) To sDescription
86395>>>>> Set Value (Item_Count(self)) To sPath
86396>>>>> End_Procedure
86397>>>>> End_Object
86398>>>>>
86398>>>>> Function GetVdfRootDir Returns String
86401>>>>> String sVdfRootDir
86401>>>>>
86401>>>>> Get_Profile_String "Defaults" "VDFRootDir" To sVDFRootDir
86404>>>>> If (Right(sVDFRootDir,1) = "\") Begin
86406>>>>> Left sVDFRootDir To sVDFRootDir (Length(sVDFRootDir)-1)
86408>>>>>>
86408>>>>> End
86408>>>>>>
86408>>>>>
86408>>>>> Function_Return sVdfRootDir
86409>>>>> End_Function
86410>>>>>
86410>>>>>
86410>>>>> Set Border_Style to Border_Thick
86411>>>>> Set Minimize_Icon to FALSE
86412>>>>> Set Label to "C_$SelectWorkspace"
86413>>>>> Set Location to 2 3
86414>>>>> Set Size to 244 275
86415>>>>> Set piMinSize to 244 275
86416>>>>>
86416>>>>>
86416>>>>>
86416>>>>>
86416>>>>> Object oImages is a cImageList
86418>>>>>
86418>>>>> //Set Focus_Mode To NonFocusable
86418>>>>>
86418>>>>>
86418>>>>> Procedure OnCreate
86421>>>>> Integer iVoid
86421>>>>> Get AddTransparentImage "WorkspaceSelector.bmp" clFuchsia To iVoid
86422>>>>> End_Procedure
86423>>>>>
86423>>>>> End_Object // oImages
86424>>>>>
86424>>>>> Object oWorkspaces is a TreeView
86426>>>>>
86426>>>>> Set TreeSortedState To True
86427>>>>>
86427>>>>>
86427>>>>> Procedure DoShowWorkspaces
86430>>>>> Integer iVOid iWorkspace
86430>>>>> Handle hoSections
86430>>>>> String sWorkspace sDescription sPath
86430>>>>>
86430>>>>> Move oSections To hoSections
86431>>>>>
86431>>>>> Send DoDeleteItem 0 // remove all items
86432>>>>>
86432>>>>> Send Delete_Data of hoSections
86433>>>>> Send Delete_Data of oWorkspacesList // remove list of Names&Descriptions
86434>>>>>
86434>>>>> Object oIni is a cIniFile
86436>>>>> // JVH - [VDF 8.3] cIniFile does not currently support delegation so
86436>>>>> // the call to GetVdfRootDir must explicitly delegate to oSelectWorkspaces
86436>>>>> // Set psFilename To (GetVdfRootDir(Self) +"\bin\Workspaces.ini")
86436>>>>> Set psFilename To (GetVdfRootDir(oSelectWorkspace) + "\bin\Workspaces.ini")
86437>>>>>
86437>>>>> Send ReadSections hoSections
86438>>>>>
86438>>>>> For iWorkspace from 0 to (Item_Count(hoSections) -1)
86444>>>>>>
86444>>>>> Get Value of hoSections iWorkspace To sWorkspace
86445>>>>> Get ReadString sWorkspace "Description" "" To sDescription
86446>>>>> Get ReadString sWorkspace "Path" "" To sPath
86447>>>>>
86447>>>>> // JVH - [VDF 8.3] cIniFile does not currently support delegation so
86447>>>>> // the we must explicitly delegate to oSelectWorkspaces
86447>>>>> If (Uppercase(sWorkspace) = Uppercase(psOriginalWorkspace(oSelectWorkspace))) Set psCurrentWorkspaceDescription of oSelectWorkspace To sDescription
86450>>>>>
86450>>>>> Send DoAddWorkspace of oWorkspacesList sWorkspace sDescription sPath // store the Name, Description & Path
86451>>>>>
86451>>>>> If (pbSortByName(parent(self))) Delegate Get AddHierarchy 0 sWorkspace To iVoid
86455>>>>> Else Delegate Get AddHierarchy 0 sDescription To iVoid
86458>>>>> Loop
86459>>>>>>
86459>>>>> End_Object
86460>>>>>
86460>>>>> Send Destroy of oIni
86461>>>>>
86461>>>>> Send DoShowCurrentWorkspace of oCurrentWorkspace
86462>>>>> End_Procedure // DoShowWorkspaces
86463>>>>>
86463>>>>>
86463>>>>> Set ImageListObject To (oImages(self))
86464>>>>>
86464>>>>> Function IsWorkspace Handle hItem Returns Integer
86467>>>>> Function_Return (ItemChildCount(self, hItem) =0)
86468>>>>> End_Function
86469>>>>>
86469>>>>> Procedure OnCreateTree
86472>>>>> Send DoShowWorkspaces
86473>>>>> End_Procedure
86474>>>>>
86474>>>>>
86474>>>>> Set peAnchors to anAll
86475>>>>> Set Size to 151 197
86476>>>>> Set Location to 56 5
86477>>>>> Set pbFullRowSelect to TRUE
86478>>>>> Set TreeRetainSelState to TRUE
86479>>>>>
86479>>>>>
86479>>>>> Procedure OnWorkspaceSelected Handle hItem
86482>>>>> Integer iItem
86482>>>>>
86482>>>>> Get ItemData hItem To iItem
86483>>>>> Set psWorkspaceSelected To (Value(oWorkspacesList(self), iItem*3))
86484>>>>> Send Stop_Modal_Ui //Close_Panel
86485>>>>> End_Procedure // OnWorkspaceSelected
86486>>>>>
86486>>>>>
86486>>>>> Procedure OnItemDblClick Handle hItem
86489>>>>> Set pbResult To True
86490>>>>> Send DoWorkspaceSelected
86491>>>>> End_Procedure
86492>>>>>
86492>>>>>
86492>>>>> Procedure DoWorkspaceSelected
86495>>>>> Handle hItem
86495>>>>> Get CurrentTreeItem To hItem
86496>>>>> If (IsWorkspace(self, hItem)) Send OnWorkspaceSelected hItem
86499>>>>> End_Procedure // DoWorkspaceSelected
86500>>>>>
86500>>>>>
86500>>>>> Procedure OnItemChanged Handle hItemNew Handle hItemOld
86503>>>>> Boolean bWorkspace
86503>>>>> Integer iItem
86503>>>>> String sName sDescription
86503>>>>>
86503>>>>> Get IsWorkspace hItemNew To bWorkspace
86504>>>>>
86504>>>>> Set Enabled_State of oSelect To bWorkspace
86505>>>>>
86505>>>>> If bWorkspace Begin
86507>>>>> Get ItemData hItemNew To iItem
86508>>>>> Get Value of oWorkspacesList (iItem *3) To sName
86509>>>>> Get Value of oWorkspacesList (iItem *3 +1) To sDescription
86510>>>>>
86510>>>>> Set value of oSelectedWorkspace To (sDescription * "- [" +sName +"]")
86511>>>>> End
86511>>>>>>
86511>>>>> Else Set value of oSelectedWorkspace To ("<" + C_$NoneSelected + ">")
86513>>>>> End_Procedure
86514>>>>>
86514>>>>> Function AddHierarchy Handle hiParent String sHierarchy Returns Handle
86517>>>>> // Returns item-handle that was added. 0=not added (already exists)
86517>>>>> Integer iPos bMoreLevels bFound icItem
86517>>>>> Handle hiLevel hiSearch hoWorkspaces
86517>>>>> String sLevel sSearchLabel
86517>>>>>
86517>>>>> Move oWorkspacesList To hoWorkspaces
86518>>>>>
86518>>>>> // treat the ".." as a literal "." in a label and not as a "double delimeter"
86518>>>>> //Move (Replaces("..", sHierarchy, character(8))) To sHierarchy
86518>>>>>
86518>>>>>
86518>>>>> Pos "." in sHierarchy to iPos
86520>>>>>>
86520>>>>> If iPos Begin
86522>>>>> Move (Left(sHierarchy, iPos -1)) To sLevel
86523>>>>> Move (Right(sHierarchy, length(sHierarchy) - iPos)) To sHierarchy
86524>>>>> Move (True) To bMoreLevels
86525>>>>> End
86525>>>>>>
86525>>>>> Else Begin // no more levels
86526>>>>> Move sHierarchy To sLevel
86527>>>>> Move (False) To bMoreLevels
86528>>>>> End
86528>>>>>>
86528>>>>>
86528>>>>> Move (Replaces(character(8), sLevel, ".")) To sLevel
86529>>>>>
86529>>>>> Get ChildItem hiParent To hiSearch
86530>>>>>
86530>>>>> Repeat
86530>>>>>>
86530>>>>> Get ItemLabel hiSearch To sSearchLabel
86531>>>>> If (Uppercase(sSearchLabel) = Uppercase(sLevel)) Begin
86533>>>>> Move (True) To bFound
86534>>>>> End
86534>>>>>>
86534>>>>> Else Get NextSiblingItem hiSearch To hiSearch
86536>>>>> Until (hiSearch =0 or bFound)
86538>>>>>
86538>>>>>
86538>>>>> If (bFound = 0) Begin
86540>>>>> Get Item_Count of hoWorkspaces To icItem
86541>>>>> Get AddTreeItem sLevel hiParent (icItem /3 -1) (bMoreLevels=0) (bMoreLevels=0) To hiLevel
86542>>>>> If (Value(hoWorkspaces, icItem-3) = psWorkspaceSelected(self)) Set CurrentTreeItem To hiLevel
86545>>>>> If bMoreLevels Get AddHierarchy hiLevel sHierarchy To hiLevel // recurse and ignore the result
86548>>>>> End
86548>>>>>>
86548>>>>> Else If bMoreLevels Get AddHierarchy hiSearch sHierarchy To hiLevel // recurse and ignore the result
86552>>>>>
86552>>>>> Function_Return hiLevel
86553>>>>> End_Function
86554>>>>>
86554>>>>> End_Object // oWorkspaces
86555>>>>>
86555>>>>> Object oSelect is a Button
86557>>>>> Set Label to "C_$Select"
86558>>>>> Set Location to 137 216
86559>>>>> Set peAnchors to anBottomRight
86560>>>>> Set Default_State to TRUE
86561>>>>>
86561>>>>> Set Label to C_$Select
86562>>>>>
86562>>>>> Procedure OnClick
86565>>>>> Set pbResult To True
86566>>>>> Send DoWorkspaceSelected of oWorkspaces
86567>>>>> End_Procedure // OnClick
86568>>>>>
86568>>>>> End_Object // oSelect
86569>>>>>
86569>>>>> Object oBrowse is a Button
86571>>>>> Set Label to "C_$Browse"
86572>>>>> Set Location to 155 216
86573>>>>> Set peAnchors to anBottomRight
86574>>>>>
86574>>>>> Set Label to C_$Browse
86575>>>>>
86575>>>>> Function DoStripExtension String sFile Returns String
86578>>>>> // Description
86578>>>>> // -----------
86578>>>>> // Returns a filename without its extension.
86578>>>>> // e.g. C:\TMP\STUFF.TXT will become C:\TMP\STUFF
86578>>>>> //
86578>>>>> Integer iPos
86578>>>>>
86578>>>>> If Not '.' In sFile Function_Return sFile //optimized
86581>>>>>
86581>>>>> Move (Length(sFile)) To iPos
86582>>>>> While (iPos >0)
86586>>>>> If (Mid(sFile, 1, iPos)) eq '.' break
86589>>>>> Decrement iPos
86590>>>>> Loop
86591>>>>>>
86591>>>>>
86591>>>>> Function_Return (Left(sFile, iPos -1))
86592>>>>> End_Function // StripExtension
86593>>>>>
86593>>>>>
86593>>>>> Procedure OnClick
86596>>>>> // Description
86596>>>>> // -----------
86596>>>>> // use the open file dialog to select a workspace .ws file. If the selected file is
86596>>>>> // registered, then open the workspace. If it is not registered, then offer to register
86596>>>>> // it before opening it....
86596>>>>> Boolean bFileSelected bFound
86596>>>>> String sWorkspaceFile
86596>>>>> String sWorkspaceName
86596>>>>> String sTestName
86596>>>>> String sVDFRootDir sWsRegCommand
86596>>>>> Integer iWorkspace icWorkspace
86596>>>>> Integer eRetVal
86596>>>>>
86596>>>>> Get Show_Dialog of oOpenDialog To bFileSelected
86597>>>>>
86597>>>>> If (bFileSelected) Begin
86599>>>>> // get the full path & filename....
86599>>>>> Get File_Name of oOpenDialog To sWorkspaceFile
86600>>>>>
86600>>>>> // determine the workspace name by removing the file
86600>>>>> // extension from the filename....
86600>>>>> Get File_Title of oOpenDialog To sWorkspaceName
86601>>>>> Get DoStripExtension sWorkspaceName To sWorkspaceName
86602>>>>>
86602>>>>> // Test if the workspace has been registered yet...
86602>>>>> Get Item_Count of oSections To icWorkspace
86603>>>>> Move (0) To iWorkspace
86604>>>>> Move (False) To bFound
86605>>>>>
86605>>>>> While (Not(bFound) and iWorkspace < (icWorkspace - 1))
86609>>>>> Get String_Value of oSections iWorkspace To sTestName
86610>>>>> Move (Uppercase(sTestName) = Uppercase(sWorkspaceName)) To bFound
86611>>>>> Increment iWorkspace
86612>>>>> Loop
86613>>>>>>
86613>>>>>
86613>>>>> // If the Workspace hasn't been registered, then ask
86613>>>>> // if they would like to register it....
86613>>>>> If (Not(bFound)) Begin
86615>>>>> // Run wsReg to register the selected workspace....
86615>>>>> 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"
86616>>>>>
86616>>>>> Get_Profile_String "Defaults" "VDFRootDir" To sVDFRootDir
86619>>>>> If (Right(sVDFRootDir,1) = "\") Left sVDFRootDir To sVDFRootDir (Length(sVDFRootDir)-1)
86623>>>>> Move (sVDFRootDir + "\Bin\WsReg.exe ") To sWsRegCommand
86624>>>>> Move (sWsRegCommand + '"' + sWorkspaceFile + '"') To sWsRegCommand
86625>>>>> Runprogram Wait sWsRegCommand
86626>>>>> End
86626>>>>>>
86626>>>>>
86626>>>>> // Now have the workspace opened....
86626>>>>> Delegate Set pbResult To True
86628>>>>> Delegate Set psWorkspaceSelected To sWorkspaceName
86630>>>>> Send Stop_Modal_Ui //Close_Panel
86631>>>>> End
86631>>>>>>
86631>>>>> End_Procedure // OnClick
86632>>>>>
86632>>>>> End_Object // oBrowse
86633>>>>>
86633>>>>> Object oCancel is a Button
86635>>>>> Set Label to "C_$Cancel"
86636>>>>> Set Location to 173 216
86637>>>>> Set peAnchors to anBottomRight
86638>>>>>
86638>>>>> Set Label to C_$Cancel
86639>>>>>
86639>>>>> Procedure OnClick
86642>>>>> Send Close_Panel
86643>>>>> End_Procedure // OnClick
86644>>>>>
86644>>>>> End_Object // oCancel
86645>>>>>
86645>>>>> Object oHelp is a Button
86647>>>>> Set Label to "C_$Help"
86648>>>>> Set Location to 191 216
86649>>>>> Set peAnchors to anBottomRight
86650>>>>>
86650>>>>> Set Label to C_$Help
86651>>>>>
86651>>>>> Procedure OnClick
86654>>>>> Send Help
86655>>>>> End_Procedure // OnClick
86656>>>>>
86656>>>>> End_Object // oHelp
86657>>>>>
86657>>>>> Object oOrderBy is a RadioGroup
86659>>>>> Set Size to 57 58
86660>>>>> Set Location to 53 208
86661>>>>> Set peAnchors to anRight
86662>>>>> Set Label to "C_$OrderBy"
86663>>>>> Object oName is a Radio
86665>>>>> Set Label to "C_$Name"
86666>>>>> Set Size to 10 35
86667>>>>> Set Location to 19 3
86668>>>>>
86668>>>>> Set Label to C_$Name
86669>>>>>
86669>>>>> End_Object // oName
86670>>>>>
86670>>>>> Object oDescription is a Radio
86672>>>>> Set Label to "C_$Description"
86673>>>>> Set Size to 10 52
86674>>>>> Set Location to 32 3
86675>>>>>
86675>>>>> Set Label to C_$Description
86676>>>>>
86676>>>>> End_Object // oDescription
86677>>>>>
86677>>>>>
86677>>>>> Set Label to C_$OrderBy
86678>>>>>
86678>>>>> Procedure Notify_Select_State integer iToItem integer iFromItem
86681>>>>> Integer iWorkspace
86681>>>>> Handle hoWorkspaces
86681>>>>>
86681>>>>> Set pbSortByName To (iToItem =0)
86682>>>>>
86682>>>>> Get ItemData of oWorkspaces (CurrentTreeItem(oWorkspaces(self))) To iWorkspace
86683>>>>> Set psWorkspaceSelected To (Value(oWorkspacesList(self), iWorkspace *3))
86684>>>>> Set CurrentTreeItem of oWorkspaces To -1 // stops all the item-changing events
86685>>>>>
86685>>>>> Send DoShowWorkspaces of oWorkspaces
86686>>>>> End_Procedure
86687>>>>>
86687>>>>> End_Object // oOrderBy
86688>>>>>
86688>>>>> Object oCurrentWorkspace_lb is a Textbox
86690>>>>> Set Label to "C_$CurrentWorkspace"
86691>>>>> Set Location to 5 8
86692>>>>> Set Size to 10 63
86693>>>>> Set FontWeight to 800
86694>>>>> Set TypeFace to "MS Sans Serif"
86695>>>>>
86695>>>>> Set Label to C_$CurrentWorkspace
86696>>>>>
86696>>>>> End_Object // oCurrentWorkspace_lb
86697>>>>>
86697>>>>> Object oCurrentWorkspace is a Textbox
86699>>>>> Set Label to "oTextBox2"
86700>>>>> Set Auto_Size_State to FALSE
86701>>>>> Set Location to 17 5
86702>>>>> Set Size to 14 261
86703>>>>> Set Border_Style to Border_StaticEdge
86704>>>>> Set TypeFace to "MS Sans Serif"
86705>>>>> Set peAnchors to anLeftRight
86706>>>>>
86706>>>>> Procedure DoShowCurrentWorkspace
86709>>>>> String sDescription sName
86709>>>>>
86709>>>>> Delegate Get psOriginalWorkspace To sName
86711>>>>> Delegate Get psCurrentWorkspaceDescription to sDescription
86713>>>>>
86713>>>>> If (sDescription = "") Move ("<" + C_$Undefined + ">") To sDescription
86716>>>>> If (sName = "") Move ("<" + C_$Undefined + ">") To sName
86719>>>>>
86719>>>>> Set Value To (sDescription * "- [" +sName +"]")
86720>>>>> End_Procedure
86721>>>>>
86721>>>>> End_Object // oCurrentWorkspace
86722>>>>>
86722>>>>> Object oLineControl2 is a LineControl
86724>>>>> Set Size to 2 267
86725>>>>> Set Location to 39 2
86726>>>>> Set peAnchors to anLeftRight
86727>>>>>
86727>>>>> Procedure Set GuiSize Integer cy Integer cx
86730>>>>> Forward Set GuiSize To 2 cx
86732>>>>> End_Procedure
86733>>>>>
86733>>>>> End_Object // oLineControl2
86734>>>>>
86734>>>>> Object oSelectedWorkspace is a Textbox
86736>>>>> Set Label to "C_$SelectedWorkspace"
86737>>>>> Set Auto_Size_State to FALSE
86738>>>>> Set Location to 212 5
86739>>>>> Set Size to 14 261
86740>>>>> Set Border_Style to Border_StaticEdge
86741>>>>> Set TypeFace to "MS Sans Serif"
86742>>>>> Set peAnchors to anBottomLeftRight
86743>>>>>
86743>>>>> Set Label to C_$SelectedWorkspace
86744>>>>>
86744>>>>> End_Object // oSelectedWorkspace
86745>>>>>
86745>>>>> Object oSelectNewWorkspace_lb is a Textbox
86747>>>>> Set Label to "C_$SelectNewWorkspace"
86748>>>>> Set Location to 44 8
86749>>>>> Set Size to 10 78
86750>>>>> Set FontWeight to 800
86751>>>>> Set TypeFace to "MS Sans Serif"
86752>>>>>
86752>>>>> Set Label to C_$SelectNewWorkspace
86753>>>>>
86753>>>>> End_Object // oSelectNewWorkspace_lb
86754>>>>>
86754>>>>> Object oOpenDialog is a OpenDialog
86756>>>>> Set Dialog_Caption to "Select a Workspace File"
86757>>>>> Set Filter_String to "Workspace Files (*.ws)|*.ws"
86758>>>>>
86758>>>>>
86758>>>>> Procedure Default_Initial_Folder
86761>>>>> // Description
86761>>>>> // -----------
86761>>>>> // Determine the default Initial_Folder.
86761>>>>> String sDefaultWorkspacePath
86761>>>>> Get_Profile_String "Defaults" "DefaultWorkspacePath" To sDefaultWorkspacePath
86764>>>>> If (Right(sDefaultWorkspacePath,1) = "\") Begin
86766>>>>> Left sDefaultWorkspacePath To sDefaultWorkspacePath (Length(sDefaultWorkspacePath)-1)
86768>>>>>>
86768>>>>> End
86768>>>>>>
86768>>>>>
86768>>>>> Set Initial_Folder To sDefaultWorkspacePath
86769>>>>> End_Procedure // Default_Initial_Folder
86770>>>>>
86770>>>>> Send Default_Initial_Folder
86771>>>>>
86771>>>>>
86771>>>>> End_Object // oOpenDialog
86772>>>>>
86772>>>>> Object oSections is a Array
86774>>>>>
86774>>>>> // This array contains the list of Workspace Names.
86774>>>>>
86774>>>>>
86774>>>>>
86774>>>>>
86774>>>>>
86774>>>>>
86774>>>>> End_Object // oSections
86775>>>>>
86775>>>>>
86775>>>>> Set Label to C_$SelectWorkspace
86776>>>>>
86776>>>>> // === PUBLIC INTERFACE ===
86776>>>>> Function SelectWorkspace Returns Boolean // new WS selected?
86779>>>>> Boolean bWorkspaceSelected
86779>>>>> String sWorkspaceName
86779>>>>>
86779>>>>> Set pbResult To False
86780>>>>> Get psWorkspaceName Of (phoWorkspace (ghoApplication)) To sWorkspaceName
86781>>>>> If (sWorkspaceName = "") Begin
86783>>>>> Get GetCurrentUserWorkspace To sWorkspaceName
86784>>>>> End
86784>>>>>>
86784>>>>> Set psOriginalWorkspace To sWorkspaceName
86785>>>>> Set psWorkspaceSelected To (psOriginalWorkspace(self))
86786>>>>>
86786>>>>> Set Enabled_State of oHelp To (Help_Id(self)) // disable if no Help_Id set (by calling program)
86787>>>>>
86787>>>>> Send Popup_Modal
86788>>>>>
86788>>>>> Move (pbResult(self) = True and psOriginalWorkspace(self) <> psWorkspaceSelected(self)) To bWorkspaceSelected
86789>>>>>
86789>>>>> If bWorkspaceSelected Begin
86791>>>>> If (pbChangeSystemCurrent(self)) Begin
86793>>>>> Send SetCurrentUserWorkspace (psWorkspaceSelected(self))
86794>>>>> End
86794>>>>>>
86794>>>>> End
86794>>>>>>
86794>>>>>
86794>>>>> Function_Return bWorkspaceSelected
86795>>>>> End_Function
86796>>>>>
86796>>>>>End_Object // oSelectWorkspace
86797>>>>>
86797>>>>>
86797>>>>>
86797>>>>>
86797>>>Use WorkSpc.utl
Including file: workspc.utl (C:\Apps\VDFQuery\AppSrc\workspc.utl)
86797>>>>>// Use WorkSpc.utl // cWorkSpace class (that features function sMakePath)
86797>>>>> // and object oAllWorkspaces that reads all WS paths
86797>>>>>
86797>>>>>
86797>>>>>Use Base.utl // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
86797>>>>>Use Version.nui
86797>>>>>
86797>>>>>Use cApplication.pkg
86797>>>>>Use SelectWorkspace.dg
86797>>>>>
86797>>>>>desktop_section
86802>>>>> object oAllWorkspaces is a cArray
86804>>>>> property string psCurrentMakePath public "" // Common to all WS
86806>>>>> object oWorkSpaceTmp is a cWorkSpace
86808>>>>> //procedure set kenter_next_state integer bNext
86808>>>>> //end_procedure
86808>>>>> //function kenter_next_state returns integer
86808>>>>> //end_function
86808>>>>> end_object
86809>>>>> item_property_list
86809>>>>> item_property string psKeyName.i
86809>>>>> item_property string psName.i
86809>>>>> item_property string psDataPath.i
86809>>>>> item_property string psBitMapPath.i
86809>>>>> item_property string psHelpPath.i
86809>>>>> item_property string psAppSrcPath.i
86809>>>>> item_property string psDDSrcPath.i
86809>>>>> item_property string psProgramPath.i
86809>>>>> item_property string psSystemDfPath.i
86809>>>>> item_property string psFileListPath.i
86809>>>>> item_property string psMakePath.i
86809>>>>> // Since the SystemMakePath is the same for all WS we also provide
86809>>>>> // the WS specific part of the MakePath:
86809>>>>> item_property string psMakePathNoSysPath.i
86809>>>>> end_item_property_list
#REM 86876 DEFINE FUNCTION PSMAKEPATHNOSYSPATH.I INTEGER LIROW RETURNS STRING
#REM 86881 DEFINE PROCEDURE SET PSMAKEPATHNOSYSPATH.I INTEGER LIROW STRING VALUE
#REM 86886 DEFINE FUNCTION PSMAKEPATH.I INTEGER LIROW RETURNS STRING
#REM 86891 DEFINE PROCEDURE SET PSMAKEPATH.I INTEGER LIROW STRING VALUE
#REM 86896 DEFINE FUNCTION PSFILELISTPATH.I INTEGER LIROW RETURNS STRING
#REM 86901 DEFINE PROCEDURE SET PSFILELISTPATH.I INTEGER LIROW STRING VALUE
#REM 86906 DEFINE FUNCTION PSSYSTEMDFPATH.I INTEGER LIROW RETURNS STRING
#REM 86911 DEFINE PROCEDURE SET PSSYSTEMDFPATH.I INTEGER LIROW STRING VALUE
#REM 86916 DEFINE FUNCTION PSPROGRAMPATH.I INTEGER LIROW RETURNS STRING
#REM 86921 DEFINE PROCEDURE SET PSPROGRAMPATH.I INTEGER LIROW STRING VALUE
#REM 86926 DEFINE FUNCTION PSDDSRCPATH.I INTEGER LIROW RETURNS STRING
#REM 86931 DEFINE PROCEDURE SET PSDDSRCPATH.I INTEGER LIROW STRING VALUE
#REM 86936 DEFINE FUNCTION PSAPPSRCPATH.I INTEGER LIROW RETURNS STRING
#REM 86941 DEFINE PROCEDURE SET PSAPPSRCPATH.I INTEGER LIROW STRING VALUE
#REM 86946 DEFINE FUNCTION PSHELPPATH.I INTEGER LIROW RETURNS STRING
#REM 86951 DEFINE PROCEDURE SET PSHELPPATH.I INTEGER LIROW STRING VALUE
#REM 86956 DEFINE FUNCTION PSBITMAPPATH.I INTEGER LIROW RETURNS STRING
#REM 86961 DEFINE PROCEDURE SET PSBITMAPPATH.I INTEGER LIROW STRING VALUE
#REM 86966 DEFINE FUNCTION PSDATAPATH.I INTEGER LIROW RETURNS STRING
#REM 86971 DEFINE PROCEDURE SET PSDATAPATH.I INTEGER LIROW STRING VALUE
#REM 86976 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 86981 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
#REM 86986 DEFINE FUNCTION PSKEYNAME.I INTEGER LIROW RETURNS STRING
#REM 86991 DEFINE PROCEDURE SET PSKEYNAME.I INTEGER LIROW STRING VALUE
86997>>>>>
86997>>>>> procedure private.add_workspace string sWorkspace string sDescription string sPath
87000>>>>> integer lhObj liRow liStatus
87000>>>>> move (oWorkSpaceTmp(self)) to lhObj
87001>>>>> send DoClearPaths to lhObj
87002>>>>> get OpenWorkSpace of lhObj sWorkspace to liStatus
87003>>>>> if (liStatus=WSWORKSPACEOPENED) begin
87005>>>>> get row_count to liRow
87006>>>>> set psKeyName.i liRow to sWorkspace
87007>>>>> set psName.i liRow to sDescription
87008>>>>> set psDataPath.i liRow to (psDataPath(lhObj))
87009>>>>> set psBitMapPath.i liRow to (psBitmapPath(lhObj))
87010>>>>> set psHelpPath.i liRow to (psHelpPath(lhObj))
87011>>>>> set psAppSrcPath.i liRow to (psAppSrcPath(lhObj))
87012>>>>> set psDDSrcPath.i liRow to (psDdSrcPath(lhObj))
87013>>>>> set psProgramPath.i liRow to sPath
87014>>>>> set psSystemDfPath.i liRow to (psSystemDfPath(lhObj))
87015>>>>> set psFileListPath.i liRow to (psFileList(lhObj))
87016>>>>> set psMakePathNoSysPath.i liRow to (psAppSrcPath(lhObj)+";"+sPath+";"+psDataPath(lhObj)+";"+psDdSrcPath(lhObj)+";"+psHelpPath(lhObj))
87017>>>>> set psMakePath.i liRow to (psMakePathNoSysPath.i(self,liRow)+";"+psSystemMakePath(lhObj))
87018>>>>> end
87018>>>>>>
87018>>>>> end_procedure
87019>>>>>
87019>>>>> procedure ReadAllWorkspaces global // Public
87021>>>>>
87021>>>>> Integer iVOid iWorkspace
87021>>>>> Handle hoSections
87021>>>>> String sWorkspace sDescription sPath
87021>>>>> String sVdfRootDir
87021>>>>>
87021>>>>> Get_Profile_String "Defaults" "VDFRootDir" To sVDFRootDir
87024>>>>> If (Right(sVDFRootDir,1) = "\") Left sVDFRootDir To sVDFRootDir (Length(sVDFRootDir)-1)
87028>>>>>
87028>>>>> send delete_data
87029>>>>>
87029>>>>> Object oSections is an cArray
87031>>>>> Move self To hoSections
87032>>>>> End_Object
87033>>>>>
87033>>>>> Object oIni is a cIniFile
87035>>>>> Set psFilename To (sVDFRootDir+"\bin\Workspaces.ini")
87036>>>>>
87036>>>>> Send ReadSections hoSections
87037>>>>>
87037>>>>> For iWorkspace from 0 to (Item_Count(hoSections) -1)
87043>>>>>>
87043>>>>> Get Value of hoSections iWorkspace To sWorkspace
87044>>>>> Get ReadString sWorkspace "Description" "" To sDescription
87045>>>>> Get ReadString sWorkspace "Path" "" To sPath
87046>>>>> send private.add_workspace sWorkspace sDescription sPath
87047>>>>> Loop
87048>>>>>>
87048>>>>> End_Object
87049>>>>> end_procedure
87050>>>>> end_object // oAllWorkspaces
87051>>>>>end_desktop_section
87056>>>>>
87056>>>>>function WorkSpc_SelectWS global returns string
87058>>>>> integer lhObj
87058>>>>> move (oSelectWorkspace(self)) to lhObj
87059>>>>> Set pbResult of lhObj To DFFALSE
87060>>>>> send popup to lhObj
87061>>>>> if (pbResult(lhObj)) function_return (psWorkspaceSelected(lhObj))
87064>>>>> else function_return ""
87066>>>>>end_function
87067>>>>>
87067>>>Use WS.nui //
Including file: ws.nui (C:\Apps\VDFQuery\AppSrc\ws.nui)
87067>>>>>// Use WS.nui //
87067>>>>>// Handling of workspaces has changed between VDF 11.1 and 12.
87067>>>>>Use Version.nui
87067>>>>>
87067>>>>>Use cApplication.pkg
87067>>>>>Use cIniFile.pkg
87067>>>>>Use SelectWorkspace.dg
87067>>>>>Use WsFunctions.pkg
Including file: WsFunctions.pkg (C:\Apps\VDFQuery\AppSrc\WsFunctions.pkg)
87067>>>>>>>// Use WsFunctions.pkg // Workspace functions encapsulated in WsFunctions object (VdfQuery)
87067>>>>>>>
87067>>>>>>>Use VdfBase.pkg // DAW package, provides low level support expected of all VDF applications (windows and webapp)
87067>>>>>>>Use cRegistry.pkg // DAW package, provides access to the Windows system Registry
87067>>>>>>>
87067>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
87067>>>>>>>
87067>>>>>>>Desktop_Section
87072>>>>>>>
87072>>>>>>> Object oWsSelector is a ModalPanel
87074>>>>>>> Set Location to 4 13
87075>>>>>>> Set size to 254 319
87076>>>>>>> Set piMinSize to 254 319
87077>>>>>>> Set label to "Work space selector"
87078>>>>>>> Set Border_Style to Border_Thick
87079>>>>>>>
87079>>>>>>> Property Boolean pbAccept
87081>>>>>>> On_Key kCancel Send close_panel
87082>>>>>>>
87082>>>>>>> Procedure AcceptPanel
87085>>>>>>> Set pbAccept to True
87086>>>>>>> Send close_panel
87087>>>>>>> End_Procedure
87088>>>>>>>
87088>>>>>>> Object oTextBox is a TextBox
87090>>>>>>> Set Size to 50 14
87091>>>>>>> Set Location to 14 27
87092>>>>>>> Set Label to "Currently selected workspace:"
87093>>>>>>> End_Object
87094>>>>>>> Object oForm is a Form
87096>>>>>>> Set Size to 14 267
87097>>>>>>> Set Location to 28 24
87098>>>>>>> Set peAnchors to anTopLeftRight
87099>>>>>>> Set Enabled_State to False
87100>>>>>>> End_Object
87101>>>>>>> Object oList is a List
87103>>>>>>> Set Size to 156 267
87104>>>>>>> Set Location to 46 24
87105>>>>>>> Set peAnchors to anAll
87106>>>>>>> Set Select_Mode to Auto_Select
87107>>>>>>> On_Key kEnter Send AcceptPanel
87108>>>>>>> Procedure DoFillList String[] aValues
87111>>>>>>> Integer iMax iItm
87111>>>>>>> Send delete_data
87112>>>>>>> Move (SizeOfArray(aValues)) to iMax
87113>>>>>>> Decrement iMax
87114>>>>>>> For iItm from 0 to iMax
87120>>>>>>>>
87120>>>>>>> Send add_item MSG_None aValues[iItm]
87121>>>>>>> Loop
87122>>>>>>>>
87122>>>>>>> End_Procedure
87123>>>>>>> Procedure Mouse_Click Integer iWindowNumber Integer iPosition // Sent on mouse double click.
87126>>>>>>> Send AcceptPanel
87127>>>>>>> End_Procedure
87128>>>>>>> End_Object
87129>>>>>>> Object oButton1 is a Button
87131>>>>>>> Set Location to 209 176
87132>>>>>>> Set Label to "Select"
87133>>>>>>> Set peAnchors to anBottomRight
87134>>>>>>> Procedure OnClick
87137>>>>>>> Send AcceptPanel
87138>>>>>>> End_Procedure
87139>>>>>>> End_Object
87140>>>>>>> Object oButton2 is a Button
87142>>>>>>> Set Location to 209 240
87143>>>>>>> Set Label to "Cancel"
87144>>>>>>> Set peAnchors to anBottomRight
87145>>>>>>> Procedure OnClick
87148>>>>>>> Send close_panel
87149>>>>>>> End_Procedure
87150>>>>>>> End_Object
87151>>>>>>>
87151>>>>>>> Function SelectSwsFile String[] aValues String sCurrent Returns String
87154>>>>>>> String sRval
87154>>>>>>> Set pbAccept to False
87155>>>>>>> Set value of oForm to sCurrent
87156>>>>>>> Send DoFillList of oList aValues
87157>>>>>>> Send popup
87158>>>>>>> If (pbAccept(Self)) Begin
87160>>>>>>> Get value of oList (Current_Item(oList)) to sRval
87161>>>>>>> End
87161>>>>>>>>
87161>>>>>>> Function_Return sRval
87162>>>>>>> End_Function
87163>>>>>>> End_Object // oWsSelector
87164>>>>>>>
87164>>>>>>> Object WsFunctions is a cObject
87166>>>>>>> Object oRecentWs is a cRegistry // Private
87168>>>>>>> Set phRootKey to HKEY_CURRENT_USER
87169>>>>>>> End_Object
87170>>>>>>>
87170>>>>>>> //> The VDF studio stores its "Recent Workspaces" list in the Windows registry. Use the ReadRegistryRecentWorkSpaces
87170>>>>>>> //> procedure to dig them out.
87170>>>>>>> Procedure ReadRegistryRecentWorkSpaces String[] ByRef aValues
87173>>>>>>> Boolean bOpen
87173>>>>>>> Handle hoArray
87173>>>>>>> Integer iMaxKey iKey
87173>>>>>>> String sKey
87173>>>>>>> Move (ResizeArray(aValues,0)) to aValues
87174>>>>>>> Get OpenKey of oRecentWs "Software\Data Access Worldwide\Visual DataFlex Tools\12.0\Studio\RecentWorkspaces" to bOpen
87175>>>>>>> If (bOpen) Begin
87177>>>>>>> Get Create U_Array to hoArray // Create an array object
87178>>>>>>> Get GetValues of oRecentWs hoArray to iMaxKey
87179>>>>>>> Decrement iMaxKey
87180>>>>>>> For iKey from 0 to iMaxKey
87186>>>>>>>>
87186>>>>>>> Get value of hoArray iKey to sKey
87187>>>>>>> Get ReadString of oRecentWs sKey to aValues[iKey]
87188>>>>>>> Loop
87189>>>>>>>>
87189>>>>>>> Send destroy of hoArray // Remove the array object from memory.
87190>>>>>>> End
87190>>>>>>>>
87190>>>>>>> End_Procedure
87191>>>>>>>
87191>>>>>>> //> Returns a handle to cWorkSpace object currently in action.
87191>>>>>>> Function WorkSpaceObject Returns Handle
87194>>>>>>> Handle hRval
87194>>>>>>> Move 0 to hRval
87195>>>>>>> If (ghoApplication>=0) Begin
87197>>>>>>> Get phoWorkspace of ghoApplication to hRval
87198>>>>>>> End
87198>>>>>>>>
87198>>>>>>> Function_Return hRval
87199>>>>>>> End_Function
87200>>>>>>>
87200>>>>>>> //> Returns the name (incl. full path) of the .ws file currently used.
87200>>>>>>> Function WorkSpaceFile Returns String
87203>>>>>>> Handle hoWs
87203>>>>>>> String sFile
87203>>>>>>> Get WorkSpaceObject to hoWs
87204>>>>>>> If (hoWs>0) Begin
87206>>>>>>> Get psWorkspaceWSFile of hoWs to sFile
87207>>>>>>> End
87207>>>>>>>>
87207>>>>>>> Else Begin
87208>>>>>>> Move "" to sFile
87209>>>>>>> End
87209>>>>>>>>
87209>>>>>>> Function_Return sFile
87210>>>>>>> End_Function
87211>>>>>>>
87211>>>>>>> //> Use this function to calculate the absolute path of the .ws file corresponding to the abslute path of a .sws file given as parameter.
87211>>>>>>> Function SwsFileToWsFile String sSwsFile Returns String
87214>>>>>>> Boolean bStop
87214>>>>>>> //Integer iChannel
87214>>>>>>> Handle hoIniFile
87214>>>>>>> String sWsFile sLine
87214>>>>>>>
87214>>>>>>> Get Create U_cIniFile To hoIniFile
87215>>>>>>>
87215>>>>>>> Set psFilename of hoIniFile To sSwsFile
87216>>>>>>> Get ReadString of hoIniFile "WorkspacePaths" "ConfigFile" "" To sWsFile
87217>>>>>>> Send Destroy of hoIniFile // destroy dynaically created inifile object
87218>>>>>>>
87218>>>>>>> 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).
87220>>>>>>> Move (Remove(swsFile,1,2)) to sWsFile // Remove the first two characters
87221>>>>>>>
87221>>>>>>> Get SEQ_ExtractPathFromFileName sSwsFile to sSwsFile // "C:\Apps\VdfQueryLib\VDFQueryLib.sws" -> "C:\Apps\VdfQueryLib"
87222>>>>>>> Get Files_AppendPath sSwsFile sWsFile to sWsFile
87223>>>>>>> End
87223>>>>>>>>
87223>>>>>>> Function_Return sWsFile
87224>>>>>>> End_Function
87225>>>>>>>
87225>>>>>>> //> Function OpenWorkspace takes a .sws or .ws file and calls the "OpenWorkSpaceFile" method of the current cWorkSpace object. The return
87225>>>>>>> //> value is one of the following:
87225>>>>>>> //> -1 : cWorkSpace object not found
87225>>>>>>> //> wsWorkspaceOpened : WS opened ok
87225>>>>>>> //> wsWorkspaceNotFound : the named WS was not found in the global list
87225>>>>>>> //> wsWorkspaceFileNotFound : the WS file was not found
87225>>>>>>> //> wsDataPathEmpty : the DataPath entry was empty
87225>>>>>>> //> wsFileListEmpty : The FileList entry was empty
87225>>>>>>> //> wsFileListNotExist : The FileList.cfg file could not be found
87225>>>>>>> Function OpenWorkspace String sFile Returns Integer
87228>>>>>>> Handle hoWs
87228>>>>>>> Integer iRval
87228>>>>>>> Get WorkSpaceObject to hoWs
87229>>>>>>> If (hoWs>=0) Begin
87231>>>>>>> If (lowercase(right(sFile,4))=".sws") Get SwsFileToWsFile sFile to sFile
87234>>>>>>> Get OpenWorkspaceFile of hoWs sFile to iRval
87235>>>>>>> End
87235>>>>>>>>
87235>>>>>>> Function_Return iRval
87236>>>>>>> End_Function
87237>>>>>>>
87237>>>>>>> Function OpenWorkspaceErrorText integer iReturnValue returns string
87240>>>>>>> if (iReturnValue=-1) function_return "cWorkSpace object not found"
87243>>>>>>> if (iReturnValue=wsWorkspaceOpened) function_return "WS opened ok"
87246>>>>>>> if (iReturnValue=wsWorkspaceNotFound) function_return "The named WS was not found in the global list"
87249>>>>>>> if (iReturnValue=wsWorkspaceFileNotFound) function_return "The WS file was not found"
87252>>>>>>> if (iReturnValue=wsDataPathEmpty) function_return "The DataPath entry was empty"
87255>>>>>>> if (iReturnValue=wsFileListEmpty) function_return "The FileList entry was empty"
87258>>>>>>> if (iReturnValue=wsFileListNotExist) function_return "'FileList.cfg' file could not be found"
87261>>>>>>> function_return ""
87262>>>>>>> End_Function
87263>>>>>>>
87263>>>>>>> Function SelectRecentWorkspaceFile Returns String
87266>>>>>>> String sSwsFile sWsFile
87266>>>>>>> String[] aValues
87267>>>>>>> Send ReadRegistryRecentWorkSpaces (&aValues)
87268>>>>>>> Get SelectSwsFile of oWsSelector aValues (WorkSpaceFile(Self)) to sSwsFile
87269>>>>>>> Function_Return sSwsFile
87270>>>>>>> End_Function
87271>>>>>>> End_Object
87272>>>>>>>End_Desktop_Section
87277>>>>>
87277>>>>>object oWsTempObject is a array
87279>>>>> procedure WS_OnCloseWorkSpace string lsOldWS
87282>>>>> end_procedure
87283>>>>> procedure WS_OnOpenWorkSpace string lsNewWS
87286>>>>> end_procedure
87287>>>>>end_object
87288>>>>>
87288>>>>>//> Returns the name of the current WS
87288>>>>>function WS_CurrentEffectiveID global returns string
87290>>>>> string lsRval
87290>>>>> integer lhWS
87290>>>>> get phoWorkspace of ghoApplication to lhWS // ghoWorkSpace
87291>>>>> //Get psWorkspaceName of lhWS to lsRval
87291>>>>> Get psWorkspaceWSFile of lhWS to lsRval
87292>>>>> function_return lsRval
87293>>>>>end_function
87294>>>>>
87294>>>>>Function WS_CurrentDefaultID Global Returns String
87296>>>>> Handle hoRegistry
87296>>>>> String sWorkspace
87296>>>>> Boolean bOpened
87296>>>>>
87296>>>>> Get Create U_cRegistry to hoRegistry
87297>>>>>
87297>>>>> //Get OpenKey of hoRegistry "SOFTWARE\Data Access Worldwide\Visual DataFlex\12.0\Workspaces" To bOpened
87297>>>>> Get OpenKey of hoRegistry "SOFTWARE\Data Access Worldwide\Visual DataFlex Tools\12.0\Studio\Workspaces" to bOpened
87298>>>>> If bOpened Begin
87300>>>>> If (ValueExists(hoRegistry, "Current Workspace")) Get ReadString of hoRegistry "Current Workspace" to sWorkspace
87303>>>>> Send CloseKey of hoRegistry
87304>>>>> End
87304>>>>>>
87304>>>>>
87304>>>>> Send Destroy of hoRegistry
87305>>>>> Function_Return sWorkspace
87306>>>>>
87306>>>>> //String lsRval lsWsFile
87306>>>>> //Get GetCurrentUserWorkspace to lsRval
87306>>>>> //Function_Return lsRval
87306>>>>>end_function
87307>>>>>
87307>>>>>function WS_IdToDescription global string lsWS returns string
87309>>>>> integer hoWorkspace hoIniFile
87309>>>>> string lsRval lsWsFile
87309>>>>> If (lsWS="") Function_Return "No Workspace"
87312>>>>> Function_Return lsWS
87313>>>>> //get phoWorkspace of ghoApplication To hoWorkspace
87313>>>>> //get GetWorkspaceFileName of hoWorkspace lsWS to lsWsFile
87313>>>>> //Get Create U_cIniFile To hoIniFile
87313>>>>>//
87313>>>>> //Set psFilename of hoIniFile To lsWsFile
87313>>>>> //Get ReadString of hoIniFile "Workspace" "Description" "" To lsRval
87313>>>>> //Send Destroy of hoIniFile // destroy dynaically created inifile object
87313>>>>> //function_return lsRval
87313>>>>>End_Function
87314>>>>>
87314>>>>>function WS_CurrentEffectiveDescription global returns string
87316>>>>> string lsRval
87316>>>>> get WS_CurrentEffectiveID to lsRval
87317>>>>> get WS_IdToDescription lsRval to lsRval
87318>>>>>// get CurrentWorkSpaceDescription of ghoWorkSpace to lsRval
87318>>>>> function_return lsRval
87319>>>>>end_function
87320>>>>>
87320>>>>>function WS_Select global string lsWS returns integer
87322>>>>> integer hoWorkspace liOpened
87322>>>>> string lsCurrentEffectiveID
87322>>>>> get WS_CurrentEffectiveID to lsCurrentEffectiveID
87323>>>>> broadcast recursive send WS_OnCloseWorkSpace to desktop lsCurrentEffectiveID
87325>>>>> get phoWorkspace of ghoApplication To hoWorkspace
87326>>>>> Send DoClearPaths of hoWorkspace
87327>>>>> //Get OpenWorkspace of hoWorkspace lsWS to liOpened
87327>>>>> Get OpenWorkspace of WsFunctions lsWS to liOpened
87328>>>>> If (liOpened <> WSWORKSPACEOPENED) Begin
87330>>>>> send stop_box "Selected workspace is invalid."
87331>>>>> End
87331>>>>>>
87331>>>>> broadcast recursive send WS_OnOpenWorkSpace to desktop lsWS // function WS_Select
87333>>>>> function_return DFTRUE
87334>>>>>end_function
87335>>>>>
87335>>>>>function WS_MakePath global returns string
87337>>>>> integer hoWorkspace
87337>>>>> string lsAppSrc lsPrograms lsDDSrc lsData lsBitmaps lsSystemMakePath lsRval
87337>>>>> get phoWorkspace of ghoApplication To hoWorkspace
87338>>>>> get psAppSrcPath of hoWorkspace to lsAppSrc
87339>>>>> get psProgramPath of hoWorkspace to lsPrograms
87340>>>>> get psDdSrcPath of hoWorkspace to lsDDSrc
87341>>>>> get psDataPath of hoWorkspace to lsData
87342>>>>> get psBitmapPath of hoWorkspace to lsBitmaps
87343>>>>> get psSystemMakePath of hoWorkspace to lsSystemMakePath
87344>>>>> move (lsAppSrc+";"+lsPrograms+";"+lsDDSrc+";"+lsData+";"+lsBitmaps+";"+lsSystemMakePath) to lsRval
87345>>>>> function_return lsRval
87346>>>>>end_function
87347>>>>>
87347>>>>>function WS_SelectNone global string lsWS returns integer
87349>>>>>end_function
87350>>>>>
87350>>>register_object Main
87350>>>register_object Client_Area
87350>>>Procedure Do_Select_WorkSpace
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
87352>>> //integer hoWorkspace eOpened
87352>>> string sWorkspace
87352>>> //get phoWorkspace of ghoApplication To hoWorkspace
87352>>> //Get WorkSpc_SelectWS to sWorkspace
87352>>> Get SelectRecentWorkspaceFile of WsFunctions to sWorkSpace
87353>>> If (sWorkspace<>"") Begin
87355>>> if (WS_Select(sWorkspace)) begin
87357>>> Send FastView_OpenDefaultCollection
87358>>> end
87358>>>>
87358>>> End
87358>>>>
87358>>>end_procedure
87359>>>use FDX.nui
87359>>>
87359>>>procedure Do_Select_FileList string lsFileList
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
87361>>> integer hoWorkspace
87361>>> string lsCurrentEffectiveID
87361>>> get WS_CurrentEffectiveID to lsCurrentEffectiveID
87362>>> broadcast recursive send WS_OnCloseWorkSpace to desktop lsCurrentEffectiveID
87364>>> get phoWorkspace of ghoApplication To hoWorkspace
87365>>> Send DoClearPaths of hoWorkspace
87366>>>
87366>>> send FLIST_SetOpenPath (SEQ_ExtractPathFromFileName(lsFileList))
87367>>> send FLIST_SetCurrentFilelist lsFileList
87368>>>
87368>>> broadcast recursive send WS_OnOpenWorkSpace to desktop "" // Procedure Do_Select_FileList
87370>>> send FastView_OpenDefaultCollection
87371>>>end_procedure
87372>>>
87372>>>procedure Do_Select_FileList_Browse
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
87374>>> string lsFileList
87374>>> move (SEQ_SelectFile("Open FILELIST.CFG","filelist.cfg|filelist.cfg|*.cfg|*.CFG")) to lsFileList
87375>>> if (lsFileList<>"") send Do_Select_FileList lsFileList
87378>>>end_procedure
87379>>>
87379>>>object oWatchedPackages is a cArray
87381>>> property string psFastViewPath
87383>>> property number pnFastViewCompileTime
87385>>> item_property_list
87385>>> item_property string psPackage.i
87385>>> item_property integer pbFound.i
87385>>> item_property string psPath.i
87385>>> item_property number pnTimeStamp.i
87385>>> end_item_property_list
#REM 87428 DEFINE FUNCTION PNTIMESTAMP.I INTEGER LIROW RETURNS NUMBER
#REM 87433 DEFINE PROCEDURE SET PNTIMESTAMP.I INTEGER LIROW NUMBER VALUE
#REM 87438 DEFINE FUNCTION PSPATH.I INTEGER LIROW RETURNS STRING
#REM 87443 DEFINE PROCEDURE SET PSPATH.I INTEGER LIROW STRING VALUE
#REM 87448 DEFINE FUNCTION PBFOUND.I INTEGER LIROW RETURNS INTEGER
#REM 87453 DEFINE PROCEDURE SET PBFOUND.I INTEGER LIROW INTEGER VALUE
#REM 87458 DEFINE FUNCTION PSPACKAGE.I INTEGER LIROW RETURNS STRING
#REM 87463 DEFINE PROCEDURE SET PSPACKAGE.I INTEGER LIROW STRING VALUE
87469>>> procedure add_package string lsPack
87472>>> integer liRow
87472>>> get row_count to liRow
87473>>> set psPackage.i liRow to lsPack
87474>>> set pbFound.i liRow to DFFALSE
87475>>> set psPath.i liRow to ""
87476>>> set pnTimeStamp.i liRow to 0
87477>>> end_procedure
87478>>> procedure DoTimeStamps
87481>>> integer liRow liMax
87481>>> string lsMakePath lsPackage lsPath
87481>>> get WS_MakePath to lsMakePath
87482>>> get row_count to liMax
87483>>> decrement liMax
87484>>> for liRow from 0 to liMax
87490>>>>
87490>>> get psPackage.i liRow to lsPackage
87491>>> get SEQ_FindFileAlongPath lsMakePath lsPackage to lsPath
87492>>> if (lsPath="") begin
87494>>> move (lsPackage+".pkg") to lsPackage
87495>>> get SEQ_FindFileAlongPath lsMakePath lsPackage to lsPath
87496>>> end
87496>>>>
87496>>> if (lsPath<>"") begin
87498>>> get SEQ_ComposeAbsoluteFileName lsPath lsPackage to lsPackage
87499>>>// if (SEQ_FileExists(lsPackage)=SEQIT_FILE) begin
87499>>> if DFTRUE begin
87501>>> set pbFound.i liRow to DFTRUE
87502>>> set pnTimeStamp.i liRow to (SEQ_FileModTime(lsPackage))
87503>>> set psPath.i liRow to lsPath
87504>>> end
87504>>>>
87504>>> else begin
87505>>> set pbFound.i liRow to DFFALSE
87506>>> set pnTimeStamp.i liRow to 0
87507>>> set psPath.i liRow to ""
87508>>> end
87508>>>>
87508>>> end
87508>>>>
87508>>> else begin
87509>>> set pbFound.i liRow to DFFALSE
87510>>> set pnTimeStamp.i liRow to 0
87511>>> set psPath.i liRow to ""
87512>>> end
87512>>>>
87512>>> loop
87513>>>>
87513>>>
87513>>> get API_OtherAttr_Value OA_RUNTIME_NAME to lsPackage
87514>>> get SEQ_ExtractPathFromFileName lsPackage to lsPath
87515>>>
87515>>> set psFastViewPath to lsPath
87516>>> set pnFastViewCompileTime to (SEQ_FileModTime(lsPackage))
87517>>> end_procedure
87518>>> function bIsProgramTooOld returns integer
87521>>> integer liRow liMax
87521>>> number lnFastViewTime
87521>>> get pnFastViewCompileTime to lnFastViewTime
87522>>> get row_count to liMax
87523>>> decrement liMax
87524>>> for liRow from 0 to liMax
87530>>>>
87530>>> if (pnTimeStamp.i(self,liRow)>lnFastViewTime) function_return DFTRUE
87533>>> loop
87534>>>>
87534>>> function_return DFFALSE
87535>>> end_function
87536>>>
87536>>> property integer pbWarningAlreadyGiven public DFFALSE
87538>>> procedure UserWarning
87541>>> integer liRow liMax
87541>>> number lnFastViewTime
87541>>> string lsRval ls10
87541>>> ifnot (pbWarningAlreadyGiven(self)) begin
87543>>> move (character(10)) to ls10
87544>>> move ("The following packages are found to be newer than the current Fastview compilation:"+ls10) to lsRval
87545>>> get pnFastViewCompileTime to lnFastViewTime
87546>>> get row_count to liMax
87547>>> decrement liMax
87548>>> for liRow from 0 to liMax
87554>>>>
87554>>> if (pnTimeStamp.i(self,liRow)>lnFastViewTime) move (lsRval+psPackage.i(self,liRow)+ls10) to lsRval
87557>>> loop
87558>>>>
87558>>> move (lsRval+ls10+"Perhaps it's time to recompile FastView...") to lsRval
87559>>> send obs lsRval
87560>>> set pbWarningAlreadyGiven to DFTRUE
87561>>> end
87561>>>>
87561>>>// function_return lsRval
87561>>>// move (lsRval+"Do you want to re-compile fastview?") to lsRval
87561>>> end_procedure
87562>>>
87562>>> property integer pbDontAskTwiceIts public DFFALSE
87564>>> procedure DoTheCheck
87567>>> integer lbError lbHome
87567>>> string lsQuestion lsMakePath lsCompilerPath lsFastViewPath
87567>>> if (integer(FVSetupValue(FVSETUP_OLD_PKG_CHECK))) begin
87569>>> ifnot (pbDontAskTwiceIts(self)) begin
87571>>> set pbDontAskTwiceIts to DFTRUE
87572>>> get FastView_GenericDDsApplicable to lbHome
87573>>> if lbHome begin
87575>>> send DoTimeStamps
87576>>> if (bIsProgramTooOld(self)) begin
87578>>> send UserWarning
87579>>> end
87579>>>>
87579>>> end
87579>>>>
87579>>> end
87579>>>>
87579>>> set pbDontAskTwiceIts to DFFALSE
87580>>> end
87580>>>>
87580>>> end_procedure
87581>>>end_object
87582>>>
87582>>>object oWatchedPackagesPanel is a aps.ModalPanel label "Watched packages"
87585>>> set locate_mode to CENTER_ON_SCREEN
87586>>> on_key kcancel send close_panel
87587>>> property integer piResult public DFFALSE
87589>>>
87589>>> object oLst is a aps.Grid
87591>>> send GridPrepare_AddColumn "Package" AFT_ASCII20
87592>>> send GridPrepare_AddColumn "Time stamp" AFT_ASCII20
87593>>> send GridPrepare_AddColumn "Path" AFT_ASCII50
87594>>> send GridPrepare_Apply self
87595>>> on_key KEY_CTRL+KEY_R send sort_data
87596>>> on_key KEY_CTRL+KEY_W send DoWriteToFile
87597>>> set size to 150 0
87598>>>
87598>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
87599>>> Set peResizeColumn to rcSelectedColumn // make sure mode is correct
87600>>> Set piResizeColumn to 2 // this is the column to resize
87601>>> procedure DoWriteToFile
87604>>> send Grid_DoWriteToFile self
87605>>> end_procedure
87606>>> function iSpecialSortValueOnColumn.i integer liColumn returns integer
87609>>> if liColumn eq 1 function_Return 1
87612>>> end_function
87613>>> function sSortValue.ii integer liColumn integer liItem returns string
87616>>> number lnTS
87616>>> if liColumn eq 1 begin
87618>>> get TS_ConvertStringToTS (value(self,liItem)) to lnTS
87619>>> function_return (IntToStrR(lnTS,14))
87620>>> end
87620>>>>
87620>>> end_function
87621>>> procedure sort_data.i integer liColumn
87624>>> send Grid_SortByColumn self liColumn
87625>>> end_procedure
87626>>> procedure sort_data
87629>>> integer liCC
87629>>> get Grid_CurrentColumn self to liCC
87630>>> send sort_data.i liCC
87631>>> end_procedure
87632>>> procedure header_mouse_click integer liItem
87635>>> send sort_data.i liItem
87636>>> forward send header_mouse_click liItem
87638>>> end_procedure
87639>>> procedure fill_list.i integer lhArray
87642>>> integer liMax liRow
87642>>> send delete_data
87643>>> get row_count of lhArray to liMax
87644>>> decrement liMax
87645>>> for liRow from 0 to liMax
87651>>>>
87651>>> send add_item MSG_NONE (psPackage.i(lhArray,liRow))
87652>>> if (pbFound.i(lhArray,liRow)) begin
87654>>> send add_item MSG_NONE (TS_ConvertToString(pnTimeStamp.i(lhArray,liRow)))
87655>>> send add_item MSG_NONE (psPath.i(lhArray,liRow))
87656>>> end
87656>>>>
87656>>> else begin
87657>>> send add_item MSG_NONE "-"
87658>>> send add_item MSG_NONE "-"
87659>>> end
87659>>>>
87659>>> loop
87660>>>>
87660>>> send Grid_SetEntryState self DFFALSE
87661>>> send sort_data.i 1 // Sort by time
87662>>> end_procedure
87663>>> end_object
87664>>> object oBtn1 is a aps.Multi_Button
87666>>> on_item t.btn.close send close_panel
87667>>> set peAnchors to (anBottom+anRight)
87668>>> end_object
87669>>> send aps_locate_multi_buttons
87670>>> set Border_Style to BORDER_THICK // Make panel resizeable
87671>>> procedure popup
87674>>> integer lhObj
87674>>> string lsLabel
87674>>> set piResult to DFFALSE
87675>>> move (oWatchedPackages(self)) to lhObj
87676>>> send fill_list.i to (oLst(self)) lhObj
87677>>>
87677>>> move "Workspace DD packages (FastView compiled #, #)" to lsLabel
87678>>> move (replace("#",lsLabel,TS_ConvertToString(pnFastViewCompileTime(lhObj)))) to lsLabel
87679>>> move (replace("#",lsLabel,psFastViewPath(lhObj))) to lsLabel
87680>>> set label to lsLabel
87681>>> if (item_count(oLst(self))) forward send popup
87685>>> else send obs "You have not compiled any DD packages into this version of Fastview" ("(Located here: "+psFastViewPath(lhObj)+")")
87687>>> end_procedure
87688>>>end_object // oWatchedPackagesPanel
87689>>>send aps_SetMinimumDialogSize (oWatchedPackagesPanel(self))
87690>>>
87690>>>
87690>>>procedure FastView_Display_UserPackages
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
87692>>> send DoTimeStamps to (oWatchedPackages(self))
87693>>> send popup to (oWatchedPackagesPanel(self))
87694>>>end_procedure
87695>>>
87695>>>procedure FastView_Check_UserPackages
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
87697>>> send DoTheCheck to (oWatchedPackages(self))
87698>>>end_procedure
87699>>>
87699>>>
87699>>>Use FvGeneri.pkg //
Including file: fvgeneri.pkg (C:\Apps\VDFQuery\AppSrc\fvgeneri.pkg)
87699>>>>>// Use FvGeneri.pkg //
87699>>>>>
87699>>>>>use Base.nui
87699>>>>>
87699>>>>>
87699>>>>>
87699>>>>>desktop_section
87704>>>>>object oCompiledLogicalTableNames is a cArray NO_IMAGE
87706>>>>> procedure add_file integer liFile string lsLogicalName
87709>>>>> if (lsLogicalName<>("FILE"+string(liFile)) and liFile<>CodeMast.file_number) set value item liFile to (uppercase(lsLogicalName))
87712>>>>> end_procedure
87713>>>>>end_object
87714>>>>>end_desktop_section
87719>>>>>
87719>>>>>function FV_GenericTableName global integer liFile returns string
87721>>>>> function_return (value(oCompiledLogicalTableNames(self),liFile))
87722>>>>>end_function
87723>>>>>
87723>>>>>function FV_GenericTablesPresent global returns integer
87725>>>>> function_return (item_count(oCompiledLogicalTableNames(self)))
87726>>>>>end_function
87727>>>>>
87727>>>>>function FV_GenericTablesUnderUs global returns integer
87729>>>>> integer lhObj liFile liMax
87729>>>>> string lsArrLN lsApiLN
87729>>>>> move (oCompiledLogicalTableNames(self)) to lhObj
87730>>>>> get item_count of lhObj to liMax
87731>>>>> decrement liMax
87732>>>>> for liFile from 0 to liMax
87738>>>>>>
87738>>>>> if (liFile<>CodeMast.file_number and liFile<>CodeType.file_number) begin
87740>>>>> get value of lhObj liFile to lsArrLN
87741>>>>> if (lsArrLN<>"") begin
87743>>>>> get_attribute DF_FILE_LOGICAL_NAME of liFile to lsApiLN
87746>>>>> //showln liFile " " lsApiLN " <-> " lsArrLN
87746>>>>> if (lsArrLN<>"DUMMYFILE") if (uppercase(lsApiLN)<>lsArrLN) function_return DFFALSE
87751>>>>> end
87751>>>>>>
87751>>>>> end
87751>>>>>>
87751>>>>> loop
87752>>>>>>
87752>>>>> function_return DFTRUE
87753>>>>>end_function
87754>>>>>
87754>>>>>
87754>>>gosub RegisterReferencedTables
87755>>>>
87755>>>
87755>>>integer giGenericDDsAlreadyCreated
87755>>>move 0 to giGenericDDsAlreadyCreated
87756>>>
87756>>>object oFastViewPreferences is a cArray
87758>>> property integer pbOnGenericTables
87760>>> object oTablesOpenStatus is a cTablesOpenStatus
87762>>> end_object
87763>>> procedure WS_OnOpenWorkSpace string lsWS
87766>>> set pbOnGenericTables to (FV_GenericTablesPresent() and FV_GenericTablesUnderUs())
87767>>> if (pbOnGenericTables(self)) begin
87769>>> ifnot giGenericDDsAlreadyCreated begin
87771>>> move 1 to giGenericDDsAlreadyCreated
87772>>> CREATE_OBJECT_GROUP OG_WorkspaceDDs PARENT desktop
87781>>> send RegisterCurrentOpenFiles to (oTablesOpenStatus(self))
87782>>>// send FastView_Check_UserPackages
87782>>> end
87782>>>>
87782>>> else begin
87783>>> // Re-create the situation as it were immediately after calling
87783>>> // the programmer defined DD code the first time.
87783>>> send RestoreFiles to (oTablesOpenStatus(self))
87784>>> end
87784>>>>
87784>>> end
87784>>>>
87784>>> else send OpenStat_CloseAllFiles
87786>>> end_procedure
87787>>>end_object
87788>>>
87788>>>function FastView_GenericDDsApplicable global returns integer
87790>>> function_return (pbOnGenericTables(oFastViewPreferences(self)))
87791>>>end_function
87792>>>
87792>>>enumeration_list
87792>>> define DDP_CLASS
87792>>>end_enumeration_list
87792>>>
87792>>>Use DDCreate.nui // Create generic DDO structures (using global FDX object)
Including file: ddcreate.nui (C:\Apps\VDFQuery\AppSrc\ddcreate.nui)
87792>>>>>// Use DDCreate.nui // Create generic DDO structures (using global FDX object)
87792>>>>>
87792>>>>>Use FieldInf // Global field info objects and abstract field types
87792>>>>>Use Set.utl // cArray, cSet and cStack classes
87792>>>>>Use FdxGlObj.nui // Global FDX object (ghFDX)
Including file: fdxglobj.nui (C:\Apps\VDFQuery\AppSrc\fdxglobj.nui)
87792>>>>>>>// Use FdxGlObj.nui // Global FDX object (ghFDX)
87792>>>>>>>use Fdx.nui
87792>>>>>>>
87792>>>>>>>integer ghFDX
87792>>>>>>>desktop_section
87797>>>>>>> object oFDXGL is a cFDX NO_IMAGE
87799>>>>>>> move self to ghFDX
87800>>>>>>> end_object
87801>>>>>>>end_desktop_section
87806>>>>>>>
87806>>>>>>>// liReadMode may be FDX_ALL_OPEN or FDX_ALL_FILES meaning read all
87806>>>>>>>// open files or read all files in filelist.cfg
87806>>>>>>>procedure FDXGL_ReadCurrentFileList global integer liReadMode
87808>>>>>>> send Read_Current_Filelist to ghFDX liReadMode
87809>>>>>>>end_procedure
87810>>>>>>>
87810>>>>>>>function FDXGL_ReadFile global string lsFileName returns integer
87812>>>>>>> string liChannel
87812>>>>>>> move (SEQ_DirectInput(lsFileName)) to liChannel
87813>>>>>>> if (liChannel>=0) begin
87815>>>>>>> send Seq_Read to ghFDX liChannel
87816>>>>>>> set psFileName of ghFDX to lsFileName
87817>>>>>>> send SEQ_CloseInput liChannel
87818>>>>>>> function_return 1
87819>>>>>>> end
87819>>>>>>>>
87819>>>>>>>end_function
87820>>>>>>>
87820>>>>>>>procedure FDXGL_WriteFile global string lsFileName
87822>>>>>>> string liChannel
87822>>>>>>> move (SEQ_DirectOutput(lsFileName)) to liChannel
87823>>>>>>> if (liChannel>=0) begin
87825>>>>>>> send Seq_Write to ghFDX liChannel
87826>>>>>>> send SEQ_CloseOutput liChannel
87827>>>>>>> function_return 1
87828>>>>>>> end
87828>>>>>>>>
87828>>>>>>>end_procedure
87829>>>>>Use Spec0005.utl // Datadictionary object procedures ("DDUTIL_" prefix)
Including file: spec0005.utl (C:\Apps\VDFQuery\AppSrc\spec0005.utl)
87829>>>>>>>// Use Spec0005.utl // Datadictionary object procedures ("DDUTIL_" prefix)
87829>>>>>>>Use DataDict // Standard VDF class
87829>>>>>>>Use Fdx_Attr.utl // FDX compatible attribute functions
87829>>>>>>>Use FdxIndex.utl // Index analysing functions
87829>>>>>>>
87829>>>>>>>//**********************************************************************
87829>>>>>>>// Useful pastry:
87829>>>>>>>//
87829>>>>>>>// class Customer_DD is a DataDictionary
87829>>>>>>>// procedure define_fields
87829>>>>>>>// forward send define_fields
87829>>>>>>>// set main_file to Customer.file_number
87829>>>>>>>// send DDUTIL_DoQuickSetup self
87829>>>>>>>// end_procedure
87829>>>>>>>// end_class
87829>>>>>>>
87829>>>>>>>//> Set key_field_state of all fields in index# to true. Also
87829>>>>>>>//> sets protect_key_state to true.
87829>>>>>>>procedure DDUTIL_DoPrimaryIndex global integer ddo# integer index#
87831>>>>>>> integer iFile iField iPos iMaxPos
87831>>>>>>> string sFields
87831>>>>>>> get main_file of ddo# to iFile
87832>>>>>>> if index# begin
87834>>>>>>> get FDX_IndexAsFields 0 iFile index# to sFields
87835>>>>>>> // We have to substitute overlap fields with their underlying fields. It
87835>>>>>>> // makes no sense to the DD object to set key_field_state of an overlap:
87835>>>>>>> get FDX_FieldsTranslateOverlaps 0 iFile sFields to sFields
87836>>>>>>> move (length(sFields)+3/4) to iMaxPos
87837>>>>>>> for iPos from 0 to (iMaxPos-1)
87843>>>>>>>>
87843>>>>>>> move (mid(sFields,4,iPos*4+1)) to iField
87844>>>>>>> set key_field_state of ddo# iField to DFTRUE
87845>>>>>>> if iField eq iMaxPos set field_options of ddo# iField to DD_AUTOFIND
87848>>>>>>> loop
87849>>>>>>>>
87849>>>>>>> set protect_key_state of ddo# to DFTRUE
87850>>>>>>> end
87850>>>>>>>>
87850>>>>>>>end_procedure
87851>>>>>>>
87851>>>>>>>//> Locates the primary index of main_file(DDO) and calls
87851>>>>>>>//> procedure DDUTIL_DoPrimaryIndex
87851>>>>>>>procedure DDUTIL_DoFindAndSetPrimaryIndex global integer ddo#
87853>>>>>>> integer iIndex iFile
87853>>>>>>> get main_file of ddo# to iFile
87854>>>>>>> get FDX_IndexFindPrimary 0 iFile to iIndex
87855>>>>>>> if iIndex send DDUTIL_DoPrimaryIndex ddo# iIndex
87858>>>>>>>end_procedure
87859>>>>>>>
87859>>>>>>>//> Does a reasonable setup of "foreign field options"
87859>>>>>>>procedure DDUTIL_DoForeignOptions global integer ddo#
87861>>>>>>> set Foreign_Field_Options of ddo# DD_KEYFIELD To DD_FINDREQ
87862>>>>>>> set Foreign_Field_Options of ddo# DD_INDEXFIELD To DD_FINDREQ DD_AUTOFIND_GE
87863>>>>>>> set Foreign_Field_Options of ddo# DD_DEFAULT To DD_NOENTER
87864>>>>>>>end_procedure
87865>>>>>>>
87865>>>>>>>procedure DDUTIL_DoQuickSetup global integer ddo#
87867>>>>>>> send DDUTIL_DoFindAndSetPrimaryIndex ddo#
87868>>>>>>> send DDUTIL_DoForeignOptions ddo#
87869>>>>>>>end_procedure
87870>>>>>>>
87870>>>>>>>procedure DDUTIL_DoDefaultNextNumericUniqueID global integer ddo#
87872>>>>>>> integer iIndex iFile iMaxSeg iField iRec iVal
87872>>>>>>> get main_file of ddo# to iFile
87873>>>>>>> get FDX_IndexFindPrimary 0 iFile to iIndex
87874>>>>>>> if iIndex begin
87876>>>>>>> get_attribute DF_INDEX_NUMBER_SEGMENTS of iFile iIndex to iMaxSeg
87879>>>>>>> if iMaxSeg eq 1 begin
87881>>>>>>> get_attribute DF_INDEX_SEGMENT_FIELD of iFile iIndex 1 to iField
87884>>>>>>> get_field_value iFile 0 to iRec
87887>>>>>>> clear iFile
87888>>>>>>> vfind iFile iIndex lt // Find last
87890>>>>>>> if (found) get_field_value iFile iField to iVal
87895>>>>>>> else move 0 to iVal
87897>>>>>>> increment iVal
87898>>>>>>> clear iFile
87899>>>>>>> if iRec begin
87901>>>>>>> set_field_value iFile 0 to iRec
87904>>>>>>> vfind iFile 0 eq
87906>>>>>>> end
87906>>>>>>>>
87906>>>>>>> set field_changed_value of ddo# iField to iVal
87907>>>>>>> end
87907>>>>>>>>
87907>>>>>>> else error 1051 "Index must be single segmented"
87909>>>>>>> end
87909>>>>>>>>
87909>>>>>>>end_procedure
87910>>>>>Use FdxField.nui // FDX Field things
87910>>>>>
87910>>>>>object DDC_PrivateObject is a cArray NO_IMAGE
87912>>>>> property integer pbUseGenericDD public DFTRUE
87914>>>>> property integer phDefaultDDClass public U_DataDictionary
87916>>>>> property integer phParent public 0
87918>>>>> property string priv.psVisitedFiles public ""
87920>>>>> property integer priv.phChildDDOHandle public 0
87922>>>>> property integer priv.phCutOffDDHandle public 0
87924>>>>> property integer priv.phCutOffDDFile public 0
87926>>>>>
87926>>>>> item_property_list
87926>>>>> item_property integer piFile.i
87926>>>>> item_property string psRootName.i
87926>>>>> end_item_property_list
#REM 87963 DEFINE FUNCTION PSROOTNAME.I INTEGER LIROW RETURNS STRING
#REM 87968 DEFINE PROCEDURE SET PSROOTNAME.I INTEGER LIROW STRING VALUE
#REM 87973 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 87978 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
87984>>>>>
87984>>>>> procedure WS_OnCloseWorkSpace
87987>>>>> set delegation_mode to DELEGATE_TO_PARENT
87988>>>>> send delete_data
87989>>>>> end_procedure
87990>>>>>
87990>>>>> function sFindRootName.is integer liFile string lsRoot returns integer
87993>>>>> integer liRow liMax
87993>>>>> move (lowercase(lsRoot)) to lsRoot
87994>>>>> get row_count to liMax
87995>>>>> decrement liMax
87996>>>>> for liRow from 0 to liMax
88002>>>>>>
88002>>>>> if (psRootName.i(self,liRow)=lsRoot) function_return liRow
88005>>>>> loop
88006>>>>>>
88006>>>>> set piFile.i (liMax+1) to liFile
88007>>>>> set psRootName.i (liMax+1) to lsRoot
88008>>>>> function_return -1
88009>>>>> end_function
88010>>>>>
88010>>>>> function bOpenAlias.i integer liFile returns integer
88013>>>>> integer liRval liRow
88013>>>>> string lsRoot
88013>>>>> get FDX_AttrValue_FILELIST ghFDX DF_FILE_ROOT_NAME liFile to lsRoot
88014>>>>> get sFindRootName.is liFile lsRoot to liRow
88015>>>>> if (liRow<>-1) begin
88017>>>>> set_attribute DF_FILE_MODE of (piFile.i(self,liRow)) to DF_FILE_IS_MASTER
88020>>>>> function_return DFTRUE
88021>>>>> end
88021>>>>>>
88021>>>>> function_return DFFALSE
88022>>>>> end_function
88023>>>>>
88023>>>>> procedure DoOpenFile integer liFile
88026>>>>> integer lbAlias
88026>>>>> ifnot (DBMS_IsOpenFile(liFile)) begin
88028>>>>> if (DBMS_OpenFile(liFile,DF_SHARE,0)) begin
88030>>>>> get bOpenAlias.i liFile to lbAlias
88031>>>>> if lbAlias set_attribute DF_FILE_MODE of liFile to DF_FILE_IS_ALIAS
88036>>>>> end
88036>>>>>>
88036>>>>> else begin
88037>>>>> send error 439 "Table could not be opened:" liFile
88038>>>>> end
88038>>>>>>
88038>>>>> end
88038>>>>>>
88038>>>>> end_procedure
88039>>>>>
88039>>>>> object oStack is a cStack NO_IMAGE
88041>>>>> end_object
88042>>>>>
88042>>>>> procedure push_handle
88045>>>>> send push.i to (oStack(self)) (priv.phChildDDOHandle(self))
88046>>>>> end_procedure
88047>>>>> procedure pop_handle
88050>>>>> set priv.phChildDDOHandle to (iPop(oStack(self)))
88051>>>>> end_procedure
88052>>>>> function bIsVisited integer liFile returns integer
88055>>>>> integer lbRval
88055>>>>> string lsValue
88055>>>>> get priv.psVisitedFiles to lsValue
88056>>>>> if (IsIntegerPresent(lsValue,liFile)) move DFTRUE to lbRval
88059>>>>> else begin
88060>>>>> get AddIntegerToString lsValue liFile to lsValue
88061>>>>> set priv.psVisitedFiles to lsValue
88062>>>>> move DFFALSE to lbRval
88063>>>>> end
88063>>>>>>
88063>>>>> function_return lbRval
88064>>>>> end_function
88065>>>>>
88065>>>>> function iCreateDDO.i integer liFile returns integer
88068>>>>> integer lhClass lhRval lhSelf lbWasGeneric liMax liRow liSysFile
88068>>>>> send DoOpenFile liFile
88069>>>>> if (pbUseGenericDD(self)) get DataDictionary_Class liFile to lhClass
88072>>>>> else move 0 to lhClass
88074>>>>> if lhClass move DFTRUE to lbWasGeneric
88077>>>>> else begin
88078>>>>> get phDefaultDDClass to lhClass
88079>>>>> move DFFALSE to lbWasGeneric
88080>>>>> end
88080>>>>>>
88080>>>>>
88080>>>>> name lhClass U_DDC_Class
88080>>>>> move self to lhSelf
88081>>>>> get phParent to self
88082>>>>> object oDD is a DDC_Class
88084>>>>> move self to lhRval
88085>>>>> if lbWasGeneric begin
88087>>>>> get System_File_Count to liMax
88088>>>>> decrement liMax
88089>>>>> for liRow from 0 to liMax
88095>>>>>>
88095>>>>> get System_File_Number liRow to liSysFile
88096>>>>> send DoOpenFile liSysFile
88097>>>>> loop
88098>>>>>>
88098>>>>> end
88098>>>>>>
88098>>>>> else begin
88099>>>>> set main_file to liFile
88100>>>>> send DDUTIL_DoQuickSetup self
88101>>>>> end
88101>>>>>>
88101>>>>> end_object
88102>>>>> move lhSelf to self
88103>>>>> function_return lhRval
88104>>>>> end_function
88105>>>>>
88105>>>>> procedure HandleAddField integer liFile integer liField string lsName integer liType integer liLen integer liPrec integer liRelFile integer liRelField integer liIndex integer liOffSet
88108>>>>> integer lhGrb
88108>>>>> if liRelFile begin
88110>>>>> if (FDX_CanOpenFile(ghFDX,liRelFile)) begin
88112>>>>> get iCreateParentDDOStructure liRelFile to lhGrb
88113>>>>> end
88113>>>>>>
88113>>>>> end
88113>>>>>>
88113>>>>> end_procedure
88114>>>>>
88114>>>>> function iCreateParentDDOStructure integer liFile returns integer
88117>>>>> integer lhRval lhChildDD
88117>>>>> ifnot (bIsVisited(self,liFile)) begin
88119>>>>>
88119>>>>> if (liFile=priv.phCutOffDDFile(self)) get priv.phCutOffDDHandle to lhRval
88122>>>>> else get iCreateDDO.i liFile to lhRval
88124>>>>>
88124>>>>> get priv.phChildDDOHandle to lhChildDD
88125>>>>> if lhChildDD set DDO_Server of lhChildDD to lhRval
88128>>>>>
88128>>>>> if (liFile<>priv.phCutOffDDFile(self)) begin
88130>>>>> send push_handle
88131>>>>> set priv.phChildDDOHandle to lhRval
88132>>>>> send FDX_FieldCallBack ghFDX liFile MSG_HandleAddField self // Protected against relating file not present
88133>>>>> send pop_handle
88134>>>>> end
88134>>>>>>
88134>>>>> end
88134>>>>>>
88134>>>>> function_return lhRval
88135>>>>> end_function
88136>>>>>
88136>>>>> function iCreateDDOStructure integer lhParent integer liFile integer lbUseGeneric integer lhDefaultDDClass returns integer
88139>>>>> integer lhRval
88139>>>>> set pbUseGenericDD to lbUseGeneric
88140>>>>> set phDefaultDDClass to lhDefaultDDClass
88141>>>>> set phParent to lhParent
88142>>>>> set priv.phChildDDOHandle to 0
88143>>>>> set priv.psVisitedFiles to ""
88144>>>>> send delete_data to (oStack(self))
88145>>>>> set priv.phCutOffDDFile to 0
88146>>>>> set priv.phCutOffDDHandle to 0
88147>>>>> get iCreateParentDDOStructure liFile to lhRval
88148>>>>> set priv.phCutOffDDFile to liFile
88149>>>>> set priv.phCutOffDDHandle to lhRval
88150>>>>> function_return lhRval
88151>>>>> end_function
88152>>>>>
88152>>>>> function iCreateChildDDOStructure integer liFile returns integer
88155>>>>> integer lhRval
88155>>>>> send delete_data to (oStack(self))
88156>>>>> set priv.psVisitedFiles to ""
88157>>>>> get iCreateParentDDOStructure liFile to lhRval
88158>>>>> set priv.phCutOffDDFile to liFile
88159>>>>> set priv.phCutOffDDHandle to lhRval
88160>>>>> function_return lhRval
88161>>>>> end_function
88162>>>>>
88162>>>>> // We need to put the object ID's of the doomed DD's into an
88162>>>>> // array instead of destroying them as we go along. The reason
88162>>>>> // is that the internal arrays of "server"- and "client"- DD's
88162>>>>> // are updated automatically when a DD present in one of those
88162>>>>> // arrays is destroyed.
88162>>>>>
88162>>>>> object oDoomedDDOs is a cArray
88164>>>>> procedure destroy_all
88167>>>>> integer liItem liMax
88167>>>>> get item_count to liMax
88168>>>>> decrement liMax
88169>>>>> for liItem from 0 to liMax
88175>>>>>>
88175>>>>> send destroy to (integer(value(self,liItem)))
88176>>>>> loop
88177>>>>>>
88177>>>>> send delete_data
88178>>>>> end_procedure
88179>>>>> procedure add_dd integer lhDD
88182>>>>> integer liItem
88182>>>>> if lhDD begin
88184>>>>> get item_count to liItem
88185>>>>> set value item liItem to lhDD
88186>>>>> end
88186>>>>>>
88186>>>>> end_procedure
88187>>>>> end_object
88188>>>>>
88188>>>>> procedure DestroyDDOStructure_Help integer lhDD
88191>>>>> integer liMax liItm lhDDO lhStack
88191>>>>> move (oStack(self)) to lhStack
88192>>>>>
88192>>>>> ifnot (bIsOnStack.i(lhStack,lhDD)) begin
88194>>>>> send push.i to lhStack lhDD
88195>>>>>
88195>>>>> get data_set_client_count of lhDD to liMax
88196>>>>> decrement liMax
88197>>>>> for liItm from 0 to liMax
88203>>>>>>
88203>>>>> get data_set_client of lhDD item liItm to lhDDO
88204>>>>> send DestroyDDOStructure_Help lhDDO
88205>>>>> loop
88206>>>>>>
88206>>>>>
88206>>>>> get data_set_server_count of lhDD to liMax
88207>>>>> decrement liMax
88208>>>>> for liItm from 0 to liMax
88214>>>>>>
88214>>>>> get data_set_server of lhDD item liItm to lhDDO
88215>>>>> send DestroyDDOStructure_Help lhDDO
88216>>>>> loop
88217>>>>>>
88217>>>>>
88217>>>>> send Drop to lhStack
88218>>>>> send add_dd to (oDoomedDDOs(self)) lhDD
88219>>>>> end
88219>>>>>>
88219>>>>> end_procedure
88220>>>>>
88220>>>>> procedure DestroyDDOStructure integer lhDD
88223>>>>> send delete_data to (oStack(self))
88224>>>>> send DestroyDDOStructure_Help lhDD
88225>>>>> send delete_data to (oStack(self))
88226>>>>> send destroy_all to (oDoomedDDOs(self))
88227>>>>> end_procedure
88228>>>>>end_object // DDC_PrivateObject
88229>>>>>
88229>>>>>//> Create a DDO structure and returns the handle for the "root" DDO.
88229>>>>>function DDC_CreateDDOStructure global integer lhParent integer liFile integer lbUseGeneric integer lhDefaultDDClass returns integer
88231>>>>> function_return (iCreateDDOStructure(DDC_PrivateObject(self),lhParent,liFile,lbUseGeneric,lhDefaultDDClass))
88232>>>>>end_function
88233>>>>>
88233>>>>>function DDC_CreateChildDDOStructure global integer liFile returns integer
88235>>>>> function_return (iCreateChildDDOStructure(DDC_PrivateObject(self),liFile))
88236>>>>>end_function
88237>>>>>
88237>>>>>procedure DDC_DestroyDDOStructure global integer lhDD
88239>>>>> send DestroyDDOStructure to (DDC_PrivateObject(self)) lhDD
88240>>>>>end_procedure
88241>>>>>
88241>>>>>//> Using this procedure will make sure that Master/Alias is always set correctly.
88241>>>>>procedure DDC_OpenFile global integer liFile
88243>>>>> send DoOpenFile to (DDC_PrivateObject(self)) liFile
88244>>>>>end_procedure
88245>>>>>
88245>>>>> object oDDC_OpenFileInclParents is a cArray
88247>>>>> property integer pbRegisterDdoClasses public 0
88249>>>>> procedure HandleField integer liFile integer liField string lsName integer liType integer liLen integer liPrec integer liRelFile integer liRelField integer liIndex integer liOffSet
88252>>>>> if liRelFile begin
88254>>>>> if (FDX_CanOpenFile(0,liRelFile)) begin
88256>>>>> send OpenFile.i liRelFile
88257>>>>> end
88257>>>>>>
88257>>>>> end
88257>>>>>>
88257>>>>> end_procedure
88258>>>>> procedure OpenFile.i integer liFile
88261>>>>> integer lbRegisterDdoClasses lbGarbage
88261>>>>> get pbRegisterDdoClasses to lbRegisterDdoClasses
88262>>>>> ifnot (integer(value(self,liFile))) begin
88264>>>>> send DDC_OpenFile liFile
88265>>>>> if (DBMS_IsOpenFile(liFile)) begin
88267>>>>> if lbRegisterDdoClasses begin
88269>>>>> get iDD_Object liFile to lbGarbage // Create if can be done
88270>>>>> end
88270>>>>>>
88270>>>>> send FDX_FieldCallBack 0 liFile MSG_HandleField self // Protected against relating file not present
88271>>>>> end
88271>>>>>>
88271>>>>> end
88271>>>>>>
88271>>>>> end_procedure
88272>>>>> end_object
88273>>>>>
88273>>>>>//> Open file and it's parents making sure that Master/Alias is set according to the rules.
88273>>>>>//> If lbRegisterDdoClasses is true DDO objects will be created (but not connected) and registered
88273>>>>>//> with fieldinf.pkg
88273>>>>>procedure DDC_OpenFileInclParents global integer liFile integer lbRegisterDdoClasses
88275>>>>> integer lhDDC_OpenFileInclParents
88275>>>>> move oDDC_OpenFileInclParents to lhDDC_OpenFileInclParents
88276>>>>> send delete_data of lhDDC_OpenFileInclParents
88277>>>>> set pbRegisterDdoClasses of lhDDC_OpenFileInclParents to lbRegisterDdoClasses
88278>>>>> send OpenFile.i of lhDDC_OpenFileInclParents liFile lbRegisterDdoClasses
88279>>>>> send delete_data of lhDDC_OpenFileInclParents
88280>>>>>end_procedure
88281>>>>>
88281>>>
88281>>>function FastView_DDProbe integer liFile integer liField integer liWhat returns string
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
88283>>> integer lhDD
88283>>> string lsRval
88283>>> if (FastView_GenericDDsApplicable()) begin
88285>>> send DDC_OpenFile liFile
88286>>> get iDD_Object liFile to lhDD // Defined in fieldinf.pkg
88287>>> if lhDD begin
88289>>> if (liWhat=DDP_CLASS) get Field_Class_Name of lhDD liField to lsRval
88292>>> end
88292>>>>
88292>>> end
88292>>>>
88292>>> function_return lsRval
88293>>>end_function
88294>>>
88294>>>
88294>>>define DEBUG$BYPASSWARNING for 1
88294>>>Use DD_Debug.utl // DDO States on Ctrl+F1
Including file: dd_debug.utl (C:\Apps\VDFQuery\AppSrc\dd_debug.utl)
88294>>>>>// Use DD_Debug.utl // DDO Starts on Ctrl+F1 (if not WebApp)
88294>>>>> Use APS // Auto Positioning and Sizing classes for VDF
88294>>>>> Use ApsTree.pkg // APS version of TreeView class
Including file: apstree.pkg (C:\Apps\VDFQuery\AppSrc\apstree.pkg)
88294>>>>>>>// Use ApsTree.pkg // APS version of TreeView class
88294>>>>>>>Use APS // Auto Positioning and Sizing classes for VDF
88294>>>>>>>Use DFTreeVw.pkg // DAC TreeView class
88294>>>>>>>
88294>>>>>>>class aps.TreeView is a TreeView startmac APS.STARTMAC_SNAP
88295>>>>>>> procedure construct_object
88297>>>>>>> forward send construct_object
88299>>>>>>> send define_aps_control_mx
88300>>>>>>> set p_auto_size_control_state to false
88301>>>>>>> end_procedure
88302>>>>>>> import_class_protocol aps_control_mx
88303>>>>>>> procedure end_construct_object
88305>>>>>>> forward send end_construct_object
88307>>>>>>> send end_define_aps_control_mx
88308>>>>>>> end_procedure
88309>>>>>>>//Procedure CallBack_Branch.hii handle hRoot# integer msg# integer obj#
88309>>>>>>>// handle hTest# hCurrent# hStop#
88309>>>>>>>// move hRoot# to hCurrent#
88309>>>>>>>// get NextSiblingItem hCurrent# to hStop#
88309>>>>>>>// while hCurrent# ne hStop#
88309>>>>>>>// send msg# to obj# hCurrent#
88309>>>>>>>// get ChildItem hCurrent# to hTest#
88309>>>>>>>// if hTest# move hTest# to hCurrent#
88309>>>>>>>// else begin // No children
88309>>>>>>>// get NextSiblingItem hCurrent# to hTest#
88309>>>>>>>// if hTest# move hTest# to hCurrent#
88309>>>>>>>// else begin // No siblings either
88309>>>>>>>// while (hCurrent# and not(htest#))
88309>>>>>>>// get ParentItem hCurrent# to hCurrent# // Back one
88309>>>>>>>// if hCurrent# begin
88309>>>>>>>// get NextSiblingItem hCurrent# to hTest#
88309>>>>>>>// if hTest# move hTest# to hCurrent#
88309>>>>>>>// end
88309>>>>>>>// end // while
88309>>>>>>>// end
88309>>>>>>>// end
88309>>>>>>>// end // while
88309>>>>>>>//End_Procedure
88309>>>>>>> Procedure CallBack_Branch.hii handle lhRoot integer lhMsg integer lhObj
88311>>>>>>> integer lhItem
88311>>>>>>> send lhMsg to lhObj lhRoot
88312>>>>>>> get ChildItem lhRoot to lhItem
88313>>>>>>> while lhItem
88317>>>>>>> send CallBack_Branch.hii lhItem lhMsg lhObj
88318>>>>>>> get NextSiblingItem lhItem to lhItem
88319>>>>>>> end
88320>>>>>>>>
88320>>>>>>> End_Procedure
88321>>>>>>> Procedure CallBack_Root.ii integer msg# integer obj#
88323>>>>>>> handle hRoot#
88323>>>>>>> get RootItem to hRoot#
88324>>>>>>> send CallBack_Branch.hii hRoot# msg# obj#
88325>>>>>>> End_Procedure
88326>>>>>>>end_class
88327>>>>> Use FdxField.nui // FDX Field things
88327>>>>> Use Focus.utl // Retrieve basic information about object
88327>>>>> Use Buttons.utl // Button texts
88327>>>>> Use FdxUiCls.pkg // UI classes for displaying FDX data
Including file: fdxuicls.pkg (C:\Apps\VDFQuery\AppSrc\fdxuicls.pkg)
88327>>>>>>>// Use FdxUiCls.pkg // UI classes for displaying FDX data
88327>>>>>>>
88327>>>>>>>Use APS // Auto Positioning and Sizing classes for VDF
88327>>>>>>>Use ApsTree.pkg // APS version of TreeView class
88327>>>>>>>Use FdxField.nui // FDX Field things
88327>>>>>>>Use Strings.nui // String manipulation for VDF (No User Interface)
88327>>>>>>>Use FDX_Attr.nui // FDX compatible attribute functions
88327>>>>>>>Use Buttons.utl // Button texts
88327>>>>>>>Use Fdx2.utl // FDX aware object for displaying a table definition
88327>>>>>>>//Use Version.nui
88327>>>>>>>Use FdxTable.nui // Procedure FDX_TablesCallback ...
Including file: fdxtable.nui (C:\Apps\VDFQuery\AppSrc\fdxtable.nui)
88327>>>>>>>>>// Use FdxTable.nui // Procedure FDX_TablesCallback ...
88327>>>>>>>>>
88327>>>>>>>>>Use FDX.nui // cFDX class
88327>>>>>>>>>Use FDX_Attr.nui // FDX compatible attribute functions
88327>>>>>>>>>
88327>>>>>>>>>//> Call back for all tables in filelist.cfg
88327>>>>>>>>>procedure FDX_TablesCallback global integer lhFDX integer lhMsg integer lhObj
88329>>>>>>>>> integer liFile
88329>>>>>>>>> string lsRoot lsLogical lsDisplay
88329>>>>>>>>> move 0 to liFile
88330>>>>>>>>> repeat
88330>>>>>>>>>>
88330>>>>>>>>> move (FDX_AttrValue_FLSTNAV(lhFDX,DF_FILE_NEXT_USED,liFile)) to liFile
88331>>>>>>>>> if liFile begin
88333>>>>>>>>> get FDX_AttrValue_FILELIST lhFDX DF_FILE_ROOT_NAME liFile to lsRoot
88334>>>>>>>>> get FDX_AttrValue_FILELIST lhFDX DF_FILE_LOGICAL_NAME liFile to lsLogical
88335>>>>>>>>> get FDX_AttrValue_FILELIST lhFDX DF_FILE_DISPLAY_NAME liFile to lsDisplay
88336>>>>>>>>> move (rtrim(lsDisplay)) to lsDisplay
88337>>>>>>>>> send lhMsg to lhObj liFile lsRoot lsLogical lsDisplay
88338>>>>>>>>> // procedure HandleTable integer liFile string lsRoot string lsLogical string lsDisplay
88338>>>>>>>>> end
88338>>>>>>>>>>
88338>>>>>>>>> until liFile eq 0
88340>>>>>>>>>end_procedure
88341>>>>>>>>>
88341>>>>>>>>> desktop_section
88346>>>>>>>>> object oConstrainedTablesCallbackHelp is a cArray
88348>>>>>>>>> property integer phFDX
88350>>>>>>>>> procedure HandleRelation integer liType integer liFromFile integer liFromField integer liToFile integer liToField
88353>>>>>>>>> // We assume that ToFile.ToField is uniquely indexed
88353>>>>>>>>> integer liIndex lhFdx
88353>>>>>>>>> get phFDX to lhFdx
88354>>>>>>>>> get FDX_IndexFindMatching lhFDX liFromFile (FDX_FieldsTranslateOverlaps(lhFdx,liFromFile,liFromField)) 0 to liIndex
88355>>>>>>>>> if liIndex set value item liFromFile to 1
88358>>>>>>>>> end_procedure
88359>>>>>>>>> end_object
88360>>>>>>>>> end_desktop_section
88365>>>>>>>>>
88365>>>>>>>>>//> Call back for all tables relating to liConstrainFile and that have an index that
88365>>>>>>>>>//> allows for sensible constraining.
88365>>>>>>>>>procedure FDX_ConstrainedTablesCallback global integer lhFDX integer liConstrainFile integer lhMsg integer lhObj
88367>>>>>>>>> integer lhTmp liFile liMax
88367>>>>>>>>> string lsRoot lsLogical lsDisplay
88367>>>>>>>>> move (oConstrainedTablesCallbackHelp(self)) to lhTmp
88368>>>>>>>>> send delete_data of lhTmp
88369>>>>>>>>> if lhFDX begin
88371>>>>>>>>> set phFDX of lhTmp to lhFDX
88372>>>>>>>>> send Callback_Relations to lhFDX MSG_HandleRelation lhFdx FDX_RELORIG_GENERIC 0 liConstrainFile
88373>>>>>>>>> get item_count of lhTmp to liMax
88374>>>>>>>>> decrement liMax
88375>>>>>>>>> for liFile from 1 to liMax
88381>>>>>>>>>>
88381>>>>>>>>> if (integer(value(lhTmp,liFile))) begin
88383>>>>>>>>> get FDX_AttrValue_FILELIST lhFDX DF_FILE_ROOT_NAME liFile to lsRoot
88384>>>>>>>>> get FDX_AttrValue_FILELIST lhFDX DF_FILE_LOGICAL_NAME liFile to lsLogical
88385>>>>>>>>> get FDX_AttrValue_FILELIST lhFDX DF_FILE_DISPLAY_NAME liFile to lsDisplay
88386>>>>>>>>> move (rtrim(lsDisplay)) to lsDisplay
88387>>>>>>>>> send lhMsg to lhObj liFile lsRoot lsLogical lsDisplay
88388>>>>>>>>> // procedure HandleTable integer liFile string lsRoot string lsLogical string lsDisplay
88388>>>>>>>>> end
88388>>>>>>>>>>
88388>>>>>>>>> loop
88389>>>>>>>>>>
88389>>>>>>>>> end
88389>>>>>>>>>>
88389>>>>>>>>> else error 429 "lhFDX must be specified in FDX_ConstrainedTablesCallback call"
88391>>>>>>>>> send delete_data of lhTmp
88392>>>>>>>>>end_procedure
88393>>>>>>>>>
88393>>>>>>>
88393>>>>>>>class Fdx.TreeViewFieldSelectorImageList is a cImageList
88394>>>>>>> procedure construct_object
88396>>>>>>> forward send construct_object
88398>>>>>>> set piMaxImages To 3
88399>>>>>>> property integer pbImageError public DFFALSE
88400>>>>>>> end_procedure
88401>>>>>>> function AddImageAutoPath string lsBitmap returns integer
88403>>>>>>> Integer liImage
88403>>>>>>> string lsDir lsPath
88403>>>>>>> get AddTransparentImage lsBitmap clFuchsia To liImage
88404>>>>>>> if (liImage=-1) begin
88406>>>>>>> get_profile_string "WorkSpaces" "SystemDFPath" to lsPath
88409>>>>>>> get SEQ_FindFileAlongPath lsPath lsBitmap to lsDir
88410>>>>>>> if (lsDir<>"") get AddTransparentImage (SEQ_ComposeAbsoluteFileName(lsDir,lsBitmap)) clFuchsia To liImage
88413>>>>>>> end
88413>>>>>>>>
88413>>>>>>> function_return liImage
88414>>>>>>> end_function
88415>>>>>>> Procedure OnCreate // add the images
88417>>>>>>> integer liImage lbError
88417>>>>>>> move DFFALSE to lbError
88418>>>>>>> get AddImageAutoPath 'Clsfldof.bmp' to liImage
88419>>>>>>> if (liImage=-1) move DFTRUE to lbError
88422>>>>>>> get AddImageAutoPath 'Clsfldon.bmp' to liImage
88423>>>>>>> if (liImage=-1) move DFTRUE to lbError
88426>>>>>>> get AddImageAutoPath 'Cls_Tab.bmp' to liImage
88427>>>>>>> if (liImage=-1) move DFTRUE to lbError
88430>>>>>>> set pbImageError to lbError
88431>>>>>>>// Get AddTransparentImage 'Clsfldof.bmp' clFuchsia To iImage
88431>>>>>>>// Get AddTransparentImage 'Clsfldon.bmp' clFuchsia To iImage
88431>>>>>>>// Get AddTransparentImage 'Cls_Tab.bmp' clFuchsia To iImage
88431>>>>>>>// Get AddTransparentImage 'xzynaksu.bmp' clNone To iImage
88431>>>>>>> End_Procedure
88432>>>>>>>end_class // Fdx.TreeViewFieldSelectorImageList
88433>>>>>>>
88433>>>>>>>class Fdx.TreeViewFieldSelector is a aps.TreeView
88434>>>>>>> procedure construct_object
88436>>>>>>> forward send construct_object
88438>>>>>>> property string priv.psVisitedFiles public ""
88439>>>>>>> property integer priv.pbRecursive public 0
88440>>>>>>> property integer priv.phCurrentItemHandle public 0
88441>>>>>>> property integer priv.phFDX public 0
88442>>>>>>> property integer priv.piFile public 0
88443>>>>>>> property string priv.psValue public ""
88444>>>>>>> object oStack is a cStack NO_IMAGE
88446>>>>>>> end_object
88447>>>>>>> property integer pbMultiSelectState public false //> Select more than one field at a time
88448>>>>>>> property integer pbExcludeOverlaps public false //> Do not display overlap fields
88449>>>>>>> property integer pbExcludeRelatingFields public false //> Leave out the relating field itself
88450>>>>>>> property integer pbExcludeAllFields public false //> Overrules all of the above
88451>>>>>>> On_Key kEnter Send Default_Key
88452>>>>>>> On_Key key_space send ToggleSelectStateCurrentItem
88453>>>>>>> On_Key KEY_CTRL+KEY_I send DisplayTableDefinition
88454>>>>>>> end_procedure
88455>>>>>>>
88455>>>>>>> procedure OnFileSelect integer liFile
88457>>>>>>> end_procedure
88458>>>>>>> procedure OnFieldSelect integer liFile integer liField
88460>>>>>>> end_procedure
88461>>>>>>> procedure OnFileCurrent integer liFile
88463>>>>>>> end_procedure
88464>>>>>>> procedure OnFieldCurrent integer liFile integer liField
88466>>>>>>> end_procedure
88467>>>>>>>
88467>>>>>>> function iFindFileHelp integer liFile integer lhRoot returns integer
88469>>>>>>> integer lhItem liTest lhRval
88469>>>>>>> get ItemData lhRoot to liTest
88470>>>>>>> if (liTest=liFile) function_return lhRoot
88473>>>>>>>
88473>>>>>>> get ChildItem lhRoot to lhItem
88474>>>>>>> while lhItem
88478>>>>>>> get ItemData lhItem to liTest
88479>>>>>>> if (liTest=liFile) function_return lhItem
88482>>>>>>> get NextSiblingItem lhItem to lhItem
88483>>>>>>> end
88484>>>>>>>>
88484>>>>>>> function_return 0
88485>>>>>>> end_function
88486>>>>>>>
88486>>>>>>> function iFindFile integer liFile returns integer
88488>>>>>>> integer lhRoot
88488>>>>>>> get RootItem to lhRoot
88489>>>>>>> if lhRoot function_return (iFindFileHelp(self,liFile,lhRoot))
88492>>>>>>> function_return 0
88493>>>>>>> end_function
88494>>>>>>>
88494>>>>>>> procedure GotoFile integer liFile
88496>>>>>>> integer lhItem
88496>>>>>>> get iFindFile liFile to lhItem
88497>>>>>>> if (lhItem<>0) set CurrentTreeItem to lhItem
88500>>>>>>> end_procedure
88501>>>>>>>
88501>>>>>>> procedure OnItemChanged handle lhItem handle lhItemOld
88503>>>>>>> integer liFile liField
88503>>>>>>> get ItemData lhItem to liFile
88504>>>>>>> if (liFile<65536) send OnFileCurrent liFile
88507>>>>>>> else begin
88508>>>>>>> move (mod(liFile,65536)) to liField
88509>>>>>>> move (liFile/65536) to liFile
88510>>>>>>> send OnFieldCurrent liFile liField
88511>>>>>>> end
88511>>>>>>>>
88511>>>>>>> end_procedure
88512>>>>>>>
88512>>>>>>> procedure OnItemDblClick Handle lhItem
88514>>>>>>> integer liFile liField
88514>>>>>>> ifnot (pbMultiSelectState(self)) begin
88516>>>>>>> get ItemData lhItem to liFile
88517>>>>>>> if (liFile<65536) send OnFileSelect liFile
88520>>>>>>> else begin
88521>>>>>>> move (mod(liFile,65536)) to liField
88522>>>>>>> move (liFile/65536) to liFile
88523>>>>>>> send OnFieldSelect liFile liField
88524>>>>>>> end
88524>>>>>>>>
88524>>>>>>> end
88524>>>>>>>>
88524>>>>>>> end_procedure
88525>>>>>>> procedure OnItemEnter
88527>>>>>>> send OnItemDblClick (CurrentTreeItem(self))
88528>>>>>>> end_procedure
88529>>>>>>>
88529>>>>>>> procedure push_handle
88531>>>>>>> send push.i to (oStack(self)) (priv.phCurrentItemHandle(self))
88532>>>>>>> end_procedure
88533>>>>>>> procedure pop_handle
88535>>>>>>> set priv.phCurrentItemHandle to (iPop(oStack(self)))
88536>>>>>>> end_procedure
88537>>>>>>>
88537>>>>>>> function bIsVisited integer liFile returns integer
88539>>>>>>> integer lbRval
88539>>>>>>> string lsValue
88539>>>>>>> get priv.psVisitedFiles to lsValue
88540>>>>>>> if (IsIntegerPresent(lsValue,liFile)) move DFTRUE to lbRval
88543>>>>>>> else begin
88544>>>>>>> get AddIntegerToString lsValue liFile to lsValue
88545>>>>>>> set priv.psVisitedFiles to lsValue
88546>>>>>>> move DFFALSE to lbRval
88547>>>>>>> end
88547>>>>>>>>
88547>>>>>>> function_return lbRval
88548>>>>>>> end_function
88549>>>>>>>
88549>>>>>>> procedure HandleAddField integer liFile integer liField string lsName integer liType integer liLen integer liPrec integer liRelFile integer liRelField integer liIndex integer liOffSet
88551>>>>>>> integer lhHandle
88551>>>>>>>
88551>>>>>>> if (not(pbExcludeAllFields(self))) begin
88553>>>>>>> if (not(pbExcludeRelatingFields(self)) or (liType<>DF_OVERLAP)) begin
88555>>>>>>> if (not(pbExcludeOverlaps(self)) or (liRelFile=0)) begin
88557>>>>>>> if (pbMultiSelectState(self)) ; get AddTreeItem lsName (priv.phCurrentItemHandle(self)) (liFile*65536+liField) 0 0 to lhHandle
88560>>>>>>> else get AddTreeItem lsName (priv.phCurrentItemHandle(self)) (liFile*65536+liField) 0 0 to lhHandle
88562>>>>>>> end
88562>>>>>>>>
88562>>>>>>> else get priv.phCurrentItemHandle to lhHandle
88564>>>>>>> end
88564>>>>>>>>
88564>>>>>>> else get priv.phCurrentItemHandle to lhHandle
88566>>>>>>> end
88566>>>>>>>>
88566>>>>>>> else get priv.phCurrentItemHandle to lhHandle
88568>>>>>>> if (liRelFile and priv.pbRecursive(self)) begin
88570>>>>>>> send push_handle
88571>>>>>>> set priv.phCurrentItemHandle to lhHandle
88572>>>>>>> send HandleAddFile (priv.phFDX(self)) liRelFile
88573>>>>>>> send pop_handle
88574>>>>>>> end
88574>>>>>>>>
88574>>>>>>> end_procedure
88575>>>>>>>
88575>>>>>>> procedure HandleAddFile integer lhFDX integer liFile
88577>>>>>>> integer lhHandle liImage
88577>>>>>>> ifnot (bIsVisited(self,liFile)) begin
88579>>>>>>> if (FDX_CanOpenFile(lhFDX,liFile)) begin
88581>>>>>>> if (pbMultiSelectState(self)) move 2 to liImage
88584>>>>>>> else move 0 to liImage
88586>>>>>>> get AddTreeItem (rtrim(FDX_AttrValue_FILELIST(lhFDX,DF_FILE_DISPLAY_NAME,liFile))) (priv.phCurrentItemHandle(self)) liFile liImage liImage to lhHandle
88587>>>>>>> send push_handle
88588>>>>>>> set priv.phCurrentItemHandle to lhHandle
88589>>>>>>> send FDX_FieldCallBack lhFDX liFile MSG_HandleAddField self // Protected against relating file not present
88590>>>>>>> send pop_handle
88591>>>>>>> send DoExpandItem lhHandle // We want table items to be expanded by default
88592>>>>>>> end
88592>>>>>>>>
88592>>>>>>> end
88592>>>>>>>>
88592>>>>>>> end_procedure
88593>>>>>>>
88593>>>>>>> procedure OnCreateTree
88595>>>>>>> integer lhRoot lhFDX lbRecursive liFile
88595>>>>>>> get priv.phFDX to lhFDX
88596>>>>>>> get priv.pbRecursive to lbRecursive
88597>>>>>>> get priv.piFile to liFile
88598>>>>>>> send delete_data to (oStack(self))
88599>>>>>>> set priv.psVisitedFiles to ""
88600>>>>>>>
88600>>>>>>> get rootitem to lhRoot
88601>>>>>>> if lhRoot send DoDeleteItem lhRoot
88604>>>>>>>
88604>>>>>>> set priv.phCurrentItemHandle to 0
88605>>>>>>> send HandleAddFile lhFDX liFile
88606>>>>>>> get rootitem to lhRoot
88607>>>>>>> if lhRoot send DoExpandItem lhRoot
88610>>>>>>> end_procedure
88611>>>>>>>
88611>>>>>>> procedure fill_list integer lhFDX integer liFile integer lbRecursive
88613>>>>>>> integer lhObj
88613>>>>>>> set priv.phFDX to lhFDX
88614>>>>>>> set priv.pbRecursive to lbRecursive
88615>>>>>>> set priv.piFile to liFile
88616>>>>>>> if (pbMultiSelectState(self)) begin
88618>>>>>>> get ImageListObject to lhObj
88619>>>>>>> if (pbImageError(lhObj)) begin
88621>>>>>>> send obs "Bitmap files that are necessary to display this dialog are not found." "You will not be able to see which fields you have selected." "These following files are needed:" "'Clsfldof.bmp', 'Clsfldon.bmp' and 'Cls_Tab.bmp'"
88622>>>>>>> end
88622>>>>>>>>
88622>>>>>>> end
88622>>>>>>>>
88622>>>>>>> end_procedure
88623>>>>>>>
88623>>>>>>> procedure ToggleSelectState integer lhItem
88625>>>>>>> integer lbSelect liData
88625>>>>>>> if (pbMultiSelectState(self)) begin
88627>>>>>>> get ItemData lhItem to liData
88628>>>>>>> if (liData>65535) begin
88630>>>>>>> get ItemSelectedImage lhItem to lbSelect
88631>>>>>>> set ItemImage lhItem to (not(lbSelect))
88632>>>>>>> set ItemSelectedImage lhItem to (not(lbSelect))
88633>>>>>>> end
88633>>>>>>>>
88633>>>>>>> end
88633>>>>>>>>
88633>>>>>>> end_procedure
88634>>>>>>> procedure ToggleSelectStateCurrentItem
88636>>>>>>> send ToggleSelectState (CurrentTreeItem(self))
88637>>>>>>> end_procedure
88638>>>>>>>
88638>>>>>>> procedure OnItemClick Handle lhItem
88640>>>>>>> send ToggleSelectState lhItem
88641>>>>>>> end_procedure
88642>>>>>>>
88642>>>>>>> procedure CreateImageList
88644>>>>>>> // create an ImageList for the images
88644>>>>>>> // Now assign the ImageList to the TreeView
88644>>>>>>> object oImageList is a Fdx.TreeViewFieldSelectorImageList
88646>>>>>>> end_object
88647>>>>>>> Set ImageListObject To (oImageList(self))
88648>>>>>>> end_procedure
88649>>>>>>>
88649>>>>>>> procedure end_construct_object
88651>>>>>>> forward send end_construct_object
88653>>>>>>> if (pbMultiSelectState(self)) send CreateImageList
88656>>>>>>> end_procedure
88657>>>>>>>
88657>>>>>>> procedure DisplayTableDefinition
88659>>>>>>> integer liFile lhItem
88659>>>>>>> get CurrentTreeItem to lhItem
88660>>>>>>> get ItemData lhItem to liFile
88661>>>>>>> if (liFile>=65536) move (liFile/65536) to liFile
88664>>>>>>> send FDX_ModalDisplayFileAttributes (priv.phFDX(self)) liFile
88665>>>>>>> end_procedure
88666>>>>>>>
88666>>>>>>> procedure AddSelectedFields integer lhItem
88668>>>>>>> integer liFile liField lbSelect liData
88668>>>>>>> string lsValue
88668>>>>>>> get ItemSelectedImage lhItem to lbSelect
88669>>>>>>> if lbSelect begin
88671>>>>>>> get ItemData lhItem to liData
88672>>>>>>> if (liData>65535) begin
88674>>>>>>> move (mod(liData,65536)) to liField
88675>>>>>>> move (liData/65536) to liFile
88676>>>>>>> get priv.psValue to lsValue
88677>>>>>>> move (lsValue+pad(liFile,4)+pad(liField,4)) to lsValue
88678>>>>>>> set priv.psValue to lsValue
88679>>>>>>> end
88679>>>>>>>>
88679>>>>>>> end
88679>>>>>>>>
88679>>>>>>> end_procedure
88680>>>>>>>
88680>>>>>>> function sSelectedFields returns string
88682>>>>>>> string lsRval
88682>>>>>>> if (pbMultiSelectState(self)) begin
88684>>>>>>> set priv.psValue to ""
88685>>>>>>> send CallBack_Root.ii MSG_AddSelectedFields self
88686>>>>>>> get priv.psValue to lsRval
88687>>>>>>> end
88687>>>>>>>>
88687>>>>>>> else move "" to lsRval
88689>>>>>>> function_return lsRval
88690>>>>>>> end_function
88691>>>>>>>end_class // Fdx.TreeViewFieldSelector
88692>>>>>>>
88692>>>>>>>object oFdxTreeViewFieldSelector is a aps.ModalPanel label "Add fields"
88695>>>>>>> set locate_mode to CENTER_ON_SCREEN
88696>>>>>>> on_key ksave_record send close_panel_ok
88697>>>>>>> on_key kcancel send close_panel
88698>>>>>>> property integer piResult public DFFALSE
88700>>>>>>> property string psResultFields public ""
88702>>>>>>>
88702>>>>>>> object oLst is a Fdx.TreeViewFieldSelector
88704>>>>>>> set size to 200 200
88705>>>>>>> set pbMultiSelectState to DFTRUE
88706>>>>>>> end_object
88707>>>>>>> object oBtn1 is a aps.Multi_Button
88709>>>>>>> on_item t.btn.ok send close_panel_ok
88710>>>>>>> end_object
88711>>>>>>> object oBtn2 is a aps.Multi_Button
88713>>>>>>> on_item t.btn.cancel send close_panel
88714>>>>>>> end_object
88715>>>>>>> send aps_locate_multi_buttons
88716>>>>>>> procedure close_panel_ok
88719>>>>>>> set psResultFields to (sSelectedFields(oLst(self)))
88720>>>>>>> set piResult to DFTRUE
88721>>>>>>> send close_panel
88722>>>>>>> end_procedure
88723>>>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
88724>>>>>>> set pMinimumSize to 100 150
88725>>>>>>> procedure aps_onResize integer delta_rw# integer delta_cl#
88728>>>>>>> send aps_resize (oLst(self)) delta_rw# delta_cl#
88729>>>>>>> send aps_register_multi_button (oBtn1(self))
88730>>>>>>> send aps_register_multi_button (oBtn2(self))
88731>>>>>>> send aps_locate_multi_buttons
88732>>>>>>> send aps_auto_size_container
88733>>>>>>> end_procedure
88734>>>>>>> function sPopup.iii integer lhFDX integer liFile integer lbRecursive returns string
88737>>>>>>> set piResult to DFFALSE
88738>>>>>>> send fill_list to (oLst(self)) lhFDX liFile lbRecursive
88739>>>>>>> send popup
88740>>>>>>> if (piResult(self)) function_return (psResultFields(self))
88743>>>>>>> else function_return ""
88745>>>>>>> end_function
88746>>>>>>>end_object // oFdxTreeViewFieldSelector
88747>>>>>>>
88747>>>>>>>function FDX_PopupFdxTreeViewFieldSelector global integer lhFDX integer liFile integer lbRecursive returns string
88749>>>>>>> string lsValue
88749>>>>>>> get sPopup.iii of (oFdxTreeViewFieldSelector(self)) lhFDX liFile lbRecursive to lsValue
88750>>>>>>> function_return lsValue
88751>>>>>>>end_function
88752>>>>>>>
88752>>>>>>>// --- Comboform class for selecting a table
88752>>>>>>>
88752>>>>>>>class Fdx.TableSelectorComboForm is a aps.ComboFormAux
88753>>>>>>> procedure construct_object
88755>>>>>>> forward send construct_object
88757>>>>>>> set combo_sort_state to false // No sorting
88758>>>>>>> set entry_state item 0 to false // No typing
88759>>>>>>> set allow_blank_state to true // Initially blank
88760>>>>>>> set p_abstract to AFT_ASCII40 // Default object size
88761>>>>>>> property integer phFdx public 0
88762>>>>>>> property integer priv.pbOK
88763>>>>>>> on_key KEY_CTRL+KEY_I send DisplayTableDefinition
88764>>>>>>> end_procedure
88765>>>>>>> procedure DisplayTableDefinition
88767>>>>>>> integer liFile
88767>>>>>>> get Combo_Current_Aux_Value to liFile
88768>>>>>>> send FDX_ModalDisplayFileAttributes (phFdx(self)) liFile
88769>>>>>>> end_procedure
88770>>>>>>> procedure HandleTable integer liFile string lsRoot string lsLogical string lsDisplay
88772>>>>>>> send combo_add_item lsDisplay liFile
88773>>>>>>> end_procedure
88774>>>>>>> procedure fill_list integer lhFdx
88776>>>>>>> send Combo_Delete_Data
88777>>>>>>> send combo_add_item "" 0
88778>>>>>>> send FDX_TablesCallback lhFdx MSG_HandleTable self
88779>>>>>>> end_procedure
88780>>>>>>> procedure fill_list_constrained_tables integer lhFdx integer liFile
88782>>>>>>> send Combo_Delete_Data
88783>>>>>>> send combo_add_item "" 0
88784>>>>>>> send FDX_ConstrainedTablesCallback lhFdx liFile MSG_HandleTable self
88785>>>>>>> end_procedure
88786>>>>>>> function iValidateTable.i integer liFile returns integer
88788>>>>>>> function_return (iFindAuxValue(self,liFile)<>-1)
88789>>>>>>> end_function
88790>>>>>>> procedure popup_select_table integer lhFDX
88792>>>>>>> integer liFile lhSelf
88792>>>>>>> string lsValue
88792>>>>>>> if (enabled_state(self)) begin // Only if we haven't been disabled
88794>>>>>>> move self to lhSelf
88795>>>>>>> get Combo_Current_Aux_Value to liFile
88796>>>>>>>// move (iFdxSelectOneFileValidate(lhFDX,liFile,GET_iValidateTable.i,lhSelf)) to liFile
88796>>>>>>> get iFdxSelectOneFileValidate lhFDX liFile GET_iValidateTable.i lhSelf to liFile
88797>>>>>>> if liFile begin
88799>>>>>>> get_attribute DF_FILE_DISPLAY_NAME of liFile to lsValue
88802>>>>>>> set value item 0 to (rtrim(lsValue))
88803>>>>>>> send OnChange
88804>>>>>>> end
88804>>>>>>>>
88804>>>>>>> end
88804>>>>>>>>
88804>>>>>>> end_procedure
88805>>>>>>>end_class // Fdx.TableSelectorComboForm
88806>>>>>>>
88806>>>>>>>// procedure AdvancedTableOpen
88806>>>>>>>// send popup_select_table to (Fdx.TableSelectorComboForm(self))
88806>>>>>>>// end_procedure
88806>>>>>>>//
88806>>>>>>>// object oToolButton is a aps.ToolButton snap SL_RIGHT
88806>>>>>>>// set p_extra_external_width to 1
88806>>>>>>>// send Add_Button ICO_STD_FIND msg_AdvancedTableOpen
88806>>>>>>>// send Add_ToolTip t.DfQuery.tt.AdvTableOpen
88806>>>>>>>// end_object
88806>>>>>>>
88806>>>>> Use Classes.nui // Class characteristics
88806>>>>> Use Fdx2.utl // FDX aware object for displaying a table definition
88806>>>>>
88806>>>>> class cDbg_DDTreeViewImageList is a Fdx.TreeViewFieldSelectorImageList
88807>>>>> procedure construct_object
88809>>>>> forward send construct_object
88811>>>>> set piMaxImages To 1
88812>>>>> end_procedure
88813>>>>> Procedure OnCreate // add the images
88815>>>>> integer liImage lbError
88815>>>>> move DFFALSE to lbError
88816>>>>> get AddImageAutoPath 'Cls_Tab.bmp' to liImage
88817>>>>> if (liImage=-1) move DFTRUE to lbError
88820>>>>> set pbImageError to lbError
88821>>>>> End_Procedure
88822>>>>> end_class // Fdx.TreeViewFieldSelectorImageList
88823>>>>>
88823>>>>> class cDbg_DDTreeView is a aps.TreeView
88824>>>>> procedure construct_object
88826>>>>> forward send construct_object
88828>>>>> property integer phRootDD public 0
88829>>>>> on_key kEnter send Default_Key
88830>>>>> on_key KEY_CTRL+KEY_I send DisplayTableDefinition
88831>>>>> end_procedure
88832>>>>>
88832>>>>> procedure CreateImageList
88834>>>>> object oImageList is a cDbg_DDTreeViewImageList
88836>>>>> end_object
88837>>>>> Set ImageListObject To (oImageList(self))
88838>>>>> end_procedure
88839>>>>>
88839>>>>> procedure Add_DDO integer lhDD integer lhItem
88841>>>>> integer lhParentDD liMax lhNewHandle liFile liItem
88841>>>>> get main_file of lhDD to liFile
88842>>>>> get AddTreeItem (rtrim(FDX_AttrValue_FILELIST(0,DF_FILE_DISPLAY_NAME,liFile))) lhItem lhDD 0 0 to lhNewHandle
88843>>>>> get data_set_server_count of lhDD to liMax
88844>>>>> decrement liMax
88845>>>>> for liItem from 0 to liMax
88851>>>>>>
88851>>>>> get data_set_server of lhDD liItem to lhParentDD
88852>>>>> send Add_DDO lhParentDD lhNewHandle
88853>>>>> loop
88854>>>>>>
88854>>>>> send DoExpandItem lhItem
88855>>>>> end_procedure
88856>>>>>
88856>>>>> procedure DisplayTableDefinition
88858>>>>> integer liFile lhItem lhDD
88858>>>>> get CurrentTreeItem to lhItem
88859>>>>> if lhItem begin
88861>>>>> get ItemData lhItem to lhDD
88862>>>>> get main_file of lhDD to liFile
88863>>>>> send FDX_ModalDisplayFileAttributes 0 liFile
88864>>>>> end
88864>>>>>>
88864>>>>> end_procedure
88865>>>>>
88865>>>>> procedure OnCreateTree
88867>>>>> integer lhRootDD lhRoot
88867>>>>> get rootitem to lhRoot
88868>>>>> if lhRoot send DoDeleteItem lhRoot
88871>>>>>
88871>>>>> get phRootDD to lhRootDD
88872>>>>> send Add_DDO lhRootDD 0
88873>>>>>
88873>>>>> end_procedure
88874>>>>> procedure end_construct_object
88876>>>>> forward send end_construct_object
88878>>>>> send CreateImageList
88879>>>>> end_procedure
88880>>>>> end_class // cDbg_DDTreeView
88881>>>>>
88881>>>>> object oDbgPanel is a aps.ModalPanel label "DDO State"
88884>>>>> on_key kCancel send close_panel
88885>>>>> set locate_mode to CENTER_ON_SCREEN
88886>>>>>
88886>>>>> object oTree is a cDbg_DDTreeView
88888>>>>> set size to 200 125
88889>>>>> procedure OnItemChanged handle lhItemNew handle lhItemOld
88892>>>>> integer lhDD
88892>>>>> get ItemData lhItemNew to lhDD
88893>>>>> send OnNewDataDictionary lhDD
88894>>>>> end_procedure
88895>>>>> end_object
88896>>>>> object oTabs is a aps.TabDiaLog snap SL_RIGHT
88899>>>>> object oTab1 is a aps.TabPage label "Properties"
88902>>>>> set p_auto_column to 0
88903>>>>> object oGrd is a aps.Grid
88905>>>>> send GridPrepare_AddColumn "Name" AFT_ASCII20
88906>>>>> send GridPrepare_AddColumn "Value" AFT_ASCII40
88907>>>>> send GridPrepare_Apply self
88908>>>>> set size to 180 0
88909>>>>> procedure add_value string lsLabel string lsValue
88912>>>>> send add_item msg_none lsLabel
88913>>>>> send add_item msg_none lsValue
88914>>>>> end_procedure
88915>>>>> procedure fill_list.i integer lhDD
88918>>>>> integer liFile
88918>>>>> move (main_file(lhDD)) to liFile
88919>>>>> set dynamic_update_state to DFFALSE
88920>>>>> send delete_data
88921>>>>> send add_value "Main file" (string(liFile))
88922>>>>> send add_value "Filelist Root" (API_AttrValue_FILELIST(DF_FILE_ROOT_NAME ,liFile))
88923>>>>> send add_value "Filelist Logical" (API_AttrValue_FILELIST(DF_FILE_LOGICAL_NAME,liFile))
88924>>>>> send add_value "Filelist Display" (rtrim(API_AttrValue_FILELIST(DF_FILE_DISPLAY_NAME,liFile)))
88925>>>>> send add_value "Current record" (current_record(lhDD))
88926>>>>> send add_value "Changed state" (if(changed_state(lhDD),"True","False"))
88927>>>>> send add_value "Should save" (if(should_save(lhDD),"True","False"))
88928>>>>> send add_value "Read only state" (if(read_only_state(lhDD),"True","False"))
88929>>>>> send Grid_SetEntryState self DFFALSE
88930>>>>> set dynamic_update_state to DFTRUE
88931>>>>> end_procedure
88932>>>>> end_object
88933>>>>> end_object
88934>>>>> object oTab2 is a aps.TabPage label "DD Values"
88937>>>>> object oGrd is a aps.Grid
88939>>>>> send GridPrepare_AddColumn "Field" AFT_ASCII20
88940>>>>> send GridPrepare_AddColumn "Value" AFT_ASCII30
88941>>>>> send GridPrepare_AddColumn "Changed" AFT_ASCII4
88942>>>>> send GridPrepare_Apply self
88943>>>>> set select_mode to MULTI_SELECT
88944>>>>> set size to 180 0
88945>>>>> procedure select_toggling integer itm# integer i#
88948>>>>> end_procedure
88949>>>>> procedure fill_list.i integer lhDD
88952>>>>> integer liMax liField liBase liFile liType
88952>>>>> string lsName lsValue
88952>>>>> set dynamic_update_state to DFFALSE
88953>>>>> send delete_data
88954>>>>> get main_file of lhDD to liFile
88955>>>>> get field_count of lhDD to liMax
88956>>>>> for liField from 0 to liMax
88962>>>>>>
88962>>>>> get item_count to liBase
88963>>>>> get_attribute DF_FIELD_NAME of liFile liField to lsName
88966>>>>> get_attribute DF_FIELD_TYPE of liFile liField to liType
88969>>>>> if (liType<>DF_OVERLAP and liType<>DF_TEXT and liType<>DF_BINARY) begin
88971>>>>> send add_item msg_none lsName
88972>>>>> get field_current_value of lhDD liField to lsValue
88973>>>>> send add_item msg_none lsValue
88974>>>>> send add_item msg_none "" //(field_changed_state(lhDD,liField))
88975>>>>> set checkbox_item_state item (liBase+2) to DFTRUE
88976>>>>> set select_state item (liBase+2) to (field_changed_state(lhDD,liField))
88977>>>>> end
88977>>>>>>
88977>>>>> loop
88978>>>>>>
88978>>>>> send Grid_SetEntryState self DFFALSE
88979>>>>> set dynamic_update_state to DFTRUE
88980>>>>> end_procedure
88981>>>>> end_object
88982>>>>> end_object
88983>>>>> object oTab3 is a aps.TabPage label "DEO objects"
88986>>>>> object oGrd is a aps.Grid
88988>>>>> send GridPrepare_AddColumn "Name" AFT_ASCII50
88989>>>>> send GridPrepare_AddColumn "Changed" AFT_ASCII4
88990>>>>> send GridPrepare_Apply self
88991>>>>> set size to 180 0
88992>>>>> set select_mode to MULTI_SELECT
88993>>>>> procedure select_toggling integer itm# integer i#
88996>>>>> end_procedure
88997>>>>> procedure fill_list.i integer lhDD
89000>>>>> integer liMax liItem lhDEO liBase liClass liFile liField
89000>>>>> string lsValue lsTmp
89000>>>>> set dynamic_update_state to DFFALSE
89001>>>>> send delete_data
89002>>>>> get data_set_user_interface_count of lhDD to liMax
89003>>>>> for liItem from 0 to (liMax-1)
89009>>>>>>
89009>>>>> get item_count to liBase
89010>>>>> get data_set_user_interface of lhDD liItem to lhDEO
89011>>>>>
89011>>>>> get Cls_ObjectClass of lhDEO to liClass
89012>>>>> if (liClass=-1) move "Unknown" to lsValue
89015>>>>> else get Cls_ClassName liClass to lsValue
89017>>>>> move (lsValue+" ("+string(lhDEO)+")") to lsValue
89018>>>>>
89018>>>>> if (liClass<>-1) begin
89020>>>>> // We assume that the object is DB aware
89020>>>>> if (Cls_ClassIsMultiItem(liClass)) begin
89022>>>>> get main_file of lhDEO to liFile
89023>>>>> get_attribute DF_FILE_LOGICAL_NAME of liFile to lsTmp
89026>>>>> move (lsValue+", "+lsTmp) to lsValue
89027>>>>> if (liClass=class.dbGrid) begin
89029>>>>> move (lsValue+", changed_state="+if(changed_state(lhDEO),"T","F")) to lsValue
89030>>>>> move (lsValue+", no_delete_state="+if(no_delete_state(lhDEO),"T","F")) to lsValue
89031>>>>> end
89031>>>>>>
89031>>>>> end
89031>>>>>>
89031>>>>> else begin
89032>>>>> get data_file of lhDEO item 0 to liFile
89033>>>>> get data_field of lhDEO item 0 to liField
89034>>>>> get FDX_FieldName 0 liFile liField DFTRUE to lsTmp
89035>>>>> move (lsValue+", "+lsTmp) to lsValue
89036>>>>> if (liClass=class.dbEdit) move (lsValue+", changed_state="+if(changed_state(lhDEO),"T","F")) to lsValue
89039>>>>> end
89039>>>>>>
89039>>>>> end
89039>>>>>>
89039>>>>> send add_item msg_none lsValue
89040>>>>> send add_item msg_none ""
89041>>>>> set checkbox_item_state item (liBase+1) to true
89042>>>>> set select_state item (liBase+1) to (changed_state(lhDEO))
89043>>>>> loop
89044>>>>>>
89044>>>>> send Grid_SetEntryState self DFFALSE
89045>>>>> set dynamic_update_state to DFTRUE
89046>>>>> end_procedure
89047>>>>> end_object
89048>>>>> end_object
89049>>>>> end_object
89050>>>>> procedure OnNewDataDictionary integer lhDD
89053>>>>> send fill_list.i to (oGrd(oTab1(oTabs(self)))) lhDD
89054>>>>> send fill_list.i to (oGrd(oTab2(oTabs(self)))) lhDD
89055>>>>> send fill_list.i to (oGrd(oTab3(oTabs(self)))) lhDD
89056>>>>> end_procedure
89057>>>>> procedure popup.i integer lhDD
89060>>>>> if lhDD begin
89062>>>>> set phRootDD of (oTree(self)) to lhDD
89063>>>>> send popup
89064>>>>> end
89064>>>>>>
89064>>>>> else send obs "DD objects not found"
89066>>>>> end_procedure
89067>>>>> object oBtn is a aps.Multi_Button
89069>>>>> on_item T.BTN.CLOSE send close_panel
89070>>>>> end_object
89071>>>>> send aps_locate_multi_buttons
89072>>>>> end_object // oDbgPanel
89073>>>>>
89073>>>>>
89073>>>>>procedure Dbg_CurrentFocus global
89075>>>>> send Focus_Analyze_Focus
89076>>>>> send popup.i to (oDbgPanel(self)) (Focus_Info(FOCUS_DD))
89077>>>>>end_procedure
89078>>>>>on_key key_ctrl+key_F1 send Dbg_CurrentFocus
89079>>>>>
89079>>>>>// Use ErrorHnd.nui // cErrorHandlerRedirector class and oErrorHandlerQuiet object (No User Interface)
89079>>>>>//
89079>>>>>// function bIsDate string lsValue returns integer
89079>>>>>// date ldDate
89079>>>>>// send ErrorHnd_Quiet_Activate
89079>>>>>// move lsValue to ldDate
89079>>>>>// send ErrorHnd_Quiet_Deactivate
89079>>>>>// ifnot (ErrorHnd_Quiet_ErrorCount()) function_return (integer(ldDate))
89079>>>>>// function_return DFFALSE
89079>>>>>// end_function
89079>>>>>//
89079>>>>>// procedure testdate string lsDate
89079>>>>>// integer lbOk
89079>>>>>// date ldDate
89079>>>>>// show lsDate " -> "
89079>>>>>// get bIsDate lsDate to lbOk
89079>>>>>// show (if(lbOk,"Good","Bad"))
89079>>>>>// if lbOk begin
89079>>>>>// move lsDate to ldDate
89079>>>>>// show " " ldDate
89079>>>>>// end
89079>>>>>// showln ""
89079>>>>>// end_procedure
89079>>>
89079>>>//Use Debug.utl // Various debug code...
89079>>>
89079>>>Use FdxGlObj.nui // Global FDX object (ghFDX)
89079>>>Use FvOption.pkg
Including file: fvoption.pkg (C:\Apps\VDFQuery\AppSrc\fvoption.pkg)
89079>>>>>Use APS // Auto Positioning and Sizing classes for VDF
89079>>>>>Use Buttons.utl // Button texts
89079>>>>>object oFastView_WSOptions is a aps.ModalPanel label "Options for current WS"
89082>>>>> set locate_mode to CENTER_ON_SCREEN
89083>>>>> on_key ksave_record send close_panel_ok
89084>>>>> on_key kcancel send close_panel
89085>>>>> property integer piResult public DFFALSE
89087>>>>> object oTabs is a aps.TabDialog
89089>>>>> object oTab1 is a aps.TabPage label "FastLoad"
89092>>>>> set p_auto_column to 0
89093>>>>> object oFinishText is an aps.Edit
89095>>>>> set size to 100 250
89096>>>>> set object_shadow_state to true
89097>>>>> set border_style to BORDER_NONE
89098>>>>> set scroll_bar_visible_state to false
89099>>>>> set value item 0 to "If the current workspace takes a long time to load (slow server or a lot of tables) you may use the fastload feature to speed things up."
89100>>>>> set value item 1 to ""
89101>>>>> set value item 2 to "Enabling 'fast load' will create a file with table definitions (FastLoad.fdx) that will be read instead of opening all tables and reading their definitions that way."
89102>>>>> set value item 3 to ""
89103>>>>> set value item 4 to "The back draw is that you must remember to refresh this file when table definitions are changed."
89104>>>>> end_object
89105>>>>> send aps_goto_max_row
89106>>>>> object oTimeStamp is a aps.Form abstract AFT_ASCII40
89109>>>>> set enabled_state to false
89110>>>>> set border_style to BORDER_NONE
89111>>>>> procedure update integer lbHonest
89114>>>>> number lnTime
89114>>>>> string lsValue lsFile
89114>>>>> if lbHonest begin
89116>>>>> move "FastLoad.fdx timestamp: #" to lsValue
89117>>>>> get FastView_FileFullName "FastLoad.fdx" to lsFile
89118>>>>> if (SEQ_FileExists(lsFile)=SEQIT_FILE) begin
89120>>>>> get SEQ_FileModTime lsFile to lnTime
89121>>>>> move (replace("#",lsValue,TS_ConvertToString(lnTime))) to lsValue
89122>>>>> end
89122>>>>>>
89122>>>>> else move "Fastload is disabled" to lsValue
89124>>>>> end
89124>>>>>>
89124>>>>> else move "" to lsValue
89126>>>>> set value item 0 to lsValue
89127>>>>> end_procedure
89128>>>>> end_object
89129>>>>> send aps_goto_max_row
89130>>>>> set p_auto_column to 1
89131>>>>> send tab_column_define 1 35 30 JMODE_LEFT
89132>>>>> object oBtn1 is a aps.Button
89134>>>>> on_item "Enable" send DoEnable
89135>>>>> end_object
89136>>>>> object oBtn2 is a aps.Button snap SL_RIGHT_SPACE
89139>>>>> on_item "Disable" send DoDisable
89140>>>>> end_object
89141>>>>> object oBtn3 is a aps.Button snap SL_RIGHT_SPACE
89144>>>>> on_item "Refresh" send DoRefresh
89145>>>>> end_object
89146>>>>> procedure DoEnable integer lbTemp
89149>>>>> integer liChannel
89149>>>>> get FastView_DirectOutput "FastLoad.fdx" to liChannel
89150>>>>> if (liChannel>=0) begin
89152>>>>> send cursor_wait to (cursor_control(self))
89153>>>>> send Seq_Write to ghFdx liChannel
89154>>>>> send SEQ_CloseOutput liChannel
89155>>>>> send cursor_ready to (cursor_control(self))
89156>>>>> send DoInit
89157>>>>> if (num_arguments=0) send obs "Fastload enabled"
89160>>>>> end
89160>>>>>>
89160>>>>> end_procedure
89161>>>>> procedure DoDisable
89164>>>>> integer liError
89164>>>>> string lsFile
89164>>>>> get FastView_FileFullName "FastLoad.fdx" to lsFile
89165>>>>> if (lsFile<>"") begin
89167>>>>> get wvaWin32_ShDeleteFile lsFile to liError
89168>>>>> // Now read in the actual definitions:
89168>>>>> send cursor_wait to (cursor_control(self))
89169>>>>> send FDXGL_ReadCurrentFileList to ghFDX FDX_ALL_FILES
89170>>>>> send cursor_ready to (cursor_control(self))
89171>>>>> send obs "Fastload disabled"
89172>>>>> end
89172>>>>>>
89172>>>>> send DoInit
89173>>>>> end_procedure
89174>>>>> procedure DoRefreshSilent
89177>>>>> send cursor_wait to (cursor_control(self))
89178>>>>> send FDXGL_ReadCurrentFileList to ghFDX FDX_ALL_FILES
89179>>>>> send cursor_ready to (cursor_control(self))
89180>>>>> send DoEnable DFFALSE
89181>>>>> send DoInit
89182>>>>> end_procedure
89183>>>>> procedure DoRefresh
89186>>>>> send DoRefreshSilent
89187>>>>> send obs "Fastload file refreshed"
89188>>>>> end_procedure
89189>>>>> procedure DoInit
89192>>>>> integer lbExists
89192>>>>> string lsPath
89192>>>>> get FastView_HomeDirectory to lsPath
89193>>>>> if (lsPath="") begin
89195>>>>> set enabled_state of (oBtn1(self)) to DFFALSE // Enable
89196>>>>> set enabled_state of (oBtn2(self)) to DFFALSE // Disable
89197>>>>> set enabled_state of (oBtn3(self)) to DFFALSE // Refresh
89198>>>>> send update of oTimeStamp 0
89199>>>>> end
89199>>>>>>
89199>>>>> else begin
89200>>>>> get FastView_FileExists "FastLoad.fdx" to lbExists
89201>>>>> set enabled_state of (oBtn1(self)) to (not(lbExists))// Enable
89202>>>>> set enabled_state of (oBtn2(self)) to lbExists // Disable
89203>>>>> set enabled_state of (oBtn3(self)) to lbExists // Refresh
89204>>>>> send update of oTimeStamp 1
89205>>>>> end
89205>>>>>>
89205>>>>> end_procedure
89206>>>>> end_object // oTab1
89207>>>>> //object oTab2 is a aps.TabPage label "Query folder"
89207>>>>> // set p_auto_column to 0
89207>>>>> // object oFinishText is an aps.Edit
89207>>>>> // set size to 100 250
89207>>>>> // set object_shadow_state to true
89207>>>>> // set border_style to BORDER_NONE
89207>>>>> // set scroll_bar_visible_state to false
89207>>>>> // set value item 0 to "In order for FastView to generate a menu of known query definitions you need to specify the 'query root folder'"
89207>>>>> // set value item 1 to ""
89207>>>>> // set value item 2 to "This is needed because the name of this folder may vary depending on your country."
89207>>>>> // set value item 3 to ""
89207>>>>> // set value item 4 to "The 'query root folder' is created automatically the first time you save a query definition. It is the folder under which a sub-folder (also automatically) is created for each windows user."
89207>>>>> // set value item 5 to ""
89207>>>>> // set value item 6 to ""
89207>>>>> // set value item 7 to "Enter query root folder:"
89207>>>>> // end_object
89207>>>>> // send aps_goto_max_row
89207>>>>> // object oFolder is a aps.SelectDirForm abstract AFT_ASCII80
89207>>>>> // set p_extra_internal_width to -160
89207>>>>> // set form_button item 0 to 0 // Manually do not add a prompt button
89207>>>>> // end_object
89207>>>>> // send aps_goto_max_row
89207>>>>> // object oBtn1 is a aps.Button
89207>>>>> // on_item "Browse" send prompt of oFolder
89207>>>>> // end_object
89207>>>>> //end_object // oTab2
89207>>>>> end_object
89208>>>>> object oBtn1 is a aps.Multi_Button
89210>>>>> on_item t.btn.close send close_panel_ok
89211>>>>> end_object
89212>>>>> send aps_locate_multi_buttons
89213>>>>> procedure close_panel_ok
89216>>>>> set piResult to DFTRUE
89217>>>>> send close_panel
89218>>>>> end_procedure
89219>>>>> procedure aps_beautify
89222>>>>> send APS_ALIGN_INSIDE_CONTAINER_BY_MOVING (oTimeStamp(oTab1(oTabs))) SL_ALIGN_CENTER
89223>>>>>// send APS_ALIGN_INSIDE_CONTAINER_BY_MOVING (oFolder(oTab2(oTabs))) SL_ALIGN_CENTER
89223>>>>>// send APS_ALIGN_INSIDE_CONTAINER_BY_MOVING (oBtn1(oTab2(oTabs))) SL_ALIGN_CENTER
89223>>>>> end_procedure
89224>>>>> procedure popup
89227>>>>> set piResult to DFFALSE
89228>>>>> send DoInit to (oTab1(oTabs(self)))
89229>>>>> forward send popup
89231>>>>> if (piResult(self)) begin
89233>>>>> end
89233>>>>>>
89233>>>>> end_procedure
89234>>>>> procedure DoRefreshSilent
89237>>>>> send DoRefreshSilent of (oTab1(oTabs(self)))
89238>>>>> end_procedure
89239>>>>>end_object // oFastView_WSOptions
89240>>>>>
89240>>>>>
89240>>>>>procedure FastView_WSOptions
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
89242>>>>> send popup to (oFastView_WSOptions(self))
89243>>>>>end_procedure
89244>>>>>
89244>>>>>function FV_FastLoadEnabled global returns integer
89246>>>>> integer lbExists
89246>>>>> string lsFolder lsFile
89246>>>>> get FastView_RootDirectory to lsFolder
89247>>>>> if (lsFolder="") function_return 0
89250>>>>> get Files_AppendPath lsFolder "FastLoad.fdx" to lsFile
89251>>>>> get SEQ_FileExists lsFile to lbExists
89252>>>>> function_return (lbExists=SEQIT_FILE)
89253>>>>>end_function
89254>>>>>
89254>>>>>procedure FV_FastLoadRefresh global
89256>>>>> if (FV_FastLoadEnabled()) send DoRefreshSilent of oFastView_WSOptions
89259>>>>>end_procedure
89260>>>>>
89260>>>
89260>>>object oMustBeIncapsulated is a cArray
89262>>> // If these procedures are located directly on the
89262>>> // desktop the hole thing locks on WS selection!
89262>>> procedure WS_OnCloseWorkSpace string lsOldWS
89265>>> broadcast recursive send Close_Query_View to desktop
89267>>> send DataDictionary_Objects_Destroy
89268>>> send OpenStat_CloseAllFiles
89269>>> end_procedure
89270>>> procedure WS_OnOpenWorkSpace string lsNewWS
89273>>> integer liGrb liChannel
89273>>> get DBMS_OpenFileAs "CODEMAST" CodeMast.file_number DF_SHARE 0 to liGrb
89274>>> ifnot liGrb send obs "Attempt to open CodeMast table failed (maybe that's OK)"
89277>>>
89277>>> send cursor_wait to (cursor_control(self))
89278>>> send FastView_SetupHomeDirectory
89279>>> get FastView_DirectInput "FastLoad.fdx" to liChannel
89280>>> if (liChannel>=0) begin
89282>>> send SEQ_Read to ghFDX liChannel
89283>>> send SEQ_CloseInput liChannel
89284>>> end
89284>>>>
89284>>> else send FDXGL_ReadCurrentFileList to ghFDX FDX_ALL_FILES
89286>>>
89286>>> broadcast recursive send delete_fieldinfo_data to desktop // Clears some arrays in fieldinf.pkg
89288>>>
89288>>> send cursor_ready to (cursor_control(self))
89289>>> end_procedure
89290>>>end_object
89291>>>
89291>>>procedure SetupDefaultWS
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
89293>>> integer liExists
89293>>> string lsWS lsFileList
89293>>> get FV_CmdLineFileList to lsFileList
89294>>> if (lsFileList<>"") begin
89296>>> get SEQ_FileExists lsFileList to liExists
89297>>> if (liExists=SEQIT_FILE) send Do_Select_FileList lsFileList
89300>>> else if (liExists=SEQIT_DIRECTORY) begin
89303>>> get SEQ_ComposeAbsoluteFileName lsFileList "filelist.cfg" to lsFileList
89304>>> get SEQ_FileExists lsFileList to liExists
89305>>> if (liExists=SEQIT_FILE) send Do_Select_FileList lsFileList
89308>>> else send obs "Filelist.cfg not found" "(as specified on the command line)"
89310>>> end
89310>>>>
89310>>> else send obs "Filelist.cfg not found" "(as specified on the command line)"
89312>>> end
89312>>>>
89312>>> else begin
89313>>> get FV_CmdLineWS to lsWS
89314>>> if (lsWS="") begin
89316>>> get FVSetupValue FVSETUP_WORKSPACE to lsWS
89317>>> if (lsWS="") get WS_CurrentDefaultID to lsWS
89320>>> end
89320>>>>
89320>>> if (WS_Select(lsWS)) begin
89322>>> send FastView_OpenDefaultCollection
89323>>> end
89323>>>>
89323>>> else send obs "Invalid default Workspace"
89325>>> end
89325>>>>
89325>>>end_procedure
89326>>>
89326>>>function FastViewAppLabel global string lsNewWS returns string
89328>>> integer lbGeneric
89328>>> string lsRval lsFileList
89328>>> get FastView_GenericDDsApplicable to lbGeneric
89329>>> if lbGeneric move (AppInfo(AI_TITLE)+" DD Ver. "+AppInfo(AI_VERSION)) to lsRval
89332>>> else move (AppInfo(AI_TITLE)+" Ver. "+AppInfo(AI_VERSION)) to lsRval
89334>>> if (lsNewWS<>"") move (lsRval+" ("+WS_CurrentEffectiveDescription()+")") to lsRval
89337>>> else begin
89338>>> get FLIST_CurrentFilelist to lsFileList
89339>>> move (lsRval+" ("+lsFileList+")") to lsRval
89340>>> end
89340>>>>
89340>>> function_return lsRval
89341>>>end_function
89342>>>
89342>>>object oExternalViews is a cArray
89344>>> item_property_list
89344>>> item_property string psTitle.i
89344>>> item_property integer piMsg.i
89344>>> end_item_property_list
#REM 89381 DEFINE FUNCTION PIMSG.I INTEGER LIROW RETURNS INTEGER
#REM 89386 DEFINE PROCEDURE SET PIMSG.I INTEGER LIROW INTEGER VALUE
#REM 89391 DEFINE FUNCTION PSTITLE.I INTEGER LIROW RETURNS STRING
#REM 89396 DEFINE PROCEDURE SET PSTITLE.I INTEGER LIROW STRING VALUE
89402>>>end_object
89403>>>
89403>>>procedure set ViewActivateMessage string lsTitle integer liMsg
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
89405>>> integer lhArr liRow
89405>>> move (oExternalViews(self)) to lhArr
89406>>> get row_count of lhArr to liRow
89407>>> set psTitle.i of lhArr liRow to lsTitle
89408>>> set piMsg.i of lhArr liRow to liMsg
89409>>>end_procedure
89410>>>
89410>>>class cFastViewPopupMenu is a ViewPopupMenu
89411>>> procedure construct_object
89413>>> forward send construct_object
89415>>> property integer phMenuData
89416>>> end_procedure
89417>>> procedure OnInitMenu
89419>>> integer lhMenu lhData
89419>>> move self to lhMenu
89420>>> get phMenuData to lhData
89421>>> send delete_data
89422>>> send fill_menu of lhData lhMenu
89423>>> end_procedure
89424>>> Procedure Redirect_Message Returns Integer
89426>>> Integer lhMsg liAux liRval liCurItm lhData
89426>>> Get Message To lhMsg
89427>>> Get Aux_Value To liAux
89428>>> //
89428>>> If lhMsg Begin // Since Menupopup Is 0, This Will Get Skipped
89430>>> If liAux Eq 0 Begin // If No Destination
89432>>> Get Focus of desktop To liAux // Try To Send To Focus
89433>>> If liAux Le Desktop ; // As Long As Focus Is Not The Desktop. Move 0 To liAux
89436>>> End
89436>>>>
89436>>> get current_item to liCurItm
89437>>> get phMenuData to lhData
89438>>> //showln (current_item(self))
89438>>> send item_action of lhData liCurItm
89439>>> If liAux Get lhMsg Of liAux To liRval
89442>>> Procedure_Return liRval
89443>>> End
89443>>>>
89443>>> end_procedure
89444>>>end_class // cFastViewPopupMenu
89445>>>
89445>>>// This blasted integer is only used in the next 10 lines or so, and was the
89445>>>// only way I could find that bypasses the VDF WS tendensy to create subkeys
89445>>>// depending on which WS is selected.
89445>>>integer ghOh_WhatCanYouDO?
89445>>>
89445>>>move ghoWorkSpace to ghOh_WhatCanYouDO?
89446>>>move 0 to ghoWorkSpace
89447>>>Object Main is a Panel // ghoWorkSpace must be 0 while this object is created
89449>>> move ghOh_WhatCanYouDO? to ghoWorkSpace
89450>>>
89450>>> property integer pbHtmlTestOutput
89452>>> property integer pbAutoPreview
89454>>>
89454>>> procedure OnActivateApp
89457>>> send FastView_Check_UserPackages
89458>>> end_procedure
89459>>>
89459>>> Procedure Save_Environment
89462>>> move ghoWorkSpace to ghOh_WhatCanYouDO?
89463>>> move 0 to ghoWorkSpace
89464>>> // ghoWorkSpace must be 0 while calling this procedure
89464>>> forward send Save_Environment
89466>>> move ghOh_WhatCanYouDO? to ghoWorkSpace
89467>>> end_procedure
89468>>>
89468>>> set label to (FastViewAppLabel(""))
89469>>> procedure WS_OnOpenWorkSpace string lsNewWS
89472>>> set delegation_mode to DELEGATE_TO_PARENT
89473>>> set label to (FastViewAppLabel(lsNewWS))
89474>>> end_procedure
89475>>> DFCreate_Menu Main_Menu
89478>>> DFCreate_Menu "&File" FilePullDown is a ViewPopupMenu
89482>>>if (FV_AdminMode()) begin
89484>>> on_item "Create a view" send FastView_CreateNew
89485>>>end
89485>>>>
89485>>> on_item "Create a query" send Activate_Query_Vw
89486>>> on_item "" send none
89487>>>
89487>>> on_item "Open view" send FastView_Open
89488>>> on_item "Close all views" send FastView_CloseAll
89489>>> on_item "" send none
89490>>> on_item "Open view collection" send FastView_OpenLayout
89491>>> on_item "Save view collection" send FastView_SaveLayout
89492>>> on_item "" send none
89493>>>if (integer(FVSetupValue(FVSETUP_USER_CHG_WS))) begin
89495>>> on_item "Select workspace" send Do_Select_WorkSpace
89496>>> on_item "Select filelist" send Do_Select_FileList_Browse
89497>>> on_item "" send none
89498>>>end
89498>>>>
89498>>> on_item "Workspace options" send FastView_WSOptions
89499>>> on_item "Close all tables" send FastView_CloseTables
89500>>> on_item "Explore data folder" send FastView_ExploreDataFolder
89501>>> on_item "" send none
89502>>> on_item "DBMS Login" send DoLogin
89503>>> on_item "" send none
89504>>> on_item "Exit \aAlt+F4" send exit_application
89505>>> End_Menu
89507>>>
89507>>> DFCreate_Menu "&Views" ViewPullDown is a cFastViewPopupMenu
89511>>> End_Menu
89513>>> DFCreate_Menu "&Queries" QueryPullDown is a cFastViewPopupMenu
89517>>> End_Menu
89519>>>
89519>>> DFCreate_Menu "&External Views" ExternalViewPullDown is a ViewPopupMenu
89523>>> procedure OnInitMenu
89526>>> integer lhArr liMax liRow
89526>>> send delete_data
89527>>> move (oExternalViews(self)) to lhArr
89528>>> get row_count of lhArr to liMax
89529>>> decrement liMax
89530>>> for liRow from 0 to liMax
89536>>>>
89536>>> send add_item (piMsg.i(lhArr,liRow)) (psTitle.i(lhArr,liRow))
89537>>> loop
89538>>>>
89538>>> end_procedure
89539>>> End_Menu
89541>>>
89541>>> DFCreate_Menu "Tools" FunctionPullDown is a ViewPopupMenu
89545>>> on_item "&Document your database \aCtrl+2" send Popup_DBD_View
89546>>>// on_item "&Document your source \aCtrl+3" send Popup_PkgDoc_View
89546>>> on_item "&System pounder" send popup_systempounder
89547>>>// on_item "&HTML page prototyper" send Activate_HtmlPagePrototyper
89547>>> on_item "&FTS Subsystem" send Popup_FTS_ControlPanel
89548>>>// on_item "&FTS Drop tables" send Popup_FTS_DropTablesWizard
89548>>>// on_item "&FTS Create tables" send Popup_FTS_CreateTablesWizard
89548>>> on_item "" send none
89549>>> on_item "DAW-Tool: Database &Builder" send OpenStat.Chain_DbBuilder
89550>>> on_item "DAW-Tool: Database &Explorer" send OpenStat.Chain_DbExplor
89551>>> on_item "Repair index files" send Activate_Sort_Vw
89552>>> on_item "Lock out other users" send popup_systemdowner
89553>>> on_item "" send none
89554>>> on_item "Save snap shot of table definitions" send activate_fvtool_01
89555>>> on_item "Show Workspace DD packages" send FastView_Display_UserPackages
89556>>> on_item "" send none
89557>>>
89557>>>// DFCreate_Menu "Odd tool box" OddToolBoxPullDown is a ViewPopupMenu
89557>>>// on_item "Split file" send Activate_FileSplit_Vw
89557>>>// on_item "Join files" send Activate_FileJoin_Vw
89557>>>// End_Menu
89557>>>
89557>>> on_item "About" send DoAbout
89558>>> End_Menu
Including file: Win_pm.inc (c:\VDF12\Pkg\Win_pm.inc)
89560>>>>//************************************************************************
89560>>>>//
89560>>>>//* Copyright (c) 1997 Data Access Corporation, Miami Florida,
89560>>>>//* All rights reserved.
89560>>>>//* DataFlex is a registered trademark of Data Access Corporation.
89560>>>>//*
89560>>>>//*
89560>>>>//* Module Name:
89560>>>>//* WIN_PM.INC
89560>>>>//*
89560>>>>//* Creator:
89560>>>>//* JJT
89560>>>>//*
89560>>>>//* Date:
89560>>>>//* 4/25/96
89560>>>>//*
89560>>>>//* Purpose:
89560>>>>//* Creates a WINDAF WINDOW pulldown menu. This menu lists
89560>>>>//* all active views in a program with a check next to the
89560>>>>//* current focus view.
89560>>>>//*
89560>>>>//*************************************************************************
89560>>>>// 01/29/97 JJT - removed work area scroll bar (until they work)
89560>>>>//
89560>>>>// 10/14/97 JJT - Added views to window pulldown. All views (and reports) will appear
89560>>>>// See OnInitMenu
89560>>>>//
89560>>>>//
89560>>>>DFCreate_Menu "&Window" Window_Menu
89564>>>> Set select_mode to Multi_Select
89565>>>> // normal number of items in pulldown (w/ no active views)
89565>>>> property integer std_item_count public 0
89567>>>>
89567>>>> DFCreate_Menu "&Display_Options" Display_Options_Menu
89571>>>> Set select_mode to Multi_Select
89572>>>> On_Item "&Tool-bar" send Toggle_ToolBar To self
89573>>>> On_Item "&Status-bar" send Toggle_StatusBar To self
89574>>>> On_Item "&Auto Arrange Icons" send Toggle_Auto_Arrange_Icons To self
89575>>>> //On_Item "&Work Area Scroll bars" send Toggle_Client_Scrollbar_state to self
89575>>>>
89575>>>>
89575>>>> // When ever the menu [pulldown] is initialized, check/set
89575>>>> // the state of its items.
89575>>>> //
89575>>>> Procedure OnInitMenu
89578>>>> integer bState
89578>>>>
89578>>>> Get ToolBar_State to bState
89579>>>> Set Select_State Item 0 to bState
89580>>>> if bState Set Status_Help Item 0 To 'Remove the Tool-bar'
89583>>>> Else Set Status_Help Item 0 to 'Add the Tool-bar'
89585>>>>
89585>>>> Get Statusbar_State to bState
89586>>>> Set Select_State Item 1 to bState
89587>>>> if bState Set Status_Help Item 1 To 'Remove the Status-bar'
89590>>>> Else Set Status_Help Item 1 to 'Add the Status-bar'
89592>>>>
89592>>>> Get Auto_Arrange_Icons_State to bState
89593>>>> Set Select_State Item 2 to bState
89594>>>> if bState Set Status_Help Item 2 To "Don't automatically arrange the icons"
89597>>>> Else Set Status_Help Item 2 to 'Automatically arrange the icons when re-sizing the Application'
89599>>>>
89599>>>> //Get Client_Scrollbar_State to bState
89599>>>> //Set Select_State Item 3 to bState
89599>>>> //if bState Set Status_Help Item 3 To "Display scroll bars when windows do not fit within the work area."
89599>>>> //Else Set Status_Help Item 3 to "Never display scroll bars in the work area."
89599>>>>
89599>>>> End_procedure
89600>>>>
89600>>>>
89600>>>> End_Pull_Down
89602>>>> //Set Status_Help to "Set tool-bar, status-bar, scroll-bar, and icon display options"
89602>>>> Set Status_Help to "Set tool-bar, status-bar, and icon display options"
89603>>>>
89603>>>> On_Item ""
89604>>>>
89604>>>> On_Item "&Cascade" send Cascade_Windows To self
89605>>>> Set Status_Help To 'Cascade all open Windows/Views'
89606>>>>
89606>>>> On_Item "Tile &Horizontally" send Tile_Windows_Horizontal To self
89607>>>> Set Status_Help To 'Tile all open Windows/Views horizontally'
89608>>>>
89608>>>> On_Item "Tile &Vertically" send Tile_Windows_Vertical To self
89609>>>> Set Status_Help To 'Tile all open Windows/Views vertically'
89610>>>>
89610>>>> On_Item ""
89611>>>>
89611>>>> On_Item "&Minimize all Windows" send Minimize_all_Windows To self
89612>>>> Set Status_Help To 'Minimize all open Windows/Views'
89613>>>>
89613>>>> On_Item "&Restore all Windows" send Restore_all_Windows To self
89614>>>> Set Status_Help To 'Restore all open Windows/Views to normal screen display mode'
89615>>>>
89615>>>> On_Item ""
89616>>>>
89616>>>> On_Item "Arrange &Icons" send Arrange_Icons To self
89617>>>> Set Status_Help To 'Arrange the icons at the bottom'
89618>>>>
89618>>>> // set this to the number of items in the menu with no views.
89618>>>> Set Std_item_count to (item_count(self))
89619>>>>
89619>>>> // add all active views to the end of the menu
89619>>>> Procedure OnInitMenu
89622>>>> integer iStdCnt iNumCnt hVw hCl iCount
89622>>>> string sLbl
89622>>>> //*** Remove all old view items
89622>>>> Get Item_count to iNumCnt
89623>>>> get Std_item_count to iStdCnt
89624>>>> For iCount from 1 to (iNumCnt - iStdCnt)
89630>>>>>
89630>>>> Send Delete_item iStdCnt
89631>>>> Loop
89632>>>>>
89632>>>>
89632>>>> Move iStdcnt to iNumCnt
89633>>>> get Client_id to hCl // object id of client area
89634>>>> If hCl Begin
89636>>>> Get Next_Mdi_Dialog of hcl TRUE to hVw // find first view
89637>>>> While hVw
89641>>>> if (Active_state(hVw)) Begin
89643>>>> if iNumCnt eq iStdCnt Begin // if first view, add separator
89645>>>> send add_item 0 ''
89646>>>> increment iNumCnt
89647>>>> end
89647>>>>>
89647>>>> Get Label of hVw to sLbl // caption bar (name) of view
89648>>>> // note that all views understand the message activate_view.
89648>>>> send add_item msg_activate_view sLbl // set message, value and destination
89649>>>> set aux_value item iNumcnt to hVw
89650>>>> // if this is the focus view, mark it.
89650>>>> If (current_scope(desktop)=hVw and View_mode(hVw)<>VIEWMODE_ICONIZE) ; set select_state item iNumCnt to True
89653>>>> // create status help
89653>>>> Set Status_help item iNumCnt to ("Make this view (" - trim(sLbl) - ") the active window.")
89654>>>> increment iNumCnt
89655>>>> end
89655>>>>>
89655>>>> Get Next_Mdi_Dialog of hcl FALSE to hVw // find next
89656>>>> End
89657>>>>>
89657>>>> End
89657>>>>>
89657>>>> End_Procedure // OnInitMenu
89658>>>>
89658>>>>End_Pull_Down
89660>>>>Set Status_Help to "Display Current Views and set other display options."
89661>>>>
89661>>> End_Menu
89663>>>
89663>>> Use cToolbar.pkg
89663>>> Object oToolBar is a cToolBar
89665>>> Set pbShowLabels To True // display the psLabel property on the button
89666>>> Set pbList To True // show the psLapel property to the right of the image
89667>>> Object oImages is a cImageList
89669>>> Set piMaxImages To 12
89670>>> Procedure OnCreate
89673>>> Integer iVoid
89673>>> Get AddTransparentImage "bgn.bmp" clLtGray To iVoid // 0
89674>>> Get AddTransparentImage "prev.bmp" clLtGray To iVoid // 1
89675>>> Get AddTransparentImage "next.bmp" clLtGray To iVoid // 2
89676>>> Get AddTransparentImage "end.bmp" clLtGray To iVoid // 3
89677>>> Get AddTransparentImage "Prompt16.bmp" clFuchsia To iVoid // 4
89678>>> Get AddTransparentImage "clr.bmp" clLtGray To iVoid // 5
89679>>> Get AddTransparentImage "clra.bmp" clLtGray To iVoid // 6
89680>>> Get AddTransparentImage "Save16.bmp" clFuchsia To iVoid // 7
89681>>> Get AddTransparentImage "Delete16.bmp" clFuchsia To iVoid // 8
89682>>> Get AddTransparentImage "Cut16.bmp" clFuchsia To iVoid // 9
89683>>> Get AddTransparentImage "Copy16.bmp" clFuchsia To iVoid // 10
89684>>> Get AddTransparentImage "Paste16.bmp" clFuchsia To iVoid // 11
89685>>> End_Procedure
89686>>> End_Object
89687>>>
89687>>> Object oImagesHot is a cImageList
89689>>> // These images are shown when the mouse cursor hovers over the button
89689>>> // There must be a matching number of images in all imagelists.
89689>>> Set piMaxImages To 12
89690>>> Procedure OnCreate
89693>>> Integer iVoid
89693>>> Get AddTransparentImage "BgnHot.bmp" clLtGray To iVoid // 0
89694>>> Get AddTransparentImage "PrevHot.bmp" clLtGray To iVoid // 1
89695>>> Get AddTransparentImage "NextHot.bmp" clLtGray To iVoid // 2
89696>>> Get AddTransparentImage "EndHot.bmp" clLtGray To iVoid // 3
89697>>> Get AddTransparentImage "Prompt16.bmp" clFuchsia To iVoid // 4
89698>>> Get AddTransparentImage "clr.bmp" clLtGray To iVoid // 5
89699>>> Get AddTransparentImage "clra.bmp" clLtGray To iVoid // 6
89700>>> Get AddTransparentImage "Save16.bmp" clFuchsia To iVoid // 7
89701>>> Get AddTransparentImage "Delete16.bmp" clFuchsia To iVoid // 8
89702>>> Get AddTransparentImage "Cut16.bmp" clFuchsia To iVoid // 9
89703>>> Get AddTransparentImage "Copy16.bmp" clFuchsia To iVoid // 10
89704>>> Get AddTransparentImage "Paste16.bmp" clFuchsia To iVoid // 11
89705>>> End_Procedure
89706>>> End_Object
89707>>>
89707>>> Set phoImageList To (oImages(self))
89708>>> Set phoImageListHot To (oImagesHot(self))
89709>>>
89709>>> Object oFirst is a cToolbarButton
89711>>> Set pbAutoSize To True
89712>>> Set psTooltip To 'Navigation:\n\nGo to the first record in the file\n(or the first record in the Constrained set)'
89713>>> Set psStatusHelp To 'Find the First record (Ctrl+Home)'
89714>>> Set piImage To 0
89715>>> Procedure OnClick
89718>>> Send DoSendToDeoFocus msg_beginning_of_data
89719>>> End_Procedure
89720>>> End_Object
89721>>>
89721>>> Object oPrevious is a cToolbarButton
89723>>> Set pbAutoSize To True
89724>>> Set psTooltip To 'Find Previous'
89725>>> Set psStatusHelp To 'Find the Previous record (F7)'
89726>>> Set piImage To 1
89727>>> Procedure OnClick
89730>>> Send DoSendToDeoFocus msg_find_previous
89731>>> End_Procedure
89732>>> End_Object
89733>>>
89733>>> Object oNext is a cToolbarButton
89735>>> Set pbAutoSize To True
89736>>> Set psTooltip To 'Find Next'
89737>>> Set psStatusHelp To 'Find the Next record (F8)'
89738>>> Set piImage To 2
89739>>> Procedure OnClick
89742>>> Send DoSendToDeoFocus msg_find_next
89743>>> End_Procedure
89744>>> End_Object
89745>>>
89745>>> Object oLast is a cToolbarButton
89747>>> Set pbAutoSize To True
89748>>> Set psTooltip To 'End of File'
89749>>> Set psStatusHelp To 'Find the Last record (Ctrl+End)'
89750>>> Set piImage To 3
89751>>> Procedure OnClick
89754>>> Send DoSendToDeoFocus msg_end_of_data
89755>>> End_Procedure
89756>>> End_Object
89757>>>
89757>>> Object oSeparator is a cToolbarButton
89759>>> Set peStyle To bsSeparator
89760>>> End_Object
89761>>>
89761>>> Object oPrompt is a cToolbarButton
89763>>> Set psLabel To "Prompt"
89764>>> Set pbAutoSize To True
89765>>> Set psTooltip To 'Prompt'
89766>>> Set psStatusHelp To 'Show available selections (F4)'
89767>>> Set piImage To 4
89768>>> Procedure OnClick
89771>>> Send DoSendToDeoFocus msg_prompt
89772>>> End_Procedure
89773>>> End_Object
89774>>>
89774>>> Object oClear is a cToolbarButton
89776>>> Set psLabel To "Clear"
89777>>> Set pbAutoSize To True
89778>>> Set psTooltip To 'Clear'
89779>>> Set psStatusHelp To 'Clear current record / Add a new record (F5)'
89780>>> Set piImage To 5
89781>>> Procedure OnClick
89784>>> Send DoSendToDeoFocus msg_request_clear
89785>>> End_Procedure
89786>>> End_Object
89787>>>
89787>>> Object oClearAll is a cToolbarButton
89789>>> Set psLabel To "Clear All"
89790>>> Set pbAutoSize To True
89791>>> Set psTooltip To 'Clear All'
89792>>> Set psStatusHelp To 'Clear all data from view (Ctrl+F5)'
89793>>> Set piImage To 6
89794>>> Procedure OnClick
89797>>> Send DoSendToDeoFocus msg_request_clear_all
89798>>> End_Procedure
89799>>> End_Object
89800>>>
89800>>> Object oSeparator is a cToolbarButton
89802>>> Set peStyle To bsSeparator
89803>>> End_Object
89804>>>
89804>>> Object oSave is a cToolbarButton
89806>>> Set psLabel To "Save"
89807>>> Set pbAutoSize To True
89808>>> Set psTooltip To 'Save'
89809>>> Set psStatusHelp To 'Save the current record (F2)'
89810>>> Set piImage To 7
89811>>> Procedure OnClick
89814>>> Send DoSendToDeoFocus msg_request_save
89815>>> End_Procedure
89816>>> End_Object
89817>>>
89817>>> Object oDelete is a cToolbarButton
89819>>> Set psLabel To "Delete"
89820>>> Set pbAutoSize To True
89821>>> Set psTooltip To 'Delete'
89822>>> Set psStatusHelp To 'Delete the current record (Shift+F2)'
89823>>> Set piImage To 8
89824>>> Procedure OnClick
89827>>> Send DoSendToDeoFocus msg_request_delete
89828>>> End_Procedure
89829>>> End_Object
89830>>>
89830>>> Object oSeparator is a cToolbarButton
89832>>> Set peStyle To bsSeparator
89833>>> End_Object
89834>>>
89834>>> Object oCut is a cToolbarButton
89836>>> Set psLabel To "Cut"
89837>>> Set pbAutoSize To True
89838>>> Set psTooltip To 'Cut'
89839>>> Set psStatusHelp To 'Cuts the selection and puts it on the Clipboard'
89840>>> Set piImage To 9
89841>>> Procedure OnClick
89844>>> Send DoSendToDeoFocus msg_cut
89845>>> End_Procedure
89846>>> End_Object
89847>>>
89847>>> Object oCopy is a cToolbarButton
89849>>> Set psLabel To "Copy"
89850>>> Set pbAutoSize To True
89851>>> Set psTooltip To 'Copy'
89852>>> Set psStatusHelp To 'Copies the selection and puts it on the Clipboard'
89853>>> Set piImage To 10
89854>>> Procedure OnClick
89857>>> Send DoSendToDeoFocus msg_copy
89858>>> End_Procedure
89859>>> End_Object
89860>>>
89860>>> Object oPaste is a cToolbarButton
89862>>> Set psLabel To "Paste"
89863>>> Set pbAutoSize To True
89864>>> Set psTooltip To 'Paste'
89865>>> Set psStatusHelp To 'Inserts Clipboard contents'
89866>>> Set piImage To 11
89867>>> Procedure OnClick
89870>>> Send DoSendToDeoFocus msg_paste
89871>>> End_Procedure
89872>>> End_Object
89873>>>
89873>>> End_Object // oMainToolbar
89874>>>
89874>>> Object Client_Area IS A AppClientArea
89876>>>
89876>>> on_key key_ctrl+key_p send Request_CreateNewQuery
89877>>> on_key key_ctrl+key_g send AutoLaunchGridQuery
89878>>>
89878>>>
89878>>> send CreateAutoDownObject of oAutoSystemDowner self
89879>>> procedure DoLogin
89882>>> get DBMS_GetDriverLogin 0 to windowindex
89883>>> end_procedure
89884>>> Use VdfQuery.rv // VDFQuery
Including file: vdfquery.rv (C:\Apps\VDFQuery\AppSrc\vdfquery.rv)
89884>>>>>
89884>>>>>integer gIdontCare
89884>>>>>
89884>>>>>move self to gIdontCare
89885>>>>>move Desktop to self
89886>>>>>
89886>>>>>use vdfquery.utl
89886>>>>>
89886>>>>>
89886>>>>>
89886>>>>>
89886>>>>>
89886>>>>>move gIdontCare to self
89887>>> move self to ghClientArea_FastView
89888>>> Use VdfSort.vw // Reindexing routines
Including file: vdfsort.vw (C:\Apps\VDFQuery\AppSrc\vdfsort.vw)
89888>>>>>// This can be used as a view in an IDE program.
89888>>>>>// This is added to a workspace by registering it as an
89888>>>>>// external component. When registered, it should be added
89888>>>>>// as a report view and its object name should be defined as
89888>>>>>// Sort_Vw
89888>>>>>//
89888>>>>>Use VdfSort.utl // send Activate_Sort_Vw
89888>>>
89888>>> Use FTSCreate.pkg // Wizard for creating a set of FTS tables
Including file: FTSCreate.pkg (C:\Apps\VDFQuery\AppSrc\FTSCreate.pkg)
89888>>>>>// Use FTSCreate.pkg // Wizard for creating (and another one for dropping) a set of FTS tables
89888>>>>>
89888>>>>>Use ApsWiz.pkg // APS wizard classes
Including file: apswiz.pkg (C:\Apps\VDFQuery\AppSrc\apswiz.pkg)
89888>>>>>>>// Use ApsWiz.pkg // APS wizard classes
89888>>>>>>>Use APS // Auto Positioning and Sizing classes for VDF
89888>>>>>>>Use Set.utl // cArray, cSet and cStack classes
89888>>>>>>>Use Buttons.utl // Button texts
89888>>>>>>>Use Language // Default language setup
89888>>>>>>>
89888>>>>>>> define t.wizbtn.back for "< Back"
89888>>>>>>> define t.wizbtn.next for "Next >"
89888>>>>>>> define t.wizbtn.finish for "Finish"
89888>>>>>>>
89888>>>>>>>enumeration_list
89888>>>>>>> define WIZSIZE_SMALL
89888>>>>>>> define WIZSIZE_NORMAL
89888>>>>>>> define WIZSIZE_LARGE
89888>>>>>>>end_enumeration_list
89888>>>>>>>
89888>>>>>>>register_object oLine
89888>>>>>>>register_function iPageValidate returns integer
89888>>>>>>>
89888>>>>>>>class aps.WizardPanel is a aps.BasicPanel
89889>>>>>>> procedure construct_object
89891>>>>>>> forward send construct_object
89893>>>>>>> set sysmenu_icon to false
89894>>>>>>> set minimize_icon to false
89895>>>>>>> set maximize_icon to false
89896>>>>>>> set popup_state to true
89897>>>>>>> set modal_state to true
89898>>>>>>> on_key kcancel send close_panel
89899>>>>>>> object oPages is a cArray
89901>>>>>>> end_object
89902>>>>>>> property integer piCurrentPage public -1
89903>>>>>>> property integer piResult public 0
89904>>>>>>> property integer p_max_row_on_tabdialog public 0
89905>>>>>>> property integer p_max_column_on_tabdialog public 0
89906>>>>>>> set locate_mode to CENTER_ON_SCREEN
89907>>>>>>> set border_style to BORDER_DIALOG
89908>>>>>>> send aps_init
89909>>>>>>> end_procedure
89910>>>>>>> procedure end_construct_object
89912>>>>>>> set p_max_row to (p_max_row_on_tabdialog(self))
89913>>>>>>> set p_max_column to (p_max_column_on_tabdialog(self))
89914>>>>>>> send aps_goto_max_row
89915>>>>>>> object oLine is a aps.LineControl
89917>>>>>>> end_object
89918>>>>>>> set multi_button_size to 16 50
89919>>>>>>> object oBtn1 is a aps.Multi_Button
89921>>>>>>> on_item t.wizbtn.back send DoPageBack
89922>>>>>>> set p_extra_external_width to (-p_column_space(self))
89923>>>>>>> end_object
89924>>>>>>> object oBtn2 is a aps.Multi_Button
89926>>>>>>> on_item t.wizbtn.next send DoPageForward
89927>>>>>>> set p_extra_external_width to (p_column_space(self))
89928>>>>>>> end_object
89929>>>>>>> object oBtn3 is a aps.Multi_Button
89931>>>>>>> on_item t.btn.cancel send close_panel
89932>>>>>>> end_object
89933>>>>>>> send aps_locate_multi_buttons
89934>>>>>>> forward send end_construct_object
89936>>>>>>> end_procedure
89937>>>>>>> procedure set minimum_size integer height# integer width#
89939>>>>>>> set p_max_row_on_tabdialog to height#
89940>>>>>>> set p_max_column_on_tabdialog to width#
89941>>>>>>> end_procedure
89942>>>>>>> procedure make_nice_size integer tmp_size_class#
89944>>>>>>> integer size_class#
89944>>>>>>> if num_arguments move tmp_size_class# to size_class#
89947>>>>>>> else move WizSize_Normal to size_class#
89949>>>>>>> if size_class# eq WIZSIZE_SMALL set minimum_size to 100 200
89952>>>>>>> if size_class# eq WIZSIZE_NORMAL set minimum_size to 150 300
89955>>>>>>> if size_class# eq WIZSIZE_LARGE set minimum_size to 200 400
89958>>>>>>> end_procedure
89959>>>>>>> procedure Register_WizardPage integer obj#
89961>>>>>>> set value of (oPages(self)) item (item_count(oPages(self))) to obj#
89962>>>>>>> end_procedure
89963>>>>>>> function iNextPage integer liCurrentPage returns integer
89965>>>>>>> function_return (liCurrentPage+1)
89966>>>>>>> end_function
89967>>>>>>> procedure DoPageForward
89969>>>>>>> string label# obj# liNextPage liCurrentPage
89969>>>>>>> get label of (oBtn2(self)) to label#
89970>>>>>>> get piCurrentPage to liCurrentPage
89971>>>>>>> get value of (oPages(self)) item liCurrentPage to obj#
89972>>>>>>> if (iPageValidate(obj#)) begin
89974>>>>>>> if label# eq t.wizbtn.finish send close_panel_ok
89977>>>>>>> else begin
89978>>>>>>> get iNextPage liCurrentPage to liNextPage
89979>>>>>>> get value of (oPages(self)) item liNextPage to obj#
89980>>>>>>> send OnDisplayPageForwardNavigation to obj# liCurrentPage
89981>>>>>>> set piPreviousPage of (integer(value(oPages(self),liNextPage))) to liCurrentPage
89982>>>>>>> send DisplayPage liNextPage
89983>>>>>>> end
89983>>>>>>>>
89983>>>>>>> end
89983>>>>>>>>
89983>>>>>>> end_procedure
89984>>>>>>> procedure DoPageBack
89986>>>>>>> integer liPreviousPage
89986>>>>>>> get piPreviousPage of (integer(value(oPages(self),piCurrentPage(self)))) to liPreviousPage
89987>>>>>>> send DisplayPage liPreviousPage
89988>>>>>>> end_procedure
89989>>>>>>> procedure DoFinish
89991>>>>>>> end_procedure
89992>>>>>>> procedure close_panel_ok
89994>>>>>>> set piResult to 1
89995>>>>>>> send close_panel
89996>>>>>>> end_procedure
89997>>>>>>> procedure popup
89999>>>>>>> set piCurrentPage to -1
90000>>>>>>> set piResult to 0
90001>>>>>>> forward send popup
90003>>>>>>> if (piResult(self)) send DoFinish
90006>>>>>>> end_procedure
90007>>>>>>>
90007>>>>>>> procedure aps_beautify
90009>>>>>>> send aps_align_inside_container_by_sizing (oLine(self)) SL_ALIGN_RIGHT
90010>>>>>>> end_procedure
90011>>>>>>>
90011>>>>>>> procedure DisplayPage integer new_pg#
90013>>>>>>> integer cur_pg# new_page_obj# cur_page_obj#
90013>>>>>>> get piCurrentPage to cur_pg#
90014>>>>>>> move (value(oPages(self),new_pg#)) to new_page_obj#
90015>>>>>>> if cur_pg# ne -1 move (value(oPages(self),cur_pg#)) to cur_page_obj#
90018>>>>>>> if (cur_page_obj# and new_page_obj#) send deactivate to cur_page_obj#
90021>>>>>>> if new_page_obj# begin
90023>>>>>>> send popup_group to new_page_obj#
90024>>>>>>> move new_pg# to cur_pg#
90025>>>>>>> end
90025>>>>>>>>
90025>>>>>>> set object_shadow_state of (oBtn1(self)) to (cur_pg#=0)
90026>>>>>>> if cur_pg# eq (item_count(oPages(self))-1) set label of (oBtn2(self)) to t.wizbtn.finish
90029>>>>>>> else set label of (oBtn2(self)) to t.wizbtn.next
90031>>>>>>> set piCurrentPage to cur_pg#
90032>>>>>>> end_procedure
90033>>>>>>> procedure page integer mode#
90035>>>>>>> forward send page mode#
90037>>>>>>> // Mode# must be 1, otherwise the object isn't created yet???
90037>>>>>>> if (mode#=1 and piCurrentPage(self)=-1) send DisplayPage 0
90040>>>>>>> end_procedure
90041>>>>>>>end_class // aps.WizardPanel
90042>>>>>>>
90042>>>>>>>class aps.WizardPage is a Container
90043>>>>>>> // The APS functionality is a copy of that in a aps.TabPage
90043>>>>>>> procedure construct_object
90045>>>>>>> forward send construct_object
90047>>>>>>> set popup_state to true //
90048>>>>>>> set caption_bar to false //
90049>>>>>>> send aps_init
90050>>>>>>> set border_style to border_none // This is out of the Wizard.pkg (DAC)
90051>>>>>>> property integer piPreviousPage public 0 // Is set dynamically as the user navigates the dialog
90052>>>>>>> set attach_parent_state to true // This achieves proper navigation to the buttons
90053>>>>>>> send aps_goto_max_row
90054>>>>>>> send aps_new_field_row
90055>>>>>>> end_procedure
90056>>>>>>> procedure set page_title string str#
90058>>>>>>>// set label of (oTitle(self)) to str#
90058>>>>>>> end_procedure
90059>>>>>>> function iPageValidate returns integer
90061>>>>>>> function_return 1
90062>>>>>>> end_function
90063>>>>>>> procedure OnDisplayPageForwardNavigation integer piPrevPage
90065>>>>>>> end_procedure
90066>>>>>>> procedure end_construct_object
90068>>>>>>> integer max_row# max_column# self#
90068>>>>>>> get p_max_row to max_row#
90069>>>>>>> get p_max_column to max_column#
90070>>>>>>> if max_row# gt (p_max_row_on_tabdialog(self)) set p_max_row_on_tabdialog to max_row#
90073>>>>>>> if max_column# gt (p_max_column_on_tabdialog(self)) set p_max_column_on_tabdialog to max_column#
90076>>>>>>> forward send end_construct_object
90078>>>>>>> move self to self#
90079>>>>>>> send Register_WizardPage self# // Register with parent object:
90080>>>>>>> end_procedure
90081>>>>>>>end_class
90082>>>>>>>
90082>>>>>>>class aps.WizardPageTitle is a aps.TextBox
90083>>>>>>> procedure construct_object
90085>>>>>>> forward send construct_object
90087>>>>>>> set Typeface to "Arial"
90088>>>>>>> set FontSize to 18 0
90089>>>>>>> set FontWeight to 700
90090>>>>>>> end_procedure
90091>>>>>>> procedure end_construct_object
90093>>>>>>> forward send end_construct_object
90095>>>>>>> send aps_goto_max_row
90096>>>>>>> send aps_new_field_row
90097>>>>>>> end_procedure
90098>>>>>>>end_class
90099>>>>>>>
90099>>>>>>>//
90099>>>>>>>// object oWizard is a aps.WizardPanel label "Hello wiz"
90099>>>>>>>// send make_nice_size WIZSIZE_NORMAL
90099>>>>>>>// object oPage1 is a aps.WizardPage
90099>>>>>>>// object oFrm is a Form
90099>>>>>>>// set value item 0 "Der kan man sgu bare se"
90099>>>>>>>// set form_margin item 0 to 5
90099>>>>>>>// set size to 12 50
90099>>>>>>>// set location to 5 5
90099>>>>>>>// end_object
90099>>>>>>>// end_object
90099>>>>>>>// object oPage2 is a aps.WizardPage
90099>>>>>>>// object oFrm is a aps.Form label "Der kan man sgu bare se (2)" abstract aft_ascii20
90099>>>>>>>// end_object
90099>>>>>>>// end_object
90099>>>>>>>// object oPage3 is a aps.WizardPage
90099>>>>>>>// object oFrm is a aps.Form label "Der kan man sgu bare se for sidste gang" abstract aft_ascii20
90099>>>>>>>// end_object
90099>>>>>>>// end_object
90099>>>>>>>// end_object
90099>>>>>>>// send popup to (oWizard(self))
90099>>>>>Use ToolUtilities.pkg // aps.YellowBox class
Including file: toolutilities.pkg (C:\Apps\VDFQuery\AppSrc\toolutilities.pkg)
90099>>>>>>>// Use ToolUtilities.pkg // aps.YellowBox class
90099>>>>>>>
90099>>>>>>>use aps
90099>>>>>>>Use strings.utl // sTextFromDfImage
90099>>>>>>>Use Spec0012.utl // Read image to string (sTextDfFromImage function)
90099>>>>>>>use rgb.utl // RGB_Brighten
90099>>>>>>>
90099>>>>>>>class aps.YellowBox is a aps.Edit
90100>>>>>>> procedure construct_object
90102>>>>>>> forward send construct_object
90104>>>>>>> set object_shadow_state to true
90105>>>>>>> set border_style to BORDER_NONE
90106>>>>>>> set color to (RGB_Brighten(clYellow,75))
90107>>>>>>> set scroll_bar_visible_state to false
90108>>>>>>> property integer piTextSourceImage public 0
90109>>>>>>> end_procedure
90110>>>>>>> procedure end_construct_object
90112>>>>>>> integer liImg
90112>>>>>>> string lsValue
90112>>>>>>> forward send end_construct_object
90114>>>>>>> get piTextSourceImage to liImg
90115>>>>>>> if liImg begin
90117>>>>>>> get sTextFromDfImage liImg to lsValue
90118>>>>>>> send Text_SetEditObjectValue self lsValue
90119>>>>>>> end
90119>>>>>>>>
90119>>>>>>> end_procedure
90120>>>>>>>end_class // aps.YellowBox
90121>>>>>>>
90121>>>>>Use GridUtil.utl // Grid and List utilities (not for dbGrid's or Table's)
90121>>>>>Use FTSData.nui // cFTS_TableAccess class.
Including file: ftsdata.nui (C:\Apps\VDFQuery\AppSrc\ftsdata.nui)
90121>>>>>>>// Use FTSData.nui // cFTS_TableAccess class.
90121>>>>>>>
90121>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
90121>>>>>>>Use DBMS.nui // Basic DBMS functions (No User Interface)
90121>>>>>>>Use TblDynAc.nui // Table, dynamic access (cDynamicTableAccess class)
Including file: tbldynac.nui (C:\Apps\VDFQuery\AppSrc\tbldynac.nui)
90121>>>>>>>>>// Use TblDynAc.nui // Table, dynamic access (cDynamicTableAccess class)
90121>>>>>>>>>
90121>>>>>>>>>// The cDynamicTableAccess enables you to define set
90121>>>>>>>>>
90121>>>>>>>>>
90121>>>>>>>>>// Use like this:
90121>>>>>>>>>//
90121>>>>>>>>>//
90121>>>>>>>>>// enumeration_list
90121>>>>>>>>>// define DBDTABLE_SYSTEM
90121>>>>>>>>>// define DBDTABLE_TABLE
90121>>>>>>>>>// define DBDTABLE_FIELD
90121>>>>>>>>>// define DBDTABLE_INDEX
90121>>>>>>>>>// end_enumeration_list
90121>>>>>>>>>//
90121>>>>>>>>>// object oDynamicTableAccess is a cDynamicTableAccess
90121>>>>>>>>>// set psRootNamePrefix to "db"
90121>>>>>>>>>//
90121>>>>>>>>>// set TableBaseData DBDTABLE_SYSTEM to "system" "DBD - System" 0
90121>>>>>>>>>// set TableBaseData DBDTABLE_TABLE to "table" "DBD - Tables" 0
90121>>>>>>>>>// set TableBaseData DBDTABLE_FIELD to "field" "DBD - Fields" 0
90121>>>>>>>>>// set TableBaseData DBDTABLE_INDEX to "index" "DBD - Indices" 0
90121>>>>>>>>>// end_object // oDynamicTableAccess
90121>>>>>>>>>//
90121>>>>>>>>>//
90121>>>>>>>>>//
90121>>>>>>>>>
90121>>>>>>>>>// Create: Mon 28-04-2003 -
90121>>>>>>>>>// Update: Tue 18-06-2003 -
90121>>>>>>>>>// Update: Sun 21-12-2003 -
90121>>>>>>>>>
90121>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
90121>>>>>>>>>Use FList.nui // A lot of FLIST- procedures and functions
90121>>>>>>>>>Use FDX_Attr.nui // FDX compatible attribute functions
90121>>>>>>>>>Use DBMS.nui // Basic DBMS functions (No User Interface)
90121>>>>>>>>>Use WildCard.nui // WildCardMatch function
90121>>>>>>>>>Use Strings.nui // String manipulation for VDF (No User Interface)
90121>>>>>>>>>Use ItemProp.nui // ITEM_PROPERTY command for use within arrays
Including file: itemprop.nui (C:\Apps\VDFQuery\AppSrc\itemprop.nui)
90121>>>>>>>>>>>// Use ItemProp.nui // ITEM_PROPERTY command for use within arrays
90121>>>>>>>>>>>
90121>>>>>>>>>>>Use Strings.nui // String manipulation for VDF
90121>>>>>>>>>>>Use Set.utl // cArray, cSet and cStack classes
90121>>>>>>>>>>>Use Array.nui // Item_Property command (No User Interface)
90121>>>>>>>>>>>
90121>>>>>>>>>>>// ************************************************
90121>>>>>>>>>>>// From here on down to the last couple of lines
90121>>>>>>>>>>>// is just one big private interface
90121>>>>>>>>>>>// ************************************************
90121>>>>>>>>>>>
90121>>>>>>>>>>>function SortValue_Number global number lnValue returns string
90123>>>>>>>>>>> integer lbNeg
90123>>>>>>>>>>> string lsValue
90123>>>>>>>>>>> move (lnValue<0) to lbNeg
90124>>>>>>>>>>> if lbNeg move (abs(lnValue)) to lnValue
90127>>>>>>>>>>> get NumToStrR lnValue 8 23 to lsValue
90128>>>>>>>>>>> // We use blank (for minus) and plus to make it sort right
90128>>>>>>>>>>> // (and we need to move the sign to the end to make it work)
90128>>>>>>>>>>> if lbNeg begin
90130>>>>>>>>>>> get String_NegateSortOrder lsValue to lsValue
90131>>>>>>>>>>> move (" "+lsValue) to lsValue
90132>>>>>>>>>>> end
90132>>>>>>>>>>>>
90132>>>>>>>>>>> else move ("+"+lsValue) to lsValue
90134>>>>>>>>>>> function_return lsValue
90135>>>>>>>>>>>end_function
90136>>>>>>>>>>>function SortValue_Real global real lrValue returns string
90138>>>>>>>>>>> string lsSortValue lsExponent
90138>>>>>>>>>>> move lrValue to lsSortValue
90139>>>>>>>>>>> move (ExtractWord(lsSortValue,"e",2)) to lsExponent
90140>>>>>>>>>>> if lsExponent ne "" replace ("e"+lsExponent) in lsSortValue with ""
90144>>>>>>>>>>> else move " " to lsSortValue
90146>>>>>>>>>>> function_return (append(lsExponent,lsSortValue))
90147>>>>>>>>>>>end_function
90148>>>>>>>>>>>function SortValue_Date global date ldValue returns string
90150>>>>>>>>>>> function_return (NumToStrR(integer(ldValue),0,6))
90151>>>>>>>>>>>end_function
90152>>>>>>>>>>>function SortValue_Integer global integer liValue returns string
90154>>>>>>>>>>> integer lbNeg
90154>>>>>>>>>>> string lsValue
90154>>>>>>>>>>> move (liValue<0) to lbNeg
90155>>>>>>>>>>> if lbNeg move (abs(liValue)) to liValue
90158>>>>>>>>>>> get NumToStrR liValue 0 10 to lsValue
90159>>>>>>>>>>> // We use blank (for minus) and plus to make it sort right
90159>>>>>>>>>>> // (and we need to move the sign to the end to make it work)
90159>>>>>>>>>>> if lbNeg begin
90161>>>>>>>>>>> get String_NegateSortOrder lsValue to lsValue
90162>>>>>>>>>>> move (" "+lsValue) to lsValue
90163>>>>>>>>>>> end
90163>>>>>>>>>>>>
90163>>>>>>>>>>> else move ("+"+lsValue) to lsValue
90165>>>>>>>>>>> function_return lsValue
90166>>>>>>>>>>>end_function
90167>>>>>>>>>>>
90167>>>>>>>>>>>function SortValueAuto global integer liType string lsValue returns string
90169>>>>>>>>>>> if liType eq ITMP_INTEGER function_return (SortValue_Integer(lsValue))
90172>>>>>>>>>>> if liType eq ITMP_STRING function_return (lsValue+" ")
90175>>>>>>>>>>> if liType eq ITMP_REAL function_return (SortValue_Real(lsValue))
90178>>>>>>>>>>> if liType eq ITMP_NUMBER function_return (SortValue_Number(lsValue))
90181>>>>>>>>>>> if liType eq ITMP_DATE function_return (SortValue_Date(lsValue))
90184>>>>>>>>>>>end_function
90185>>>>>>>>>>>
90185>>>>>>>>>>>function SortValue_ToNumber global string lsValue returns number
90187>>>>>>>>>>> function_return (number(trim(lsValue)))
90188>>>>>>>>>>>end_function
90189>>>>>>>>>>>function SortValue_ToReal global string lsValue returns real
90191>>>>>>>>>>> string lsExponent
90191>>>>>>>>>>> move (left(lsValue,4)) to lsExponent
90192>>>>>>>>>>> replace lsExponent in lsValue with ""
90194>>>>>>>>>>> if lsExponent eq "" function_return (real(lsValue))
90197>>>>>>>>>>> function_return (real(lsValue+"e"+lsExponent))
90198>>>>>>>>>>>end_function
90199>>>>>>>>>>>function SortValue_ToDate global string lsValue returns date
90201>>>>>>>>>>> function_return (date(trim(lsValue)))
90202>>>>>>>>>>>end_function
90203>>>>>>>>>>>function SortValue_ToInteger global string lsValue returns integer
90205>>>>>>>>>>> function_return (integer(trim(lsValue)))
90206>>>>>>>>>>>end_function
90207>>>>>>>>>>>
90207>>>>>>>>>>>desktop_section
90212>>>>>>>>>>> object ITMP_DataArray is a cArray
90214>>>>>>>>>>> end_object
90215>>>>>>>>>>> object ITMP_SortArray is a cArray
90217>>>>>>>>>>> end_object
90218>>>>>>>>>>> object ITMP_SortSegments is a cArray
90220>>>>>>>>>>> property integer pbDescending public 0
90222>>>>>>>>>>> item_property_list // See? It's taking its own medicine!
90222>>>>>>>>>>> item_property integer piColumn.i
90222>>>>>>>>>>> item_property integer piType.i
90222>>>>>>>>>>> item_property integer pbUppercase.i
90222>>>>>>>>>>> end_item_property_list
#REM 90262 DEFINE FUNCTION PBUPPERCASE.I INTEGER LIROW RETURNS INTEGER
#REM 90267 DEFINE PROCEDURE SET PBUPPERCASE.I INTEGER LIROW INTEGER VALUE
#REM 90272 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 90277 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 90282 DEFINE FUNCTION PICOLUMN.I INTEGER LIROW RETURNS INTEGER
#REM 90287 DEFINE PROCEDURE SET PICOLUMN.I INTEGER LIROW INTEGER VALUE
90293>>>>>>>>>>> register_function item_property_type integer liColumn returns integer
90293>>>>>>>>>>> procedure DoColumnTypes integer lhObj
90296>>>>>>>>>>> integer liMax liRow
90296>>>>>>>>>>> get row_count to liMax
90297>>>>>>>>>>> decrement liMax
90298>>>>>>>>>>> for liRow from 0 to liMax
90304>>>>>>>>>>>>
90304>>>>>>>>>>> set piType.i liRow to (item_property_type(lhObj,piColumn.i(self,liRow)))
90305>>>>>>>>>>> loop
90306>>>>>>>>>>>>
90306>>>>>>>>>>> end_procedure
90307>>>>>>>>>>> procedure DoSortData integer lhObj
90310>>>>>>>>>>> integer lhData lhSort liColumnCount liDataRowCount liDataRow
90310>>>>>>>>>>> integer liColumn liType liRow liMaxSegment liSegment lbUppercase
90310>>>>>>>>>>> string lsSortValue
90310>>>>>>>>>>> move (ITMP_DataArray(self)) to lhData
90311>>>>>>>>>>> move (ITMP_SortArray(self)) to lhSort
90312>>>>>>>>>>> send delete_data to lhData
90313>>>>>>>>>>> send delete_data to lhSort
90314>>>>>>>>>>>
90314>>>>>>>>>>> send DoColumnTypes lhObj
90315>>>>>>>>>>>
90315>>>>>>>>>>> get column_count of lhObj to liColumnCount
90316>>>>>>>>>>> send Clone_Array lhObj lhData
90317>>>>>>>>>>>
90317>>>>>>>>>>> get row_count of lhObj to liDataRowCount
90318>>>>>>>>>>> decrement liDataRowCount
90319>>>>>>>>>>>
90319>>>>>>>>>>> if (row_count(self)=1) begin // Fast
90321>>>>>>>>>>> get piColumn.i 0 to liColumn
90322>>>>>>>>>>> get piType.i 0 to liType
90323>>>>>>>>>>> get pbUppercase.i 0 to lbUppercase
90324>>>>>>>>>>> for liRow from 0 to liDataRowCount
90330>>>>>>>>>>>>
90330>>>>>>>>>>> get SortValueAuto liType (value(lhObj,liRow*liColumnCount+liColumn)) to lsSortValue
90331>>>>>>>>>>> if lbUppercase move (uppercase(lsSortValue)) to lsSortValue
90334>>>>>>>>>>> set value of lhSort item liRow to (lsSortValue+pad(string(liRow),10))
90335>>>>>>>>>>> loop
90336>>>>>>>>>>>>
90336>>>>>>>>>>> end
90336>>>>>>>>>>>>
90336>>>>>>>>>>> else begin // Not so fast
90337>>>>>>>>>>> get row_count to liMaxSegment
90338>>>>>>>>>>> decrement liMaxSegment
90339>>>>>>>>>>> for liRow from 0 to liDataRowCount
90345>>>>>>>>>>>>
90345>>>>>>>>>>> move "" to lsSortValue
90346>>>>>>>>>>> for liSegment from 0 to liMaxSegment
90352>>>>>>>>>>>>
90352>>>>>>>>>>> get piColumn.i liSegment to liColumn
90353>>>>>>>>>>> get piType.i liSegment to liType
90354>>>>>>>>>>> get pbUppercase.i liSegment to lbUppercase
90355>>>>>>>>>>> if lbUppercase ; move (lsSortValue+uppercase(SortValueAuto(liType,value(lhObj,liRow*liColumnCount+liColumn)))) to lsSortValue
90358>>>>>>>>>>> else ; move (lsSortValue+SortValueAuto(liType,value(lhObj,liRow*liColumnCount+liColumn))) to lsSortValue
90360>>>>>>>>>>> loop
90361>>>>>>>>>>>>
90361>>>>>>>>>>> set value of lhSort item liRow to (lsSortValue+pad(string(liRow),10))
90362>>>>>>>>>>> loop
90363>>>>>>>>>>>>
90363>>>>>>>>>>> end
90363>>>>>>>>>>>>
90363>>>>>>>>>>>
90363>>>>>>>>>>> if (pbDescending(self)) send sort_items to lhSort DESCENDING
90366>>>>>>>>>>> else send sort_items to lhSort
90368>>>>>>>>>>> set pbDescending to DFFALSE
90369>>>>>>>>>>>
90369>>>>>>>>>>> // Put the data back:
90369>>>>>>>>>>> for liRow from 0 to liDataRowCount
90375>>>>>>>>>>>>
90375>>>>>>>>>>> get value of lhSort item liRow to lsSortValue
90376>>>>>>>>>>> move (right(lsSortValue,10)) to liDataRow
90377>>>>>>>>>>> for liColumn from 0 to (liColumnCount-1)
90383>>>>>>>>>>>>
90383>>>>>>>>>>> set value of lhObj item (liRow*liColumnCount+liColumn) to (value(lhData,liDataRow*liColumnCount+liColumn))
90384>>>>>>>>>>> loop
90385>>>>>>>>>>>>
90385>>>>>>>>>>> loop
90386>>>>>>>>>>>>
90386>>>>>>>>>>> send delete_data to lhData
90387>>>>>>>>>>> send delete_data to lhSort
90388>>>>>>>>>>> end_procedure
90389>>>>>>>>>>> end_object
90390>>>>>>>>>>>end_desktop_section
90395>>>>>>>>>>>
90395>>>>>>>>>>>procedure ITMP_Sort_DoReset global
90397>>>>>>>>>>> send delete_data to (ITMP_SortSegments(self))
90398>>>>>>>>>>> set pbDescending of (ITMP_SortSegments(self)) to DFFALSE
90399>>>>>>>>>>>end_procedure
90400>>>>>>>>>>>procedure ITMP_Sort_DoAddSegment global integer liColumn integer lbUppercase
90402>>>>>>>>>>> integer lbTemp liRow
90402>>>>>>>>>>> if (NUM_ARGUMENTS>1) move lbUppercase to lbTemp
90405>>>>>>>>>>> else move DFFALSE to lbTemp
90407>>>>>>>>>>> get row_count of (ITMP_SortSegments(self)) to liRow
90408>>>>>>>>>>> set piColumn.i of (ITMP_SortSegments(self)) liRow to liColumn
90409>>>>>>>>>>> set pbUppercase.i of (ITMP_SortSegments(self)) liRow to lbTemp
90410>>>>>>>>>>>end_procedure
90411>>>>>>>>>>>procedure ITMP_Sort_DoSortData global integer lhObj
90413>>>>>>>>>>> send DoSortData to (ITMP_SortSegments(self)) lhObj
90414>>>>>>>>>>>end_procedure
90415>>>>>>>>>>>
90415>>>>>>>>>>>// **************************
90415>>>>>>>>>>>// Last couple of lines:
90415>>>>>>>>>>>// **************************
90415>>>>>>>>>>>
90415>>>>>>>>>>>// To sort the rows of an item_property array by the value
90415>>>>>>>>>>>// of the first subsequently the third "column",
90415>>>>>>>>>>>//
90415>>>>>>>>>>>// send sort_rows of oMyArray 0 2
90415>>>>>>>>>>>//
90415>>>>>>>>>>>procedure sort_rows for Array integer liTemp // Actually takes a variable count of parameters
90417>>>>>>>>>>> integer liArg liColumn
90417>>>>>>>>>>> send ITMP_Sort_DoReset
90418>>>>>>>>>>> for liArg from 1 to num_arguments
90424>>>>>>>>>>>>
90424>>>>>>>>>>> move liArg& to liColumn // tricky way to parse passed arguments
90425>>>>>>>>>>> send ITMP_Sort_DoAddSegment liColumn
90426>>>>>>>>>>> loop
90427>>>>>>>>>>>>
90427>>>>>>>>>>> send ITMP_Sort_DoSortData self
90428>>>>>>>>>>>end_procedure
90429>>>>>>>>>>>
90429>>>>>>>>>>>// Does the same as the one above, but sorts the rows of the array in
90429>>>>>>>>>>>// descending order:
90429>>>>>>>>>>>procedure sort_rows_descending for Array integer liTemp // Variable parameter count
90431>>>>>>>>>>> integer liArg liColumn
90431>>>>>>>>>>> send ITMP_Sort_DoReset
90432>>>>>>>>>>> set pbDescending of (ITMP_SortSegments(self)) to DFTRUE
90433>>>>>>>>>>> for liArg from 1 to num_arguments
90439>>>>>>>>>>>>
90439>>>>>>>>>>> move liArg& to liColumn // tricky way to parse passed arguments
90440>>>>>>>>>>> send ITMP_Sort_DoAddSegment liColumn
90441>>>>>>>>>>> loop
90442>>>>>>>>>>>>
90442>>>>>>>>>>> send ITMP_Sort_DoSortData self
90443>>>>>>>>>>>end_procedure
90444>>>>>>>>>
90444>>>>>>>>> class cDynamicTableAccess_Help is a cArray // Private class
90445>>>>>>>>> item_property_list
90445>>>>>>>>> item_property integer piFile.i
90445>>>>>>>>> item_property string psPrefix.i
90445>>>>>>>>> item_property string psOpenDescription.i
90445>>>>>>>>> end_item_property_list cDynamicTableAccess_Help
#REM 90480 DEFINE FUNCTION PSOPENDESCRIPTION.I INTEGER LIROW RETURNS STRING
#REM 90484 DEFINE PROCEDURE SET PSOPENDESCRIPTION.I INTEGER LIROW STRING VALUE
#REM 90488 DEFINE FUNCTION PSPREFIX.I INTEGER LIROW RETURNS STRING
#REM 90492 DEFINE PROCEDURE SET PSPREFIX.I INTEGER LIROW STRING VALUE
#REM 90496 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 90500 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
90505>>>>>>>>> procedure add_prefix integer liFile string lsPrefix string lsOpenDescription
90507>>>>>>>>> integer liRow
90507>>>>>>>>> get row_count to liRow
90508>>>>>>>>> set piFile.i liRow to liFile
90509>>>>>>>>> set psPrefix.i liRow to lsPrefix
90510>>>>>>>>> set psOpenDescription.i liRow to lsOpenDescription
90511>>>>>>>>> end_procedure
90512>>>>>>>>> end_class // cDynamicTableAccess_Help
90513>>>>>>>>>
90513>>>>>>>>>class cDynamicTableAccess is a cArray
90514>>>>>>>>> procedure construct_object // Private
90516>>>>>>>>> forward send construct_object
90518>>>>>>>>>
90518>>>>>>>>> property string psRootNamePrefix public ""
90519>>>>>>>>> property string psPurpose public ""
90520>>>>>>>>>
90520>>>>>>>>> //> This boolean property determines if the object attempt to open the tables
90520>>>>>>>>> //> on 'end_construct_object'.
90520>>>>>>>>> property integer pbOpenTablesOnDefine public TRUE
90521>>>>>>>>> //> Allow the object to open the tables even if they are not listed in filelist.cfg?
90521>>>>>>>>> property integer pbAllowTemporaryFilelistEntries public TRUE
90522>>>>>>>>>
90522>>>>>>>>> property integer pbAllTablesAreOpen private FALSE
90523>>>>>>>>> property integer piOpenMode private DF_SHARE
90524>>>>>>>>>
90524>>>>>>>>>///// object oTempArray is a cArray NO_IMAGE
90524>>>>>>>>>///// end_object
90524>>>>>>>>>
90524>>>>>>>>> object oListOfSets is a cDynamicTableAccess_Help
90526>>>>>>>>> end_object
90527>>>>>>>>> end_procedure
90528>>>>>>>>>
90528>>>>>>>>> procedure DeclareOpenError string lsError
90530>>>>>>>>> move (replace("#",lsError,psRootNamePrefix(self))) to lsError
90531>>>>>>>>> error 208 lsError
90532>>>>>>>>>>
90532>>>>>>>>> end_procedure
90533>>>>>>>>>
90533>>>>>>>>> function pbAllTablesAreOpen returns integer
90535>>>>>>>>> function_return (!$.pbAllTablesAreOpen(self))
90536>>>>>>>>> end_function
90537>>>>>>>>>
90537>>>>>>>>> item_property_list
90537>>>>>>>>> item_property integer piFile.i
90537>>>>>>>>> item_property string psRootname.i
90537>>>>>>>>> item_property string psLogicalName.i
90537>>>>>>>>> item_property string psUserName.i
90537>>>>>>>>>
90537>>>>>>>>> item_property string psRootOfRootName.i
90537>>>>>>>>> item_property string psRootOfUserName.i
90537>>>>>>>>> item_property integer piOpenByIndex.i
90537>>>>>>>>>
90537>>>>>>>>> item_property integer piOpenState.i // -1:Open by foreign table 0:Not opened 1:Open
90537>>>>>>>>> end_item_property_list cDynamicTableAccess
#REM 90587 DEFINE FUNCTION PIOPENSTATE.I INTEGER LIROW RETURNS INTEGER
#REM 90591 DEFINE PROCEDURE SET PIOPENSTATE.I INTEGER LIROW INTEGER VALUE
#REM 90595 DEFINE FUNCTION PIOPENBYINDEX.I INTEGER LIROW RETURNS INTEGER
#REM 90599 DEFINE PROCEDURE SET PIOPENBYINDEX.I INTEGER LIROW INTEGER VALUE
#REM 90603 DEFINE FUNCTION PSROOTOFUSERNAME.I INTEGER LIROW RETURNS STRING
#REM 90607 DEFINE PROCEDURE SET PSROOTOFUSERNAME.I INTEGER LIROW STRING VALUE
#REM 90611 DEFINE FUNCTION PSROOTOFROOTNAME.I INTEGER LIROW RETURNS STRING
#REM 90615 DEFINE PROCEDURE SET PSROOTOFROOTNAME.I INTEGER LIROW STRING VALUE
#REM 90619 DEFINE FUNCTION PSUSERNAME.I INTEGER LIROW RETURNS STRING
#REM 90623 DEFINE PROCEDURE SET PSUSERNAME.I INTEGER LIROW STRING VALUE
#REM 90627 DEFINE FUNCTION PSLOGICALNAME.I INTEGER LIROW RETURNS STRING
#REM 90631 DEFINE PROCEDURE SET PSLOGICALNAME.I INTEGER LIROW STRING VALUE
#REM 90635 DEFINE FUNCTION PSROOTNAME.I INTEGER LIROW RETURNS STRING
#REM 90639 DEFINE PROCEDURE SET PSROOTNAME.I INTEGER LIROW STRING VALUE
#REM 90643 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 90647 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
90652>>>>>>>>>
90652>>>>>>>>> procedure set TableBaseData integer liRow string lsRootOfRoot string lsRootOfUser integer liOpenByIndex
90654>>>>>>>>> set psRootOfRootName.i liRow to lsRootOfRoot
90655>>>>>>>>> set psRootOfUserName.i liRow to lsRootOfUser
90656>>>>>>>>> set piOpenByIndex.i liRow to liOpenByIndex
90657>>>>>>>>> end_procedure
90658>>>>>>>>>
90658>>>>>>>>> procedure set TableAccess integer liRow integer liFile string lsRootname string lsLogicalName string lsUserName // Private
90660>>>>>>>>> set piFile.i liRow to liFile
90661>>>>>>>>> set psRootname.i liRow to lsRootname
90662>>>>>>>>> set psLogicalName.i liRow to lsLogicalName
90663>>>>>>>>> set psUserName.i liRow to lsUserName
90664>>>>>>>>> end_procedure
90665>>>>>>>>>
90665>>>>>>>>> procedure DoCalcFilelistValues // Private
90667>>>>>>>>> integer liMax liRow
90667>>>>>>>>> string lsPrefix lsPurpose
90667>>>>>>>>> get psPurpose to lsPurpose
90668>>>>>>>>> if (lsPurpose<>"") move (" ("+lsPurpose+")") to lsPurpose
90671>>>>>>>>>
90671>>>>>>>>> get psRootNamePrefix to lsPrefix
90672>>>>>>>>> move (lowercase(trim(lsPrefix))) to lsPrefix
90673>>>>>>>>> get row_count to liMax
90674>>>>>>>>> decrement liMax
90675>>>>>>>>> for liRow from 0 to liMax
90681>>>>>>>>>>
90681>>>>>>>>> set TableAccess liRow to 0 (lsPrefix+psRootOfRootName.i(self,liRow)) (lsPrefix+psRootOfRootName.i(self,liRow)) (psRootOfUserName.i(self,liRow)+lsPurpose)
90682>>>>>>>>> loop
90683>>>>>>>>>>
90683>>>>>>>>> end_procedure
90684>>>>>>>>>
90684>>>>>>>>> function iFind_FL_Entry_By_LogName string lsLogName returns integer // Private
90686>>>>>>>>> integer liFile
90686>>>>>>>>> string lsFilelistValue
90686>>>>>>>>> move (lowercase(lsLogName)) to lsLogName
90687>>>>>>>>> move 0 to liFile
90688>>>>>>>>> repeat
90688>>>>>>>>>>
90688>>>>>>>>> get_attribute DF_FILE_NEXT_USED of liFile to liFile
90691>>>>>>>>> if liFile begin
90693>>>>>>>>> get_attribute DF_FILE_LOGICAL_NAME of liFile to lsFilelistValue
90696>>>>>>>>> if (lowercase(lsFilelistValue)=lsLogName) function_return liFile
90699>>>>>>>>> end
90699>>>>>>>>>>
90699>>>>>>>>> until liFile eq 0
90701>>>>>>>>> function_return -1
90702>>>>>>>>> end_function
90703>>>>>>>>>
90703>>>>>>>>> procedure FindExistingFileListEntries // Private
90705>>>>>>>>> integer liMax liRow liFile
90705>>>>>>>>> string lsLogical
90705>>>>>>>>> get row_count to liMax
90706>>>>>>>>> decrement liMax
90707>>>>>>>>> for liRow from 0 to liMax
90713>>>>>>>>>>
90713>>>>>>>>> if (piFile.i(self,liRow)=0) begin
90715>>>>>>>>> get psLogicalName.i liRow to lsLogical
90716>>>>>>>>> get iFind_FL_Entry_By_LogName lsLogical to liFile
90717>>>>>>>>> if (liFile>0) set piFile.i liRow to liFile
90720>>>>>>>>> end
90720>>>>>>>>>>
90720>>>>>>>>> loop
90721>>>>>>>>>>
90721>>>>>>>>> end_procedure
90722>>>>>>>>>
90722>>>>>>>>> // Find an empty entry in filelist cfg, that is not temporarily used
90722>>>>>>>>> // by an "open as" statement. Start the search at entry liFile.
90722>>>>>>>>> function iFind_FL_Entry_Unused integer liFile returns integer // Private
90724>>>>>>>>> integer lbOpened
90724>>>>>>>>> repeat
90724>>>>>>>>>>
90724>>>>>>>>> get_attribute DF_FILE_NEXT_EMPTY of liFile to liFile
90727>>>>>>>>> if liFile begin
90729>>>>>>>>> //get_attribute DF_FILE_NEXT_OPENED of liFile to lbOpened
90729>>>>>>>>> get_attribute DF_FILE_OPENED of liFile to lbOpened
90732>>>>>>>>> ifnot lbOpened function_return liFile
90735>>>>>>>>> end
90735>>>>>>>>>>
90735>>>>>>>>> until liFile eq 0
90737>>>>>>>>> function_return -1
90738>>>>>>>>> end_function
90739>>>>>>>>>
90739>>>>>>>>>////// // Find liHowMany empty entries in filelist cfg, that are not temporarily used
90739>>>>>>>>>////// // by an "open as" statement. Start the search at entry liFile. The function
90739>>>>>>>>>////// // returns the number of the first such entry or 0 if none is found.
90739>>>>>>>>>////// function iFind_FL_Entries_Unused integer liFile integer liHowMany returns integer // Private
90739>>>>>>>>>////// integer lhTempArray
90739>>>>>>>>>////// move oTempArray to lhTempArray
90739>>>>>>>>>////// repeat
90739>>>>>>>>>////// get iFind_FL_Entry_Unused liFile to liFile
90739>>>>>>>>>//////
90739>>>>>>>>>////// until liFile eq 0
90739>>>>>>>>>////// function_return 0
90739>>>>>>>>>////// end_function
90739>>>>>>>>>
90739>>>>>>>>> function bConvertFilelistTo4095 returns integer
90741>>>>>>>>> function_return 0
90742>>>>>>>>>// function_return (MB_Verify4("Your filelist.cfg is an old one","with less than 256 entries.","","Should it be converted to a 4095 entry filelist?",1))
90742>>>>>>>>> end_function
90743>>>>>>>>>
90743>>>>>>>>> procedure AutoAssignFileListEntries // Private
90745>>>>>>>>> end_procedure
90746>>>>>>>>>
90746>>>>>>>>> procedure AutoAssignTemporaryFileListEntries // Private
90748>>>>>>>>> integer liMax liRow liFile
90748>>>>>>>>> string lsLogical
90748>>>>>>>>>
90748>>>>>>>>> if (FLIST_Information(FLINFO_LT_256)) begin
90750>>>>>>>>> if (bConvertFilelistTo4095(self)) send FLIST_Make4095
90753>>>>>>>>> end
90753>>>>>>>>>>
90753>>>>>>>>> send FindExistingFileListEntries
90754>>>>>>>>>
90754>>>>>>>>> if (pbAllowTemporaryFilelistEntries(self)) begin
90756>>>>>>>>> get row_count to liMax
90757>>>>>>>>> decrement liMax
90758>>>>>>>>> move 400 to liFile // We start at 400
90759>>>>>>>>> for liRow from 0 to liMax
90765>>>>>>>>>>
90765>>>>>>>>> if (piFile.i(self,liRow)=0) begin
90767>>>>>>>>> get iFind_FL_Entry_Unused liFile to liFile
90768>>>>>>>>> if (liFile>0) set piFile.i liRow to liFile
90771>>>>>>>>> else procedure_return
90773>>>>>>>>> end
90773>>>>>>>>>>
90773>>>>>>>>> loop
90774>>>>>>>>>>
90774>>>>>>>>> end
90774>>>>>>>>>>
90774>>>>>>>>> end_procedure
90775>>>>>>>>>
90775>>>>>>>>> procedure DoCloseTables
90777>>>>>>>>> integer liMax liRow liFile
90777>>>>>>>>> string lsRoot
90777>>>>>>>>> get row_count to liMax
90778>>>>>>>>> decrement liMax
90779>>>>>>>>> for liRow from 0 to liMax
90785>>>>>>>>>>
90785>>>>>>>>> get piFile.i liRow to liFile
90786>>>>>>>>> if (liFile<>0 and piOpenState.i(self,liRow)=1) begin
90788>>>>>>>>> close liFile
90789>>>>>>>>> set piOpenState.i liRow to 0
90790>>>>>>>>> end
90790>>>>>>>>>>
90790>>>>>>>>> loop
90791>>>>>>>>>>
90791>>>>>>>>> set !$.pbAllTablesAreOpen to false
90792>>>>>>>>> end_procedure
90793>>>>>>>>>
90793>>>>>>>>> procedure OnAllTablesOpened
90795>>>>>>>>> // Augment to set relationships
90795>>>>>>>>> end_procedure
90796>>>>>>>>>
90796>>>>>>>>> function DoOpenTables returns integer
90798>>>>>>>>> integer liMax liRow liFile liOpened liOpenMode
90798>>>>>>>>> string lsRoot
90798>>>>>>>>> get !$.piOpenMode to liOpenMode // DF_SHARE or DF_EXCLUSIVE
90799>>>>>>>>> send DoCalcFilelistValues
90800>>>>>>>>> send AutoAssignTemporaryFileListEntries
90801>>>>>>>>> get row_count to liMax
90802>>>>>>>>> decrement liMax
90803>>>>>>>>> for liRow from 0 to liMax
90809>>>>>>>>>>
90809>>>>>>>>> get piFile.i liRow to liFile
90810>>>>>>>>> if (liFile<>0) begin
90812>>>>>>>>> // At this point it would be fair to check that the entry is not
90812>>>>>>>>> // already open with an irrelevant file. If this is found to be
90812>>>>>>>>> // the case piOpenState.i should be set to -1.
90812>>>>>>>>> get psRootname.i liRow to lsRoot
90813>>>>>>>>> get DBMS_OpenFileAs lsRoot liFile liOpenMode (piOpenByIndex.i(self,liRow)) to liOpened
90814>>>>>>>>> ifnot liOpened get DBMS_OpenFileAs (lsRoot+".int") liFile liOpenMode (piOpenByIndex.i(self,liRow)) to liOpened
90817>>>>>>>>>
90817>>>>>>>>> set piOpenState.i liRow to (if(liOpened,1,0))
90818>>>>>>>>> end
90818>>>>>>>>>>
90818>>>>>>>>> else move 0 to liOpened
90820>>>>>>>>> ifnot liOpened begin
90822>>>>>>>>> send DoCloseTables
90823>>>>>>>>> function_return 0 // error
90824>>>>>>>>> end
90824>>>>>>>>>>
90824>>>>>>>>> loop
90825>>>>>>>>>>
90825>>>>>>>>> set !$.pbAllTablesAreOpen to true
90826>>>>>>>>> send OnAllTablesOpened
90827>>>>>>>>> function_return 1 // ok
90828>>>>>>>>> end_function
90829>>>>>>>>> function DoOpenTablesExclusive returns integer
90831>>>>>>>>> integer liRval
90831>>>>>>>>> set !$.piOpenMode to DF_EXCLUSIVE
90832>>>>>>>>> get DoOpenTables to liRval
90833>>>>>>>>> set !$.piOpenMode to DF_SHARE
90834>>>>>>>>> function_return liRval
90835>>>>>>>>> end_function
90836>>>>>>>>>
90836>>>>>>>>> // The Precond_TableInFilelist and Precond_TableOnDisk functions are
90836>>>>>>>>> // only here so that a package that wants to create a set of tables
90836>>>>>>>>> // can ask these sensible cousins if *they* think that's alright.
90836>>>>>>>>> function Precond_TableInFilelist string lsRootname integer lbQuiet returns integer
90838>>>>>>>>> integer liFile
90838>>>>>>>>> string lsError
90838>>>>>>>>> get FDX_FindRootName 0 lsRootname 0 to liFile
90839>>>>>>>>> if (liFile and not(lbQuiet)) begin
90841>>>>>>>>> move "A table with root-name '#' is already listed in filelist.cfg at entry #" to lsError
90842>>>>>>>>> move (replace("#",lsError,lsRootname)) to lsError
90843>>>>>>>>> move (replace("#",lsError,string(liFile))) to lsError
90844>>>>>>>>> error 201 lsError
90845>>>>>>>>>>
90845>>>>>>>>> function_return 1
90846>>>>>>>>> end
90846>>>>>>>>>>
90846>>>>>>>>> get FDX_FindLogicalName 0 lsRootname 0 to liFile
90847>>>>>>>>> if (liFile and not(lbQuiet)) begin
90849>>>>>>>>> move "A table with logical name '#' is already listed in filelist.cfg at entry #" to lsError
90850>>>>>>>>> move (replace("#",lsError,lsRootname)) to lsError
90851>>>>>>>>> move (replace("#",lsError,string(liFile))) to lsError
90852>>>>>>>>> error 201 lsError
90853>>>>>>>>>>
90853>>>>>>>>> function_return 1
90854>>>>>>>>> end
90854>>>>>>>>>>
90854>>>>>>>>> function_return 0
90855>>>>>>>>> end_function
90856>>>>>>>>>
90856>>>>>>>>> function Precond_TableOnDisk string lsRootname integer lbQuiet returns integer
90858>>>>>>>>> string lsError lsPath
90858>>>>>>>>> get SEQ_FindFileAlongDFPath (lsRootName+".dat") to lsPath
90859>>>>>>>>> if (lsPath<>"" and not(lbQuiet)) begin
90861>>>>>>>>> move "A file named '#' is found in this folder: #" to lsError
90862>>>>>>>>> move (replace("#",lsError,lsRootname+".dat")) to lsError
90863>>>>>>>>> move (replace("#",lsError,lsPath)) to lsError
90864>>>>>>>>> error 204 lsError
90865>>>>>>>>>>
90865>>>>>>>>> function_return 1
90866>>>>>>>>> end
90866>>>>>>>>>>
90866>>>>>>>>> get SEQ_FindFileAlongDFPath (lsRootName+".int") to lsPath
90867>>>>>>>>> if (lsPath<>"" and not(lbQuiet)) begin
90869>>>>>>>>> move "A file named '#' is found in this folder: #" to lsError
90870>>>>>>>>> move (replace("#",lsError,lsRootname+".int")) to lsError
90871>>>>>>>>> move (replace("#",lsError,lsPath)) to lsError
90872>>>>>>>>> error 204 lsError
90873>>>>>>>>>>
90873>>>>>>>>> function_return 1
90874>>>>>>>>> end
90874>>>>>>>>>>
90874>>>>>>>>> function_return 0
90875>>>>>>>>> end_function
90876>>>>>>>>>
90876>>>>>>>>> function Precond_CreateTables integer lbQuiet returns integer
90878>>>>>>>>> integer liMax liRow lbOK liFile
90878>>>>>>>>> string lsRoot
90878>>>>>>>>> get row_count to liMax
90879>>>>>>>>> decrement liMax
90880>>>>>>>>> move 1 to lbOK
90881>>>>>>>>> for liRow from 0 to liMax
90887>>>>>>>>>>
90887>>>>>>>>> get psRootname.i liRow to lsRoot
90888>>>>>>>>> get Precond_TableInFilelist lsRoot lbQuiet to liFile
90889>>>>>>>>> if liFile move 0 to lbOK
90892>>>>>>>>> loop
90893>>>>>>>>>>
90893>>>>>>>>> if (not(lbOK) and not(lbQuiet)) begin
90895>>>>>>>>> error 203 "This function cannot create tables that are already listed in filelist.cfg"
90896>>>>>>>>>>
90896>>>>>>>>> function_return 0
90897>>>>>>>>> end
90897>>>>>>>>>>
90897>>>>>>>>> for liRow from 0 to liMax
90903>>>>>>>>>>
90903>>>>>>>>> get psRootname.i liRow to lsRoot
90904>>>>>>>>> get Precond_TableOnDisk lsRoot lbQuiet to liFile
90905>>>>>>>>> if liFile move 0 to lbOK
90908>>>>>>>>> loop
90909>>>>>>>>>>
90909>>>>>>>>> if (not(lbOK) and not(lbQuiet)) begin
90911>>>>>>>>> error 205 "This function cannot create tables that are already found on disk"
90912>>>>>>>>>>
90912>>>>>>>>> function_return 0
90913>>>>>>>>> end
90913>>>>>>>>>>
90913>>>>>>>>> function_return 1
90914>>>>>>>>> end_function
90915>>>>>>>>>
90915>>>>>>>>> function iMainFileRecords returns integer
90917>>>>>>>>> integer liFile liRecords
90917>>>>>>>>> move -1 to liRecords
90918>>>>>>>>> if (pbAllTablesAreOpen(self)) begin
90920>>>>>>>>> get piFile.i 0 to liFile
90921>>>>>>>>> if liFile get_attribute DF_FILE_RECORDS_USED of liFile to liRecords
90926>>>>>>>>> end
90926>>>>>>>>>>
90926>>>>>>>>> function_return liRecords
90927>>>>>>>>> end_function
90928>>>>>>>>>
90928>>>>>>>>> function OpenDescription returns string
90930>>>>>>>>> integer liMainFileRecords
90930>>>>>>>>> if (pbAllTablesAreOpen(self)) begin
90932>>>>>>>>> get iMainFileRecords to liMainFileRecords
90933>>>>>>>>> function_return (string(liMainFileRecords)+" records in main file")
90934>>>>>>>>> end
90934>>>>>>>>>>
90934>>>>>>>>> else function_return ""
90936>>>>>>>>> end_function
90937>>>>>>>>>
90937>>>>>>>>> // Only meant for applications that wants to create and
90937>>>>>>>>> // (in this case) drop databases automatically:
90937>>>>>>>>> function DoEraseAllTables returns integer
90939>>>>>>>>> integer liMax liRow liFile lbDrop lbExclusive
90939>>>>>>>>> string lsRootName1 lsRootName2
90939>>>>>>>>> send DoCloseTables
90940>>>>>>>>> send DoCalcFilelistValues
90941>>>>>>>>> send FindExistingFileListEntries
90942>>>>>>>>> get DoOpenTablesExclusive to lbExclusive
90943>>>>>>>>> send DoCloseTables
90944>>>>>>>>> if lbExclusive begin
90946>>>>>>>>> get row_count to liMax
90947>>>>>>>>> decrement liMax
90948>>>>>>>>> move 1 to lbDrop
90949>>>>>>>>> for liRow from 0 to liMax
90955>>>>>>>>>>
90955>>>>>>>>> get piFile.i liRow to liFile
90956>>>>>>>>> if liFile begin
90958>>>>>>>>> get_attribute DF_FILE_ROOT_NAME of liFile to lsRootName1
90961>>>>>>>>> get psRootname.i liRow to lsRootName2
90962>>>>>>>>> ifnot (lowercase(DBMS_StripPathAndDriver(lsRootName1))=lowercase(lsRootName2)) move 0 to lbDrop
90965>>>>>>>>> end
90965>>>>>>>>>>
90965>>>>>>>>> loop
90966>>>>>>>>>>
90966>>>>>>>>> if lbDrop begin
90968>>>>>>>>> for liRow from 0 to liMax
90974>>>>>>>>>>
90974>>>>>>>>> get piFile.i liRow to liFile
90975>>>>>>>>> if liFile begin
90977>>>>>>>>> get DBMS_EraseDfFile liFile "" to lbDrop
90978>>>>>>>>> set_attribute DF_FILE_LOGICAL_NAME of liFile to ""
90981>>>>>>>>> set_attribute DF_FILE_ROOT_NAME of liFile to ""
90984>>>>>>>>> set_attribute DF_FILE_DISPLAY_NAME of liFile to ""
90987>>>>>>>>> end
90987>>>>>>>>>>
90987>>>>>>>>> else begin
90988>>>>>>>>> get psRootname.i liRow to lsRootName2
90989>>>>>>>>> get DBMS_EraseDfFile 0 lsRootName2 to lbDrop
90990>>>>>>>>> end
90990>>>>>>>>>>
90990>>>>>>>>> loop
90991>>>>>>>>>>
90991>>>>>>>>> end
90991>>>>>>>>>>
90991>>>>>>>>> end
90991>>>>>>>>>>
90991>>>>>>>>> else begin
90992>>>>>>>>> //error 206 "Table(s) could not be dropped"
90992>>>>>>>>> move 0 to lbDrop
90993>>>>>>>>> end
90993>>>>>>>>>>
90993>>>>>>>>> function_return lbDrop
90994>>>>>>>>> end_function
90995>>>>>>>>>
90995>>>>>>>>> // Call this to search the filelist.cfg for existing sets of tables that matches the
90995>>>>>>>>> // psRootOfRootName.i (i.e. matches except for the prefix). Makes a list of complete
90995>>>>>>>>> // FTS databases that are available in the current filelist.
90995>>>>>>>>> // NOTE that calling this procedure will close the set of tables that the object currently
90995>>>>>>>>> // has opened, if any (this is also for "God" applications only).
90995>>>>>>>>> procedure DoBuildSetsOfTables
90997>>>>>>>>> integer lhSetOfSets liFile
90997>>>>>>>>> string lsPush lsRootOfRoot lsRoot lsPrefix lsOpenDescription
90997>>>>>>>>> move (oListOfSets(self)) to lhSetOfSets
90998>>>>>>>>> send delete_data to lhSetOfSets
90999>>>>>>>>> send DoCloseTables
91000>>>>>>>>> get psRootNamePrefix to lsPush
91001>>>>>>>>> if (row_count(self)) begin
91003>>>>>>>>> get psRootOfRootName.i 0 to lsRootOfRoot
91004>>>>>>>>> send WildCardMatchPrepare ("*"+lowercase(lsRootOfRoot))
91005>>>>>>>>> move 0 to liFile
91006>>>>>>>>> repeat
91006>>>>>>>>>>
91006>>>>>>>>> get FDX_AttrValue_FLSTNAV 0 DF_FILE_NEXT_USED liFile to liFile
91007>>>>>>>>> if liFile begin // If any more files
91009>>>>>>>>> get FDX_AttrValue_FILELIST 0 DF_FILE_ROOT_NAME liFile to lsRoot
91010>>>>>>>>> get DBMS_StripPathAndDriver lsRoot to lsRoot
91011>>>>>>>>> if (WildCardMatch(lowercase(lsRoot))) begin // If the root name matches our own first root name
91013>>>>>>>>> get StringLeftBut lsRoot (length(lsRootOfRoot)) to lsPreFix
91014>>>>>>>>> set psRootNamePrefix to lsPrefix
91015>>>>>>>>> if (DoOpenTables(self)) begin
91017>>>>>>>>> get OpenDescription to lsOpenDescription
91018>>>>>>>>> send add_prefix to lhSetOfSets liFile lsPrefix lsOpenDescription
91019>>>>>>>>> send DoCloseTables
91020>>>>>>>>> end
91020>>>>>>>>>>
91020>>>>>>>>> end
91020>>>>>>>>>>
91020>>>>>>>>> end
91020>>>>>>>>>>
91020>>>>>>>>> until (not(liFile))
91022>>>>>>>>> send sort_rows to lhSetOfSets 1
91023>>>>>>>>> end
91023>>>>>>>>>>
91023>>>>>>>>> set psRootNamePrefix to lsPush
91024>>>>>>>>> end_procedure
91025>>>>>>>>>
91025>>>>>>>>> procedure end_construct_object
91027>>>>>>>>> forward send end_construct_object
91029>>>>>>>>> if (pbOpenTablesOnDefine(self)) begin
91031>>>>>>>>> ifnot (DoOpenTables(self)) send DeclareOpenError "Tables could not be opened (#)" // Open the tables
91034>>>>>>>>> end
91034>>>>>>>>>>
91034>>>>>>>>> end_procedure
91035>>>>>>>>>
91035>>>>>>>>>end_class // cDynamicTableAccess
91036>>>>>>>
91036>>>>>>>enumeration_list
91036>>>>>>> define FTSTABLE_WORD
91036>>>>>>> define FTSTABLE_ARTWRD
91036>>>>>>> define FTSTABLE_ARTPHR
91036>>>>>>> define FTSTABLE_ARTICL
91036>>>>>>> define FTSTABLE_SEARCH
91036>>>>>>>end_enumeration_list
91036>>>>>>>
91036>>>>>>>class cFTS_TableAccess is a cDynamicTableAccess
91037>>>>>>> procedure construct_object
91039>>>>>>> forward send construct_object
91041>>>>>>>
91041>>>>>>> set pbAllowTemporaryFilelistEntries to FALSE
91042>>>>>>>
91042>>>>>>> // These two properties are set automatically when tables are opened
91042>>>>>>> property integer piArticleIdWidth public 0 // NUMERIC 6.0
91043>>>>>>> property integer piPhraseLength public 0 // Minimum 6, maximum 14
91044>>>>>>>
91044>>>>>>> set psRootNamePrefix to "ft"
91045>>>>>>>
91045>>>>>>> set TableBaseData FTSTABLE_WORD to "word" "FTS - Words" 0
91046>>>>>>> set TableBaseData FTSTABLE_ARTWRD to "artwrd" "FTS - Article words" 2
91047>>>>>>> set TableBaseData FTSTABLE_ARTPHR to "artphr" "FTS - Phrases" 2
91048>>>>>>> set TableBaseData FTSTABLE_ARTICL to "articl" "FTS - Articles" 0
91049>>>>>>> set TableBaseData FTSTABLE_SEARCH to "search" "FTS - Searches" 0
91050>>>>>>> end_procedure
91051>>>>>>>
91051>>>>>>> function FTS_ValidatePrefix string lsPrefix returns integer
91053>>>>>>> integer lbOK
91053>>>>>>> move (lowercase(trim(lsPrefix))) to lsPrefix
91054>>>>>>> if (length(lsPrefix)=2) begin
91056>>>>>>> get StringConsistsOf (left(lsPrefix,1)) "abcdefghijklmnopqrstuvwxyz" to lbOK
91057>>>>>>> if lbOK get StringConsistsOf (left(lsPrefix,2)) "abcdefghijklmnopqrstuvwxyz01234567890" to lbOK
91060>>>>>>> end
91060>>>>>>>>
91060>>>>>>> else move 0 to lbOK
91062>>>>>>> ifnot lbOK begin
91064>>>>>>> error 209 "Prefix must be two letters (or a letter and a digit)"
91065>>>>>>>>
91065>>>>>>> function_return 0
91066>>>>>>> end
91066>>>>>>>>
91066>>>>>>> function_return 1
91067>>>>>>> end_function
91068>>>>>>>
91068>>>>>>> function DoOpenTables returns integer
91070>>>>>>> integer liRval liFile liLen
91070>>>>>>> forward get DoOpenTables to liRval
91072>>>>>>> if liRval begin // Tables opened succesfully
91074>>>>>>> // If openened we must set the piArticleIdWidth and piPhraseLength properties
91074>>>>>>>
91074>>>>>>> // First we will find the definition of the xxArticl.Article_Id field:
91074>>>>>>> get piFile.i FTSTABLE_ARTICL to liFile
91075>>>>>>> get_attribute DF_FIELD_LENGTH of liFile 1 to liLen // xxArticl.Article_Id
91078>>>>>>> set piArticleIdWidth to liLen
91079>>>>>>>
91079>>>>>>> // Secondly, determine the phrase length set by the xxArtPhr file
91079>>>>>>> get piFile.i FTSTABLE_ARTPHR to liFile
91080>>>>>>> get_attribute DF_FILE_NUMBER_FIELDS of liFile to liLen
91083>>>>>>> set piPhraseLength to (liLen-1) // The first field of the xxArtPhr file is the Article_Id
91084>>>>>>>
91084>>>>>>> end
91084>>>>>>>>
91084>>>>>>> function_return liRval
91085>>>>>>> end_function
91086>>>>>>> procedure DeclareOpenError string lsError
91088>>>>>>> move (replace("#",lsError,psRootNamePrefix(self))) to lsError
91089>>>>>>> send error 718 lsError
91090>>>>>>> end_procedure
91091>>>>>>> function DoZerofileAllTables returns integer // (Except the search table)
91093>>>>>>> integer lbSuccess liFile
91093>>>>>>> move DFFALSE to lbSuccess
91094>>>>>>> if (pbAllTablesAreOpen(self)) begin
91096>>>>>>> send DoCloseTables
91097>>>>>>>
91097>>>>>>> if (DoOpenTablesExclusive(self)) begin
91099>>>>>>> get piFile.i FTSTABLE_WORD to liFile
91100>>>>>>> zerofile liFile
91101>>>>>>> get piFile.i FTSTABLE_ARTWRD to liFile
91102>>>>>>> zerofile liFile
91103>>>>>>> get piFile.i FTSTABLE_ARTPHR to liFile
91104>>>>>>> zerofile liFile
91105>>>>>>> get piFile.i FTSTABLE_ARTICL to liFile
91106>>>>>>> zerofile liFile
91107>>>>>>> move DFTRUE to lbSuccess
91108>>>>>>> end
91108>>>>>>>>
91108>>>>>>> else send DeclareOpenError "Exclusive access could not be obtained (#)"
91110>>>>>>> ifnot (DoOpenTables(self)) send DeclareOpenError "FTS tables could not be re-opened (#)"
91113>>>>>>> end
91113>>>>>>>>
91113>>>>>>> function_return lbSuccess
91114>>>>>>> end_function
91115>>>>>>> procedure DoCloseTables
91117>>>>>>> forward send DoCloseTables
91119>>>>>>> set piArticleIdWidth to 0
91120>>>>>>> set piPhraseLength to 0
91121>>>>>>> end_procedure
91122>>>>>>> function OpenDescription returns string
91124>>>>>>> string lsValue
91124>>>>>>> if (pbAllTablesAreOpen(self)) begin
91126>>>>>>> move "# articles (art.id width: #, phrase length: #)" to lsValue
91127>>>>>>> move (replace("#",lsValue,string(iMainFileRecords(self)))) to lsValue
91128>>>>>>> move (replace("#",lsValue,string(piArticleIdWidth(self)))) to lsValue
91129>>>>>>> move (replace("#",lsValue,string(piPhraseLength(self)))) to lsValue
91130>>>>>>> end
91130>>>>>>>>
91130>>>>>>> else move "" to lsValue
91132>>>>>>> function_return lsValue
91133>>>>>>> end_function
91134>>>>>>> procedure end_construct_object
91136>>>>>>> integer lhSelf
91136>>>>>>> forward send end_construct_object
91138>>>>>>> move self to lhSelf
91139>>>>>>> set phTableAccessObject to lhSelf // This is resolved in the encapsulating cFTS_System object
91140>>>>>>> if (pbOpenTablesOnDefine(self)) begin
91142>>>>>>> ifnot (DoOpenTables(self)) send DeclareOpenError "FTS tables could not be opened (#)" // Open the tables
91145>>>>>>> end
91145>>>>>>>>
91145>>>>>>> end_procedure
91146>>>>>>>end_class // cFTS_TableAccess
91147>>>>>Use DBMS.nui // Basic DBMS functions (No User Interface)
91147>>>>>Use FTSTblCr.pkg // Free text search - Create FTS tables
Including file: ftstblcr.pkg (C:\Apps\VDFQuery\AppSrc\ftstblcr.pkg)
91147>>>>>>>// Use FTSTblCr.pkg // Free text search - Create FTS tables
91147>>>>>>>
91147>>>>>>>Use FTSData.nui // cFTS_TableAccess class.
91147>>>>>>>Use TblCreate // cTableCreator class
Including file: tblcreate.pkg (C:\Apps\VDFQuery\AppSrc\tblcreate.pkg)
91147>>>>>>>>>// Use TblCreate // cTableCreator class
91147>>>>>>>>>
91147>>>>>>>>>// Use this the cTableCreator class to store a table definition and have
91147>>>>>>>>>// the application create it when needed.
91147>>>>>>>>>
91147>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
91147>>>>>>>>>Use API_Attr.nui // Functions for querying API attributes
91147>>>>>>>>>Use FDX.nui // cFDX class
91147>>>>>>>>>Use DBMS.nui // Basic DBMS functions (No User Interface)
91147>>>>>>>>>Use StructEx.utl // Restructuring extensions
Including file: structex.utl (C:\Apps\VDFQuery\AppSrc\structex.utl)
91147>>>>>>>>>>>// Use StructEx.utl // Restructuring extensions
91147>>>>>>>>>>>
91147>>>>>>>>>>>Use Fdx_Attr.utl // FDX compatible attribute functions
91147>>>>>>>>>>>Use Structur.utl // Object for restructuring table definitions
91147>>>>>>>>>>>
91147>>>>>>>>>>>function RSX_CreateTableFromFDX global integer lhFDX integer liFile string lsRoot returns integer
91149>>>>>>>>>>> integer liField liMax liIndex liSegment liMaxSegment liTmp
91149>>>>>>>>>>> integer liLockType liType liRelFile liRelField liMainIndex liDir
91149>>>>>>>>>>> integer liValue
91149>>>>>>>>>>> string lsRN
91149>>>>>>>>>>> if lsRoot ne "" move lsRoot to lsRN
91152>>>>>>>>>>> else move (FDX_AttrValue_FILELIST(lhFDX,DF_FILE_ROOT_NAME,liFile)) to lsRN
91154>>>>>>>>>>>
91154>>>>>>>>>>>// get DBMS_StripPathAndDriver lsRN to lsRN
91154>>>>>>>>>>>// get HowManyWords lsRN "/\:" to liTmp
91154>>>>>>>>>>>// if (liTmp<>1) get ExtractWord lsRN "/\:" liTmp to lsRN // get rid of driver and path
91154>>>>>>>>>>>
91154>>>>>>>>>>> if lsRN ne "" begin
91156>>>>>>>>>>> if (RS_TableCreateName(lsRN)) begin
91158>>>>>>>>>>> // Create fields:
91158>>>>>>>>>>> move (FDX_AttrValue_FILE(lhFDX,DF_FILE_NUMBER_FIELDS,liFile)) to liMax
91159>>>>>>>>>>> for liField from 1 to liMax
91165>>>>>>>>>>>>
91165>>>>>>>>>>> move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile,liField)) to liType
91166>>>>>>>>>>> send RS_AppendField (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_NAME,liFile,liField)) liType
91167>>>>>>>>>>> if liType ne DF_DATE ; send RS_SetFieldAttr DF_FIELD_LENGTH IMPLICIT_FIELD (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_LENGTH,liFile,liField))
91170>>>>>>>>>>> if liType eq DF_BCD ; send RS_SetFieldAttr DF_FIELD_PRECISION IMPLICIT_FIELD (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_PRECISION,liFile,liField))
91173>>>>>>>>>>> move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_RELATED_FILE,liFile,liField)) to liRelFile
91174>>>>>>>>>>> move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_RELATED_FIELD,liFile,liField)) to liRelField
91175>>>>>>>>>>> move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_INDEX,liFile,liField)) to liMainIndex
91176>>>>>>>>>>> if liRelFile send RS_SetFieldAttr DF_FIELD_RELATED_FILE IMPLICIT_FIELD liRelFile
91179>>>>>>>>>>> if liRelField send RS_SetFieldAttr DF_FIELD_RELATED_FIELD IMPLICIT_FIELD liRelField
91182>>>>>>>>>>> if liMainIndex send RS_SetFieldAttr DF_FIELD_INDEX IMPLICIT_FIELD liMainIndex
91185>>>>>>>>>>> if liType eq DF_OVERLAP ; send RS_SetFieldAttr DF_FIELD_OFFSET IMPLICIT_FIELD (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_OFFSET,liFile,liField))
91188>>>>>>>>>>> loop
91189>>>>>>>>>>>>
91189>>>>>>>>>>> for liIndex from 1 to 15
91195>>>>>>>>>>>>
91195>>>>>>>>>>> move (integer(FDX_AttrValue_INDEX(lhFDX,DF_INDEX_NUMBER_SEGMENTS,liFile,liIndex))) to liMaxSegment
91196>>>>>>>>>>> if liMaxSegment begin
91198>>>>>>>>>>> send RS_SetIndexAttr DF_INDEX_NUMBER_SEGMENTS liIndex liMaxSegment
91199>>>>>>>>>>> for liSegment from 1 to liMaxSegment
91205>>>>>>>>>>>>
91205>>>>>>>>>>> send RS_SetIndexSegAttr DF_INDEX_SEGMENT_FIELD liIndex liSegment (FDX_AttrValue_IDXSEG(lhFDX,DF_INDEX_SEGMENT_FIELD ,liFile,liIndex,liSegment))
91206>>>>>>>>>>> get FDX_AttrValue_IDXSEG lhFDX DF_INDEX_SEGMENT_DIRECTION liFile liIndex liSegment to liDir
91207>>>>>>>>>>> send RS_SetIndexSegAttr DF_INDEX_SEGMENT_DIRECTION liIndex liSegment liDir // (FDX_AttrValue_IDXSEG(lhFDX,DF_INDEX_SEGMENT_DIRECTION,liFile,liIndex,liSegment))
91208>>>>>>>>>>> send RS_SetIndexSegAttr DF_INDEX_SEGMENT_CASE liIndex liSegment (FDX_AttrValue_IDXSEG(lhFDX,DF_INDEX_SEGMENT_CASE ,liFile,liIndex,liSegment))
91209>>>>>>>>>>> loop
91210>>>>>>>>>>>>
91210>>>>>>>>>>> send RS_SetIndexAttr DF_INDEX_TYPE liIndex (FDX_AttrValue_INDEX(lhFDX,DF_INDEX_TYPE,liFile,liIndex))
91211>>>>>>>>>>> end
91211>>>>>>>>>>>>
91211>>>>>>>>>>> loop
91212>>>>>>>>>>>>
91212>>>>>>>>>>>
91212>>>>>>>>>>> // File parameters:
91212>>>>>>>>>>>
91212>>>>>>>>>>> move (FDX_AttrValue_FILE(lhFDX,DF_FILE_MAX_RECORDS ,liFile)) to liValue
91213>>>>>>>>>>> if (liValue>16711679) move 16711679 to liValue
91216>>>>>>>>>>> send RS_SetFileAttr DF_FILE_MAX_RECORDS liValue
91217>>>>>>>>>>>
91217>>>>>>>>>>> send RS_SetFileAttr DF_FILE_MULTIUSER (FDX_AttrValue_FILE(lhFDX,DF_FILE_MULTIUSER ,liFile))
91218>>>>>>>>>>> send RS_SetFileAttr DF_FILE_REUSE_DELETED (FDX_AttrValue_FILE(lhFDX,DF_FILE_REUSE_DELETED ,liFile))
91219>>>>>>>>>>> send RS_SetFileAttr DF_FILE_COMPRESSION (FDX_AttrValue_FILE(lhFDX,DF_FILE_COMPRESSION ,liFile))
91220>>>>>>>>>>> send RS_SetFileAttr DF_FILE_RECORD_LENGTH (FDX_AttrValue_FILE(lhFDX,DF_FILE_RECORD_LENGTH ,liFile))
91221>>>>>>>>>>> send RS_SetFileAttr DF_FILE_INTEGRITY_CHECK (FDX_AttrValue_FILE(lhFDX,DF_FILE_INTEGRITY_CHECK,liFile))
91222>>>>>>>>>>>
91222>>>>>>>>>>> move (FDX_AttrValue_FILE(lhFDX,DF_FILE_TRANSACTION ,liFile)) to liValue
91223>>>>>>>>>>> if (liValue=DF_FILE_TRANSACTION_SERVER_LOGGED) move DF_FILE_TRANSACTION_CLIENT_ATOMIC to liValue
91226>>>>>>>>>>> send RS_SetFileAttr DF_FILE_TRANSACTION liValue
91227>>>>>>>>>>>
91227>>>>>>>>>>> // Mysteriously we have to 'fork' lock type in place. Apparently
91227>>>>>>>>>>> // DF_FILE_LOCK_TYPE *may* return 255, which is not a legal value.
91227>>>>>>>>>>> move (FDX_AttrValue_FILE(lhFDX,DF_FILE_LOCK_TYPE,liFile)) to liLockType
91228>>>>>>>>>>> if (liLockType<>DF_LOCK_TYPE_NONE and liLockType<>DF_LOCK_TYPE_FILE and liLockType<>DF_LOCK_TYPE_RECORD) move DF_LOCK_TYPE_FILE to liLockType
91231>>>>>>>>>>> if (liLockType=DF_LOCK_TYPE_RECORD) move DF_LOCK_TYPE_FILE to liLockType
91234>>>>>>>>>>> send RS_SetFileAttr DF_FILE_LOCK_TYPE liLockType
91235>>>>>>>>>>>
91235>>>>>>>>>>> send RS_Structure_End
91236>>>>>>>>>>> function_Return 1
91237>>>>>>>>>>> end
91237>>>>>>>>>>>>
91237>>>>>>>>>>> end
91237>>>>>>>>>>>>
91237>>>>>>>>>>> function_return 0
91238>>>>>>>>>>>end_function
91239>>>>>>>>>Use Strings.nui // String manipulation for VDF (No User Interface)
91239>>>>>>>>>
91239>>>>>>>>>desktop_section
91244>>>>>>>>> object oTableCreator_FdxFileDef is a cFdxFileDef
91246>>>>>>>>> end_object
91247>>>>>>>>>end_desktop_section
91252>>>>>>>>>
91252>>>>>>>>> class cTblCrFieldList is a cArray
91253>>>>>>>>> item_property_list
91253>>>>>>>>> item_property string psName.i // Field name
91253>>>>>>>>> item_property integer piType.i // Field type
91253>>>>>>>>> item_property integer piLength.i
91253>>>>>>>>> item_property integer piPrecision.i
91253>>>>>>>>> item_property integer piOverlapFrom.i
91253>>>>>>>>> item_property integer piOverlapTo.i
91253>>>>>>>>> item_property integer piMainIndex.i
91253>>>>>>>>> item_property integer piRelFile.i
91253>>>>>>>>> item_property integer piRelField.i
91253>>>>>>>>> item_property integer piOverlapOffset.i
91253>>>>>>>>> end_item_property_list cTblCrFieldList
#REM 91309 DEFINE FUNCTION PIOVERLAPOFFSET.I INTEGER LIROW RETURNS INTEGER
#REM 91313 DEFINE PROCEDURE SET PIOVERLAPOFFSET.I INTEGER LIROW INTEGER VALUE
#REM 91317 DEFINE FUNCTION PIRELFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 91321 DEFINE PROCEDURE SET PIRELFIELD.I INTEGER LIROW INTEGER VALUE
#REM 91325 DEFINE FUNCTION PIRELFILE.I INTEGER LIROW RETURNS INTEGER
#REM 91329 DEFINE PROCEDURE SET PIRELFILE.I INTEGER LIROW INTEGER VALUE
#REM 91333 DEFINE FUNCTION PIMAININDEX.I INTEGER LIROW RETURNS INTEGER
#REM 91337 DEFINE PROCEDURE SET PIMAININDEX.I INTEGER LIROW INTEGER VALUE
#REM 91341 DEFINE FUNCTION PIOVERLAPTO.I INTEGER LIROW RETURNS INTEGER
#REM 91345 DEFINE PROCEDURE SET PIOVERLAPTO.I INTEGER LIROW INTEGER VALUE
#REM 91349 DEFINE FUNCTION PIOVERLAPFROM.I INTEGER LIROW RETURNS INTEGER
#REM 91353 DEFINE PROCEDURE SET PIOVERLAPFROM.I INTEGER LIROW INTEGER VALUE
#REM 91357 DEFINE FUNCTION PIPRECISION.I INTEGER LIROW RETURNS INTEGER
#REM 91361 DEFINE PROCEDURE SET PIPRECISION.I INTEGER LIROW INTEGER VALUE
#REM 91365 DEFINE FUNCTION PILENGTH.I INTEGER LIROW RETURNS INTEGER
#REM 91369 DEFINE PROCEDURE SET PILENGTH.I INTEGER LIROW INTEGER VALUE
#REM 91373 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 91377 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 91381 DEFINE FUNCTION PSNAME.I INTEGER LIROW RETURNS STRING
#REM 91385 DEFINE PROCEDURE SET PSNAME.I INTEGER LIROW STRING VALUE
91390>>>>>>>>> procedure DoReset
91392>>>>>>>>> send delete_data
91393>>>>>>>>> end_procedure
91394>>>>>>>>> function iFindFieldName.s string lsFieldName returns integer
91396>>>>>>>>> integer liMax liRow
91396>>>>>>>>> get row_count to liMax
91397>>>>>>>>> decrement liMax
91398>>>>>>>>> move (uppercase(lsFieldName)) to lsFieldName
91399>>>>>>>>> for liRow from 0 to liMax
91405>>>>>>>>>>
91405>>>>>>>>> if (uppercase(psName.i(self,liRow))=lsFieldName) function_return liRow
91408>>>>>>>>> loop
91409>>>>>>>>>>
91409>>>>>>>>> function_return -1
91410>>>>>>>>> end_function
91411>>>>>>>>> function iByteLengthFieldRange integer liFromRow integer liToRow returns integer
91413>>>>>>>>> integer liRval liRow liType liLength
91413>>>>>>>>> move 0 to liRval
91414>>>>>>>>> for liRow from liFromRow to liToRow
91420>>>>>>>>>>
91420>>>>>>>>> get piType.i liRow to liType
91421>>>>>>>>> if (liType<>DF_OVERLAP) begin
91423>>>>>>>>> get piLength.i liRow to liLength
91424>>>>>>>>> if liType eq DF_BCD move (liLength/2) to liLength
91427>>>>>>>>> move (liRval+liLength) to liRval
91428>>>>>>>>> end
91428>>>>>>>>>>
91428>>>>>>>>> loop
91429>>>>>>>>>>
91429>>>>>>>>> function_return liRval
91430>>>>>>>>> end_function
91431>>>>>>>>> procedure DoEndDefinition // Calculate field offsets
91433>>>>>>>>> integer liRow liMax liFromRow liToRow liOffset liLength
91433>>>>>>>>> get row_count to liMax
91434>>>>>>>>> decrement liMax
91435>>>>>>>>> // set length of date fields
91435>>>>>>>>> for liRow from 0 to liMax // Dates
91441>>>>>>>>>>
91441>>>>>>>>> if (piType.i(self,liRow)=DF_DATE) set piLength.i liRow to 3
91444>>>>>>>>> loop
91445>>>>>>>>>>
91445>>>>>>>>> // having done that we may calculate overlap offsets:
91445>>>>>>>>> for liRow from 0 to liMax
91451>>>>>>>>>>
91451>>>>>>>>> if (piType.i(self,liRow)=DF_OVERLAP) begin
91453>>>>>>>>> move (piOverlapFrom.i(self,liRow)-1) to liFromRow
91454>>>>>>>>> move (piOverlapTo.i(self,liRow)-1) to liToRow
91455>>>>>>>>> get iByteLengthFieldRange 0 (liFromRow-1) to liOffset
91456>>>>>>>>> increment liOffSet
91457>>>>>>>>> get iByteLengthFieldRange liFromRow liToRow to liLength
91458>>>>>>>>> set piLength.i liRow to liLength
91459>>>>>>>>> set piOverlapOffset.i liRow to liOffset
91460>>>>>>>>> end
91460>>>>>>>>>>
91460>>>>>>>>> loop
91461>>>>>>>>>>
91461>>>>>>>>> end_procedure
91462>>>>>>>>> procedure DoAddField string lsName integer liType number lnLength
91464>>>>>>>>> integer liRow liPrecision
91464>>>>>>>>> // if (length(lsName)>15) error 254 ("Field name too long ("+lsName+")")
91464>>>>>>>>> get row_count to liRow
91465>>>>>>>>> set psName.i liRow to lsName
91466>>>>>>>>> set piType.i liRow to liType
91467>>>>>>>>> if liType eq DF_BCD begin
91469>>>>>>>>> move (lnLength-integer(lnLength)*10) to liPrecision
91470>>>>>>>>> move (integer(lnLength)) to lnLength
91471>>>>>>>>> set piLength.i liRow to (lnLength+liPrecision)
91472>>>>>>>>> set piPrecision to liPrecision
91473>>>>>>>>> end
91473>>>>>>>>>>
91473>>>>>>>>> else set piLength.i liRow to lnLength
91475>>>>>>>>> end_procedure
91476>>>>>>>>> procedure Set piPrecision integer liPrecision
91478>>>>>>>>> set piPrecision.i (row_count(self)-1) to liPrecision
91479>>>>>>>>> end_procedure
91480>>>>>>>>> procedure Set piMainIndex integer liIndex
91482>>>>>>>>> set piMainIndex.i (row_count(self)-1) to liindex
91483>>>>>>>>> end_procedure
91484>>>>>>>>> procedure Set piOverlapFieldRange integer liFieldFrom integer liFieldTo
91486>>>>>>>>> set piOverlapFrom.i (row_count(self)-1) to liFieldFrom
91487>>>>>>>>> set piOverlapTo.i (row_count(self)-1) to liFieldTo
91488>>>>>>>>> end_procedure
91489>>>>>>>>> procedure Set piRelation integer liFile integer liField
91491>>>>>>>>> set piRelFile.i (row_count(self)-1) to liFile
91492>>>>>>>>> set piRelField.i (row_count(self)-1) to liField
91493>>>>>>>>> end_procedure
91494>>>>>>>>> end_class // cTblCrFieldList
91495>>>>>>>>>
91495>>>>>>>>> class cTblCrIndexList is a cArray
91496>>>>>>>>> procedure construct_object integer liImg
91498>>>>>>>>> forward send construct_object liImg
91500>>>>>>>>> property integer piCurrentDefiningIndex public -1
91501>>>>>>>>> end_procedure
91502>>>>>>>>> item_property_list
91502>>>>>>>>> item_property integer piOnline.i // On-line/Batch
91502>>>>>>>>> item_property string psFields.i
91502>>>>>>>>> item_property string psUppercase.i
91502>>>>>>>>> item_property string psDirection.i
91502>>>>>>>>> end_item_property_list cTblCrIndexList
#REM 91540 DEFINE FUNCTION PSDIRECTION.I INTEGER LIROW RETURNS STRING
#REM 91544 DEFINE PROCEDURE SET PSDIRECTION.I INTEGER LIROW STRING VALUE
#REM 91548 DEFINE FUNCTION PSUPPERCASE.I INTEGER LIROW RETURNS STRING
#REM 91552 DEFINE PROCEDURE SET PSUPPERCASE.I INTEGER LIROW STRING VALUE
#REM 91556 DEFINE FUNCTION PSFIELDS.I INTEGER LIROW RETURNS STRING
#REM 91560 DEFINE PROCEDURE SET PSFIELDS.I INTEGER LIROW STRING VALUE
#REM 91564 DEFINE FUNCTION PIONLINE.I INTEGER LIROW RETURNS INTEGER
#REM 91568 DEFINE PROCEDURE SET PIONLINE.I INTEGER LIROW INTEGER VALUE
91573>>>>>>>>> function iSegments.i integer liIndex returns integer
91575>>>>>>>>> function_return (length(psFields.i(self,liIndex))/4)
91576>>>>>>>>> end_function
91577>>>>>>>>> procedure DoReset
91579>>>>>>>>> send delete_data
91580>>>>>>>>> end_procedure
91581>>>>>>>>> procedure DoAddIndex integer liIndex integer liOnLine
91583>>>>>>>>> set piCurrentDefiningIndex to liIndex
91584>>>>>>>>> set piOnline.i liIndex to liOnline
91585>>>>>>>>> end_procedure
91586>>>>>>>>> procedure DoAddSegment integer liField integer lbUppercased integer liDirection
91588>>>>>>>>> integer liIndex
91588>>>>>>>>> get piCurrentDefiningIndex to liIndex
91589>>>>>>>>> set psFields.i liIndex to (psFields.i(self,liIndex)+pad(string(liField),4))
91590>>>>>>>>> set psUppercase.i liIndex to (psUppercase.i(self,liIndex)+pad(string(lbUppercased),4))
91591>>>>>>>>> set psDirection.i liIndex to (psDirection.i(self,liIndex)+pad(string(liDirection),4))
91592>>>>>>>>> end_procedure
91593>>>>>>>>> function iHelpExtract.si string lsValue integer liSegment returns integer
91595>>>>>>>>> function_return (mid(lsValue,4,liSegment-1*4+1))
91596>>>>>>>>> end_function
91597>>>>>>>>> function iIndexSegmentField integer liIndex integer liSegment returns integer
91599>>>>>>>>> function_return (iHelpExtract.si(self,psFields.i(self,liIndex),liSegment))
91600>>>>>>>>> end_function
91601>>>>>>>>> function iIndexSegmentUppercase integer liIndex integer liSegment returns integer
91603>>>>>>>>> function_return (iHelpExtract.si(self,psUppercase.i(self,liIndex),liSegment))
91604>>>>>>>>> end_function
91605>>>>>>>>> function iIndexSegmentDirection integer liIndex integer liSegment returns integer
91607>>>>>>>>> function_return (iHelpExtract.si(self,psDirection.i(self,liIndex),liSegment))
91608>>>>>>>>> end_function
91609>>>>>>>>> end_class // cTblCrIndexList
91610>>>>>>>>>
91610>>>>>>>>>class cTableCreator is a cTblCrFieldList
91611>>>>>>>>> procedure construct_object
91613>>>>>>>>> forward send construct_object
91615>>>>>>>>> property integer piFile public 0
91616>>>>>>>>> property string psRoot public ""
91617>>>>>>>>> property string psLogicalName public ""
91618>>>>>>>>> property string psUserName public ""
91619>>>>>>>>> property integer piMaxRecords public 10000
91620>>>>>>>>> property integer piMultiuser public DF_FILE_USER_MULTI
91621>>>>>>>>> property integer piReuse_deleted public DF_FILE_DELETED_REUSE
91622>>>>>>>>> property integer piCompression public DF_FILE_COMPRESS_NONE
91623>>>>>>>>> property integer piIntegrity_check public DFTRUE
91624>>>>>>>>> property integer piTransaction public DF_FILE_TRANSACTION_CLIENT_ATOMIC
91625>>>>>>>>> property integer piLockType public DF_LOCK_TYPE_FILE
91626>>>>>>>>> object oIndexList is a cTblCrIndexList NO_IMAGE
91628>>>>>>>>> end_object
91629>>>>>>>>>
91629>>>>>>>>> // If true filelist.cfg will be updated when tables are created:
91629>>>>>>>>> property integer pbUpdateFilelist public DFTRUE
91630>>>>>>>>>
91630>>>>>>>>> end_procedure
91631>>>>>>>>>
91631>>>>>>>>> procedure OnDefine
91633>>>>>>>>> end_procedure
91634>>>>>>>>>
91634>>>>>>>>> procedure DoDefine
91636>>>>>>>>> send DoReset_Help DFFALSE
91637>>>>>>>>> send OnDefine
91638>>>>>>>>> send DoEndDefinition // Calculate field offsets
91639>>>>>>>>> end_procedure
91640>>>>>>>>>
91640>>>>>>>>> procedure DoReset_Help integer lbAll
91642>>>>>>>>> forward send DoReset
91644>>>>>>>>> send DoReset to (oIndexList(self))
91645>>>>>>>>> if lbAll begin
91647>>>>>>>>> set piFile to 0
91648>>>>>>>>> set psRoot to ""
91649>>>>>>>>> set psLogicalName to ""
91650>>>>>>>>> set psUserName to ""
91651>>>>>>>>> set piMaxRecords to 10000
91652>>>>>>>>> set piMultiuser to DF_FILE_USER_MULTI
91653>>>>>>>>> set piReuse_deleted to DF_FILE_DELETED_REUSE
91654>>>>>>>>> set piCompression to DF_FILE_COMPRESS_NONE
91655>>>>>>>>> set piIntegrity_check to DF_FILE_INTEGRITY_CHECK
91656>>>>>>>>> set piTransaction to DF_FILE_TRANSACTION_CLIENT_ATOMIC
91657>>>>>>>>> end
91657>>>>>>>>>>
91657>>>>>>>>> end_procedure
91658>>>>>>>>>
91658>>>>>>>>> procedure DoReset
91660>>>>>>>>> send DoReset_Help DFTRUE
91661>>>>>>>>> end_procedure
91662>>>>>>>>>
91662>>>>>>>>> procedure set FileListValues integer liFile string lsRoot string lsLogicalName string lsUserName
91664>>>>>>>>> set piFile to liFile
91665>>>>>>>>> set psRoot to lsRoot
91666>>>>>>>>> set psLogicalName to lsLogicalName
91667>>>>>>>>> set psUserName to lsUserName
91668>>>>>>>>> end_procedure
91669>>>>>>>>>
91669>>>>>>>>> procedure DoAddIndex integer liIndex integer lbOnLine
91671>>>>>>>>> send DoAddIndex to (oIndexList(self)) liIndex lbOnLine
91672>>>>>>>>> end_procedure
91673>>>>>>>>> procedure DoAddSegment integer liField integer lbUppercased integer liDirection
91675>>>>>>>>> send DoAddSegment to (oIndexList(self)) liField lbUppercased liDirection
91676>>>>>>>>> end_procedure
91677>>>>>>>>>
91677>>>>>>>>> procedure DoAddOnlineIndex integer liIndex string lsFieldNames
91679>>>>>>>>> integer liItem liSegments liField
91679>>>>>>>>> integer lbUppercased lbDescending
91679>>>>>>>>> string lsFieldName
91679>>>>>>>>> send DoAddIndex liIndex DF_INDEX_TYPE_ONLINE
91680>>>>>>>>> get HowManyWords lsFieldNames " ," to liSegments
91681>>>>>>>>> for liItem from 1 to liSegments
91687>>>>>>>>>>
91687>>>>>>>>> get ExtractWord lsFieldNames " ," liItem to lsFieldName
91688>>>>>>>>>
91688>>>>>>>>> if (left(lsFieldName,1)="-") begin
91690>>>>>>>>> move (StringRightBut(lsFieldName,1)) to lsFieldName
91691>>>>>>>>> move DFTRUE to lbDescending
91692>>>>>>>>> end
91692>>>>>>>>>>
91692>>>>>>>>> else move DFFALSE to lbDescending
91694>>>>>>>>>
91694>>>>>>>>> if (uppercase(lsFieldName)=lsFieldName) move DFTRUE to lbUppercased
91697>>>>>>>>> else move DFFALSE to lbUppercased
91699>>>>>>>>>
91699>>>>>>>>> get iFindFieldName.s lsFieldName to liField
91700>>>>>>>>> increment liField
91701>>>>>>>>>
91701>>>>>>>>> if (liField=0 and uppercase(lsFieldName)<>"RECNUM") move -1 to liField
91704>>>>>>>>>
91704>>>>>>>>> if (liField<>-1) ; send DoAddSegment liField ; (if(lbUppercased,DF_CASE_IGNORED,DF_CASE_USED)) ; (if(lbDescending,DF_DESCENDING,DF_ASCENDING))
91707>>>>>>>>> else error 652 "Illegal fieldname in index spec (AppDB)"
91709>>>>>>>>> loop
91710>>>>>>>>>>
91710>>>>>>>>> end_procedure
91711>>>>>>>>> function iIndexSegmentField integer liIndex integer liSegment returns integer
91713>>>>>>>>> function_return (iIndexSegmentField(oIndexList(self),liIndex,liSegment))
91714>>>>>>>>> end_function
91715>>>>>>>>> function iIndexSegmentUppercase integer liIndex integer liSegment returns integer
91717>>>>>>>>> function_return (iIndexSegmentUppercase(oIndexList(self),liIndex,liSegment))
91718>>>>>>>>> end_function
91719>>>>>>>>> function iIndexSegmentDirection integer liIndex integer liSegment returns integer
91721>>>>>>>>> function_return (iIndexSegmentDirection(oIndexList(self),liIndex,liSegment))
91722>>>>>>>>> end_function
91723>>>>>>>>> function iIndexSegments integer liIndex returns integer
91725>>>>>>>>> function_return (iSegments.i(oIndexList(self),liIndex))
91726>>>>>>>>> end_function
91727>>>>>>>>> function iIndexType integer liIndex returns integer
91729>>>>>>>>> function_return (piOnline.i(oIndexList(self),liIndex))
91730>>>>>>>>> end_function
91731>>>>>>>>>
91731>>>>>>>>> procedure TransferDefinitionToFDX
91733>>>>>>>>> integer liRow liMax liFile liFieldType liIndex liSegment liMaxSegment lhAppDbTable lhFdx
91733>>>>>>>>>
91733>>>>>>>>> move self to lhAppDbTable
91734>>>>>>>>> move (oTableCreator_FdxFileDef(self)) to lhFdx
91735>>>>>>>>>
91735>>>>>>>>> //send DoDefine to lhAppDbTable
91735>>>>>>>>> send Reset to lhFdx
91736>>>>>>>>> get piFile of lhAppDbTable to liFile
91737>>>>>>>>> set piMainFile of lhFDX to liFile
91738>>>>>>>>>
91738>>>>>>>>> set AttrValue_FILE of lhFDX DF_FILE_MAX_RECORDS liFile to (piMaxRecords(self))
91739>>>>>>>>> set AttrValue_FILE of lhFDX DF_FILE_MULTIUSER liFile to (piMultiuser(self))
91740>>>>>>>>> set AttrValue_FILE of lhFDX DF_FILE_REUSE_DELETED liFile to (piReuse_deleted(self))
91741>>>>>>>>> set AttrValue_FILE of lhFDX DF_FILE_COMPRESSION liFile to (piCompression(self))
91742>>>>>>>>> set AttrValue_FILE of lhFDX DF_FILE_INTEGRITY_CHECK liFile to (piIntegrity_check(self))
91743>>>>>>>>> set AttrValue_FILE of lhFDX DF_FILE_TRANSACTION liFile to (piTransaction(self))
91744>>>>>>>>> set AttrValue_FILE of lhFDX DF_FILE_LOCK_TYPE liFile to (piLockType(self))
91745>>>>>>>>> set AttrValue_FILE of lhFDX DF_FILE_RECORD_LENGTH liFile to 8 // Automatically incremented during field appending
91746>>>>>>>>>
91746>>>>>>>>> get row_count of lhAppDbTable to liMax
91747>>>>>>>>> set AttrValue_FILE of lhFDX DF_FILE_NUMBER_FIELDS liFile to liMax
91748>>>>>>>>> decrement liMax
91749>>>>>>>>> for liRow from 0 to liMax
91755>>>>>>>>>>
91755>>>>>>>>> get piType.i of lhAppDbTable liRow to liFieldType
91756>>>>>>>>> set AttrValue_FIELD of lhFDX DF_FIELD_NAME liFile (liRow+1) to (psName.i(lhAppDbTable,liRow))
91757>>>>>>>>> set AttrValue_FIELD of lhFDX DF_FIELD_TYPE liFile (liRow+1) to liFieldType
91758>>>>>>>>> set AttrValue_FIELD of lhFDX DF_FIELD_LENGTH liFile (liRow+1) to (piLength.i(lhAppDbTable,liRow))
91759>>>>>>>>> set AttrValue_FIELD of lhFDX DF_FIELD_PRECISION liFile (liRow+1) to (piPrecision.i(lhAppDbTable,liRow))
91760>>>>>>>>> set AttrValue_FIELD of lhFDX DF_FIELD_RELATED_FILE liFile (liRow+1) to (piRelFile.i(lhAppDbTable,liRow))
91761>>>>>>>>> set AttrValue_FIELD of lhFDX DF_FIELD_RELATED_FIELD liFile (liRow+1) to (piRelField.i(lhAppDbTable,liRow))
91762>>>>>>>>> set AttrValue_FIELD of lhFDX DF_FIELD_INDEX liFile (liRow+1) to (piMainIndex.i(lhAppDbTable,liRow))
91763>>>>>>>>> if liFieldType eq DF_OVERLAP begin
91765>>>>>>>>> set AttrValue_FIELD of lhFDX DF_FIELD_OFFSET liFile (liRow+1) to (piOverlapOffset.i(lhAppDbTable,liRow))
91766>>>>>>>>> end
91766>>>>>>>>>>
91766>>>>>>>>> loop
91767>>>>>>>>>>
91767>>>>>>>>>
91767>>>>>>>>> for liIndex from 1 to 15
91773>>>>>>>>>>
91773>>>>>>>>> get iIndexSegments of lhAppDbTable liIndex to liMaxSegment
91774>>>>>>>>> if liMaxSegment begin
91776>>>>>>>>> set AttrValue_INDEX of lhFDX DF_INDEX_TYPE liFile liIndex to (iIndexType(lhAppDbTable,liIndex))
91777>>>>>>>>> set AttrValue_INDEX of lhFDX DF_INDEX_NUMBER_SEGMENTS liFile liIndex to liMaxSegment
91778>>>>>>>>> for liSegment from 1 to liMaxSegment
91784>>>>>>>>>>
91784>>>>>>>>> set AttrValue_IDXSEG of lhFDX DF_INDEX_SEGMENT_FIELD liFile liIndex liSegment to (iIndexSegmentField(lhAppDbTable,liIndex,liSegment))
91785>>>>>>>>> set AttrValue_IDXSEG of lhFDX DF_INDEX_SEGMENT_DIRECTION liFile liIndex liSegment to (iIndexSegmentDirection(lhAppDbTable,liIndex,liSegment))
91786>>>>>>>>> set AttrValue_IDXSEG of lhFDX DF_INDEX_SEGMENT_CASE liFile liIndex liSegment to (iIndexSegmentUppercase(lhAppDbTable,liIndex,liSegment))
91787>>>>>>>>> loop
91788>>>>>>>>>>
91788>>>>>>>>> end
91788>>>>>>>>>>
91788>>>>>>>>> loop
91789>>>>>>>>>>
91789>>>>>>>>> //send FDX_ModalDisplayFileAttributes lhFdx liFile
91789>>>>>>>>> end_procedure
91790>>>>>>>>>
91790>>>>>>>>> procedure OnTableCreated
91792>>>>>>>>> end_procedure
91793>>>>>>>>>
91793>>>>>>>>> procedure CreateTable
91795>>>>>>>>> integer liRval liFile
91795>>>>>>>>> send TransferDefinitionToFDX
91796>>>>>>>>> get RSX_CreateTableFromFDX (oTableCreator_FdxFileDef(self)) (piFile(self)) (psRoot(self)) to liRval
91797>>>>>>>>> if liRval begin
91799>>>>>>>>> if (pbUpdateFilelist(self)) begin
91801>>>>>>>>> get piFile to liFile
91802>>>>>>>>> set_attribute DF_FILE_ROOT_NAME of liFile to (psRoot(self))
91805>>>>>>>>> set_attribute DF_FILE_LOGICAL_NAME of liFile to (psLogicalName(self))
91808>>>>>>>>> set_attribute DF_FILE_DISPLAY_NAME of liFile to (rtrim(psUserName(self)))
91811>>>>>>>>> end
91811>>>>>>>>>>
91811>>>>>>>>> send OnTableCreated
91812>>>>>>>>> end
91812>>>>>>>>>>
91812>>>>>>>>> end_procedure
91813>>>>>>>>>end_class // cTableCreator
91814>>>>>>>>>
91814>>>>>>>
91814>>>>>>>object oFTS_TableDefinitions is a cArray
91816>>>>>>> property integer piArticleIdWidth public 0 // NUMERIC 6.0
91818>>>>>>> property integer piPhraseLength public 0 // Minimum 6, maximum 14
91820>>>>>>>
91820>>>>>>> object oTable_word is a cTableCreator
91822>>>>>>> procedure OnDefine
91825>>>>>>> set piMaxRecords to 1000000 // 1 million
91826>>>>>>> send DoAddField "WORD_ID" DF_BCD 6
91827>>>>>>> send DoAddField "WORD" DF_ASCII 30
91828>>>>>>> send DoAddField "FREQUENCY" DF_BCD 8
91829>>>>>>> send DoAddOnlineIndex 1 "word_id"
91830>>>>>>> send DoAddOnlineIndex 2 "WORD" // Uppercase = Ignore case
91831>>>>>>> end_procedure
91832>>>>>>> end_object
91833>>>>>>> object oTable_artwrd is a cTableCreator
91835>>>>>>> procedure OnDefine
91838>>>>>>> set piMaxRecords to 10000000 // 10 million
91839>>>>>>> send DoAddField "ARTICLE_ID" DF_BCD (piArticleIdWidth(self))
91840>>>>>>> send DoAddField "WORD_ID" DF_BCD 6
91841>>>>>>> send DoAddOnlineIndex 1 "article_id word_id"
91842>>>>>>> send DoAddOnlineIndex 2 "word_id article_id"
91843>>>>>>> end_procedure
91844>>>>>>> end_object
91845>>>>>>> object oTable_artphr is a cTableCreator
91847>>>>>>> procedure OnDefine
91850>>>>>>> integer liPhrLen liPhrPos
91850>>>>>>> string lsIndex1 lsIndex2 lsFieldName
91850>>>>>>>
91850>>>>>>> set piMaxRecords to 16700000 // 16.7 million
91851>>>>>>>
91851>>>>>>> move "article_id" to lsIndex1
91852>>>>>>> move "" to lsIndex2
91853>>>>>>> get piPhraseLength to liPhrLen
91854>>>>>>> send DoAddField "ARTICLE_ID" DF_BCD (piArticleIdWidth(self))
91855>>>>>>>
91855>>>>>>> for liPhrPos from 1 to liPhrLen
91861>>>>>>>>
91861>>>>>>> move "WORD_ID" to lsFieldName
91862>>>>>>> if (liPhrPos<>1) move (lsFieldName+"_S"+string(liPhrPos-1)) to lsFieldName
91865>>>>>>> send DoAddField lsFieldName DF_BCD 6
91866>>>>>>> move (lsIndex1*lsFieldName) to lsIndex1
91867>>>>>>> move (lsIndex2*lsFieldName) to lsIndex2
91868>>>>>>> loop
91869>>>>>>>>
91869>>>>>>> move (lsIndex1*"recnum") to lsIndex1
91870>>>>>>> move (lsIndex2*"recnum") to lsIndex2
91871>>>>>>>
91871>>>>>>> send DoAddOnlineIndex 1 (lowercase(trim(lsIndex1)))
91872>>>>>>> send DoAddOnlineIndex 2 (lowercase(trim(lsIndex2)))
91873>>>>>>>
91873>>>>>>>// send DoAddField "WORD_ID" DF_BCD 6
91873>>>>>>>// send DoAddField "WORD_ID_S1" DF_BCD 6
91873>>>>>>>// send DoAddField "WORD_ID_S2" DF_BCD 6
91873>>>>>>>// send DoAddField "WORD_ID_S3" DF_BCD 6
91873>>>>>>>// send DoAddField "WORD_ID_S4" DF_BCD 6
91873>>>>>>>// send DoAddField "WORD_ID_S5" DF_BCD 6
91873>>>>>>>// send DoAddOnlineIndex 1 "article_id word_id word_id_s1 word_id_s2 word_id_s3 word_id_s4 word_id_s5 recnum"
91873>>>>>>>// send DoAddOnlineIndex 2 "word_id word_id_s1 word_id_s2 word_id_s3 word_id_s4 word_id_s5 recnum"
91873>>>>>>>
91873>>>>>>> end_procedure
91874>>>>>>> end_object
91875>>>>>>> object oTable_articl is a cTableCreator
91877>>>>>>> procedure OnDefine
91880>>>>>>> set piMaxRecords to 1000000 // 1 million
91881>>>>>>>
91881>>>>>>> send DoAddField "ARTICLE_ID" DF_BCD (piArticleIdWidth(self))
91882>>>>>>> send DoAddField "DATE" DF_DATE 0
91883>>>>>>> send DoAddField "TIME" DF_ASCII 8
91884>>>>>>> send DoAddField "HIT_COUNT" DF_BCD 6
91885>>>>>>> send DoAddField "ARTICLE_CLASS" DF_ASCII 20
91886>>>>>>> send DoAddField "INDEXED_DATE" DF_DATE 0
91887>>>>>>> send DoAddField "INDEXED_TIME" DF_ASCII 8
91888>>>>>>> send DoAddOnlineIndex 1 "article_id"
91889>>>>>>> end_procedure
91890>>>>>>> end_object
91891>>>>>>>
91891>>>>>>> object oTable_search is a cTableCreator
91893>>>>>>> procedure OnDefine
91896>>>>>>> set piMaxRecords to 1000000 // 1 million
91897>>>>>>> send DoAddField "SEARCH_ID" DF_BCD 8 // 1
91898>>>>>>> send DoAddField "USER_ID" DF_BCD 8 // 2
91899>>>>>>> send DoAddField "SEARCH_STRING" DF_ASCII 80 // 3
91900>>>>>>> send DoAddField "SEARCH_DATE" DF_DATE 0 // 4
91901>>>>>>> send DoAddField "SEARCH_TIME" DF_ASCII 8 // 5
91902>>>>>>> send DoAddField "RESULT_COUNT" DF_BCD 6 // 6
91903>>>>>>> send DoAddField "EXECUTION_TIME" DF_BCD 8 // 7
91904>>>>>>> send DoAddField "LOW_DATE_LIMIT" DF_DATE 0 // 8
91905>>>>>>> send DoAddField "HIGH_DATE_LIMIT" DF_DATE 0 // 9
91906>>>>>>> send DoAddField "ORDER_BY" DF_BCD 2 // 10
91907>>>>>>> send DoAddField "ERROR_CODE" DF_BCD 2 // 11
91908>>>>>>> send DoAddField "AUX_VALUE" DF_ASCII 20 // 12
91909>>>>>>> send DoAddOnlineIndex 1 "search_id"
91910>>>>>>> send DoAddOnlineIndex 2 "user_id search_id"
91911>>>>>>> end_procedure
91912>>>>>>> end_object
91913>>>>>>>
91913>>>>>>> procedure DoCreateTables integer lhTableAccess integer liArticleIdWidth integer liPhraseLength
91916>>>>>>> integer liFile lhAppDbTable lbSuccess
91916>>>>>>> string lsRoot lsLogical lsDisplay
91916>>>>>>>
91916>>>>>>> set piArticleIdWidth to liArticleIdWidth
91917>>>>>>> set piPhraseLength to liPhraseLength
91918>>>>>>>
91918>>>>>>> get piFile.i of lhTableAccess FTSTABLE_WORD to liFile
91919>>>>>>> get psRootname.i of lhTableAccess FTSTABLE_WORD to lsRoot
91920>>>>>>> get psLogicalName.i of lhTableAccess FTSTABLE_WORD to lsLogical
91921>>>>>>> get psUserName.i of lhTableAccess FTSTABLE_WORD to lsDisplay
91922>>>>>>> set FileListValues of oTable_word to liFile lsRoot lsLogical lsDisplay
91923>>>>>>> send DoDefine of oTable_word
91924>>>>>>> send CreateTable of oTable_word
91925>>>>>>>
91925>>>>>>> get piFile.i of lhTableAccess FTSTABLE_ARTWRD to liFile
91926>>>>>>> get psRootname.i of lhTableAccess FTSTABLE_ARTWRD to lsRoot
91927>>>>>>> get psLogicalName.i of lhTableAccess FTSTABLE_ARTWRD to lsLogical
91928>>>>>>> get psUserName.i of lhTableAccess FTSTABLE_ARTWRD to lsDisplay
91929>>>>>>> set FileListValues of oTable_artwrd to liFile lsRoot lsLogical lsDisplay
91930>>>>>>> send DoDefine of oTable_artwrd
91931>>>>>>> send CreateTable of oTable_artwrd
91932>>>>>>>
91932>>>>>>> get piFile.i of lhTableAccess FTSTABLE_ARTPHR to liFile
91933>>>>>>> get psRootname.i of lhTableAccess FTSTABLE_ARTPHR to lsRoot
91934>>>>>>> get psLogicalName.i of lhTableAccess FTSTABLE_ARTPHR to lsLogical
91935>>>>>>> get psUserName.i of lhTableAccess FTSTABLE_ARTPHR to lsDisplay
91936>>>>>>> set FileListValues of oTable_artphr to liFile lsRoot lsLogical lsDisplay
91937>>>>>>> send DoDefine of oTable_artphr
91938>>>>>>> send CreateTable of oTable_artphr
91939>>>>>>>
91939>>>>>>> get piFile.i of lhTableAccess FTSTABLE_ARTICL to liFile
91940>>>>>>> get psRootname.i of lhTableAccess FTSTABLE_ARTICL to lsRoot
91941>>>>>>> get psLogicalName.i of lhTableAccess FTSTABLE_ARTICL to lsLogical
91942>>>>>>> get psUserName.i of lhTableAccess FTSTABLE_ARTICL to lsDisplay
91943>>>>>>> set FileListValues of oTable_articl to liFile lsRoot lsLogical lsDisplay
91944>>>>>>> send DoDefine of oTable_articl
91945>>>>>>> send CreateTable of oTable_articl
91946>>>>>>>
91946>>>>>>> get piFile.i of lhTableAccess FTSTABLE_SEARCH to liFile
91947>>>>>>> get psRootname.i of lhTableAccess FTSTABLE_SEARCH to lsRoot
91948>>>>>>> get psLogicalName.i of lhTableAccess FTSTABLE_SEARCH to lsLogical
91949>>>>>>> get psUserName.i of lhTableAccess FTSTABLE_SEARCH to lsDisplay
91950>>>>>>> set FileListValues of oTable_search to liFile lsRoot lsLogical lsDisplay
91951>>>>>>> send DoDefine of oTable_search
91952>>>>>>> send CreateTable of oTable_search
91953>>>>>>> end_procedure
91954>>>>>>>end_object // oFTS_TableDefinitions
91955>>>>>>>
91955>>>>>>>procedure FTS_CreateTables global integer lhTableAccess integer liArticleIdWidth integer lhPhraseLength
91957>>>>>>> send DoCreateTables of oFTS_TableDefinitions lhTableAccess liArticleIdWidth lhPhraseLength
91958>>>>>>>end_procedure
91959>>>>>Use WildCard.nui // WildCardMatch function
91959>>>>>
91959>>>>>object oFTS_DropTablesWizard is a aps.WizardPanel label "Drop FTS tables"
91962>>>>> send make_nice_size WIZSIZE_NORMAL
91963>>>>>
91963>>>>> property integer phTableAccessObject // This is here only to fool the cFTS_TableAccess into not complaining
91965>>>>> object oFTS_TableAccess is a cFTS_TableAccess
91967>>>>> set pbOpenTablesOnDefine to false
91968>>>>> end_object // cFTS_TableAccess
91969>>>>> object oPage1 is a aps.WizardPage
91971>>>>> object oYellow is a aps.YellowBox
91973>>>>> set size to 55 100
91974>>>>> set value item 0 to "Use this wizard to drop a set of FTS tables (FTS)."
91975>>>>> set value item 1 to ""
91976>>>>> set value item 2 to "5 tables will be removed from filelist.cfg (and erased) with names that are fixed except for a prefix of two letters."
91977>>>>> set value item 3 to ""
91978>>>>> set value item 4 to "You will need exclusive access to these tables in order to complete this operation."
91979>>>>> end_object
91980>>>>> send aps_goto_max_row
91981>>>>> send aps_make_row_space 5
91982>>>>>
91982>>>>> object oLabel1 is a aps.TextBox label "Drop this set of FTS tables:"
91985>>>>> set fixed_size to 10 200
91986>>>>> set Fontweight to 900
91987>>>>> end_object
91988>>>>> send aps_goto_max_row
91989>>>>> object oExisting is a aps.Grid
91991>>>>> send GridPrepare_AddColumn "Prefix" AFT_ASCII6
91992>>>>> send GridPrepare_AddColumn "Existing sets of FTS tables" AFT_ASCII40
91993>>>>> send GridPrepare_Apply self
91994>>>>> set select_mode to NO_SELECT
91995>>>>> on_key KNEXT_ITEM send switch
91996>>>>> on_key KPREVIOUS_ITEM send switch_back
91997>>>>> set size to 43 0
91998>>>>> procedure fill_list.i integer lhFTS
92001>>>>> integer lhTableAccessObject lhObj liMax liRow
92001>>>>> get phTableAccessObject of lhFTS to lhTableAccessObject
92002>>>>> send delete_data
92003>>>>> send DoBuildSetsOfTables of lhTableAccessObject
92004>>>>> move (oListOfSets(lhTableAccessObject)) to lhObj
92005>>>>> get row_count of lhObj to liMax
92006>>>>> decrement liMax
92007>>>>> for liRow from 0 to liMax
92013>>>>>>
92013>>>>> send add_item MSG_NONE (psPrefix.i(lhobj,liRow))
92014>>>>> send add_item MSG_NONE (psOpenDescription.i(lhobj,liRow))
92015>>>>> loop
92016>>>>>>
92016>>>>> send Grid_SetEntryState self 0
92017>>>>> end_procedure
92018>>>>> function sCurrentPrefix returns string
92021>>>>> integer liBase
92021>>>>> if (item_count(self)) begin
92023>>>>> get Grid_BaseItem self to liBase
92024>>>>> function_return (value(self,liBase))
92025>>>>> end
92025>>>>>>
92025>>>>> function_return ""
92026>>>>> end_function
92027>>>>> end_object // oExisting
92028>>>>>
92028>>>>> function sPrefix returns string
92031>>>>> string lsValue
92031>>>>> get sCurrentPrefix of oExisting to lsValue
92032>>>>> function_return (lowercase(lsValue))
92033>>>>> end_function
92034>>>>> procedure DoInitialize
92037>>>>> //send fill_list of oExisting
92037>>>>> end_procedure
92038>>>>>
92038>>>>> function iPageValidate returns integer
92041>>>>> integer lbOK lhTableAccess
92041>>>>> string lsValue
92041>>>>> move oFTS_TableAccess to lhTableAccess
92042>>>>> get sPrefix to lsValue
92043>>>>> get FTS_ValidatePrefix of lhTableAccess lsValue to lbOK
92044>>>>> if lbOK begin
92046>>>>> send DoCloseTables of lhTableAccess
92047>>>>> set psRootNamePrefix of lhTableAccess to lsValue
92048>>>>> get DoOpenTables of lhTableAccess to lbOK
92049>>>>> ifnot lbOK error 210 "FTS tables named with the specified prefix could not be opened"
92052>>>>> end
92052>>>>>>
92052>>>>> function_return lbOK
92053>>>>> end_function
92054>>>>> procedure aps_beautify
92057>>>>> send aps_align_inside_container_by_sizing (oYellow(self)) SL_ALIGN_RIGHT
92058>>>>> send aps_align_inside_container_by_moving (oExisting(self)) SL_ALIGN_CENTER
92059>>>>> end_procedure
92060>>>>> end_object // oPage1
92061>>>>> object oPage2 is a aps.WizardPage
92063>>>>> send aps_make_row_space -10
92064>>>>> object oLabel is a aps.TextBox label "These are the tables that you are about to drop:"
92067>>>>> set fixed_size to 10 200
92068>>>>> set Fontweight to 900
92069>>>>> end_object
92070>>>>> send aps_goto_max_row
92071>>>>> object oYellow is a aps.YellowBox
92073>>>>> set size to 20 100
92074>>>>> set value item 0 to "Click the Finish button to drop the tables"
92075>>>>> end_object
92076>>>>> send aps_goto_max_row
92077>>>>> send aps_make_row_space 5
92078>>>>> object oGrid is a aps.Grid
92080>>>>> send GridPrepare_AddColumn "Table" AFT_ASCII10
92081>>>>> send GridPrepare_AddColumn "User display name" AFT_ASCII32
92082>>>>> send GridPrepare_AddColumn "Filelist" AFT_NUMERIC4.0
92083>>>>> send GridPrepare_AddColumn "Records" AFT_NUMERIC8.0
92084>>>>> send GridPrepare_Apply self
92085>>>>> set select_mode to NO_SELECT
92086>>>>> on_key KNEXT_ITEM send switch
92087>>>>> on_key KPREVIOUS_ITEM send switch_back
92088>>>>> set size to 62 0
92089>>>>> procedure fill_list
92092>>>>> integer liMax liRow lhTableAccess liFile liRecords
92092>>>>> string lsValue
92092>>>>> move oFTS_TableAccess to lhTableAccess
92093>>>>> send delete_data
92094>>>>> get row_count of lhTableAccess to liMax
92095>>>>> decrement liMax
92096>>>>> for liRow from 0 to liMax
92102>>>>>>
92102>>>>> get piFile.i of lhTableAccess liRow to liFile
92103>>>>> get_attribute DF_FILE_LOGICAL_NAME of liFile to lsValue
92106>>>>> send add_item MSG_NONE (lowercase(lsValue))
92107>>>>> get_attribute DF_FILE_DISPLAY_NAME of liFile to lsValue
92110>>>>> move (rtrim(lsValue)) to lsValue
92111>>>>> send add_item MSG_NONE (lowercase(lsValue))
92112>>>>> send add_item MSG_NONE (string(liFile))
92113>>>>> get_attribute DF_FILE_RECORDS_USED of liFile to liRecords
92116>>>>> send add_item MSG_NONE (string(liRecords))
92117>>>>> loop
92118>>>>>>
92118>>>>> send Grid_SetEntryState self false
92119>>>>> end_procedure
92120>>>>> end_object // oGrid
92121>>>>> procedure DoInitialize
92124>>>>> send fill_list of oGrid
92125>>>>> end_procedure
92126>>>>> function iPageValidate returns integer
92129>>>>> integer lbOK lhTableAccess
92129>>>>> move oFTS_TableAccess to lhTableAccess
92130>>>>> send DoCloseTables of lhTableAccess
92131>>>>> get DoOpenTablesExclusive of lhTableAccess to lbOK
92132>>>>> ifnot lbOK begin
92134>>>>> send DoCloseTables of lhTableAccess
92135>>>>> error 211 "Exclusive access could not be obtained"
92136>>>>>>
92136>>>>> function_return 0
92137>>>>> end
92137>>>>>>
92137>>>>> send DoCloseTables of lhTableAccess
92138>>>>> function_return 1
92139>>>>> end_function
92140>>>>> procedure aps_beautify
92143>>>>> send aps_align_inside_container_by_sizing (oYellow(self)) SL_ALIGN_RIGHT
92144>>>>> end_procedure
92145>>>>> end_object // oPage2
92146>>>>> procedure DisplayPage integer liPage
92149>>>>> integer liCurrentPage
92149>>>>> get piCurrentPage to liCurrentPage
92150>>>>> if (liPage=1) begin //
92152>>>>> if (liCurrentPage<1) send DoInitialize of oPage2
92155>>>>> end
92155>>>>>>
92155>>>>> forward send DisplayPage liPage
92157>>>>> end_procedure
92158>>>>> procedure DoFinish
92161>>>>> integer lbOK lhTableAccess
92161>>>>> move oFTS_TableAccess to lhTableAccess
92162>>>>> send cursor_wait to (cursor_control(self))
92163>>>>> get DoEraseAllTables of lhTableAccess to lbOK
92164>>>>> send cursor_ready to (cursor_control(self))
92165>>>>> if lbOK send obs "Tables have been dropped"
92168>>>>> else send obs "An error occurred while dropping the tables"
92170>>>>> end_procedure
92171>>>>> procedure aps_beautify
92174>>>>> forward send aps_beautify
92176>>>>> send aps_beautify of oPage1
92177>>>>> send aps_beautify of oPage2
92178>>>>> end_procedure
92179>>>>> procedure popup.i integer lhFTS
92182>>>>> send fill_list.i of (oExisting(oPage1(self))) lhFTS
92183>>>>> send popup
92184>>>>> end_procedure
92185>>>>>end_object // oFTS_DropTablesWizard
92186>>>>>
92186>>>>>procedure Popup_FTS_DropTablesWizard integer lhFTS
92189>>>>> send popup.i of oFTS_DropTablesWizard lhFTS
92190>>>>>end_procedure
92191>>>>>
92191>>>>>// *****************************************************************************************************************************
92191>>>>>// *****************************************************************************************************************************
92191>>>>>// *****************************************************************************************************************************
92191>>>>>// *****************************************************************************************************************************
92191>>>>>// *****************************************************************************************************************************
92191>>>>>// *****************************************************************************************************************************
92191>>>>>// *****************************************************************************************************************************
92191>>>>>
92191>>>>>object oFTS_CreateTablesWizard is a aps.WizardPanel label "Create FTS tables"
92194>>>>> send make_nice_size WIZSIZE_NORMAL
92195>>>>>
92195>>>>> property integer phTableAccessObject // This is here only to fool the cFTS_TableAccess into not complaining
92197>>>>> object oFTS_TableAccess is a cFTS_TableAccess
92199>>>>> set pbOpenTablesOnDefine to false
92200>>>>> end_object // cFTS_TableAccess
92201>>>>>
92201>>>>> object oPage1 is a aps.WizardPage
92203>>>>> object oYellow is a aps.YellowBox
92205>>>>> set size to 70 100
92206>>>>> set value item 0 to "Use this wizard to create a set of tables to be used with the free text search classes (FTS)."
92207>>>>> set value item 1 to ""
92208>>>>> set value item 2 to "5 tables will be created with names that are fixed except for a prefix of two letters. These tables will be added to filelist.cfg"
92209>>>>> set value item 3 to ""
92210>>>>> set value item 4 to "You may delete these tables again by using the 'Drop FTS tables' tool."
92211>>>>> end_object
92212>>>>> send aps_goto_max_row
92213>>>>> send aps_make_row_space 10
92214>>>>>
92214>>>>> object oPrefix is a aps.Form label "Enter a 2-letter prefix to be used when naming FTS tables:" abstract AFT_ASCII2
92218>>>>> set p_extra_internal_width to 15
92219>>>>> end_object
92220>>>>> send aps_relocate (oPrefix(self)) 0 35
92221>>>>> send aps_goto_max_row
92222>>>>> send aps_make_row_space 10
92223>>>>> object oPurpose is a aps.Form label "Enter an indication of purpose (or leave empty):" abstract AFT_ASCII10
92227>>>>> set p_extra_internal_width to 15
92228>>>>> end_object
92229>>>>> send aps_relocate (oPurpose(self)) 0 35
92230>>>>> procedure aps_beautify
92233>>>>> send aps_align_inside_container_by_sizing (oYellow(self)) SL_ALIGN_RIGHT
92234>>>>> end_procedure
92235>>>>> function sPurpose returns string
92238>>>>> string lsValue
92238>>>>> get value of oPurpose to lsValue
92239>>>>> function_return lsValue
92240>>>>> end_function
92241>>>>> function sPrefix returns string
92244>>>>> string lsValue
92244>>>>> get value of oPrefix to lsValue
92245>>>>> function_return (lowercase(lsValue))
92246>>>>> end_function
92247>>>>> function iPageValidate returns integer
92250>>>>> integer lbOK lhTableAccess
92250>>>>> string lsValue lsPrefix lsPurpose
92250>>>>> move oFTS_TableAccess to lhTableAccess
92251>>>>> get sPrefix to lsPrefix
92252>>>>> get FTS_ValidatePrefix of lhTableAccess lsPrefix to lbOK
92253>>>>> if lbOK begin
92255>>>>> get sPurpose to lsPurpose
92256>>>>> set psRootNamePrefix of oFTS_TableAccess to lsPrefix
92257>>>>> set psPurpose of oFTS_TableAccess to lsPurpose
92258>>>>> send DoCalcFilelistValues of oFTS_TableAccess
92259>>>>> get Precond_CreateTables of oFTS_TableAccess DFFALSE to lbOK
92260>>>>> end
92260>>>>>>
92260>>>>> function_return lbOK
92261>>>>> end_function
92262>>>>> end_object
92263>>>>> object oPage2 is a aps.WizardPage
92265>>>>> send aps_make_row_space -10
92266>>>>> object oLabel is a aps.TextBox label "Assigning filelist entries:"
92269>>>>> set fixed_size to 10 200
92270>>>>> set Fontweight to 900
92271>>>>> end_object
92272>>>>> send aps_goto_max_row
92273>>>>> object oYellow is a aps.YellowBox
92275>>>>> set size to 20 100
92276>>>>> set value item 0 to "The tables that will be created need to be assigned to available entries in filelist.cfg"
92277>>>>> end_object
92278>>>>> send aps_goto_max_row
92279>>>>> send aps_make_row_space 5
92280>>>>> object oGrid is a aps.Grid
92282>>>>> send GridPrepare_AddColumn "Table name" AFT_ASCII10
92283>>>>> send GridPrepare_AddColumn "User display name" AFT_ASCII32
92284>>>>> send GridPrepare_AddColumn "Filelist entry" AFT_NUMERIC4.0
92285>>>>> send GridPrepare_Apply self
92286>>>>> set select_mode to NO_SELECT
92287>>>>> on_key KNEXT_ITEM send switch
92288>>>>> on_key KPREVIOUS_ITEM send switch_back
92289>>>>> set size to 62 0
92290>>>>> procedure fill_list
92293>>>>> integer lhTableAccess liRow liMax liBase
92293>>>>> move oFTS_TableAccess to lhTableAccess
92294>>>>> send delete_data
92295>>>>> get row_count of lhTableAccess to liMax
92296>>>>> decrement liMax
92297>>>>> for liRow from 0 to liMax
92303>>>>>>
92303>>>>> get item_count to liBase
92304>>>>> send add_item MSG_NONE (psRootname.i(lhTableAccess,liRow))
92305>>>>> set aux_value item liBase to liRow
92306>>>>> send add_item MSG_NONE (psUserName.i(lhTableAccess,liRow))
92307>>>>> send add_item MSG_NONE (piFile.i(lhTableAccess,liRow))
92308>>>>> loop
92309>>>>>>
92309>>>>> send Grid_SetEntryState self false
92310>>>>> end_procedure
92311>>>>> register_object oCombo
92311>>>>> procedure DoAssignOne
92314>>>>> integer liBase liFile
92314>>>>> get Grid_BaseItem self to liBase
92315>>>>> get value item (liBase+2) to liFile
92316>>>>> ifnot liFile begin
92318>>>>> get iTakeOutValue of oCombo to liFile
92319>>>>> set value item (liBase+2) to liFile
92320>>>>> set Current_Item to (current_item(self)+Grid_Columns(self))
92321>>>>> end
92321>>>>>>
92321>>>>> end_procedure
92322>>>>> procedure DoReset
92325>>>>> integer liMax liRow liBase
92325>>>>> get Grid_RowCount self to liMax
92326>>>>> decrement liMax
92327>>>>> for liRow from 0 to liMax
92333>>>>>>
92333>>>>> get Grid_RowBaseItem self liRow to liBase
92334>>>>> set value item (liBase+2) to 0
92335>>>>> loop
92336>>>>>>
92336>>>>> end_procedure
92337>>>>> procedure UpdateTableAccess
92340>>>>> integer lhTableAccess liRow liMax liAccessRow liBase liFile
92340>>>>> move oFTS_TableAccess to lhTableAccess
92341>>>>> get row_count of lhTableAccess to liMax
92342>>>>> decrement liMax
92343>>>>> for liRow from 0 to liMax
92349>>>>>>
92349>>>>> get Grid_RowBaseItem self liRow to liBase
92350>>>>> get value item (liBase+2) to liFile
92351>>>>> get aux_value item liBase to liAccessRow
92352>>>>> set piFile.i of lhTableAccess liAccessRow to liFile
92353>>>>> loop
92354>>>>>>
92354>>>>> end_procedure
92355>>>>> function bValidate returns integer
92358>>>>> integer liMax liRow liBase liFile
92358>>>>> get Grid_RowCount self to liMax
92359>>>>> decrement liMax
92360>>>>> for liRow from 0 to liMax
92366>>>>>>
92366>>>>> get Grid_RowBaseItem self liRow to liBase
92367>>>>> get value item (liBase+2) to liFile
92368>>>>> ifnot liFile function_return 0
92371>>>>> loop
92372>>>>>>
92372>>>>> function_return 1
92373>>>>> end_function
92374>>>>> end_object // oGrid
92375>>>>> send aps_goto_max_row
92376>>>>> send aps_make_row_space 5
92377>>>>>
92377>>>>> object oCombo is a aps.ComboForm label "Entries available in filelist.cfg:" abstract AFT_ASCII6
92381>>>>> set Combo_Sort_State to false
92382>>>>> set entry_state item 0 to false
92383>>>>> set p_extra_external_width to 10
92384>>>>> procedure AddEntry integer liFile
92387>>>>> send Combo_Add_Item (string(liFile))
92388>>>>> end_procedure
92389>>>>> procedure fill_list
92392>>>>> integer liFile
92392>>>>> send Combo_Delete_Data
92393>>>>> send DBMS_Callback_FilelistEntries FLEC_EMPTY_NOT_OPEN msg_AddEntry self
92394>>>>> get Combo_Value 0 to liFile
92395>>>>> set value to liFile
92396>>>>> end_procedure
92397>>>>> function iTakeOutValue returns integer
92400>>>>> integer liItem
92400>>>>> string lsValue lsNext
92400>>>>> get value item 0 to lsValue
92401>>>>> get Combo_Item_Matching lsValue to liItem
92402>>>>> if (liItem>-1) begin
92404>>>>> get Combo_Value (liItem+1) to lsNext
92405>>>>> send Combo_Delete_Item liItem
92406>>>>> set value item 0 to lsNext
92407>>>>> end
92407>>>>>>
92407>>>>> else move "" to lsValue
92409>>>>> function_return (integer(lsValue))
92410>>>>> end_function
92411>>>>> end_object
92412>>>>> send aps_relocate (oCombo(self)) 0 15
92413>>>>>
92413>>>>> procedure DoAssignAll
92416>>>>> integer liFile
92416>>>>> send cursor_wait to (cursor_control(self))
92417>>>>> get value of oCombo to liFile
92418>>>>> send DoReset
92419>>>>> set current_item of oGrid to 0
92420>>>>> set value of oCombo to liFile
92421>>>>> send DoAssignOne of oGrid
92422>>>>> send DoAssignOne of oGrid
92423>>>>> send DoAssignOne of oGrid
92424>>>>> send DoAssignOne of oGrid
92425>>>>> send DoAssignOne of oGrid
92426>>>>> send cursor_ready to (cursor_control(self))
92427>>>>> end_procedure
92428>>>>> procedure DoReset
92431>>>>> send DoReset of oGrid
92432>>>>> send fill_list of oCombo
92433>>>>> end_procedure
92434>>>>>
92434>>>>> object oBtnAll is a aps.Button snap SL_RIGHT_SPACE
92437>>>>> set size to 13 46
92438>>>>> on_item "Assign all" send DoAssignAll
92439>>>>> end_object
92440>>>>> object oBtnOne is a aps.Button snap SL_RIGHT
92443>>>>> set size to 13 36
92444>>>>> on_item "Assign" send DoAssignOne of oGrid
92445>>>>> end_object
92446>>>>> object oBtnReset is a aps.Button snap SL_RIGHT
92449>>>>> set size to 13 36
92450>>>>> on_item "Reset" send DoReset
92451>>>>> end_object
92452>>>>>
92452>>>>> procedure aps_beautify
92455>>>>> send aps_align_inside_container_by_sizing (oYellow(self)) SL_ALIGN_RIGHT
92456>>>>> send aps_align_inside_container_by_moving (oGrid(self)) SL_ALIGN_CENTER
92457>>>>> end_procedure
92458>>>>> function iPageValidate returns integer
92461>>>>> integer lbOK
92461>>>>> get bValidate of oGrid to lbOK
92462>>>>> if lbOK begin
92464>>>>> send UpdateTableAccess of oGrid
92465>>>>> end
92465>>>>>>
92465>>>>> else error 207 "All tables must be assigned filelist entries"
92467>>>>> function_return lbOK
92468>>>>> end_function
92469>>>>>
92469>>>>> procedure DoInitialize
92472>>>>> string lsPrefix lsPurpose
92472>>>>> get sPrefix of oPage1 to lsPrefix
92473>>>>> get sPurpose of oPage1 to lsPurpose
92474>>>>> set psRootNamePrefix of oFTS_TableAccess to lsPrefix
92475>>>>> set psPurpose of oFTS_TableAccess to lsPurpose
92476>>>>> send DoCalcFilelistValues of oFTS_TableAccess
92477>>>>> send fill_list of oGrid
92478>>>>> send fill_list of oCombo
92479>>>>> end_procedure
92480>>>>> end_object // oPage2
92481>>>>> object oPage3 is a aps.WizardPage
92483>>>>> send aps_make_row_space -10
92484>>>>> object oLabel is a aps.TextBox label "Final parameters:"
92487>>>>> set fixed_size to 10 200
92488>>>>> set Fontweight to 900
92489>>>>> end_object
92490>>>>> send aps_goto_max_row
92491>>>>> object oYellow1 is a aps.YellowBox
92493>>>>> set size to 45 100
92494>>>>> set value item 0 to "The FTS classes identifies an 'article' by a unique number. You must specify the maximum value of this number. The width ranges from 6 (a million) to 14 (a lot)."
92495>>>>> set value item 1 to ""
92496>>>>> set value item 2 to "For both values on this page it is true that smaller values increases the speed. I have however not verified to what degree this may be the case."
92497>>>>> end_object
92498>>>>> send aps_goto_max_row
92499>>>>> send aps_make_row_space 5
92500>>>>> object oArticleWidth is a aps.ComboForm label "Maximum with of article id:" abstract AFT_ASCII6
92504>>>>> set Combo_Sort_State to false
92505>>>>> set entry_state item 0 to false
92506>>>>> send Combo_Add_Item (string(6))
92507>>>>> send Combo_Add_Item (string(7))
92508>>>>> send Combo_Add_Item (string(8))
92509>>>>> send Combo_Add_Item (string(9))
92510>>>>> send Combo_Add_Item (string(10))
92511>>>>> send Combo_Add_Item (string(11))
92512>>>>> send Combo_Add_Item (string(12))
92513>>>>> send Combo_Add_Item (string(13))
92514>>>>> send Combo_Add_Item (string(14))
92515>>>>> end_object
92516>>>>> send aps_relocate (oArticleWidth(self)) 0 60
92517>>>>>
92517>>>>> send aps_goto_max_row
92518>>>>> send aps_make_row_space 5
92519>>>>>
92519>>>>> object oYellow2 is a aps.YellowBox
92521>>>>> set size to 30 100
92522>>>>> set value item 0 to "The FTS table that stores a sequence of words for each record is able to handle from 6 to 14 words in a phrase. This number is identical to the maximum number of words taken into account when phrase searching."
92523>>>>> end_object
92524>>>>> send aps_goto_max_row
92525>>>>> send aps_make_row_space 5
92526>>>>> object oPhraseWidth is a aps.ComboForm label "Maximum phrase length:" abstract AFT_ASCII6
92530>>>>> set Combo_Sort_State to false
92531>>>>> set entry_state item 0 to false
92532>>>>> send Combo_Add_Item (string(6))
92533>>>>> send Combo_Add_Item (string(7))
92534>>>>> send Combo_Add_Item (string(8))
92535>>>>> send Combo_Add_Item (string(9))
92536>>>>> send Combo_Add_Item (string(10))
92537>>>>> send Combo_Add_Item (string(11))
92538>>>>> send Combo_Add_Item (string(12))
92539>>>>> send Combo_Add_Item (string(13))
92540>>>>> send Combo_Add_Item (string(14))
92541>>>>> end_object
92542>>>>> send aps_relocate (oPhraseWidth(self)) 0 60
92543>>>>> procedure aps_beautify
92546>>>>> send aps_align_inside_container_by_sizing (oYellow1(self)) SL_ALIGN_RIGHT
92547>>>>> send aps_align_inside_container_by_sizing (oYellow2(self)) SL_ALIGN_RIGHT
92548>>>>> end_procedure
92549>>>>> end_object
92550>>>>> object oPage99 is a aps.WizardPage
92552>>>>> object oFinishText is an aps.Edit
92554>>>>> set size to 110 300
92555>>>>> set object_shadow_state to DFTRUE
92556>>>>> set border_style to BORDER_NONE
92557>>>>> set scroll_bar_visible_state to DFFALSE
92558>>>>> set value item 0 to 'Click the "Finish" button to create the tables.'
92559>>>>> set value item 1 to ''
92560>>>>> set value item 2 to "You may delete these tables again by using the 'Drop FTS tables' tool."
92561>>>>> set value item 3 to ''
92562>>>>> procedure activate
92565>>>>> send activate of oBtn2 // Nothing here will take focus. Givi it to the finish button
92566>>>>> end_procedure
92567>>>>> end_object
92568>>>>> end_object
92569>>>>> procedure DisplayPage integer liPage
92572>>>>> integer liCurrentPage
92572>>>>> get piCurrentPage to liCurrentPage
92573>>>>> if (liPage=1) begin //
92575>>>>> if (liCurrentPage<1) send DoInitialize of oPage2
92578>>>>> end
92578>>>>>>
92578>>>>> forward send DisplayPage liPage
92580>>>>> end_procedure
92581>>>>> procedure DoFinish
92584>>>>> integer lhTableAccess liArticleIdWidth lhPhraseLength
92584>>>>> move oFTS_TableAccess to lhTableAccess
92585>>>>> get value of (oArticleWidth(oPage3(self))) to liArticleIdWidth
92586>>>>> get value of (oPhraseWidth(oPage3(self))) to lhPhraseLength
92587>>>>> send FTS_CreateTables lhTableAccess liArticleIdWidth lhPhraseLength
92588>>>>> send obs "Tables have been created"
92589>>>>> end_procedure
92590>>>>> procedure aps_beautify
92593>>>>> forward send aps_beautify
92595>>>>> send aps_beautify of oPage1
92596>>>>> send aps_beautify of oPage2
92597>>>>> send aps_beautify of oPage3
92598>>>>> end_procedure
92599>>>>>end_object // oFTS_CreateTablesWizard
92600>>>>>
92600>>>>>procedure Popup_FTS_CreateTablesWizard
92603>>>>> send popup of oFTS_CreateTablesWizard
92604>>>>>end_procedure
92605>>>>>
92605>>> Use FTSCtrlVw.pkg // FTS Control Panel
Including file: FTSCtrlVw.pkg (C:\Apps\VDFQuery\AppSrc\FTSCtrlVw.pkg)
92605>>>>>use aps
92605>>>>>use fts.nui
Including file: fts.nui (C:\Apps\VDFQuery\AppSrc\fts.nui)
92605>>>>>>>// Use FTS.nui // Freetext search system classes
92605>>>>>>>
92605>>>>>>>Use FTSWrdSp.nui // cFTS_WordSplitter class (to be used internally by cFreeText_Indexer and cFTS_Searcher classes)
Including file: ftswrdsp.nui (C:\Apps\VDFQuery\AppSrc\ftswrdsp.nui)
92605>>>>>>>>>// Use FTSWrdSp.nui // cFTS_WordSplitter class (to be used internally by cFreeText_Indexer and cFTS_Searcher classes)
92605>>>>>>>>>
92605>>>>>>>>>//> The cFTS_WordSplitter class is able to split up an article into words. It is done like this:
92605>>>>>>>>>//>
92605>>>>>>>>>//><CODE>
92605>>>>>>>>>//> Send DoReset to lhWordSplitter
92605>>>>>>>>>//> Send DoAddText to lhWordSplitter <text> // as many as needed
92605>>>>>>>>>//></CODE>
92605>>>>>>>>>//> Legal letters are determined by the psLetters property
92605>>>>>>>>>//>
92605>>>>>>>>>
92605>>>>>>>>>// Programmed by Sture Andersen for Sture ApS. E-mail: sture.aps@mail.tele.dk, Tel: +45 40 59 70 20
92605>>>>>>>>>
92605>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
92605>>>>>>>>>Use Language.pkg
92605>>>>>>>>>
92605>>>>>>>>>define FTS_WORDCHARACTERS_DANISH for "ABCDEFGHIJKLMNOPQRSTUVWXYZ’Ž™šµÖàéí·ÔÞãëabcdefghijklmnopqrstuvwxyz‘›†„” ‚¡¢£ì…Š•—"
92605>>>>>>>>>define FTS_WORDCHARACTERS_ENGLISH for "ABCDEFGHIJKLMNOPQRSTUVWXYZµÖàéí·ÔÞãëabcdefghijklmnopqrstuvwxyz ‚¡¢£ì…Š•—¤"
92605>>>>>>>>>
92605>>>>>>>>>enumeration_list
92605>>>>>>>>> // Set this property to the string of letters that are considered to be legal in your langauge (or rather
92605>>>>>>>>> // the language of the articles, you're going to index)
92605>>>>>>>>> define FTS_WORDCHARACTERS
92605>>>>>>>>> // If paragraphs can be trusted to not include CR/LF characters you may set this property to DFTRUE. This will
92605>>>>>>>>> // prevent finding phrases that starts in one paragraph and ends in the next (and therefore technically are not
92605>>>>>>>>> // phrases). If however, like in newsgroup articles, paragraphs are divided into a number of CR/LF delimited lines,
92605>>>>>>>>> // it should be set DFFALSE (as indeed is the default value).
92605>>>>>>>>> define FTS_CRLFCANBETRUSTED
92605>>>>>>>>>end_enumeration_list
92605>>>>>>>>>
92605>>>>>>>>>desktop_section
92610>>>>>>>>> object oFTS_GlobalSetup is a cArray
92612>>>>>>>>> // The set up values contained in this array are default values
92612>>>>>>>>> // for properties of all objects of the cFTS_WordSplitter class.
92612>>>>>>>>> end_object
92613>>>>>>>>>end_desktop_section
92618>>>>>>>>>
92618>>>>>>>>>procedure set FTS_Parameter global integer liItm string lsValue
92620>>>>>>>>> set value of (oFTS_GlobalSetup(self)) item liItm to lsValue
92621>>>>>>>>>end_procedure
92622>>>>>>>>>function FTS_Parameter global integer liItm returns string
92624>>>>>>>>> function_return (value(oFTS_GlobalSetup(self),liItm))
92625>>>>>>>>>end_function
92626>>>>>>>>>
92626>>>>>>>>>// Set up default parameters
92626>>>>>>>>> set FTS_Parameter FTS_WORDCHARACTERS to FTS_WORDCHARACTERS_ENGLISH
92627>>>>>>>>>
92627>>>>>>>>>set FTS_Parameter FTS_CRLFCANBETRUSTED to DFFALSE
92628>>>>>>>>>
92628>>>>>>>>>//> As the name implies an object of the cFTS_WordSplitter class is used to
92628>>>>>>>>>//> break up an article into words.
92628>>>>>>>>>class cFTS_WordSplitter is a cArray
92629>>>>>>>>> procedure construct_object integer liImg
92631>>>>>>>>> forward send construct_object liImg
92633>>>>>>>>> property string psLetters private (FTS_Parameter(FTS_WORDCHARACTERS))
92634>>>>>>>>> property string psDelimiters private ""
92635>>>>>>>>>
92635>>>>>>>>> // Very private. Is used to temporarily make the DoAddText procedure but
92635>>>>>>>>> // the list of words to an external object instead of itself.
92635>>>>>>>>> property integer phRedirectObj private 0
92636>>>>>>>>> property integer pbDoNotRegisterWithParent public false
92637>>>>>>>>>
92637>>>>>>>>> // Property pbCrLfCanBeTrusted should be set to TRUE if we can rely upon
92637>>>>>>>>> // hard coded line shifts.
92637>>>>>>>>> property integer pbCrLfCanBeTrusted public (FTS_Parameter(FTS_CRLFCANBETRUSTED))
92638>>>>>>>>> end_procedure
92639>>>>>>>>>
92639>>>>>>>>> item_property_list
92639>>>>>>>>> item_property string psWord.i
92639>>>>>>>>> item_property integer piWordId.i // Used by external procedures to assign word ID's
92639>>>>>>>>> item_property integer piFrequency.i // Used by external procedures to assign word frequencies
92639>>>>>>>>> end_item_property_list cFTS_WordSplitter
#REM 92674 DEFINE FUNCTION PIFREQUENCY.I INTEGER LIROW RETURNS INTEGER
#REM 92678 DEFINE PROCEDURE SET PIFREQUENCY.I INTEGER LIROW INTEGER VALUE
#REM 92682 DEFINE FUNCTION PIWORDID.I INTEGER LIROW RETURNS INTEGER
#REM 92686 DEFINE PROCEDURE SET PIWORDID.I INTEGER LIROW INTEGER VALUE
#REM 92690 DEFINE FUNCTION PSWORD.I INTEGER LIROW RETURNS STRING
#REM 92694 DEFINE PROCEDURE SET PSWORD.I INTEGER LIROW STRING VALUE
92699>>>>>>>>>
92699>>>>>>>>> procedure BuildDelimiters // Private
92701>>>>>>>>> integer liAscii
92701>>>>>>>>> string lsDelimiters lsChar lsNotDelimiters
92701>>>>>>>>> move "" to lsDelimiters
92702>>>>>>>>> get psLetters to lsNotDelimiters
92703>>>>>>>>> move (lsNotDelimiters+"01234567890") to lsNotDelimiters
92704>>>>>>>>> for liAscii from 33 to 255
92710>>>>>>>>>>
92710>>>>>>>>> ifnot (character(liAscii)) in lsNotDelimiters move (lsDelimiters+character(liAscii)) to lsDelimiters
92713>>>>>>>>> loop
92714>>>>>>>>>>
92714>>>>>>>>> set cFTS_WordSplitter.psDelimiters to lsDelimiters
92715>>>>>>>>> end_procedure
92716>>>>>>>>>
92716>>>>>>>>> procedure set psLetters string lsLetters
92718>>>>>>>>> set cFTS_WordSplitter.psLetters to lsLetters
92719>>>>>>>>> send BuildDelimiters
92720>>>>>>>>> end_procedure
92721>>>>>>>>>
92721>>>>>>>>> function psLetters returns string
92723>>>>>>>>> function_return (cFTS_WordSplitter.psLetters(self))
92724>>>>>>>>> end_function
92725>>>>>>>>>
92725>>>>>>>>> procedure end_construct_object // Private
92727>>>>>>>>> integer lhSelf
92727>>>>>>>>> forward send end_construct_object
92729>>>>>>>>> send BuildDelimiters
92730>>>>>>>>> ifnot (pbDoNotRegisterWithParent(self)) begin
92732>>>>>>>>> move self to lhSelf
92733>>>>>>>>> set phWordsplitterObject to lhSelf // This is resolved in the encapsulating cFTS_System object
92734>>>>>>>>> end
92734>>>>>>>>>>
92734>>>>>>>>> end_procedure
92735>>>>>>>>>
92735>>>>>>>>> //> Use procedure DoReset to delete all data in the array.
92735>>>>>>>>> procedure DoReset
92737>>>>>>>>> send delete_data
92738>>>>>>>>> end_procedure
92739>>>>>>>>>
92739>>>>>>>>> enumeration_list // Private
92739>>>>>>>>> define PRIV_FTS_NOT_IN_ITEM // These are just constants used internally by the DoAddText
92739>>>>>>>>> define PRIV_FTS_WORD // procedure for values of internal state variable liState:
92739>>>>>>>>> define PRIV_FTS_NUMBER
92739>>>>>>>>> define PRIV_FTS_DELIMITER
92739>>>>>>>>> define PRIV_FTS_BELOW32
92739>>>>>>>>> end_enumeration_list
92739>>>>>>>>>
92739>>>>>>>>> //> This procedure adds rows to item_property structure by filling the
92739>>>>>>>>> //> psWord.i column only. The DoAddText procedure does not reset the
92739>>>>>>>>> //> values in the array before doing this. This must be done manually
92739>>>>>>>>> //> by calling the DoReset procedure.
92739>>>>>>>>> //>
92739>>>>>>>>> //> The function of this procedure is influenced by properties psLetters
92739>>>>>>>>> //> and pbCrLfCanBeTrusted.
92739>>>>>>>>> //>
92739>>>>>>>>> //> If you want to fundamentally change the way words are being derived
92739>>>>>>>>> //> from articles, this is the procedure to want to change.
92739>>>>>>>>>
92739>>>>>>>>> procedure DoAddText string lsText
92741>>>>>>>>> integer liLen liPos liRow liState lbBelow32CountsAsWord lhSelf
92741>>>>>>>>> string lsChar lsWord lsLetter lsNumbers lsDelimiters
92741>>>>>>>>>
92741>>>>>>>>> get cFTS_WordSplitter.phRedirectObj to lhSelf // If>0 the result of the splitting should be send elsewhere
92742>>>>>>>>> ifnot lhSelf move self to lhSelf
92745>>>>>>>>> set cFTS_WordSplitter.phRedirectObj to 0 // Make sure that the redirecting doesn't stick
92746>>>>>>>>>
92746>>>>>>>>> move (trim(lsText)) to lsText
92747>>>>>>>>> move (length(lsText)) to liLen
92748>>>>>>>>> move "" to lsWord
92749>>>>>>>>> move PRIV_FTS_NOT_IN_ITEM to liState
92750>>>>>>>>> move 0 to liRow
92751>>>>>>>>> get psLetters to lsLetter
92752>>>>>>>>> get cFTS_WordSplitter.psDelimiters to lsDelimiters
92753>>>>>>>>> get pbCrLfCanBeTrusted to lbBelow32CountsAsWord
92754>>>>>>>>> move "0123456789" to lsNumbers
92755>>>>>>>>>
92755>>>>>>>>> move (lsLetter+lsNumbers) to lsLetter
92756>>>>>>>>> move "" to lsNumbers
92757>>>>>>>>>
92757>>>>>>>>> for liPos from 1 to liLen
92763>>>>>>>>>>
92763>>>>>>>>> mid lsText to lsChar 1 liPos
92766>>>>>>>>>>
92766>>>>>>>>> if lsChar in lsLetter begin
92768>>>>>>>>> if liState eq PRIV_FTS_WORD move (lsWord+lsChar) to lsWord
92771>>>>>>>>> else begin
92772>>>>>>>>> if (liState=PRIV_FTS_NUMBER or liState=PRIV_FTS_DELIMITER or liState=PRIV_FTS_BELOW32) begin
92774>>>>>>>>> if (liState<>PRIV_FTS_BELOW32 or lbBelow32CountsAsWord<>0) begin
92776>>>>>>>>> set psWord.i of lhSelf liRow to lsWord
92777>>>>>>>>> increment liRow
92778>>>>>>>>> end
92778>>>>>>>>>>
92778>>>>>>>>> end
92778>>>>>>>>>>
92778>>>>>>>>> move PRIV_FTS_WORD to liState
92779>>>>>>>>> move lsChar to lsWord
92780>>>>>>>>> end
92780>>>>>>>>>>
92780>>>>>>>>> end
92780>>>>>>>>>>
92780>>>>>>>>> else if lsChar in lsNumbers begin
92783>>>>>>>>> if liState eq PRIV_FTS_NUMBER move (lsWord+lsChar) to lsWord
92786>>>>>>>>> else begin
92787>>>>>>>>> if (liState=PRIV_FTS_WORD or liState=PRIV_FTS_DELIMITER or liState=PRIV_FTS_BELOW32) begin
92789>>>>>>>>> if (liState<>PRIV_FTS_BELOW32 or lbBelow32CountsAsWord<>0) begin
92791>>>>>>>>> set psWord.i of lhSelf liRow to lsWord
92792>>>>>>>>> increment liRow
92793>>>>>>>>> end
92793>>>>>>>>>>
92793>>>>>>>>> end
92793>>>>>>>>>>
92793>>>>>>>>> move PRIV_FTS_NUMBER to liState
92794>>>>>>>>> move lsChar to lsWord
92795>>>>>>>>> end
92795>>>>>>>>>>
92795>>>>>>>>> end
92795>>>>>>>>>>
92795>>>>>>>>> else if (lsChar=" ") begin
92798>>>>>>>>> if lsWord ne "" begin
92800>>>>>>>>> set psWord.i of lhSelf liRow to lsWord
92801>>>>>>>>> increment liRow
92802>>>>>>>>> end
92802>>>>>>>>>>
92802>>>>>>>>> move PRIV_FTS_NOT_IN_ITEM to liState
92803>>>>>>>>> move ""to lsWord
92804>>>>>>>>> end
92804>>>>>>>>>>
92804>>>>>>>>> else if lsChar in lsDelimiters begin
92807>>>>>>>>> if liState eq PRIV_FTS_DELIMITER move (lsWord+lsChar) to lsWord
92810>>>>>>>>> else begin
92811>>>>>>>>> if (liState=PRIV_FTS_WORD or liState=PRIV_FTS_NUMBER or liState=PRIV_FTS_BELOW32) begin
92813>>>>>>>>> if (liState<>PRIV_FTS_BELOW32 or lbBelow32CountsAsWord<>0) begin
92815>>>>>>>>> set psWord.i of lhSelf liRow to lsWord
92816>>>>>>>>> increment liRow
92817>>>>>>>>> end
92817>>>>>>>>>>
92817>>>>>>>>> end
92817>>>>>>>>>>
92817>>>>>>>>> move PRIV_FTS_DELIMITER to liState
92818>>>>>>>>> move lsChar to lsWord
92819>>>>>>>>> end
92819>>>>>>>>>>
92819>>>>>>>>> end
92819>>>>>>>>>>
92819>>>>>>>>> else if (ascii(lsChar)<32) begin
92822>>>>>>>>> if lsWord ne "" begin
92824>>>>>>>>> set psWord.i of lhSelf liRow to lsWord
92825>>>>>>>>> increment liRow
92826>>>>>>>>> end
92826>>>>>>>>>>
92826>>>>>>>>> move PRIV_FTS_BELOW32 to liState
92827>>>>>>>>> move "" to lsWord
92828>>>>>>>>> end
92828>>>>>>>>>>
92828>>>>>>>>> loop
92829>>>>>>>>>>
92829>>>>>>>>> if lsWord ne "" set psWord.i of lhSelf liRow to lsWord
92832>>>>>>>>> end_procedure
92833>>>>>>>>>
92833>>>>>>>>>end_class // cFTS_WordSplitter
92834>>>>>>>Use FTSData.nui // cFTS_TableAccess class.
92834>>>>>>>Use FTSIndex.nui // cFTS_System and cFTS_Indexer classes
Including file: ftsindex.nui (C:\Apps\VDFQuery\AppSrc\ftsindex.nui)
92834>>>>>>>>>// Use FTSIndex.nui // cFTS_System and cFTS_Indexer classes
92834>>>>>>>>>
92834>>>>>>>>>Use FTSWrdSp.nui // cFTS_WordSplitter class (to be used internally by cFreeText_Indexer and cFTS_Searcher classes)
92834>>>>>>>>>
92834>>>>>>>>>Use Dates.nui // Date routines (No User Interface)
92834>>>>>>>>>Use LogFile.nui // Class for handling a log file (No User Interface)
92834>>>>>>>>>Use ItemProp.nui // ITEM_PROPERTY command for use within arrays
92834>>>>>>>>>Use Language // Set default languange if not set by compiler command line
92834>>>>>>>>>
92834>>>>>>>>>Use FTSData.nui // cFTS_TableAccess class.
92834>>>>>>>>>
92834>>>>>>>>>register_object oResultAttacher
92834>>>>>>>>>
92834>>>>>>>>>number ft_searcher@stop_time
92834>>>>>>>>>integer ft_searcher@max_time
92834>>>>>>>>>
92834>>>>>>>>>enumeration_list
92834>>>>>>>>> define FTIS_NO_ERROR // No error
92834>>>>>>>>> define FTIS_MISSING_VALUE // No search value was specified
92834>>>>>>>>> define FTIS_NO_POSITIVE // No positive search values
92834>>>>>>>>> define FTIS_TOO_MANY // Too many hits on least probable segment
92834>>>>>>>>> define FTIS_RESULTSETNOTFOUND // Result set could not be found (Sequential file not found)
92834>>>>>>>>> define FTIS_SEARCH_TIMEOUT // The search broke the time limit
92834>>>>>>>>> define FTIS_NO_ITEMS_FOUND //
92834>>>>>>>>> define FTIS_MAX // This is just a marker that may ne used to offset new user errors
92834>>>>>>>>>end_enumeration_list
92834>>>>>>>>>
92834>>>>>>>>> function FT_ErrorText global integer liError returns string
92836>>>>>>>>> if (liError=FTIS_NO_ERROR) function_return "No error"
92839>>>>>>>>> if (liError=FTIS_MISSING_VALUE) function_return "No search value was specified"
92842>>>>>>>>> if (liError=FTIS_NO_POSITIVE) function_return "No positive search values"
92845>>>>>>>>> if (liError=FTIS_TOO_MANY) function_return "Too many hits on least probable segment"
92848>>>>>>>>> if (liError=FTIS_RESULTSETNOTFOUND) function_return "Result set could not be found"
92851>>>>>>>>> if (liError=FTIS_NO_ITEMS_FOUND) function_return "The search failed to find anything"
92854>>>>>>>>> if (liError=FTIS_SEARCH_TIMEOUT) function_return ("Max search time exceeded ("+string(ft_searcher@max_time)+" seconds)")
92857>>>>>>>>> function_return "Unknown FTS error"
92858>>>>>>>>> end_function
92859>>>>>>>>>
92859>>>>>>>>>desktop_section
92864>>>>>>>>> object oFTS_SystemList is a cArray
92866>>>>>>>>> item_property_list
92866>>>>>>>>> item_property integer phFTS_System.i
92866>>>>>>>>> end_item_property_list
#REM 92900 DEFINE FUNCTION PHFTS_SYSTEM.I INTEGER LIROW RETURNS INTEGER
#REM 92905 DEFINE PROCEDURE SET PHFTS_SYSTEM.I INTEGER LIROW INTEGER VALUE
92911>>>>>>>>> procedure add_fts_system integer lhFTS
92914>>>>>>>>> integer liRow
92914>>>>>>>>> get row_count to liRow
92915>>>>>>>>> set phFTS_System.i liRow to lhFTS
92916>>>>>>>>> end_procedure
92917>>>>>>>>> end_object
92918>>>>>>>>>end_desktop_section
92923>>>>>>>>>
92923>>>>>>>>>class cFTS_System is a cArray
92924>>>>>>>>> procedure construct_object integer liImg
92926>>>>>>>>> forward send construct_object liImg
92928>>>>>>>>>
92928>>>>>>>>> property integer phWordsplitterObject // Splits articles into words
92929>>>>>>>>> property integer phTableAccessObject // Takes care of opening the house keeping tables
92930>>>>>>>>> property integer phIndexerObject // Stores the articles as prepared by the word splitter object
92931>>>>>>>>> property integer phSearcherObject // Searches the DB according to a search string
92932>>>>>>>>> property integer phResultBrowserObject // Eases the pain of browsing through the result set
92933>>>>>>>>>
92933>>>>>>>>> property integer phAllowFastViewToRebuild public true
92934>>>>>>>>>
92934>>>>>>>>> // --- For test purposes ---
92934>>>>>>>>> property integer piMainFile
92935>>>>>>>>> object oIndexedFields is a cArray
92937>>>>>>>>> end_object
92938>>>>>>>>> // -------------------------
92938>>>>>>>>> end_procedure
92939>>>>>>>>>
92939>>>>>>>>> procedure end_construct_object
92941>>>>>>>>> integer lhSelf
92941>>>>>>>>> move self to lhSelf
92942>>>>>>>>> forward send end_construct_object
92944>>>>>>>>> send add_fts_system of oFTS_SystemList lhSelf
92945>>>>>>>>> end_procedure
92946>>>>>>>>>
92946>>>>>>>>> procedure DoCreateSearch integer liUser string lsSearchString date ldFrom date ldTo integer liOrderby
92948>>>>>>>>> send DoCreateSearch of (phSearcherObject(self)) liUser lsSearchString ldFrom ldTo liOrderby
92949>>>>>>>>> end_procedure
92950>>>>>>>>>
92950>>>>>>>>> procedure Delete_Article
92952>>>>>>>>> integer liFile liRecnum
92952>>>>>>>>> string lsError lsName
92952>>>>>>>>> get piMainFile to liFile
92953>>>>>>>>> if liFile begin
92955>>>>>>>>> get_field_value liFile 0 to liRecnum
92958>>>>>>>>> if liRecnum send DoDeleteArticle of (phIndexerObject(self))
92961>>>>>>>>> end
92961>>>>>>>>>>
92961>>>>>>>>> else begin
92962>>>>>>>>> move "Procedure Delete_Article has not been specified (object: #)" to lsError
92963>>>>>>>>> get name of self to lsName
92964>>>>>>>>> move (replace("#",lsError,lsName)) to lsError
92965>>>>>>>>> error 401 lsError
92966>>>>>>>>>>
92966>>>>>>>>> end
92966>>>>>>>>>>
92966>>>>>>>>> end_procedure
92967>>>>>>>>> procedure Save_Article
92969>>>>>>>>> integer liFile liField lhArray liItem liMax liRecnum
92969>>>>>>>>> string lsFieldValue lsArticleText
92969>>>>>>>>> string lsError lsName
92969>>>>>>>>> get piMainFile to liFile
92970>>>>>>>>> if liFile begin
92972>>>>>>>>> get_field_value liFile 0 to liRecnum
92975>>>>>>>>> if liRecnum begin
92977>>>>>>>>> send Delete_Article // First remove the existing
92978>>>>>>>>> move (oIndexedFields(self)) to lhArray
92979>>>>>>>>> get item_count of lhArray to liMax
92980>>>>>>>>> decrement liMax
92981>>>>>>>>> for liItem from 0 to liMax
92987>>>>>>>>>>
92987>>>>>>>>> get value of lhArray liItem to liField
92988>>>>>>>>> get_field_value liFile liField to lsFieldValue
92991>>>>>>>>> if (lsFieldValue<>"") begin
92993>>>>>>>>> if (liItem>0) move (lsArticleText+character(10)) to lsArticleText
92996>>>>>>>>> move (lsArticleText+lsFieldValue) to lsArticleText
92997>>>>>>>>> end
92997>>>>>>>>>>
92997>>>>>>>>> loop
92998>>>>>>>>>>
92998>>>>>>>>> if liRecnum send DoAddArticle of (phIndexerObject(self)) liRecnum lsArticleText 0 "" 0
93001>>>>>>>>> end
93001>>>>>>>>>>
93001>>>>>>>>> end
93001>>>>>>>>>>
93001>>>>>>>>> else begin
93002>>>>>>>>> move "Procedure Save_Article has not been specified (object: #)" to lsError
93003>>>>>>>>> get name of self to lsName
93004>>>>>>>>> move (replace("#",lsError,lsName)) to lsError
93005>>>>>>>>> error 402 lsError
93006>>>>>>>>>>
93006>>>>>>>>> end
93006>>>>>>>>>>
93006>>>>>>>>> end_procedure
93007>>>>>>>>> procedure DoRebuildFtsIndex
93009>>>>>>>>> integer lbOK lbFound liFile lhIndexer
93009>>>>>>>>> string lsError lsName
93009>>>>>>>>> get piMainFile to liFile
93010>>>>>>>>> if liFile begin
93012>>>>>>>>> get DoZerofileAllTables of (phTableAccessObject(self)) to lbOK // Zero file the lot (single user only!)
93013>>>>>>>>> if lbOK begin
93015>>>>>>>>> get phIndexerObject to lhIndexer
93016>>>>>>>>> send DoDisableIndices of lhIndexer // Turn of indices on phrases table
93017>>>>>>>>> send DoBeginUpdate of lhIndexer // Can't remember what
93018>>>>>>>>>
93018>>>>>>>>> clear liFile
93019>>>>>>>>> repeat
93019>>>>>>>>>>
93019>>>>>>>>> vfind liFile 0 gt
93021>>>>>>>>> move (found) to lbFound
93022>>>>>>>>> if lbFound begin
93024>>>>>>>>> send save_article
93025>>>>>>>>> //showln Song.id
93025>>>>>>>>> end
93025>>>>>>>>>>
93025>>>>>>>>> until (not(lbFound))
93027>>>>>>>>>
93027>>>>>>>>> send DoEndUpdate of lhIndexer // This one does nothing
93028>>>>>>>>> showln "Reindexing..."
93030>>>>>>>>> send DoEnableIndices of lhIndexer // And this one turns the indices back on
93031>>>>>>>>> showln "Done!"
93033>>>>>>>>> end
93033>>>>>>>>>>
93033>>>>>>>>> end
93033>>>>>>>>>>
93033>>>>>>>>> else begin
93034>>>>>>>>> move "Procedure DoRebuildFtsIndex has not been specified (object: #)" to lsError
93035>>>>>>>>> get name of self to lsName
93036>>>>>>>>> move (replace("#",lsError,lsName)) to lsError
93037>>>>>>>>> error 403 lsError
93038>>>>>>>>>>
93038>>>>>>>>> end
93038>>>>>>>>>>
93038>>>>>>>>> end_procedure
93039>>>>>>>>>//procedure DoDisplayStatistics
93039>>>>>>>>>// integer lhLogFile liWords
93039>>>>>>>>>// number lnStart lnStop
93039>>>>>>>>>// move (oLogFile(self)) to lhLogFile
93039>>>>>>>>>// send AppendOutput to lhLogFile
93039>>>>>>>>>// send DoWriteTimeEntry to lhLogFile
93039>>>>>>>>>// get !$.pnStopWatchStop to lnStop
93039>>>>>>>>>// get !$.pnStopWatchStart to lnStart
93039>>>>>>>>>// get !$.piWordUpdates to liWords
93039>>>>>>>>>// send WriteLn to lhLogFile ("Execution time: "+TS_ConvertToString(lnStop-lnStart))
93039>>>>>>>>>// send WriteLn to lhLogFile ("Updates to word table: "+string(liWords))
93039>>>>>>>>>// send WriteLn to lhLogFile ("Words per second: "+string(liWords/(lnStop-lnStart)))
93039>>>>>>>>>// send CloseOutput to lhLogFile
93039>>>>>>>>>//end_procedure
93039>>>>>>>>>end_class // cFTS_System
93040>>>>>>>>>
93040>>>>>>>>>class cFTS_ResultBrowser is a cArray
93041>>>>>>>>> procedure construct_object
93043>>>>>>>>> forward send construct_object
93045>>>>>>>>> property integer piError
93046>>>>>>>>> property string psError
93047>>>>>>>>> property integer piResultCount
93048>>>>>>>>> property string psSearchTime
93049>>>>>>>>> property integer piMaxPage // This one is set by the bReadResultPage function to indicate the maximum number of pages
93050>>>>>>>>>
93050>>>>>>>>> property integer piArticlesPerPage public 10
93051>>>>>>>>> property string psResultsXtoYofZ public ""
93052>>>>>>>>> end_procedure
93053>>>>>>>>>
93053>>>>>>>>> procedure reset
93055>>>>>>>>> send delete_data
93056>>>>>>>>> set piError to 0
93057>>>>>>>>> set psError to ""
93058>>>>>>>>> set piResultCount to 0
93059>>>>>>>>> set psResultsXtoYofZ to ""
93060>>>>>>>>> set psSearchTime to ""
93061>>>>>>>>> set piMaxPage to 0
93062>>>>>>>>> end_procedure
93063>>>>>>>>>
93063>>>>>>>>> procedure UpdateSearchTime
93065>>>>>>>>> integer liFile liExecTime
93065>>>>>>>>> get piFile.i of (phTableAccessObject(self)) FTSTABLE_SEARCH to liFile
93066>>>>>>>>> get_field_value liFile 7 to liExecTime // EXECUTION_TIME
93069>>>>>>>>> set psSearchTime to (NumToStr(liExecTime/1000.0,3)+" seconds")
93070>>>>>>>>> end_procedure
93071>>>>>>>>>
93071>>>>>>>>> // This function should be called with an active FTSearch records
93071>>>>>>>>> function bReadResultPage integer liPage returns integer // First page is page 0
93073>>>>>>>>> integer liChannel liResultCount liError liLine liArticlesPerPage liSkipCount liArticle
93073>>>>>>>>> integer lbSeqEof lhResultAttacher
93073>>>>>>>>> string lsError lsValue lsFileName
93073>>>>>>>>> send reset
93074>>>>>>>>>
93074>>>>>>>>> move (oResultAttacher(phSearcherObject(self))) to lhResultAttacher
93075>>>>>>>>>
93075>>>>>>>>> get CurrentRecordAbsoluteFileName of lhResultAttacher to lsFileName
93076>>>>>>>>> get SEQ_DirectInput lsFileName to liChannel
93077>>>>>>>>> if (liChannel>-1) begin
93079>>>>>>>>> readln channel liChannel liError
93081>>>>>>>>> set piError to liError
93082>>>>>>>>> if liError begin
93084>>>>>>>>> readln lsError
93085>>>>>>>>> set psError to lsError
93086>>>>>>>>> end
93086>>>>>>>>>>
93086>>>>>>>>> else begin
93087>>>>>>>>> readln liResultCount
93088>>>>>>>>> set piResultCount to liResultCount
93089>>>>>>>>>
93089>>>>>>>>> get piArticlesPerPage to liArticlesPerPage
93090>>>>>>>>>
93090>>>>>>>>> move (liPage*liArticlesPerPage) to liSkipCount
93091>>>>>>>>> for liLine from 1 to liSkipCount
93097>>>>>>>>>>
93097>>>>>>>>> readln liArticle
93098>>>>>>>>> loop
93099>>>>>>>>>>
93099>>>>>>>>>
93099>>>>>>>>> move 0 to liLine
93100>>>>>>>>> repeat
93100>>>>>>>>>>
93100>>>>>>>>> readln liArticle
93101>>>>>>>>> move (seqeof) to lbSeqEof
93102>>>>>>>>> ifnot lbSeqEof begin
93104>>>>>>>>> set value item liLine to liArticle
93105>>>>>>>>> increment liLine
93106>>>>>>>>> end
93106>>>>>>>>>>
93106>>>>>>>>> until (lbSeqEof<>0 or liLine>=liArticlesPerPage)
93108>>>>>>>>>
93108>>>>>>>>> move "Results # to # out of #" to lsValue
93109>>>>>>>>> move (replace("#",lsValue,liPage*liArticlesPerPage+1)) to lsValue
93110>>>>>>>>> move (replace("#",lsValue,liPage+1*liArticlesPerPage min liResultCount)) to lsValue
93111>>>>>>>>> move (replace("#",lsValue,liResultCount)) to lsValue
93112>>>>>>>>> set psResultsXtoYofZ to lsValue
93113>>>>>>>>> send UpdateSearchTime
93114>>>>>>>>> set piMaxPage to (liResultCount+liArticlesPerPage-1/liArticlesPerPage)
93115>>>>>>>>> end
93115>>>>>>>>>>
93115>>>>>>>>> send SEQ_CloseInput liChannel
93116>>>>>>>>> function_return (not(liError))
93117>>>>>>>>> end
93117>>>>>>>>>>
93117>>>>>>>>> set piError to FTIS_RESULTSETNOTFOUND
93118>>>>>>>>> set psError to (FT_ErrorText(FTIS_RESULTSETNOTFOUND))
93119>>>>>>>>> function_return 0
93120>>>>>>>>> end_function
93121>>>>>>>>>
93121>>>>>>>>> // This function should be called with an active FTSearch records
93121>>>>>>>>> function bReadResultAll returns integer
93123>>>>>>>>> integer liChannel liResultCount liError liLine liArticle
93123>>>>>>>>> integer lhResultAttacher
93123>>>>>>>>> string lsError lsValue lsFileName
93123>>>>>>>>> send reset
93124>>>>>>>>>
93124>>>>>>>>> move (oResultAttacher(phSearcherObject(self))) to lhResultAttacher
93125>>>>>>>>>
93125>>>>>>>>> get CurrentRecordAbsoluteFileName of lhResultAttacher to lsFileName
93126>>>>>>>>>
93126>>>>>>>>> get SEQ_DirectInput lsFileName to liChannel
93127>>>>>>>>> if (liChannel>-1) begin
93129>>>>>>>>> readln channel liChannel liError
93131>>>>>>>>> set piError to liError
93132>>>>>>>>> if liError begin
93134>>>>>>>>> readln lsError
93135>>>>>>>>> set psError to lsError
93136>>>>>>>>> end
93136>>>>>>>>>>
93136>>>>>>>>> else begin
93137>>>>>>>>> readln liResultCount
93138>>>>>>>>> set piResultCount to liResultCount
93139>>>>>>>>> decrement liResultCount
93140>>>>>>>>> for liLine from 0 to liResultCount
93146>>>>>>>>>>
93146>>>>>>>>> readln liArticle
93147>>>>>>>>> ifnot (SeqEof) set value item liLine to liArticle
93150>>>>>>>>> loop
93151>>>>>>>>>>
93151>>>>>>>>>
93151>>>>>>>>> move "# articles in set" to lsValue
93152>>>>>>>>> move (replace("#",lsValue,liResultCount+1)) to lsValue
93153>>>>>>>>> set psResultsXtoYofZ to lsValue
93154>>>>>>>>> send UpdateSearchTime
93155>>>>>>>>> end
93155>>>>>>>>>>
93155>>>>>>>>> send SEQ_CloseInput liChannel
93156>>>>>>>>> function_return (not(liError))
93157>>>>>>>>> end
93157>>>>>>>>>>
93157>>>>>>>>> set piError to FTIS_RESULTSETNOTFOUND
93158>>>>>>>>> set psError to (FT_ErrorText(FTIS_RESULTSETNOTFOUND))
93159>>>>>>>>> function_return 0
93160>>>>>>>>> end_function
93161>>>>>>>>> procedure end_construct_object
93163>>>>>>>>> integer lhSelf
93163>>>>>>>>> forward send end_construct_object
93165>>>>>>>>> move self to lhSelf
93166>>>>>>>>> set phResultBrowserObject to lhSelf // This is resolved in the encapsulating cFTS_System object
93167>>>>>>>>> end_procedure
93168>>>>>>>>>end_class // cFTS_ResultBrowser
93169>>>>>>>>>
93169>>>>>>>>>
93169>>>>>>>>>class cFTS_Indexer is a cArray
93170>>>>>>>>> // This class frequently accesses a property of name phTableAccessObject. This
93170>>>>>>>>> // is not defined in this class but should be defined in the encapsulating
93170>>>>>>>>> // object (a cFTS_System object). The same is true for the phWordsplitterObject
93170>>>>>>>>> // property.
93170>>>>>>>>> procedure construct_object integer liImg
93172>>>>>>>>> forward send construct_object liImg
93174>>>>>>>>> property number pnNextAvailableWordId private 0
93175>>>>>>>>> property integer piIndexEnableState private DFTRUE
93176>>>>>>>>> property integer pbUpdating private DFFALSE
93177>>>>>>>>> object oLogFile is a cLogFile NO_IMAGE
93179>>>>>>>>> set psFileName to "FreeText.log"
93180>>>>>>>>> set psPurpose to "Free text indexer efficiency"
93181>>>>>>>>> end_object
93182>>>>>>>>> end_procedure
93183>>>>>>>>>
93183>>>>>>>>> procedure DoDisableIndices
93185>>>>>>>>> integer liFile lhFile lbEmbedded
93185>>>>>>>>> string lsDriver
93185>>>>>>>>> set !$.piIndexEnableState to DFFALSE
93186>>>>>>>>>
93186>>>>>>>>> get piFile.i of (phTableAccessObject(self)) FTSTABLE_ARTPHR to lhFile
93187>>>>>>>>> get piFile.i of (phTableAccessObject(self)) FTSTABLE_ARTPHR to liFile
93188>>>>>>>>>
93188>>>>>>>>> // to make DBMS's other than the embedded happy (Dan Walsh)
93188>>>>>>>>> get_attribute DF_FILE_DRIVER of liFile to lsDriver
93191>>>>>>>>> move (uppercase(lsDriver) = "DATAFLEX") to lbEmbedded
93192>>>>>>>>> if (not(lbEmbedded)) procedure_return
93195>>>>>>>>>
93195>>>>>>>>> structure_start lhFile
93196>>>>>>>>> set_attribute DF_INDEX_TYPE of liFile 1 to DF_INDEX_TYPE_BATCH
93199>>>>>>>>> set_attribute DF_INDEX_TYPE of liFile 2 to DF_INDEX_TYPE_BATCH
93202>>>>>>>>> structure_end lhFile DF_STRUCTEND_OPT_NONE "."
93204>>>>>>>>> close liFile
93205>>>>>>>>> open liFile index.2
93207>>>>>>>>> end_procedure
93208>>>>>>>>>
93208>>>>>>>>> procedure DoMaxSortBuffer
93210>>>>>>>>> integer liGrb iNull
93210>>>>>>>>> string sNull
93210>>>>>>>>> call_driver iNull "DATAFLEX" function FLEX_SET_MAX_SORT_BUFFER callback iNull passing sNull iNull 65536 result liGrb
93215>>>>>>>>> end_procedure
93216>>>>>>>>>
93216>>>>>>>>> procedure DoEnableIndices
93218>>>>>>>>> integer liFile lhFile lbEmbedded
93218>>>>>>>>> string lsDriver
93218>>>>>>>>>
93218>>>>>>>>> get piFile.i of (phTableAccessObject(self)) FTSTABLE_ARTPHR to lhFile
93219>>>>>>>>> get piFile.i of (phTableAccessObject(self)) FTSTABLE_ARTPHR to liFile
93220>>>>>>>>>
93220>>>>>>>>> send DoMaxSortBuffer
93221>>>>>>>>> set !$.piIndexEnableState to DFTRUE
93222>>>>>>>>>
93222>>>>>>>>> // to make DBMS's other than the embedded happy
93222>>>>>>>>> get_attribute DF_FILE_DRIVER of liFile to lsDriver
93225>>>>>>>>> move (uppercase(lsDriver) = "DATAFLEX") to lbEmbedded
93226>>>>>>>>> if (not(lbEmbedded)) procedure_return
93229>>>>>>>>>
93229>>>>>>>>> structure_start lhFile
93230>>>>>>>>> set_attribute DF_INDEX_TYPE of liFile 1 to DF_INDEX_TYPE_ONLINE
93233>>>>>>>>> set_attribute DF_INDEX_TYPE of liFile 2 to DF_INDEX_TYPE_ONLINE
93236>>>>>>>>> structure_end lhFile DF_STRUCTEND_OPT_NONE "."
93238>>>>>>>>> close liFile
93239>>>>>>>>> open liFile index.2
93241>>>>>>>>> end_procedure
93242>>>>>>>>>
93242>>>>>>>>> // Use these two messages to begin/end an update of the search
93242>>>>>>>>> // database
93242>>>>>>>>> procedure DoBeginUpdate
93244>>>>>>>>> integer liWord liFileWord lbFound
93244>>>>>>>>> number lnValue
93244>>>>>>>>> set !$.pbUpdating to true
93245>>>>>>>>> get piFile.i of (phTableAccessObject(self)) FTSTABLE_WORD to liFileWord
93246>>>>>>>>>
93246>>>>>>>>> clear liFileWord // clear FTWORD
93247>>>>>>>>> set_field_value liFileWord 1 to 999999 // move 999999 to FTWORD.WORD_ID
93250>>>>>>>>> vfind liFileWord 1 LT // find lt FTWORD by index.1 // Find last
93252>>>>>>>>> move (found) to lbFound
93253>>>>>>>>> get_field_value liFileWord 1 to lnValue //
93256>>>>>>>>> if lbFound set !$.pnNextAvailableWordId to (lnValue+1) // if (found) set !$.pnNextAvailableWordId to (FTWORD.WORD_ID+1)
93259>>>>>>>>> else set !$.pnNextAvailableWordId to 1 // else set !$.pnNextAvailableWordId to 1
93261>>>>>>>>> end_procedure
93262>>>>>>>>>
93262>>>>>>>>> procedure DoEndUpdate
93264>>>>>>>>> set !$.pbUpdating to false
93265>>>>>>>>> //unlock
93265>>>>>>>>> end_procedure
93266>>>>>>>>>
93266>>>>>>>>> // Use these two messages to decrement/increment the occurance of a
93266>>>>>>>>> // word.
93266>>>>>>>>> procedure DoDecrementWord integer liWordID
93268>>>>>>>>> integer liFileWord liFreq
93268>>>>>>>>> get piFile.i of (phTableAccessObject(self)) FTSTABLE_WORD to liFileWord
93269>>>>>>>>> clear liFileWord // clear FTWORD
93270>>>>>>>>> set_field_value liFileWord 1 to liWordID // move liWordID to FTWORD.WORD_ID
93273>>>>>>>>> vfind liFileWord 1 EQ // find eq FTWORD by index.1
93275>>>>>>>>> if (found) begin // if (found) begin
93277>>>>>>>>> get_field_value liFileWord 3 to liFreq
93280>>>>>>>>> set_field_value liFileWord 3 to (liFreq-1) // move (FTWORD.FREQUENCY-1) to FTWORD.FREQUENCY
93283>>>>>>>>> saverecord liFileWord // saverecord FTWORD
93284>>>>>>>>> end // end
93284>>>>>>>>>>
93284>>>>>>>>> end_procedure
93285>>>>>>>>> function DoIncrementWord string lsWord returns number
93287>>>>>>>>> integer liFileWord liFreq liWordID
93287>>>>>>>>> get piFile.i of (phTableAccessObject(self)) FTSTABLE_WORD to liFileWord
93288>>>>>>>>> clear liFileWord // clear FTWORD
93289>>>>>>>>> set_field_value liFileWord 2 to lsWord // move lsWord to FTWORD.WORD
93292>>>>>>>>> vfind liFileWord 2 EQ // find eq FTWORD by index.2
93294>>>>>>>>> ifnot (found) begin // ifnot (found) begin
93296>>>>>>>>> get !$.pnNextAvailableWordId to liWordID //
93297>>>>>>>>> set_field_value liFileWord 1 to liWordID // get !$.pnNextAvailableWordId to FTWORD.WORD_ID
93300>>>>>>>>> set !$.pnNextAvailableWordId to (liWordID+1) // set !$.pnNextAvailableWordId to (FTWORD.WORD_ID+1)
93301>>>>>>>>> end // end
93301>>>>>>>>>>
93301>>>>>>>>> get_field_value liFileWord 3 to liFreq // move (FTWORD.FREQUENCY+1) to FTWORD.FREQUENCY
93304>>>>>>>>> set_field_value liFileWord 3 to (liFreq+1) //
93307>>>>>>>>> saverecord liFileWord // saverecord FTWORD
93308>>>>>>>>> get_field_value liFileWord 1 to liWordID //
93311>>>>>>>>> function_return liWordID // function_return FTWORD.WORD_ID
93312>>>>>>>>> end_function
93313>>>>>>>>>
93313>>>>>>>>> procedure DoDeleteArticle number lnArticleID
93315>>>>>>>>> integer liWordCount liFile lbFound
93315>>>>>>>>> number lnTest
93315>>>>>>>>> move 0 to liWordCount
93316>>>>>>>>> lock
93317>>>>>>>>>>
93317>>>>>>>>>
93317>>>>>>>>> // First delete article
93317>>>>>>>>> get piFile.i of (phTableAccessObject(self)) FTSTABLE_ARTICL to liFile
93318>>>>>>>>> clear liFile
93319>>>>>>>>> set_field_value liFile 1 to lnArticleId
93322>>>>>>>>> vfind liFile 1 EQ // find eq FTArticl by index.1
93324>>>>>>>>> [found] delete liFile
93325>>>>>>>>>
93325>>>>>>>>> // Then delete all phrases:
93325>>>>>>>>> get piFile.i of (phTableAccessObject(self)) FTSTABLE_ARTPHR to liFile
93326>>>>>>>>> clear liFile
93327>>>>>>>>> set_field_value liFile 1 to lnArticleId
93330>>>>>>>>> repeat
93330>>>>>>>>>>
93330>>>>>>>>> vfind liFile 1 GT
93332>>>>>>>>> move (found) to lbFound
93333>>>>>>>>> if lbFound begin
93335>>>>>>>>> get_field_value liFile 1 to lnTest // Article_Id
93338>>>>>>>>> move (lnTest=lnArticleId) to lbFound
93339>>>>>>>>> end
93339>>>>>>>>>>
93339>>>>>>>>> if lbFound begin
93341>>>>>>>>> get_field_value liFile 2 to lnTest // Word_Id
93344>>>>>>>>> send DoDecrementWord lnTest //FTArtPhr.WORD_ID
93345>>>>>>>>> increment liWordCount
93346>>>>>>>>> delete liFile
93347>>>>>>>>> end
93347>>>>>>>>>>
93347>>>>>>>>> until (not(found))
93349>>>>>>>>>
93349>>>>>>>>> // And finally, all the words:
93349>>>>>>>>> get piFile.i of (phTableAccessObject(self)) FTSTABLE_ARTWRD to liFile
93350>>>>>>>>> clear liFile
93351>>>>>>>>> set_field_value liFile 1 to lnArticleId
93354>>>>>>>>> repeat
93354>>>>>>>>>>
93354>>>>>>>>> vfind liFile 1 GT
93356>>>>>>>>> move (found) to lbFound
93357>>>>>>>>> if lbFound begin
93359>>>>>>>>> get_field_value liFile 1 to lnTest // Article_Id
93362>>>>>>>>> move (lnTest=lnArticleId) to lbFound
93363>>>>>>>>> end
93363>>>>>>>>>>
93363>>>>>>>>> if lbFound delete liFile
93366>>>>>>>>> until (not(found))
93368>>>>>>>>> unlock
93369>>>>>>>>>>
93369>>>>>>>>> end_procedure
93370>>>>>>>>>
93370>>>>>>>>> procedure DoAddArticle number lnArticleID string lsText date ldDate string lsTime integer liHits
93372>>>>>>>>> integer lhWordSplitter liMax liRow liType liPhraseLength liArtPhrFile liArtWrdFile
93372>>>>>>>>> integer lbAlreadyUpdating liArticlFile
93372>>>>>>>>> get phWordsplitterObject to lhWordSplitter
93373>>>>>>>>> send DoReset to lhWordSplitter
93374>>>>>>>>> send DoAddText to lhWordSplitter lsText
93375>>>>>>>>> get row_count of lhWordSplitter to liMax
93376>>>>>>>>> decrement liMax
93377>>>>>>>>> lock
93378>>>>>>>>>>
93378>>>>>>>>>
93378>>>>>>>>> get !$.pbUpdating to lbAlreadyUpdating
93379>>>>>>>>> ifnot lbAlreadyUpdating send DoBeginUpdate // Send DoBeginUpdate automatically if not part of a bigger update
93382>>>>>>>>>
93382>>>>>>>>> if lnArticleID le 0 error 843 "Article ID must be positive"
93385>>>>>>>>> // First we assign word ID's to the words in the article
93385>>>>>>>>> for liRow from 0 to liMax
93391>>>>>>>>>>
93391>>>>>>>>> set piWordId.i of lhWordSplitter liRow to (DoIncrementWord(self,psWord.i(lhWordSplitter,liRow)))
93392>>>>>>>>> loop
93393>>>>>>>>>>
93393>>>>>>>>>
93393>>>>>>>>> get piFile.i of (phTableAccessObject(self)) FTSTABLE_ARTPHR to liArtPhrFile
93394>>>>>>>>> get piPhraseLength of (phTableAccessObject(self)) to liPhraseLength
93395>>>>>>>>>
93395>>>>>>>>> get piFile.i of (phTableAccessObject(self)) FTSTABLE_ARTWRD to liArtWrdFile
93396>>>>>>>>>
93396>>>>>>>>> decrement liMax // We don't need the last word of the article to be saved as a phrase by itself (Dan Walsh)
93397>>>>>>>>> for liRow from 0 to liMax
93403>>>>>>>>>>
93403>>>>>>>>> clear liArtPhrFile // clear FTArtPhr
93404>>>>>>>>> set_field_value liArtPhrFile 1 to lnArticleId // move lnArticleID to FTArtPhr.ARTICLE_ID
93407>>>>>>>>> set_field_value liArtPhrFile 2 to (piWordId.i(lhWordSplitter,liRow)) // move (piWordId.i(lhWordSplitter,liRow)) to FTArtPhr.WORD_ID
93410>>>>>>>>> if liRow le liMax set_field_value liArtPhrFile 3 to (piWordId.i(lhWordSplitter,liRow+1)) //if liRow le liMax move (piWordId.i(lhWordSplitter,liRow+1)) to FTArtPhr.WORD_ID_S1
93415>>>>>>>>> if liRow le (liMax-1) set_field_value liArtPhrFile 4 to (piWordId.i(lhWordSplitter,liRow+2)) //if liRow le (liMax-1) move (piWordId.i(lhWordSplitter,liRow+2)) to FTArtPhr.WORD_ID_S2
93420>>>>>>>>> if liRow le (liMax-2) set_field_value liArtPhrFile 5 to (piWordId.i(lhWordSplitter,liRow+3)) //if liRow le (liMax-2) move (piWordId.i(lhWordSplitter,liRow+3)) to FTArtPhr.WORD_ID_S3
93425>>>>>>>>> if liRow le (liMax-3) set_field_value liArtPhrFile 6 to (piWordId.i(lhWordSplitter,liRow+4)) //if liRow le (liMax-3) move (piWordId.i(lhWordSplitter,liRow+4)) to FTArtPhr.WORD_ID_S4
93430>>>>>>>>> if liRow le (liMax-4) set_field_value liArtPhrFile 7 to (piWordId.i(lhWordSplitter,liRow+5)) //if liRow le (liMax-4) move (piWordId.i(lhWordSplitter,liRow+5)) to FTArtPhr.WORD_ID_S5
93435>>>>>>>>>
93435>>>>>>>>> if liPhraseLength ge 7 if liRow le (liMax- 5) set_field_value liArtPhrFile 8 to (piWordId.i(lhWordSplitter,liRow+ 6))
93442>>>>>>>>> if liPhraseLength ge 8 if liRow le (liMax- 6) set_field_value liArtPhrFile 9 to (piWordId.i(lhWordSplitter,liRow+ 7))
93449>>>>>>>>> if liPhraseLength ge 9 if liRow le (liMax- 7) set_field_value liArtPhrFile 10 to (piWordId.i(lhWordSplitter,liRow+ 8))
93456>>>>>>>>> if liPhraseLength ge 10 if liRow le (liMax- 8) set_field_value liArtPhrFile 11 to (piWordId.i(lhWordSplitter,liRow+ 9))
93463>>>>>>>>> if liPhraseLength ge 11 if liRow le (liMax- 9) set_field_value liArtPhrFile 12 to (piWordId.i(lhWordSplitter,liRow+10))
93470>>>>>>>>> if liPhraseLength ge 12 if liRow le (liMax-10) set_field_value liArtPhrFile 13 to (piWordId.i(lhWordSplitter,liRow+11))
93477>>>>>>>>> if liPhraseLength ge 13 if liRow le (liMax-11) set_field_value liArtPhrFile 14 to (piWordId.i(lhWordSplitter,liRow+12))
93484>>>>>>>>> if liPhraseLength ge 14 if liRow le (liMax-12) set_field_value liArtPhrFile 15 to (piWordId.i(lhWordSplitter,liRow+13))
93491>>>>>>>>>
93491>>>>>>>>> saverecord liArtPhrFile
93492>>>>>>>>>
93492>>>>>>>>> clear liArtWrdFile // clear FTArtWrd
93493>>>>>>>>> set_field_value liArtWrdFile 1 to lnArticleId // move lnArticleID to FTArtWrd.ARTICLE_ID
93496>>>>>>>>> set_field_value liArtWrdFile 2 to (piWordId.i(lhWordSplitter,liRow)) // move (piWordId.i(lhWordSplitter,liRow)) to FTArtWrd.WORD_ID
93499>>>>>>>>> vfind liArtWrdFile 1 EQ // find eq FTArtWrd by index.1
93501>>>>>>>>> ifnot (found) saverecord liArtWrdFile // ifnot (found) saverecord FTArtWrd
93504>>>>>>>>> loop
93505>>>>>>>>>>
93505>>>>>>>>>
93505>>>>>>>>> // Finally save the article:
93505>>>>>>>>> get piFile.i of (phTableAccessObject(self)) FTSTABLE_ARTICL to liArticlFile
93506>>>>>>>>> clear liArticlFile
93507>>>>>>>>> set_field_value liArticlFile 1 to lnArticleId // ARTICLE_ID
93510>>>>>>>>> set_field_value liArticlFile 2 to ldDate // DATE
93513>>>>>>>>> set_field_value liArticlFile 3 to lsTime // TIME
93516>>>>>>>>> set_field_value liArticlFile 4 to liHits // HIT_COUNT
93519>>>>>>>>> set_field_value liArticlFile 6 to (dSysDate()) // INDEXED_DATE
93522>>>>>>>>> set_field_value liArticlFile 7 to (sSysTime()) // INDEXED_TIME
93525>>>>>>>>> saverecord liArticlFile
93526>>>>>>>>>
93526>>>>>>>>> ifnot lbAlreadyUpdating send DoEndUpdate
93529>>>>>>>>> unlock
93530>>>>>>>>>>
93530>>>>>>>>> end_procedure
93531>>>>>>>>> procedure end_construct_object
93533>>>>>>>>> integer lhSelf
93533>>>>>>>>> forward send end_construct_object
93535>>>>>>>>> move self to lhSelf
93536>>>>>>>>> set phIndexerObject to lhSelf // This is resolved in the encapsulating cFTS_System object
93537>>>>>>>>> end_procedure
93538>>>>>>>>>end_class // cFTS_Indexer
93539>>>>>>>>>
93539>>>>>>>use FTSearch.nui // cFTS_Searcher class.
Including file: ftsearch.nui (C:\Apps\VDFQuery\AppSrc\ftsearch.nui)
93539>>>>>>>>>// use FTSearch.nui // cFTS_Searcher class.
93539>>>>>>>>>
93539>>>>>>>>>Use Strings.nui // String manipulation for VDF (No User Interface)
93539>>>>>>>>>Use FTSIndex.nui // cFTS_System and cFTS_Indexer classes
93539>>>>>>>>>Use FTSData.nui // cFTS_TableAccess class.
93539>>>>>>>>>Use Dates.nui // Date routines (No User Interface)
93539>>>>>>>>>Use DocAttach.nui // Class for putting files 'attached' to records into one directory.
Including file: docattach.nui (C:\Apps\VDFQuery\AppSrc\docattach.nui)
93539>>>>>>>>>>>// Use DocAttach.nui // Class for putting files 'attached' to records into one directory.
93539>>>>>>>>>>>//
93539>>>>>>>>>>>// Purpose
93539>>>>>>>>>>>//
93539>>>>>>>>>>>// Let us say that you want to store a number of files (called documents for
93539>>>>>>>>>>>// the purpose of this class) for each record in a given table (from now on
93539>>>>>>>>>>>// called the document parent table). You want to save all these files in a
93539>>>>>>>>>>>// single directory (or possibly in a directory structure).
93539>>>>>>>>>>>//
93539>>>>>>>>>>>// Even if this sounds simple enough, you will probably end up trying to
93539>>>>>>>>>>>// figure out how to avoid conflicting file names and how to copy these
93539>>>>>>>>>>>// documents (files) around your disk system.
93539>>>>>>>>>>>//
93539>>>>>>>>>>>// The cDocumentAttacher class defined in this package helps you get around
93539>>>>>>>>>>>// this problem.
93539>>>>>>>>>>>//
93539>>>>>>>>>>>// First you need to create a table that relates to the 'document parent table'
93539>>>>>>>>>>>// and that will hold one record for each attached document.
93539>>>>>>>>>>>//
93539>>>>>>>>>>>//
93539>>>>>>>>>>>//
93539>>>>>>>>>>>//
93539>>>>>>>>>>>//
93539>>>>>>>>>>>Use Windows
93539>>>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
93539>>>>>>>>>>>Use Files.nui // Utilities for handling file related stuff (No User Interface)
93539>>>>>>>>>>>Use HTML.utl // HTML functions
93539>>>>>>>>>>>Use Strings.nui // String manipulation for VDF (No User Interface)
93539>>>>>>>>>>>
93539>>>>>>>>>>>//
93539>>>>>>>>>>>// Implementation template:
93539>>>>>>>>>>>//
93539>>>>>>>>>>>// object oMyDocumentAttacher is a cDocumentAttacher
93539>>>>>>>>>>>//
93539>>>>>>>>>>>// // If you do not set the psHomeDirectory property it will default
93539>>>>>>>>>>>// // a subdirectory called "attach" found under your data directory.
93539>>>>>>>>>>>// set psHomeDirectory to "k:\documents"
93539>>>>>>>>>>>//
93539>>>>>>>>>>>// // This function must return the root name of a record (no path
93539>>>>>>>>>>>// // and *WITHOUT* extension)
93539>>>>>>>>>>>// function CurrentRecordRootName returns string //
93539>>>>>>>>>>>// function_return (IntToStrRzf(VmAttach.Udsted_Aar,4)+"-"+IntToStrRzf(VmAttach.Loebe_Nr,4)+"-"+IntToStrRzf(VmAttach.Nr,2))
93539>>>>>>>>>>>// end_function
93539>>>>>>>>>>>//
93539>>>>>>>>>>>// function CurrentRecordOriginalFileName returns string
93539>>>>>>>>>>>// function_return Trex021.original_name
93539>>>>>>>>>>>// end_function
93539>>>>>>>>>>>//
93539>>>>>>>>>>>// procedure set CurrentRecordOriginalFileName string lsValue
93539>>>>>>>>>>>// move lsValue to Trex021.original_name
93539>>>>>>>>>>>// end_procedure
93539>>>>>>>>>>>//
93539>>>>>>>>>>>// end_object
93539>>>>>>>>>>>//
93539>>>>>>>>>>>// class Trex021_DataDictionary is a DataDictionary
93539>>>>>>>>>>>// procedure request_save_document string lsExternalFileName
93539>>>>>>>>>>>// integer lhDoc lbCheckIn lbExists lbSuccess
93539>>>>>>>>>>>// string lsErrorMsg
93539>>>>>>>>>>>// move (oMyDocumentAttacher(self)) to lhDoc
93539>>>>>>>>>>>// // Does the document exist?
93539>>>>>>>>>>>// if (SEQ_FileExists(lsExternalFileName)=SEQIT_FILE) begin
93539>>>>>>>>>>>// // If so, make sure we have a record:
93539>>>>>>>>>>>// set field_changed_Value field Trex021.original_name to Trex021.original_name
93539>>>>>>>>>>>// send request_save
93539>>>>>>>>>>>// ifnot (should_save(self)) begin // If it saved OK
93539>>>>>>>>>>>// get Doc_Exists of lhDoc to lbExists // Do we already have it the database?
93539>>>>>>>>>>>// if lbExists get MB_Verify "Document already exists, overwrite?" DFTRUE to lbCheckIn
93539>>>>>>>>>>>// else move DFTRUE to lbCheckIn
93539>>>>>>>>>>>// if lbCheckIn begin
93539>>>>>>>>>>>// get Doc_CheckIn of lhDoc lsExternalFileName to lbSuccess
93539>>>>>>>>>>>// ifnot lbSuccess begin
93539>>>>>>>>>>>// move ("Error saving document Source: "+lsExternalFileName+" Internal target: "+CurrentRecordAbsoluteFileName(lhDoc)) to lsErrorMsg
93539>>>>>>>>>>>// send error 224 lsErrorMsg
93539>>>>>>>>>>>// end
93539>>>>>>>>>>>// else begin
93539>>>>>>>>>>>// set field_changed_Value field Trex021.original_name to (SEQ_RemovePathFromFileName(lsExternalFileName))
93539>>>>>>>>>>>// send request_save
93539>>>>>>>>>>>// end
93539>>>>>>>>>>>// end
93539>>>>>>>>>>>// end
93539>>>>>>>>>>>// end
93539>>>>>>>>>>>// else error 221 "Document not found"
93539>>>>>>>>>>>// end_procedure
93539>>>>>>>>>>>// procedure delete_main_file
93539>>>>>>>>>>>// integer lhDoc liGrb lbSuccess
93539>>>>>>>>>>>// string lsInternalFileName
93539>>>>>>>>>>>// if (current_record(self)) begin
93539>>>>>>>>>>>// move (oMyDocumentAttacher(self)) to lhDoc
93539>>>>>>>>>>>// if (Doc_Exists(lhDoc)) begin
93539>>>>>>>>>>>// get Doc_Delete of lhDoc to lbSuccess
93539>>>>>>>>>>>// end
93539>>>>>>>>>>>// else move 1 to lbSuccess
93539>>>>>>>>>>>// ifnot lbSuccess error 223 "Document could not be deleted"
93539>>>>>>>>>>>// end
93539>>>>>>>>>>>// forward send delete_main_file
93539>>>>>>>>>>>// end_procedure
93539>>>>>>>>>>>// procedure save_main_file
93539>>>>>>>>>>>// if (Trex021.filename="") move trex021.original_name to Trex021.filename
93539>>>>>>>>>>>// forward send save_main_file
93539>>>>>>>>>>>// end_procedure
93539>>>>>>>>>>>// end_class
93539>>>>>>>>>>>//
93539>>>>>>>>>>>// From within a grid:
93539>>>>>>>>>>>//
93539>>>>>>>>>>>// procedure DoAddFile
93539>>>>>>>>>>>// string lsFileName
93539>>>>>>>>>>>// if (should_save(self)) send obs "Changes must be saved before document can be added"
93539>>>>>>>>>>>// else begin
93539>>>>>>>>>>>// if (current_record(self)) send add_or_remove_row
93539>>>>>>>>>>>// ifnot (current_record(self)) begin
93539>>>>>>>>>>>// get SEQ_SelectFile "Select document to attach" "All files|*.*" to lsFileName
93539>>>>>>>>>>>// if (lsFileName<>"") ;
93539>>>>>>>>>>>// send request_save_document to (server(self)) lsFileName
93539>>>>>>>>>>>// else send add_or_remove_row
93539>>>>>>>>>>>// end
93539>>>>>>>>>>>// end
93539>>>>>>>>>>>// end_procedure
93539>>>>>>>>>>>// procedure DoLaunchFile
93539>>>>>>>>>>>// integer lbOK
93539>>>>>>>>>>>// string lsFileName
93539>>>>>>>>>>>// if (current_record(server(self))) begin
93539>>>>>>>>>>>// get Doc_Exists of oMyDocumentAttacher to lbOK
93539>>>>>>>>>>>// if lbOK begin
93539>>>>>>>>>>>// send Doc_Execute of oMyDocumentAttacher
93539>>>>>>>>>>>// end
93539>>>>>>>>>>>// else error 222 "Document not found"
93539>>>>>>>>>>>// end
93539>>>>>>>>>>>// end_procedure
93539>>>>>>>>>>>//
93539>>>>>>>>>>>//
93539>>>>>>>>>>>//
93539>>>>>>>>>>>//
93539>>>>>>>>>>>
93539>>>>>>>>>>>use files.nui
93539>>>>>>>>>>>class cDocumentAttacher is a cArray
93540>>>>>>>>>>> procedure construct_object
93542>>>>>>>>>>> forward send construct_object
93544>>>>>>>>>>> property string psHomeDirectory public ""
93545>>>>>>>>>>> property integer priv.pbHomeDirectoryOK public -1 // Not checked yet
93546>>>>>>>>>>> property string priv.RenFrom public ""
93547>>>>>>>>>>> end_procedure
93548>>>>>>>>>>>
93548>>>>>>>>>>> function pbHomeDirectoryOK returns integer
93550>>>>>>>>>>> integer lbHomeDirectory lbCreateError
93550>>>>>>>>>>> string lsPath
93550>>>>>>>>>>> get priv.pbHomeDirectoryOK to lbHomeDirectory
93551>>>>>>>>>>> if (lbHomeDirectory=-1) begin // Not checked yet
93553>>>>>>>>>>> get psHomeDirectory to lsPath
93554>>>>>>>>>>>// send obs "pbHomeDirectoryOK" lsPath
93554>>>>>>>>>>> if (SEQ_FileExists(lsPath)=SEQIT_NONE) begin
93556>>>>>>>>>>>// send obs "Does not exist"
93556>>>>>>>>>>> // Doesn't exist, let's create it:
93556>>>>>>>>>>> get wvaWin32_CreateDirectory (ToAnsi(lsPath)) to lbCreateError
93557>>>>>>>>>>> if lbCreateError move DFFALSE to lbHomeDirectory
93560>>>>>>>>>>> else move DFTRUE to lbHomeDirectory
93562>>>>>>>>>>> end
93562>>>>>>>>>>>>
93562>>>>>>>>>>> else move DFTRUE to lbHomeDirectory
93564>>>>>>>>>>> set priv.pbHomeDirectoryOK to lbHomeDirectory
93565>>>>>>>>>>> end
93565>>>>>>>>>>>>
93565>>>>>>>>>>> function_return lbHomeDirectory
93566>>>>>>>>>>> end_procedure
93567>>>>>>>>>>>
93567>>>>>>>>>>> procedure DoSetHomeDirectoryRelative string lsDir
93569>>>>>>>>>>> string lsFileListPath
93569>>>>>>>>>>> if (SEQ_FileExists("filelist.cfg")=SEQIT_FILE) begin
93571>>>>>>>>>>> get SEQ_FindFileAlongDFPath "filelist.cfg" to lsFileListPath
93572>>>>>>>>>>> get Files_AppendPath lsFileListPath lsDir to lsFileListPath
93573>>>>>>>>>>> set psHomeDirectory to lsFileListPath
93574>>>>>>>>>>> end
93574>>>>>>>>>>>>
93574>>>>>>>>>>> end_procedure
93575>>>>>>>>>>>
93575>>>>>>>>>>> // If there is any dynamic "addition" to the home directory for the current
93575>>>>>>>>>>> // record function CurrentRecordSubDirectory should return the segment to
93575>>>>>>>>>>> // be added. Standard return value for this function is "".
93575>>>>>>>>>>> function CurrentRecordSubDirectory returns string
93577>>>>>>>>>>> function_return ""
93578>>>>>>>>>>> end_function
93579>>>>>>>>>>>
93579>>>>>>>>>>> // To be filled out at the instantiation level. Should return the 'root
93579>>>>>>>>>>> // name' of the file for the current record (without any extension).
93579>>>>>>>>>>> function CurrentRecordRootName returns string
93581>>>>>>>>>>> end_function
93582>>>>>>>>>>>
93582>>>>>>>>>>> // To be filled out at the instantiation level. Should return the 'root
93582>>>>>>>>>>> // name' of the file for the current record.
93582>>>>>>>>>>> function CurrentRecordOriginalFileName returns string
93584>>>>>>>>>>> // To be filled out
93584>>>>>>>>>>> end_function
93585>>>>>>>>>>>
93585>>>>>>>>>>> procedure set CurrentRecordOriginalFileName string lsValue
93587>>>>>>>>>>> // To be filled out
93587>>>>>>>>>>> end_procedure
93588>>>>>>>>>>>
93588>>>>>>>>>>> // Returns the extension of the original filename
93588>>>>>>>>>>> function CurrentRecordOriginalExtension returns string
93590>>>>>>>>>>> string lsFile lsRval
93590>>>>>>>>>>> get CurrentRecordOriginalFileName to lsFile
93591>>>>>>>>>>> get SEQ_ExtractExtensionFromFileName (trim(lsFile)) to lsRval
93592>>>>>>>>>>> function_return lsRval
93593>>>>>>>>>>> end_function
93594>>>>>>>>>>>
93594>>>>>>>>>>> // This function returns the full path and filename of
93594>>>>>>>>>>> // the attached file as named by this system.
93594>>>>>>>>>>> function CurrentRecordAbsoluteFileName returns string
93596>>>>>>>>>>> integer lbCreateError
93596>>>>>>>>>>> string lsDir lsSubdir lsFile lsRval lsExt lsCheckPath
93596>>>>>>>>>>> if (pbHomeDirectoryOK(self)) begin
93598>>>>>>>>>>> get psHomeDirectory to lsDir
93599>>>>>>>>>>>
93599>>>>>>>>>>> get CurrentRecordSubDirectory to lsSubdir
93600>>>>>>>>>>> if (lsSubdir<>"") begin
93602>>>>>>>>>>> get Files_AppendPath lsDir lsSubDir to lsCheckPath
93603>>>>>>>>>>> if (SEQ_FileExists(lsCheckPath)=SEQIT_NONE) begin
93605>>>>>>>>>>> // Doesn't exist, let's create it:
93605>>>>>>>>>>> get wvaWin32_CreateDirectory (ToAnsi(lsCheckPath)) to lbCreateError
93606>>>>>>>>>>> if lbCreateError function_return ""
93609>>>>>>>>>>> end
93609>>>>>>>>>>>>
93609>>>>>>>>>>> end
93609>>>>>>>>>>>>
93609>>>>>>>>>>>
93609>>>>>>>>>>> get CurrentRecordRootName to lsFile
93610>>>>>>>>>>>// showln "Bla 1 " lsFile
93610>>>>>>>>>>> if (lsFile="") function_return "" // Supposedly an error condition!
93613>>>>>>>>>>> if (lsSubdir<>"") begin
93615>>>>>>>>>>> get Files_AppendPath lsDir lsSubDir to lsRval
93616>>>>>>>>>>> get Files_AppendPath lsRval lsFile to lsRval
93617>>>>>>>>>>> end
93617>>>>>>>>>>>>
93617>>>>>>>>>>> else get Files_AppendPath lsDir lsFile to lsRval
93619>>>>>>>>>>>// showln "Bla 2 " lsRval
93619>>>>>>>>>>> get CurrentRecordOriginalExtension to lsExt
93620>>>>>>>>>>> if (lsExt<>"") move (lsRval+"."+lsExt) to lsRval
93623>>>>>>>>>>>// showln "Bla 3 " lsRval
93623>>>>>>>>>>> end
93623>>>>>>>>>>>>
93623>>>>>>>>>>> else move "" to lsRval
93625>>>>>>>>>>> function_return lsRval
93626>>>>>>>>>>> end_function
93627>>>>>>>>>>>
93627>>>>>>>>>>> function Doc_Exists returns integer
93629>>>>>>>>>>> string lsFileName
93629>>>>>>>>>>> if (pbHomeDirectoryOK(self)) begin
93631>>>>>>>>>>> get CurrentRecordAbsoluteFileName to lsFileName
93632>>>>>>>>>>>// send obs "Doc exisis" lsFileName
93632>>>>>>>>>>> function_return (SEQ_FileExists(lsFileName)=SEQIT_FILE)
93633>>>>>>>>>>> end
93633>>>>>>>>>>>>
93633>>>>>>>>>>> function_return 0
93634>>>>>>>>>>> end_function
93635>>>>>>>>>>>
93635>>>>>>>>>>> function Doc_CheckIn string lsExtFileName returns integer
93637>>>>>>>>>>> integer liRval
93637>>>>>>>>>>> string lsRoot lsOrigName lsIntFileName
93637>>>>>>>>>>> if (pbHomeDirectoryOK(self)) begin
93639>>>>>>>>>>> // Remove the path from the incoming file name:
93639>>>>>>>>>>>// showln "Doc_CheckIn 1" lsExtFileName
93639>>>>>>>>>>> get SEQ_RemovePathFromFileName lsExtFileName to lsOrigName
93640>>>>>>>>>>>// showln "Doc_CheckIn 2" lsOrigName
93640>>>>>>>>>>> // Have the class descendant store the name in the record buffer:
93640>>>>>>>>>>> set CurrentRecordOriginalFileName to lsOrigName
93641>>>>>>>>>>> // Now, let's have the inseide file name:
93641>>>>>>>>>>> get CurrentRecordAbsoluteFileName to lsIntFileName
93642>>>>>>>>>>>// showln "Doc_CheckIn 3" lsIntFileName
93642>>>>>>>>>>> // And now copy it:
93642>>>>>>>>>>> get SEQ_CopyFile lsExtFileName lsIntFileName to liRval // Returns true if OK
93643>>>>>>>>>>> end
93643>>>>>>>>>>>>
93643>>>>>>>>>>> else move 0 to liRval
93645>>>>>>>>>>> function_return liRval //
93646>>>>>>>>>>> end_function
93647>>>>>>>>>>>
93647>>>>>>>>>>> function Doc_CopyOut string lsExtFileName returns integer
93649>>>>>>>>>>> integer liRval
93649>>>>>>>>>>> string lsIntFileName
93649>>>>>>>>>>> if (pbHomeDirectoryOK(self)) begin
93651>>>>>>>>>>> get CurrentRecordAbsoluteFileName to lsIntFileName
93652>>>>>>>>>>> get SEQ_CopyFile lsIntFileName lsExtFileName to liRval // Returns true if OK
93653>>>>>>>>>>> end
93653>>>>>>>>>>>>
93653>>>>>>>>>>> else move 0 to liRval
93655>>>>>>>>>>> function_return liRval //
93656>>>>>>>>>>> end_function
93657>>>>>>>>>>>
93657>>>>>>>>>>> procedure Doc_Execute
93659>>>>>>>>>>> string lsIntFileName
93659>>>>>>>>>>> if (pbHomeDirectoryOK(self)) begin
93661>>>>>>>>>>> get CurrentRecordAbsoluteFileName to lsIntFileName
93662>>>>>>>>>>> send html_StartDoc lsIntFileName
93663>>>>>>>>>>> end
93663>>>>>>>>>>>>
93663>>>>>>>>>>> end_procedure
93664>>>>>>>>>>>
93664>>>>>>>>>>> function Doc_Delete returns integer
93666>>>>>>>>>>> integer liRval
93666>>>>>>>>>>> string lsIntFileName
93666>>>>>>>>>>> if (pbHomeDirectoryOK(self)) begin
93668>>>>>>>>>>> get CurrentRecordAbsoluteFileName to lsIntFileName
93669>>>>>>>>>>> get SEQ_EraseFile lsIntFileName to liRval
93670>>>>>>>>>>> end
93670>>>>>>>>>>>>
93670>>>>>>>>>>> else move 0 to liRval
93672>>>>>>>>>>> function_return liRval
93673>>>>>>>>>>> end_function
93674>>>>>>>>>>>
93674>>>>>>>>>>> //> The Doc_Rename procedure works like this:
93674>>>>>>>>>>> //>
93674>>>>>>>>>>> //> 1. Find record
93674>>>>>>>>>>> //> 2. Doc_Rename_Setup_From // Setup source path
93674>>>>>>>>>>> //> 3. Rename the record and save
93674>>>>>>>>>>> //> 4. Call Doc_Rename
93674>>>>>>>>>>>
93674>>>>>>>>>>> procedure Doc_Rename_Setup_From
93676>>>>>>>>>>> string lsFrom
93676>>>>>>>>>>> get CurrentRecordAbsoluteFileName to lsFrom
93677>>>>>>>>>>> set priv.RenFrom to lsFrom
93678>>>>>>>>>>> end_procedure
93679>>>>>>>>>>>
93679>>>>>>>>>>> procedure Doc_Rename
93681>>>>>>>>>>> integer lbOk
93681>>>>>>>>>>> string lsFrom lsTo
93681>>>>>>>>>>> get priv.RenFrom to lsFrom
93682>>>>>>>>>>> get CurrentRecordAbsoluteFileName to lsTo
93683>>>>>>>>>>> if (SEQ_FileExists(lsFrom)=SEQIT_FILE) begin
93685>>>>>>>>>>> // We only attempt this if the source document exists
93685>>>>>>>>>>> get SEQ_MoveFile lsFrom lsTo to lbOk
93686>>>>>>>>>>> ifnot lbOk error 225 "Document could not be renamed!"
93689>>>>>>>>>>> end
93689>>>>>>>>>>>>
93689>>>>>>>>>>> end_procedure
93690>>>>>>>>>>>
93690>>>>>>>>>>> procedure end_construct_object // Assign a standard value to psHomeDirectory
93692>>>>>>>>>>> string lsFileListPath
93692>>>>>>>>>>> forward send end_construct_object
93694>>>>>>>>>>> if (psHomeDirectory(self)="") begin
93696>>>>>>>>>>> send DoSetHomeDirectoryRelative "Attach"
93697>>>>>>>>>>>// if (SEQ_FileExists("filelist.cfg")=SEQIT_FILE) begin
93697>>>>>>>>>>>// get SEQ_FindFileAlongDFPath "filelist.cfg" to lsFileListPath
93697>>>>>>>>>>>// get Files_AppendPath lsFileListPath "attach" to lsFileListPath
93697>>>>>>>>>>>// set psHomeDirectory to lsFileListPath
93697>>>>>>>>>>>// end
93697>>>>>>>>>>> end
93697>>>>>>>>>>>>
93697>>>>>>>>>>> end_procedure
93698>>>>>>>>>>>end_class // cDocumentAttacher
93699>>>>>>>>>
93699>>>>>>>>> class cFTS_ResultSet is a cArray
93700>>>>>>>>> procedure construct_object
93702>>>>>>>>> forward send construct_object
93704>>>>>>>>> property string priv.psSearchValue public ""
93705>>>>>>>>> property integer pbIsPopulated public -1 // Not popuplated
93706>>>>>>>>> property integer pbNegative public DFFALSE
93707>>>>>>>>> property integer piArticleCount public 0
93708>>>>>>>>> end_procedure
93709>>>>>>>>>
93709>>>>>>>>> function bDoLogicalAnd integer lhResultSet returns integer
93711>>>>>>>>> integer liMax liArticle lbOK liDecrement
93711>>>>>>>>> move 0 to liDecrement
93712>>>>>>>>> get item_count to liMax
93713>>>>>>>>> decrement liMax
93714>>>>>>>>> for liArticle from 0 to liMax
93720>>>>>>>>>>
93720>>>>>>>>> if (integer(value(self,liArticle))) begin
93722>>>>>>>>> get bEvalArticle of lhResultSet liArticle to lbOK
93723>>>>>>>>> ifnot lbOK begin
93725>>>>>>>>> set value item liArticle to 0
93726>>>>>>>>> increment liDecrement
93727>>>>>>>>> end
93727>>>>>>>>>>
93727>>>>>>>>> end
93727>>>>>>>>>>
93727>>>>>>>>> if (mod(liArticle,50)=0 and ft_searcher@stop_time<>0) begin
93729>>>>>>>>> if (TS_SysTime()>ft_searcher@stop_time) function_return FTIS_SEARCH_TIMEOUT
93732>>>>>>>>> end
93732>>>>>>>>>>
93732>>>>>>>>> loop
93733>>>>>>>>>>
93733>>>>>>>>> set piArticleCount to (piArticleCount(self)-liDecrement)
93734>>>>>>>>> end_function
93735>>>>>>>>> end_class // cFTS_ResultSet
93736>>>>>>>>>
93736>>>>>>>>> // This is a help class to the cFTSearch class.
93736>>>>>>>>> // Public interface:
93736>>>>>>>>> //
93736>>>>>>>>> // property string psSearchValue
93736>>>>>>>>> //
93736>>>>>>>>> // function iEstimatedHits returns integer
93736>>>>>>>>> //
93736>>>>>>>>> // function iBuildTheSet returns integer
93736>>>>>>>>> //
93736>>>>>>>>> //
93736>>>>>>>>> class cFTS_ResultSetWord is a cFTS_ResultSet
93737>>>>>>>>> procedure construct_object
93739>>>>>>>>> forward send construct_object
93741>>>>>>>>> property integer priv.piWordId
93742>>>>>>>>> end_procedure
93743>>>>>>>>>
93743>>>>>>>>> function bEvalArticle integer liArticle returns integer
93745>>>>>>>>> integer lbRval liMax liItm liFile
93745>>>>>>>>> if (pbIsPopulated(self)) move (integer(value(self,liArticle))) to lbRval
93748>>>>>>>>> else begin // not populated
93749>>>>>>>>> get filenumber_ftartwrd to liFile
93750>>>>>>>>>
93750>>>>>>>>> clear liFile // clear ftartwrd
93751>>>>>>>>> set_field_value liFile 1 to liArticle // move liArticle to ftartwrd.article_id
93754>>>>>>>>> set_field_value liFile 2 to (priv.piWordId(self)) // get priv.piWordId to ftartwrd.word_id
93757>>>>>>>>> vfind liFile 1 EQ // find eq ftartwrd by index.1
93759>>>>>>>>> move (found) to lbRval // move (found) to lbRval
93760>>>>>>>>> end
93760>>>>>>>>>>
93760>>>>>>>>> if (pbNegative(self)) function_return (not(lbRval))
93763>>>>>>>>> function_return lbRval
93764>>>>>>>>> end_function
93765>>>>>>>>>
93765>>>>>>>>> procedure set psSearchValue string lsValue
93767>>>>>>>>> set priv.psSearchValue to lsValue
93768>>>>>>>>> end_procedure
93769>>>>>>>>>
93769>>>>>>>>> function psSearchValue returns string
93771>>>>>>>>> function_return (priv.psSearchValue(self))
93772>>>>>>>>> end_function
93773>>>>>>>>>
93773>>>>>>>>> function iEstimatedHits returns integer
93775>>>>>>>>> integer liFile liValue
93775>>>>>>>>> get filenumber_ftword to liFile
93776>>>>>>>>>
93776>>>>>>>>> clear liFile // clear FTWord
93777>>>>>>>>> set_field_value liFile 2 to (psSearchValue(self)) // get psSearchValue to FTWord.Word
93780>>>>>>>>> vfind liFile 2 eq // find eq FTWord by index.2
93782>>>>>>>>> get_field_value liFile 1 to liValue // .Word_Id //
93785>>>>>>>>> set priv.piWordId to liValue // set priv.piWordId to FTWord.Word_Id
93786>>>>>>>>> get_field_value liFile 3 to liValue // .Frequency //
93789>>>>>>>>> function_return liValue // function_return FTWord.Frequency
93790>>>>>>>>> end_function
93791>>>>>>>>>
93791>>>>>>>>> function iBuildTheSet returns integer
93793>>>>>>>>> integer liWordId liArticleCount liFile liArticleId lbFound liValue
93793>>>>>>>>>
93793>>>>>>>>> get filenumber_ftartwrd to liFile
93794>>>>>>>>>
93794>>>>>>>>> send delete_data
93795>>>>>>>>> get priv.piWordId to liWordId
93796>>>>>>>>> move 0 to liArticleCount
93797>>>>>>>>>
93797>>>>>>>>> clear liFile
93798>>>>>>>>> set_field_Value liFile 2 to liWordId
93801>>>>>>>>> repeat
93801>>>>>>>>>>
93801>>>>>>>>> vfind liFile 2 GT
93803>>>>>>>>> move (found) to lbFound
93804>>>>>>>>> if lbFound begin
93806>>>>>>>>> get_field_value liFile 2 to liValue
93809>>>>>>>>> move (liValue=liWordId) to lbFound
93810>>>>>>>>> if lbFound begin
93812>>>>>>>>> get_field_value liFile 1 to liArticleId
93815>>>>>>>>> set value item liArticleId to DFTRUE
93816>>>>>>>>> increment liArticleCount
93817>>>>>>>>> if (mod(liArticleCount,50)=0 and ft_searcher@stop_time<>0) begin
93819>>>>>>>>> if (TS_SysTime()>ft_searcher@stop_time) function_return FTIS_SEARCH_TIMEOUT
93822>>>>>>>>> end
93822>>>>>>>>>>
93822>>>>>>>>> end
93822>>>>>>>>>>
93822>>>>>>>>> end
93822>>>>>>>>>>
93822>>>>>>>>> until not lbFound
93824>>>>>>>>> set piArticleCount to liArticleCount
93825>>>>>>>>> set pbIsPopulated to DFTRUE
93826>>>>>>>>> function_return FTIS_NO_ERROR
93827>>>>>>>>> end_function
93828>>>>>>>>> end_class // cFTS_ResultSetWord
93829>>>>>>>>>
93829>>>>>>>>>
93829>>>>>>>>> class cFTS_ResultSetPhrase is a cFTS_ResultSet
93830>>>>>>>>> procedure construct_object
93832>>>>>>>>> forward send construct_object
93834>>>>>>>>> object oPrivateWordSplitter is a cFTS_WordSplitter NO_IMAGE
93836>>>>>>>>> set pbDoNotRegisterWithParent to true
93837>>>>>>>>> end_object
93838>>>>>>>>> property string priv.psSearchValue public ""
93839>>>>>>>>> property integer pbNegative public DFFALSE
93840>>>>>>>>> end_procedure
93841>>>>>>>>>
93841>>>>>>>>> function bEvalArticle integer liArticle returns integer
93843>>>>>>>>> integer lhWordSplitter liMax liRow liItm liFile liPhraseLength liValue lbFound
93843>>>>>>>>> if (pbIsPopulated(self)) move (integer(value(self,liArticle))) to lbFound
93846>>>>>>>>> else begin // not populated
93847>>>>>>>>> move (oPrivateWordSplitter(self)) to lhWordSplitter
93848>>>>>>>>> get row_count of lhWordSplitter to liMax
93849>>>>>>>>> decrement liMax
93850>>>>>>>>>
93850>>>>>>>>> get filenumber_ftartphr to liFile
93851>>>>>>>>> get piPhraseLength to liPhraseLength
93852>>>>>>>>>
93852>>>>>>>>> clear liFile // clear FTArtPhr
93853>>>>>>>>> set_field_value liFile 1 to liArticle // move liArticle to FTArtPhr.Article_Id
93856>>>>>>>>>
93856>>>>>>>>> if liMax ge 0 set_field_value liFile 2 to (piWordId.i(lhWordSplitter, 0))
93861>>>>>>>>> if liMax ge 1 set_field_value liFile 3 to (piWordId.i(lhWordSplitter, 1))
93866>>>>>>>>> if liMax ge 2 set_field_value liFile 4 to (piWordId.i(lhWordSplitter, 2))
93871>>>>>>>>> if liMax ge 3 set_field_value liFile 5 to (piWordId.i(lhWordSplitter, 3))
93876>>>>>>>>> if liMax ge 4 set_field_value liFile 6 to (piWordId.i(lhWordSplitter, 4))
93881>>>>>>>>> if liMax ge 5 set_field_value liFile 7 to (piWordId.i(lhWordSplitter, 5))
93886>>>>>>>>> if liPhraseLength ge 7 if liMax ge 6 set_field_value liFile 8 to (piWordId.i(lhWordSplitter, 6))
93893>>>>>>>>> if liPhraseLength ge 8 if liMax ge 7 set_field_value liFile 9 to (piWordId.i(lhWordSplitter, 7))
93900>>>>>>>>> if liPhraseLength ge 9 if liMax ge 8 set_field_value liFile 10 to (piWordId.i(lhWordSplitter, 8))
93907>>>>>>>>> if liPhraseLength ge 10 if liMax ge 9 set_field_value liFile 11 to (piWordId.i(lhWordSplitter, 9))
93914>>>>>>>>> if liPhraseLength ge 11 if liMax ge 10 set_field_value liFile 12 to (piWordId.i(lhWordSplitter,10))
93921>>>>>>>>> if liPhraseLength ge 12 if liMax ge 11 set_field_value liFile 13 to (piWordId.i(lhWordSplitter,11))
93928>>>>>>>>> if liPhraseLength ge 13 if liMax ge 12 set_field_value liFile 14 to (piWordId.i(lhWordSplitter,12))
93935>>>>>>>>> if liPhraseLength ge 14 if liMax ge 13 set_field_value liFile 15 to (piWordId.i(lhWordSplitter,13))
93942>>>>>>>>>
93942>>>>>>>>> vfind liFile 1 EQ
93944>>>>>>>>> move (found) to lbFound
93945>>>>>>>>> if lbFound begin
93947>>>>>>>>> get_field_value liFile 1 to liValue
93950>>>>>>>>> move (liArticle=liValue) to lbFound
93951>>>>>>>>> end
93951>>>>>>>>>>
93951>>>>>>>>>
93951>>>>>>>>> if lbFound if liMax ge 0 begin
93955>>>>>>>>> get_field_value liFile 2 to liValue
93958>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 0)) to lbFound
93959>>>>>>>>> end
93959>>>>>>>>>>
93959>>>>>>>>> if lbFound if liMax ge 1 begin
93963>>>>>>>>> get_field_value liFile 3 to liValue
93966>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 1)) to lbFound
93967>>>>>>>>> end
93967>>>>>>>>>>
93967>>>>>>>>> if lbFound if liMax ge 2 begin
93971>>>>>>>>> get_field_value liFile 4 to liValue
93974>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 2)) to lbFound
93975>>>>>>>>> end
93975>>>>>>>>>>
93975>>>>>>>>> if lbFound if liMax ge 3 begin
93979>>>>>>>>> get_field_value liFile 5 to liValue
93982>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 3)) to lbFound
93983>>>>>>>>> end
93983>>>>>>>>>>
93983>>>>>>>>> if lbFound if liMax ge 4 begin
93987>>>>>>>>> get_field_value liFile 6 to liValue
93990>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 4)) to lbFound
93991>>>>>>>>> end
93991>>>>>>>>>>
93991>>>>>>>>> if lbFound if liMax ge 5 begin
93995>>>>>>>>> get_field_value liFile 7 to liValue
93998>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 5)) to lbFound
93999>>>>>>>>> end
93999>>>>>>>>>>
93999>>>>>>>>> if liPhraseLength ge 7 if lbFound if liMax ge 6 begin
94005>>>>>>>>> get_field_value liFile 8 to liValue
94008>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 6)) to lbFound
94009>>>>>>>>> end
94009>>>>>>>>>>
94009>>>>>>>>> if liPhraseLength ge 8 if lbFound if liMax ge 7 begin
94015>>>>>>>>> get_field_value liFile 9 to liValue
94018>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 7)) to lbFound
94019>>>>>>>>> end
94019>>>>>>>>>>
94019>>>>>>>>> if liPhraseLength ge 9 if lbFound if liMax ge 8 begin
94025>>>>>>>>> get_field_value liFile 10 to liValue
94028>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 8)) to lbFound
94029>>>>>>>>> end
94029>>>>>>>>>>
94029>>>>>>>>> if liPhraseLength ge 10 if lbFound if liMax ge 9 begin
94035>>>>>>>>> get_field_value liFile 11 to liValue
94038>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 9)) to lbFound
94039>>>>>>>>> end
94039>>>>>>>>>>
94039>>>>>>>>> if liPhraseLength ge 11 if lbFound if liMax ge 10 begin
94045>>>>>>>>> get_field_value liFile 12 to liValue
94048>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter,10)) to lbFound
94049>>>>>>>>> end
94049>>>>>>>>>>
94049>>>>>>>>> if liPhraseLength ge 12 if lbFound if liMax ge 11 begin
94055>>>>>>>>> get_field_value liFile 13 to liValue
94058>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter,11)) to lbFound
94059>>>>>>>>> end
94059>>>>>>>>>>
94059>>>>>>>>> if liPhraseLength ge 13 if lbFound if liMax ge 12 begin
94065>>>>>>>>> get_field_value liFile 14 to liValue
94068>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter,12)) to lbFound
94069>>>>>>>>> end
94069>>>>>>>>>>
94069>>>>>>>>> if liPhraseLength ge 14 if lbFound if liMax ge 13 begin
94075>>>>>>>>> get_field_value liFile 15 to liValue
94078>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter,13)) to lbFound
94079>>>>>>>>> end
94079>>>>>>>>>>
94079>>>>>>>>> end
94079>>>>>>>>>>
94079>>>>>>>>> function_return lbFound
94080>>>>>>>>> end_function
94081>>>>>>>>>
94081>>>>>>>>> procedure set psSearchValue string lsValue
94083>>>>>>>>> integer lhWordSplitter lhPrivateWordSplitter
94083>>>>>>>>> move (oPrivateWordSplitter(self)) to lhPrivateWordSplitter
94084>>>>>>>>> get phWordsplitterObject to lhWordSplitter
94085>>>>>>>>> send delete_data // reset the result set
94086>>>>>>>>> send DoReset to lhPrivateWordSplitter
94087>>>>>>>>> set cFTS_WordSplitter.phRedirectObj of lhWordSplitter to lhPrivateWordSplitter
94088>>>>>>>>> send DoAddText to lhWordSplitter lsValue
94089>>>>>>>>> set priv.psSearchValue to lsValue
94090>>>>>>>>> end_procedure
94091>>>>>>>>>
94091>>>>>>>>> function psSearchValue returns string
94093>>>>>>>>> function_return (priv.psSearchValue(self))
94094>>>>>>>>> end_function
94095>>>>>>>>>
94095>>>>>>>>> function iEstimatedHits returns integer
94097>>>>>>>>> integer lhWordSplitter liMax liRow liType liRval liFile liValue
94097>>>>>>>>> string lsWord
94097>>>>>>>>>
94097>>>>>>>>> get filenumber_ftword to liFile
94098>>>>>>>>>
94098>>>>>>>>> move -1 to liRval
94099>>>>>>>>> move (oPrivateWordSplitter(self)) to lhWordSplitter
94100>>>>>>>>> get row_count of lhWordSplitter to liMax
94101>>>>>>>>> decrement liMax
94102>>>>>>>>> for liRow from 0 to liMax
94108>>>>>>>>>>
94108>>>>>>>>> get psWord.i of lhWordSplitter liRow to lsWord
94109>>>>>>>>>
94109>>>>>>>>> clear liFile //clear FTWord
94110>>>>>>>>> set_field_value liFile 2 to lsWord //move lsWord to FTWord.Word
94113>>>>>>>>> vfind liFile 2 EQ //find eq FTWord by index.2
94115>>>>>>>>>
94115>>>>>>>>> if (found) begin
94117>>>>>>>>> get_field_value liFile 1 to liValue // FTWORD.WORD_ID
94120>>>>>>>>> set piWordId.i of lhWordSplitter liRow to liValue
94121>>>>>>>>> get_field_value liFile 3 to liValue // FTWord.Frequency
94124>>>>>>>>> set piFrequency.i of lhWordSplitter liRow to liValue
94125>>>>>>>>> if (liRval=-1 or liValue<liRval) move liValue to liRval // if (liRval=-1 or FTWord.Frequency<liRval) move FTWord.Frequency to liRval
94128>>>>>>>>> end
94128>>>>>>>>>>
94128>>>>>>>>> else move 0 to liRval
94130>>>>>>>>> loop
94131>>>>>>>>>>
94131>>>>>>>>> function_return (liRval/(liMax+1))
94132>>>>>>>>> end_function
94133>>>>>>>>>
94133>>>>>>>>> function iBuildTheSet returns integer
94135>>>>>>>>> integer lhWordSplitter liMax liRow liArticleCount lbFound liMaxArticles
94135>>>>>>>>> integer liWordID liFile liPhraseLength liValue
94135>>>>>>>>>
94135>>>>>>>>> send delete_data
94136>>>>>>>>>
94136>>>>>>>>> if liMaxArticles eq 0 move 999999 to liMaxArticles
94139>>>>>>>>>
94139>>>>>>>>> move (oPrivateWordSplitter(self)) to lhWordSplitter
94140>>>>>>>>> get row_count of lhWordSplitter to liMax
94141>>>>>>>>> ifnot liMax function_return 0
94144>>>>>>>>> decrement liMax
94145>>>>>>>>> move 0 to liArticleCount
94146>>>>>>>>>
94146>>>>>>>>> get filenumber_ftartphr to liFile
94147>>>>>>>>> get piPhraseLength to liPhraseLength
94148>>>>>>>>>
94148>>>>>>>>> clear liFile //clear FTArtPhr
94149>>>>>>>>>
94149>>>>>>>>> if liMax ge 0 set_field_value liFile 2 to (piWordId.i(lhWordSplitter, 0))
94154>>>>>>>>> if liMax ge 1 set_field_value liFile 3 to (piWordId.i(lhWordSplitter, 1))
94159>>>>>>>>> if liMax ge 2 set_field_value liFile 4 to (piWordId.i(lhWordSplitter, 2))
94164>>>>>>>>> if liMax ge 3 set_field_value liFile 5 to (piWordId.i(lhWordSplitter, 3))
94169>>>>>>>>> if liMax ge 4 set_field_value liFile 6 to (piWordId.i(lhWordSplitter, 4))
94174>>>>>>>>> if liMax ge 5 set_field_value liFile 7 to (piWordId.i(lhWordSplitter, 5))
94179>>>>>>>>> if liPhraseLength ge 7 if liMax ge 6 set_field_value liFile 8 to (piWordId.i(lhWordSplitter, 6))
94186>>>>>>>>> if liPhraseLength ge 8 if liMax ge 7 set_field_value liFile 9 to (piWordId.i(lhWordSplitter, 7))
94193>>>>>>>>> if liPhraseLength ge 9 if liMax ge 8 set_field_value liFile 10 to (piWordId.i(lhWordSplitter, 8))
94200>>>>>>>>> if liPhraseLength ge 10 if liMax ge 9 set_field_value liFile 11 to (piWordId.i(lhWordSplitter, 9))
94207>>>>>>>>> if liPhraseLength ge 11 if liMax ge 10 set_field_value liFile 12 to (piWordId.i(lhWordSplitter,10))
94214>>>>>>>>> if liPhraseLength ge 12 if liMax ge 11 set_field_value liFile 13 to (piWordId.i(lhWordSplitter,11))
94221>>>>>>>>> if liPhraseLength ge 13 if liMax ge 12 set_field_value liFile 14 to (piWordId.i(lhWordSplitter,12))
94228>>>>>>>>> if liPhraseLength ge 14 if liMax ge 13 set_field_value liFile 15 to (piWordId.i(lhWordSplitter,13))
94235>>>>>>>>>
94235>>>>>>>>> repeat
94235>>>>>>>>>>
94235>>>>>>>>> vfind liFile 2 GT // find gt FTArtPhr by index.2
94237>>>>>>>>> move (found) to lbFound
94238>>>>>>>>> if lbFound if liMax ge 0 begin
94242>>>>>>>>> get_field_value liFile 2 to liValue
94245>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 0)) to lbFound
94246>>>>>>>>> end
94246>>>>>>>>>>
94246>>>>>>>>> if lbFound if liMax ge 1 begin
94250>>>>>>>>> get_field_value liFile 3 to liValue
94253>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 1)) to lbFound
94254>>>>>>>>> end
94254>>>>>>>>>>
94254>>>>>>>>> if lbFound if liMax ge 2 begin
94258>>>>>>>>> get_field_value liFile 4 to liValue
94261>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 2)) to lbFound
94262>>>>>>>>> end
94262>>>>>>>>>>
94262>>>>>>>>> if lbFound if liMax ge 3 begin
94266>>>>>>>>> get_field_value liFile 5 to liValue
94269>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 3)) to lbFound
94270>>>>>>>>> end
94270>>>>>>>>>>
94270>>>>>>>>> if lbFound if liMax ge 4 begin
94274>>>>>>>>> get_field_value liFile 6 to liValue
94277>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 4)) to lbFound
94278>>>>>>>>> end
94278>>>>>>>>>>
94278>>>>>>>>> if lbFound if liMax ge 5 begin
94282>>>>>>>>> get_field_value liFile 7 to liValue
94285>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 5)) to lbFound
94286>>>>>>>>> end
94286>>>>>>>>>>
94286>>>>>>>>> if liPhraseLength ge 7 if lbFound if liMax ge 6 begin
94292>>>>>>>>> get_field_value liFile 8 to liValue
94295>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 6)) to lbFound
94296>>>>>>>>> end
94296>>>>>>>>>>
94296>>>>>>>>> if liPhraseLength ge 8 if lbFound if liMax ge 7 begin
94302>>>>>>>>> get_field_value liFile 9 to liValue
94305>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 7)) to lbFound
94306>>>>>>>>> end
94306>>>>>>>>>>
94306>>>>>>>>> if liPhraseLength ge 9 if lbFound if liMax ge 8 begin
94312>>>>>>>>> get_field_value liFile 10 to liValue
94315>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 8)) to lbFound
94316>>>>>>>>> end
94316>>>>>>>>>>
94316>>>>>>>>> if liPhraseLength ge 10 if lbFound if liMax ge 9 begin
94322>>>>>>>>> get_field_value liFile 11 to liValue
94325>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter, 9)) to lbFound
94326>>>>>>>>> end
94326>>>>>>>>>>
94326>>>>>>>>> if liPhraseLength ge 11 if lbFound if liMax ge 10 begin
94332>>>>>>>>> get_field_value liFile 12 to liValue
94335>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter,10)) to lbFound
94336>>>>>>>>> end
94336>>>>>>>>>>
94336>>>>>>>>> if liPhraseLength ge 12 if lbFound if liMax ge 11 begin
94342>>>>>>>>> get_field_value liFile 13 to liValue
94345>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter,11)) to lbFound
94346>>>>>>>>> end
94346>>>>>>>>>>
94346>>>>>>>>> if liPhraseLength ge 13 if lbFound if liMax ge 12 begin
94352>>>>>>>>> get_field_value liFile 14 to liValue
94355>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter,12)) to lbFound
94356>>>>>>>>> end
94356>>>>>>>>>>
94356>>>>>>>>> if liPhraseLength ge 14 if lbFound if liMax ge 13 begin
94362>>>>>>>>> get_field_value liFile 15 to liValue
94365>>>>>>>>> move (liValue=piWordId.i(lhWordSplitter,13)) to lbFound
94366>>>>>>>>> end
94366>>>>>>>>>>
94366>>>>>>>>> if lbFound begin
94368>>>>>>>>> increment liArticleCount
94369>>>>>>>>> get_field_value liFile 1 to liValue // FTArtPhr.ARTICLE_ID
94372>>>>>>>>> set value item liValue to 1
94373>>>>>>>>> if (mod(liArticleCount,50)=0 and ft_searcher@stop_time<>0) begin
94375>>>>>>>>> if (TS_SysTime()>ft_searcher@stop_time) function_return FTIS_SEARCH_TIMEOUT
94378>>>>>>>>> end
94378>>>>>>>>>>
94378>>>>>>>>> end
94378>>>>>>>>>>
94378>>>>>>>>> until (not(lbFound) or liArticleCount=liMaxArticles)
94380>>>>>>>>> set piArticleCount to liArticleCount
94381>>>>>>>>> set pbIsPopulated to DFTRUE
94382>>>>>>>>> function_return FTIS_NO_ERROR
94383>>>>>>>>> end_function
94384>>>>>>>>> end_class // cFTS_ResultSetPhrase
94385>>>>>>>>>
94385>>>>>>>>> class cFTS_ResultSorter is a cArray
94386>>>>>>>>> item_property_list
94386>>>>>>>>> item_property integer piArticle.i
94386>>>>>>>>> item_property date pdDate.i
94386>>>>>>>>> item_property string psTime.i
94386>>>>>>>>> item_property integer piHits.i
94386>>>>>>>>> end_item_property_list cFTS_ResultSorter
#REM 94424 DEFINE FUNCTION PIHITS.I INTEGER LIROW RETURNS INTEGER
#REM 94428 DEFINE PROCEDURE SET PIHITS.I INTEGER LIROW INTEGER VALUE
#REM 94432 DEFINE FUNCTION PSTIME.I INTEGER LIROW RETURNS STRING
#REM 94436 DEFINE PROCEDURE SET PSTIME.I INTEGER LIROW STRING VALUE
#REM 94440 DEFINE FUNCTION PDDATE.I INTEGER LIROW RETURNS DATE
#REM 94444 DEFINE PROCEDURE SET PDDATE.I INTEGER LIROW DATE VALUE
#REM 94448 DEFINE FUNCTION PIARTICLE.I INTEGER LIROW RETURNS INTEGER
#REM 94452 DEFINE PROCEDURE SET PIARTICLE.I INTEGER LIROW INTEGER VALUE
94457>>>>>>>>> procedure AddArticle integer liArticle date ldDate string lsTime integer liHits
94459>>>>>>>>> integer liRow
94459>>>>>>>>> get row_count to liRow
94460>>>>>>>>> set piArticle.i liRow to liArticle
94461>>>>>>>>> set pdDate.i liRow to ldDate
94462>>>>>>>>> set psTime.i liRow to lsTime
94463>>>>>>>>> set piHits.i liRow to liHits
94464>>>>>>>>> end_procedure
94465>>>>>>>>> procedure DumpToArray integer lhArray
94467>>>>>>>>> integer liMax liRow
94467>>>>>>>>> send delete_data of lhArray
94468>>>>>>>>> get row_count to liMax
94469>>>>>>>>> decrement liMax
94470>>>>>>>>> for liRow from 0 to liMax
94476>>>>>>>>>>
94476>>>>>>>>> set value of lhArray item liRow to (piArticle.i(self,liRow))
94477>>>>>>>>> loop
94478>>>>>>>>>>
94478>>>>>>>>> end_procedure
94479>>>>>>>>> procedure DumpToChannel integer liChannel
94481>>>>>>>>> integer liMax liRow
94481>>>>>>>>> get row_count to liMax
94482>>>>>>>>> writeln channel liChannel liMax
94485>>>>>>>>> decrement liMax
94486>>>>>>>>> for liRow from 0 to liMax
94492>>>>>>>>>>
94492>>>>>>>>> writeln (piArticle.i(self,liRow))
94494>>>>>>>>> loop
94495>>>>>>>>>>
94495>>>>>>>>> end_procedure
94496>>>>>>>>> end_class // cFTS_ResultSorter
94497>>>>>>>>>
94497>>>>>>>>> class cFTS_ResultAttacher is a cDocumentAttacher
94498>>>>>>>>> procedure construct_object
94500>>>>>>>>> forward send construct_object
94502>>>>>>>>> // A directory of this name will be created under
94502>>>>>>>>> // the directory holding filelist.cfg:
94502>>>>>>>>> send DoSetHomeDirectoryRelative "FTS"
94503>>>>>>>>> end_procedure
94504>>>>>>>>> function CurrentRecordSubDirectory returns string
94506>>>>>>>>> string lsPrefix
94506>>>>>>>>> get psRootNamePrefix to lsPrefix
94507>>>>>>>>> function_return (lsPrefix+"_results")
94508>>>>>>>>> end_function
94509>>>>>>>>> function CurrentRecordRootName returns string //
94511>>>>>>>>> integer liFile liSearchId
94511>>>>>>>>> string lsPrefix
94511>>>>>>>>> get psRootNamePrefix to lsPrefix
94512>>>>>>>>> get filenumber_ftsearch to liFile
94513>>>>>>>>> get_field_value liFile 1 to liSearchId
94516>>>>>>>>> function_return (lsPrefix+IntToStrRzf(liSearchId,8))
94517>>>>>>>>> end_function
94518>>>>>>>>> // This function really is not necessary. It instructs the
94518>>>>>>>>> // class about the original name of a given document (in
94518>>>>>>>>> // this case: a constant) if instructed to copy it out
94518>>>>>>>>> // of the 'database'.
94518>>>>>>>>> function CurrentRecordOriginalFileName returns string
94520>>>>>>>>> string lsPrefix
94520>>>>>>>>> get psRootNamePrefix to lsPrefix
94521>>>>>>>>> function_return (lsPrefix+".res")
94522>>>>>>>>> end_function
94523>>>>>>>>> end_class // cFTS_ResultAttacher
94524>>>>>>>>>
94524>>>>>>>>>
94524>>>>>>>>>class cFTS_Searcher is a cArray
94525>>>>>>>>> procedure construct_object
94527>>>>>>>>> forward send construct_object
94529>>>>>>>>>
94529>>>>>>>>> object oFinalSet is a cArray
94531>>>>>>>>> end_object
94532>>>>>>>>>
94532>>>>>>>>> object oResultSorter is a cFTS_ResultSorter
94534>>>>>>>>> end_object
94535>>>>>>>>>
94535>>>>>>>>> object oResultAttacher is a cFTS_ResultAttacher
94537>>>>>>>>> end_object
94538>>>>>>>>>
94538>>>>>>>>> // This class accesses a property of name phTableAccessObject. This is
94538>>>>>>>>> // not defined in this class but should be defined in the encapsulating
94538>>>>>>>>> // object (a cFTS_System object).
94538>>>>>>>>>
94538>>>>>>>>> property integer piSearchTimeout public 5 // Search timeout value in seconds
94539>>>>>>>>> end_procedure
94540>>>>>>>>>
94540>>>>>>>>> item_property_list
94540>>>>>>>>> item_property integer pbNegative.i
94540>>>>>>>>> item_property integer piEstimatedHits.i
94540>>>>>>>>> item_property integer pbIsPhrase.i
94540>>>>>>>>> item_property integer phResultObj.i
94540>>>>>>>>> item_property integer piActualHits.i
94540>>>>>>>>> end_item_property_list cFTS_Searcher
#REM 94581 DEFINE FUNCTION PIACTUALHITS.I INTEGER LIROW RETURNS INTEGER
#REM 94585 DEFINE PROCEDURE SET PIACTUALHITS.I INTEGER LIROW INTEGER VALUE
#REM 94589 DEFINE FUNCTION PHRESULTOBJ.I INTEGER LIROW RETURNS INTEGER
#REM 94593 DEFINE PROCEDURE SET PHRESULTOBJ.I INTEGER LIROW INTEGER VALUE
#REM 94597 DEFINE FUNCTION PBISPHRASE.I INTEGER LIROW RETURNS INTEGER
#REM 94601 DEFINE PROCEDURE SET PBISPHRASE.I INTEGER LIROW INTEGER VALUE
#REM 94605 DEFINE FUNCTION PIESTIMATEDHITS.I INTEGER LIROW RETURNS INTEGER
#REM 94609 DEFINE PROCEDURE SET PIESTIMATEDHITS.I INTEGER LIROW INTEGER VALUE
#REM 94613 DEFINE FUNCTION PBNEGATIVE.I INTEGER LIROW RETURNS INTEGER
#REM 94617 DEFINE PROCEDURE SET PBNEGATIVE.I INTEGER LIROW INTEGER VALUE
94622>>>>>>>>>
94622>>>>>>>>> procedure DoReset
94624>>>>>>>>> integer liRow liMax lhObj
94624>>>>>>>>> get row_count to liMax
94625>>>>>>>>> decrement liMax
94626>>>>>>>>> for liRow from 0 to liMax
94632>>>>>>>>>>
94632>>>>>>>>> get phResultObj.i liRow to lhObj
94633>>>>>>>>> if lhObj send request_destroy_object to lhObj
94636>>>>>>>>> loop
94637>>>>>>>>>>
94637>>>>>>>>> send delete_data
94638>>>>>>>>> end_procedure
94639>>>>>>>>>
94639>>>>>>>>> function filenumber_ftartwrd returns integer
94641>>>>>>>>> function_return (piFile.i(phTableAccessObject(self),FTSTABLE_ARTWRD))
94642>>>>>>>>> end_function
94643>>>>>>>>> function filenumber_ftartphr returns integer
94645>>>>>>>>> function_return (piFile.i(phTableAccessObject(self),FTSTABLE_ARTPHR))
94646>>>>>>>>> end_function
94647>>>>>>>>> function filenumber_ftarticl returns integer
94649>>>>>>>>> function_return (piFile.i(phTableAccessObject(self),FTSTABLE_ARTICL))
94650>>>>>>>>> end_function
94651>>>>>>>>> function filenumber_ftword returns integer
94653>>>>>>>>> function_return (piFile.i(phTableAccessObject(self),FTSTABLE_WORD))
94654>>>>>>>>> end_function
94655>>>>>>>>> function filenumber_ftsearch returns integer
94657>>>>>>>>> function_return (piFile.i(phTableAccessObject(self),FTSTABLE_SEARCH))
94658>>>>>>>>> end_function
94659>>>>>>>>> function piPhraseLength returns integer
94661>>>>>>>>> function_return (piPhraseLength(phTableAccessObject(self)))
94662>>>>>>>>> end_function
94663>>>>>>>>> function psRootNamePrefix returns string
94665>>>>>>>>> function_return (psRootNamePrefix(phTableAccessObject(self)))
94666>>>>>>>>> end_function
94667>>>>>>>>>
94667>>>>>>>>>
94667>>>>>>>>> procedure add_search_item string lsSearchString integer lbNegative integer lbIsPhrase
94669>>>>>>>>> integer lhObj liRow lhWordSplitter
94669>>>>>>>>>
94669>>>>>>>>> // *************************************************************************************
94669>>>>>>>>> // If lbIsPhrase is false, we still have to examine whether we have to treat it as
94669>>>>>>>>> // a phrase. This is due to words like this: WINERR=2. We have to break it up in order
94669>>>>>>>>> // to see if it's actually a phrase.
94669>>>>>>>>> ifnot lbIsPhrase begin
94671>>>>>>>>> get phWordsplitterObject to lhWordSplitter
94672>>>>>>>>> send DoReset to lhWordSplitter
94673>>>>>>>>> send DoAddText to lhWordSplitter lsSearchString
94674>>>>>>>>> if (row_count(lhWordSplitter)>1) begin // It's a phrase!
94676>>>>>>>>> move DFTRUE to lbIsPhrase
94677>>>>>>>>> end
94677>>>>>>>>>>
94677>>>>>>>>> send DoReset to lhWordSplitter
94678>>>>>>>>> end
94678>>>>>>>>>>
94678>>>>>>>>> // *************************************************************************************
94678>>>>>>>>>
94678>>>>>>>>> get row_count to liRow
94679>>>>>>>>> if lbIsPhrase begin
94681>>>>>>>>> object oResultSet is a cFTS_ResultSetPhrase NO_IMAGE
94683>>>>>>>>> move self to lhObj
94684>>>>>>>>> end_object
94685>>>>>>>>> end
94685>>>>>>>>>>
94685>>>>>>>>> else begin
94686>>>>>>>>> object oResultSet is a cFTS_ResultSetWord NO_IMAGE
94688>>>>>>>>> move self to lhObj
94689>>>>>>>>> end_object
94690>>>>>>>>> end
94690>>>>>>>>>>
94690>>>>>>>>> set psSearchValue of lhObj to lsSearchString
94691>>>>>>>>> set pbNegative of lhObj to lbNegative
94692>>>>>>>>> set piArticleCount of lhObj to 0
94693>>>>>>>>> set pbIsPopulated of lhObj to DFFALSE // Not populated
94694>>>>>>>>> set pbNegative.i liRow to lbNegative
94695>>>>>>>>> set pbIsPhrase.i liRow to lbIsPhrase
94696>>>>>>>>> set piEstimatedHits.i liRow to -1 // Don't know
94697>>>>>>>>> set piActualHits.i liRow to -1 // Don't know
94698>>>>>>>>> set phResultObj.i liRow to lhObj
94699>>>>>>>>> end_procedure
94700>>>>>>>>>
94700>>>>>>>>> function InterpreteSearchString string lsSearchString returns integer
94702>>>>>>>>> integer liItm liMax lsItem
94702>>>>>>>>> integer lbInPhrase lbErrorCode lbNegative lbNegativePhrase
94702>>>>>>>>> string lsWord lsPhrase
94702>>>>>>>>> move FTIS_NO_ERROR to lbErrorCode
94703>>>>>>>>> get HowManyWords (trim(lsSearchString)) " " to liMax
94704>>>>>>>>> move DFFALSE to lbInPhrase
94705>>>>>>>>> move "" to lsPhrase
94706>>>>>>>>> for liItm from 1 to liMax
94712>>>>>>>>>>
94712>>>>>>>>> get ExtractWord lsSearchString " " liItm to lsWord
94713>>>>>>>>>
94713>>>>>>>>> // First we sort out the negative positive thing:
94713>>>>>>>>> ifnot lbInPhrase begin
94715>>>>>>>>> if (left(lsWord,1)="-") begin
94717>>>>>>>>> move DFTRUE to lbNegative
94718>>>>>>>>> move (trim(StringRightBut(lsWord,1))) to lsWord // Note lsWord may be empty after this
94719>>>>>>>>> end
94719>>>>>>>>>>
94719>>>>>>>>> else begin
94720>>>>>>>>> if (left(lsWord,1)="+") begin
94722>>>>>>>>> move DFFALSE to lbNegative
94723>>>>>>>>> move (trim(StringLeftBut(lsWord,1))) to lsWord // Note lsWord may be empty after this
94724>>>>>>>>> end
94724>>>>>>>>>>
94724>>>>>>>>> end
94724>>>>>>>>>>
94724>>>>>>>>> end
94724>>>>>>>>>>
94724>>>>>>>>> else move DFFALSE to lbNegative
94726>>>>>>>>>
94726>>>>>>>>> if (lsWord<>"") begin
94728>>>>>>>>> if lbInPhrase begin
94730>>>>>>>>> move (lsPhrase*lsWord) to lsPhrase
94731>>>>>>>>> if (right(lsWord,1)='"') begin
94733>>>>>>>>> move (StringLeftBut(lsPhrase,1)) to lsPhrase
94734>>>>>>>>> send add_search_item lsPhrase lbNegativePhrase DFTRUE
94735>>>>>>>>> move "" to lsPhrase
94736>>>>>>>>> move DFFALSE to lbInPhrase
94737>>>>>>>>> end
94737>>>>>>>>>>
94737>>>>>>>>> end
94737>>>>>>>>>>
94737>>>>>>>>> else begin
94738>>>>>>>>> if (left(lsWord,1)='"') begin // If phrase start
94740>>>>>>>>> move (replace('"',lsWord,"")) to lsWord
94741>>>>>>>>> move DFTRUE to lbInPhrase
94742>>>>>>>>> move lsWord to lsPhrase
94743>>>>>>>>> move lbNegative to lbNegativePhrase
94744>>>>>>>>> if (right(lsWord,1)='"') begin // If the phrase is terminated immediately.
94746>>>>>>>>> move (StringLeftBut(lsPhrase,1)) to lsPhrase
94747>>>>>>>>> send add_search_item lsPhrase lbNegativePhrase DFTRUE
94748>>>>>>>>> move "" to lsPhrase
94749>>>>>>>>> move DFFALSE to lbInPhrase
94750>>>>>>>>> end
94750>>>>>>>>>>
94750>>>>>>>>> move "" to lsWord
94751>>>>>>>>> end
94751>>>>>>>>>>
94751>>>>>>>>> else send add_search_item lsWord lbNegative DFFALSE
94753>>>>>>>>> end
94753>>>>>>>>>>
94753>>>>>>>>> end
94753>>>>>>>>>>
94753>>>>>>>>>
94753>>>>>>>>> loop
94754>>>>>>>>>>
94754>>>>>>>>> if lbInPhrase send add_search_item lsWord lbNegativePhrase DFTRUE
94757>>>>>>>>> function_return lbErrorCode
94758>>>>>>>>> end_function
94759>>>>>>>>>
94759>>>>>>>>> procedure CalculateMaxPossibleHits
94761>>>>>>>>> integer liMax liRow lhObj liEstimatedHits
94761>>>>>>>>> get row_count to liMax
94762>>>>>>>>> decrement liMax
94763>>>>>>>>> for liRow from 0 to liMax
94769>>>>>>>>>>
94769>>>>>>>>> get phResultObj.i liRow to lhObj
94770>>>>>>>>> get iEstimatedHits of lhObj to liEstimatedHits
94771>>>>>>>>> set piEstimatedHits.i liRow to liEstimatedHits
94772>>>>>>>>> loop
94773>>>>>>>>>>
94773>>>>>>>>> end_procedure
94774>>>>>>>>> procedure PrioritizeTheSearch
94776>>>>>>>>> send sort_rows 0 1 // ValueCantBePresent NumberOfHits
94777>>>>>>>>> end_procedure
94778>>>>>>>>>
94778>>>>>>>>> function iDoSearchRow integer liRow integer liCurrentResultSize returns integer
94780>>>>>>>>> integer lhResultObj liEstimatedHits liError liGarbage
94780>>>>>>>>> get phResultObj.i liRow to lhResultObj
94781>>>>>>>>> get piEstimatedHits.i liRow to liEstimatedHits
94782>>>>>>>>> move FTIS_NO_ERROR to liError
94783>>>>>>>>>
94783>>>>>>>>> if liRow begin // not the first row
94785>>>>>>>>> ifnot (pbNegative.i(self,liRow)) begin
94787>>>>>>>>> // We only do this if we have less than 1000 estimated:
94787>>>>>>>>> if (liEstimatedHits<1000 and liCurrentResultSize>25) get iBuildTheSet of lhResultObj to liError
94790>>>>>>>>> end
94790>>>>>>>>>>
94790>>>>>>>>> ifnot liError get bDoLogicalAnd of (phResultObj.i(self,0)) lhResultObj to liError
94793>>>>>>>>> end
94793>>>>>>>>>>
94793>>>>>>>>> else begin // First row
94794>>>>>>>>>// if (liEstimatedHits>5000) move FTIS_TOO_MANY to liError
94794>>>>>>>>>// else get iBuildTheSet of lhResultObj to liGarbage
94794>>>>>>>>> get iBuildTheSet of lhResultObj to liError
94795>>>>>>>>> end
94795>>>>>>>>>>
94795>>>>>>>>> function_return liError
94796>>>>>>>>> end_function
94797>>>>>>>>>
94797>>>>>>>>> procedure BuildFinalSet
94799>>>>>>>>> integer lhResultSet lhFinalResultSet liMax liArticle liCounter
94799>>>>>>>>> move (phResultObj.i(self,0)) to lhResultSet
94800>>>>>>>>> move (oFinalSet(self)) to lhFinalResultSet
94801>>>>>>>>> get item_count of lhResultSet to liMax
94802>>>>>>>>> decrement liMax
94803>>>>>>>>> move 0 to liCounter
94804>>>>>>>>> for liArticle from 0 to liMax
94810>>>>>>>>>>
94810>>>>>>>>> if (integer(value(lhResultSet,liArticle))) begin
94812>>>>>>>>> set value of lhFinalResultSet item liCounter to liArticle
94813>>>>>>>>> increment liCounter
94814>>>>>>>>> end
94814>>>>>>>>>>
94814>>>>>>>>> loop
94815>>>>>>>>>>
94815>>>>>>>>> end_procedure
94816>>>>>>>>>
94816>>>>>>>>> function DoPostSearchProcessing returns integer
94818>>>>>>>>> end_function
94819>>>>>>>>>
94819>>>>>>>>> // This is a low level access to the search function
94819>>>>>>>>> // 0 means OK, result set was generated
94819>>>>>>>>> // liMaxSeconds=0 => no limit!
94819>>>>>>>>> function iDoSearch string lsSearchString integer liMaxSeconds returns integer
94821>>>>>>>>> integer liError lhResultSet liMax liRow liCurrentResultSize
94821>>>>>>>>> send DoReset
94822>>>>>>>>> move FTIS_NO_ERROR to liError
94823>>>>>>>>> get InterpreteSearchString lsSearchString to liError
94824>>>>>>>>> send delete_data to (oFinalSet(self))
94825>>>>>>>>>
94825>>>>>>>>> if liMaxSeconds begin
94827>>>>>>>>> get TS_SysTime to ft_searcher@stop_time
94828>>>>>>>>> move (ft_searcher@stop_time+liMaxSeconds) to ft_searcher@stop_time
94829>>>>>>>>> move liMaxSeconds to ft_searcher@max_time
94830>>>>>>>>> end
94830>>>>>>>>>>
94830>>>>>>>>> else begin
94831>>>>>>>>> move 0 to ft_searcher@stop_time
94832>>>>>>>>> move 0 to ft_searcher@max_time
94833>>>>>>>>> end
94833>>>>>>>>>>
94833>>>>>>>>>
94833>>>>>>>>> ifnot liError begin
94835>>>>>>>>> send CalculateMaxPossibleHits
94836>>>>>>>>> send PrioritizeTheSearch
94837>>>>>>>>> if (row_count(self)) begin
94839>>>>>>>>> ifnot (pbNegative.i(self,0)) begin
94841>>>>>>>>> get phResultObj.i 0 to lhResultSet
94842>>>>>>>>> get row_count to liMax
94843>>>>>>>>> move 0 to liRow
94844>>>>>>>>> move -1 to liCurrentResultSize
94845>>>>>>>>> while (not(liError) and liRow<liMax)
94849>>>>>>>>> get iDoSearchRow liRow liCurrentResultSize to liError
94850>>>>>>>>> get piArticleCount of lhResultSet to liCurrentResultSize
94851>>>>>>>>> increment liRow
94852>>>>>>>>> end
94853>>>>>>>>>>
94853>>>>>>>>> ifnot liError send BuildFinalSet
94856>>>>>>>>> end
94856>>>>>>>>>>
94856>>>>>>>>> else move FTIS_NO_POSITIVE to liError
94858>>>>>>>>> end
94858>>>>>>>>>>
94858>>>>>>>>> else move FTIS_MISSING_VALUE to liError
94860>>>>>>>>> end
94860>>>>>>>>>>
94860>>>>>>>>> // send DoReset
94860>>>>>>>>> ifnot liError get DoPostSearchProcessing to liError
94863>>>>>>>>>
94863>>>>>>>>> function_return liError
94864>>>>>>>>> end_function // iDoSearch
94865>>>>>>>>>
94865>>>>>>>>> function bSelectArticle integer liArticleId returns integer
94867>>>>>>>>> function_return 1
94868>>>>>>>>> end_function
94869>>>>>>>>>
94869>>>>>>>>>
94869>>>>>>>>> // The ArticleId_ArrayValueToArticleId function has been introduced to get
94869>>>>>>>>> // around the following problem: In Electos the system is built to find
94869>>>>>>>>> // articles by what is known as the DocumentId. But when the search is
94869>>>>>>>>> // completed the array of document ID's is converted into an array of
94869>>>>>>>>> // TimeLine ID's (possibly not even the same number of items). Therefore
94869>>>>>>>>> // this little function with the funny name is needed to allow Electos to
94869>>>>>>>>> // 'get back' to its original DocumentId - Phew!
94869>>>>>>>>> function ArticleId_ArrayValueToArticleId integer liArticleId returns integer
94871>>>>>>>>> function_return liArticleId
94872>>>>>>>>> end_function
94873>>>>>>>>>
94873>>>>>>>>> function iDoSearchActiveSearchRecord returns integer
94875>>>>>>>>> integer liSearchFile
94875>>>>>>>>> integer lhResultSorter
94875>>>>>>>>> integer lhFinalSet
94875>>>>>>>>> integer liMax liItem
94875>>>>>>>>> integer liArticleFile
94875>>>>>>>>> integer liArtId liGenericArtId
94875>>>>>>>>> integer liHitCount
94875>>>>>>>>> integer lbOk
94875>>>>>>>>> integer liOrder
94875>>>>>>>>> integer liChannel
94875>>>>>>>>> integer liError
94875>>>>>>>>> integer liArticleCount
94875>>>>>>>>> date ldFrom ldTo
94875>>>>>>>>> date ldDate
94875>>>>>>>>> string lsSearchString
94875>>>>>>>>> string lsTime
94875>>>>>>>>> string lsStartTime lsStopTime // Used for measuring the duration of the search
94875>>>>>>>>> string lsFileName // Name of sequential file where search result will be written
94875>>>>>>>>> number lnElap // Very temporarily
94875>>>>>>>>>
94875>>>>>>>>> move (oFinalSet(self)) to lhFinalSet
94876>>>>>>>>>
94876>>>>>>>>> // Mark the time we started the search:
94876>>>>>>>>> get MilliSeconds_Systime to lsStartTime
94877>>>>>>>>>
94877>>>>>>>>> // Open output to file in whichs we will store the result:
94877>>>>>>>>> get CurrentRecordAbsoluteFileName of oResultAttacher to lsFileName
94878>>>>>>>>> get SEQ_DirectOutput lsFileName to liChannel
94879>>>>>>>>>
94879>>>>>>>>>
94879>>>>>>>>> get filenumber_ftsearch to liSearchFile
94880>>>>>>>>> get_field_value liSearchFile 3 to lsSearchString // FTSEARCH.SEARCH_STRING
94883>>>>>>>>>
94883>>>>>>>>> get iDoSearch lsSearchString (piSearchTimeout(self)) to liError
94884>>>>>>>>> writeln channel liChannel liError
94887>>>>>>>>>
94887>>>>>>>>> if (liError=FTIS_NO_ERROR) begin
94889>>>>>>>>> get_field_value liSearchFile 8 to ldFrom // FTSEARCH.LOW_DATE_LIMIT
94892>>>>>>>>> get_field_value liSearchFile 9 to ldTo // FTSEARCH.HIGH_DATE_LIMIT
94895>>>>>>>>>
94895>>>>>>>>> if (integer(ldTo)=0) move LargestPossibleDate to ldTo // LargestPossibleDate (constant defined in dates.nui)
94898>>>>>>>>>
94898>>>>>>>>> get filenumber_ftarticl to liArticleFile
94899>>>>>>>>>
94899>>>>>>>>> move (oResultSorter(self)) to lhResultSorter
94900>>>>>>>>> send delete_data of lhResultSorter
94901>>>>>>>>> get result_count to liMax
94902>>>>>>>>> decrement liMax
94903>>>>>>>>>
94903>>>>>>>>> for liItem from 0 to liMax // Go through the articles of the result set
94909>>>>>>>>>>
94909>>>>>>>>> get result_article liItem to liArtId
94910>>>>>>>>>
94910>>>>>>>>> // Electos stunt:
94910>>>>>>>>> get ArticleId_ArrayValueToArticleId liArtId to liGenericArtId
94911>>>>>>>>>
94911>>>>>>>>> clear liArticleFile
94912>>>>>>>>> set_field_value liArticleFile 1 to liGenericArtId // FTArticl.Article_Id
94915>>>>>>>>> vfind liArticleFile 1 EQ // find eq FTArticl by index.1
94917>>>>>>>>>
94917>>>>>>>>> if (found) begin
94919>>>>>>>>> get_field_value liArticleFile 2 to ldDate // FTArticl.Date
94922>>>>>>>>> move (ldDate>=ldFrom and ldDate<=ldTo) to lbOk
94923>>>>>>>>> if lbOk get bSelectArticle liArtId to lbOk
94926>>>>>>>>> if lbOK begin
94928>>>>>>>>> get_field_value liArticleFile 3 to lsTime // FTArticl.Time
94931>>>>>>>>> get_field_value liArticleFile 4 to liHitCount // FTArticl.Hit_Count
94934>>>>>>>>> send AddArticle of lhResultSorter liArtId ldDate lsTime liHitCount
94935>>>>>>>>> end
94935>>>>>>>>>>
94935>>>>>>>>> end
94935>>>>>>>>>>
94935>>>>>>>>> loop
94936>>>>>>>>>>
94936>>>>>>>>>
94936>>>>>>>>> // Now we check if we need to sort the articles according to date or hit count:
94936>>>>>>>>> get_field_value liSearchFile 10 to liOrder
94939>>>>>>>>> if (liOrder=1) send sort_rows_descending of lhResultSorter 1 2 // Date, Time
94942>>>>>>>>> if (liOrder=2) send sort_rows_descending of lhResultSorter 3 // Hit counter
94945>>>>>>>>>
94945>>>>>>>>> send DumpToChannel of lhResultSorter liChannel // Write to result file
94946>>>>>>>>> send DumpToArray of lhResultSorter lhFinalSet
94947>>>>>>>>> get row_count of lhResultSorter to liArticleCount
94948>>>>>>>>> send delete_data of lhResultSorter
94949>>>>>>>>> end
94949>>>>>>>>>>
94949>>>>>>>>> else begin
94950>>>>>>>>> move 0 to liArticleCount
94951>>>>>>>>> writeln channel liChannel (FT_ErrorText(liError))
94954>>>>>>>>> end
94954>>>>>>>>>>
94954>>>>>>>>>
94954>>>>>>>>> send SEQ_CloseOutput liChannel
94955>>>>>>>>> get MilliSeconds_Systime to lsStopTime // Mark the stoptime
94956>>>>>>>>>
94956>>>>>>>>> if (liError=FTIS_NO_ERROR and liArticleCount=0) move FTIS_NO_ITEMS_FOUND to liError
94959>>>>>>>>>
94959>>>>>>>>> reread liSearchFile
94963>>>>>>>>> set_field_value liSearchFile 4 to (dSysDate()) // SEARCH_DATE
94966>>>>>>>>> set_field_value liSearchFile 5 to (sSysTime()) // SEARCH_TIME
94969>>>>>>>>> set_field_value liSearchFile 6 to liArticleCount // RESULT_COUNT
94972>>>>>>>>> move (MilliSeconds_Elapsed(lsStartTime,lsStopTime)) to lnElap
94973>>>>>>>>> set_field_value liSearchFile 7 to lnElap // EXECUTION_TIME
94976>>>>>>>>> set_field_value liSearchFile 11 to liError // ERROR_CODE
94979>>>>>>>>> saverecord liSearchFile
94980>>>>>>>>> unlock
94981>>>>>>>>>>
94981>>>>>>>>>
94981>>>>>>>>> function_return liError
94982>>>>>>>>> end_function
94983>>>>>>>>>
94983>>>>>>>>> function iNextAvailableSearchId returns integer
94985>>>>>>>>> integer liFile liNewId
94985>>>>>>>>> get filenumber_ftsearch to liFile
94986>>>>>>>>>
94986>>>>>>>>> clear liFile
94987>>>>>>>>> set_field_value liFile 1 to 99999999 // // FTSEARCH.SEARCH_ID
94990>>>>>>>>> vfind liFile 1 LT
94992>>>>>>>>> if (found) get_field_value liFile 1 to liNewId
94997>>>>>>>>> else move 0 to liNewId
94999>>>>>>>>> increment liNewId
95000>>>>>>>>> clear liFile
95001>>>>>>>>> function_return liNewId
95002>>>>>>>>> end_function
95003>>>>>>>>>
95003>>>>>>>>> procedure DoPreCreateSearchRecord
95005>>>>>>>>> end_procedure
95006>>>>>>>>>
95006>>>>>>>>> procedure DoCreateSearch integer liUserId string lsSearchString date ldFrom date ldTo integer liOrderby
95008>>>>>>>>> integer liSearchFile liNewId liError
95008>>>>>>>>>
95008>>>>>>>>> get filenumber_ftsearch to liSearchFile
95009>>>>>>>>> lock
95010>>>>>>>>>>
95010>>>>>>>>> get iNextAvailableSearchId to liNewId
95011>>>>>>>>> clear liSearchFile
95012>>>>>>>>>
95012>>>>>>>>> set_field_value liSearchFile 1 to liNewId // FTSEARCH.SEARCH_ID
95015>>>>>>>>> set_field_value liSearchFile 2 to liUserId // FTSEARCH.USER_ID
95018>>>>>>>>> set_field_value liSearchFile 3 to lsSearchString // FTSEARCH.SEARCH_STRING
95021>>>>>>>>> set_field_value liSearchFile 8 to ldFrom // FTSEARCH.LOW_DATE_LIMIT
95024>>>>>>>>> set_field_value liSearchFile 9 to ldTo // FTSEARCH.HIGH_DATE_LIMIT
95027>>>>>>>>> set_field_value liSearchFile 10 to liOrderBy // FTSEARCH.ORDER_BY
95030>>>>>>>>>
95030>>>>>>>>> send DoPreCreateSearchRecord
95031>>>>>>>>>
95031>>>>>>>>> saverecord liSearchFile
95032>>>>>>>>> unlock
95033>>>>>>>>>>
95033>>>>>>>>> get iDoSearchActiveSearchRecord to liError
95034>>>>>>>>> end_procedure
95035>>>>>>>>>
95035>>>>>>>>> function result_count returns integer
95037>>>>>>>>> function_return (item_count(oFinalSet(self)))
95038>>>>>>>>> end_function
95039>>>>>>>>> function result_article integer liItm returns integer
95041>>>>>>>>> function_return (value(oFinalSet(self),liItm))
95042>>>>>>>>> end_function
95043>>>>>>>>>
95043>>>>>>>>> procedure end_construct_object
95045>>>>>>>>> integer lhSelf
95045>>>>>>>>> forward send end_construct_object
95047>>>>>>>>> move self to lhSelf
95048>>>>>>>>> set phSearcherObject to lhSelf // This is resolved in the encapsulating cFTS_System object
95049>>>>>>>>> end_procedure
95050>>>>>>>>>
95050>>>>>>>>>end_class // cFTS_Searcher
95051>>>>>use gridutil.utl
95051>>>>>use strings.utl
95051>>>>>Use MsgBox.utl // obs procedure
95051>>>>>
95051>>>>>Use FTSData.nui // cFTS_TableAccess class.
95051>>>>>Use FTSTblCr.pkg // Free text search - Create FTS tables (FTS_CreateTables)
95051>>>>>Use API_Attr.nui // Functions for querying API attributes (No User Interface)
95051>>>>>Use Version.nui
95051>>>>>Use ToolUtilities.pkg // aps.YellowBox class
95051>>>>>Use FTSCreate.pkg // Wizard for creating (and another one for dropping) a set of FTS tables
95051>>>>>
95051>>>>>
95051>>>>>object oDefaultFTS_System is a cFTS_System
95053>>>>> set phAllowFastViewToRebuild to false
95054>>>>> object oWordSplitter is a cFTS_WordSplitter
95056>>>>> set psLetters to FTS_WORDCHARACTERS_ENGLISH // Englidh letters
95057>>>>> set pbCrLfCanBeTrusted to True
95058>>>>> end_object
95059>>>>> object oTableAccess is a cFTS_TableAccess
95061>>>>> set psRootNamePrefix to "ft"
95062>>>>> set psPurpose to "Default"
95063>>>>> set pbOpenTablesOnDefine to false // Do not open tables on definition
95064>>>>> function bConvertFilelistTo4095 returns integer
95067>>>>> function_return (MB_Verify4("Your filelist.cfg is an old one","with less than 256 entries.","","Should it be converted to a 4095 entry filelist?",1))
95068>>>>> end_function
95069>>>>> end_object
95070>>>>> object oIndexer is a cFTS_Indexer
95072>>>>> end_object
95073>>>>> object oSearcher is a cFTS_Searcher
95075>>>>> end_object
95076>>>>> object oBrowser is a cFTS_ResultBrowser
95078>>>>> end_object
95079>>>>>end_object // oDefaultFTS_System
95080>>>>>
95080>>>>>object oFTS_OpenTablesDialog is a aps.ModalPanel label "Open FTS tables"
95083>>>>> set locate_mode to CENTER_ON_SCREEN
95084>>>>> on_key ksave_record send close_panel_ok
95085>>>>> on_key kcancel send close_panel
95086>>>>> property integer pbResult
95088>>>>> object oYellow is a aps.YellowBox
95090>>>>> set size to 40 300
95091>>>>> set value item 0 to "Using this dialog you may open an existing set of FTS tables or create a new set of FTS tables."
95092>>>>> set value item 1 to ""
95093>>>>> set value item 2 to 'If you have compiled a custom FTS handling object into this application you also have the option to select which FTS handler object (other than the one labelled "default") should be used to open the tables.'
95094>>>>> end_object
95095>>>>> send aps_goto_max_row
95096>>>>> send aps_make_row_space 5
95097>>>>> object oLabel1 is a aps.TextBox label "Open this set of FTS tables:"
95100>>>>> set fixed_size to 10 200
95101>>>>> set Fontweight to 900
95102>>>>> end_object
95103>>>>> send aps_goto_max_row
95104>>>>> object oExisting is a aps.Grid
95106>>>>> send GridPrepare_AddColumn "" AFT_ASCII6
95107>>>>> send GridPrepare_AddColumn "Existing sets of FTS tables" AFT_ASCII40
95108>>>>> send GridPrepare_Apply self
95109>>>>> set select_mode to NO_SELECT
95110>>>>> on_key KNEXT_ITEM send switch
95111>>>>> on_key KPREVIOUS_ITEM send switch_back
95112>>>>> set size to 43 0
95113>>>>> procedure fill_list
95116>>>>> integer lhTableAccessObject lhObj liMax liRow
95116>>>>> move oDefaultFTS_System to lhTableAccessObject
95117>>>>> get phTableAccessObject of lhTableAccessObject to lhTableAccessObject
95118>>>>> send delete_data
95119>>>>> send DoBuildSetsOfTables of lhTableAccessObject
95120>>>>> move (oListOfSets(lhTableAccessObject)) to lhObj
95121>>>>> get row_count of lhObj to liMax
95122>>>>> decrement liMax
95123>>>>> for liRow from 0 to liMax
95129>>>>>>
95129>>>>> send add_item MSG_NONE (psPrefix.i(lhobj,liRow))
95130>>>>> send add_item MSG_NONE (psOpenDescription.i(lhobj,liRow))
95131>>>>> loop
95132>>>>>>
95132>>>>> send Grid_SetEntryState self 0
95133>>>>> end_procedure
95134>>>>> function sCurrentPrefix returns string
95137>>>>> integer liBase
95137>>>>> if (item_count(self)) begin
95139>>>>> get Grid_BaseItem self to liBase
95140>>>>> function_return (value(self,liBase))
95141>>>>> end
95141>>>>>>
95141>>>>> function_return ""
95142>>>>> end_function
95143>>>>> end_object // oExisting
95144>>>>> procedure DoCreate
95147>>>>> send Popup_FTS_CreateTablesWizard
95148>>>>> send fill_list of oExisting
95149>>>>> end_procedure
95150>>>>> object oCreateBtn is a aps.Button snap SL_RIGHT_SPACE
95153>>>>> set size to 14 50
95154>>>>> on_item "Create new" send DoCreate
95155>>>>> end_object
95156>>>>> send aps_goto_max_row
95157>>>>> send aps_make_row_space 5
95158>>>>> object oLabel2 is a aps.TextBox label "Using this FTS controller:"
95161>>>>> set fixed_size to 10 200
95162>>>>> set Fontweight to 900
95163>>>>> end_object
95164>>>>> send aps_goto_max_row
95165>>>>> object oControllerGrid is a aps.Grid
95167>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
95168>>>>> Set peResizeColumn to rcSelectedColumn // make sure mode is correct
95169>>>>> Set piResizeColumn to 1 // this is the column to resize
95170>>>>> set size to 43 0
95171>>>>> send GridPrepare_AddColumn "Purpose" AFT_ASCII10
95172>>>>> send GridPrepare_AddColumn "Object name" AFT_ASCII40
95173>>>>> send GridPrepare_AddColumn "Can update" AFT_ASCII3
95174>>>>> send GridPrepare_Apply self
95175>>>>> set select_mode to NO_SELECT
95176>>>>> on_key KNEXT_ITEM send switch
95177>>>>> on_key KPREVIOUS_ITEM send switch_back
95178>>>>> procedure fill_list
95181>>>>> integer lhArray liRow liMax liBase lhTableAccess lhFTS
95181>>>>> send delete_data
95182>>>>> move oFTS_SystemList to lhArray
95183>>>>> get row_count of lhArray to liMax
95184>>>>> decrement liMax
95185>>>>> for liRow from 0 to liMax
95191>>>>>>
95191>>>>> get item_count to liBase
95192>>>>> get phFTS_System.i of lhArray liRow to lhFTS
95193>>>>> get phTableAccessObject of lhFTS to lhTableAccess
95194>>>>> send add_item MSG_NONE (psPurpose(lhTableAccess))
95195>>>>> set aux_value item liBase to lhFTS
95196>>>>> send add_item MSG_NONE (name(lhFTS))
95197>>>>> if (phAllowFastViewToRebuild(lhFTS)) send add_item MSG_NONE "yes"
95200>>>>> else send add_item MSG_NONE "no"
95202>>>>> loop
95203>>>>>>
95203>>>>> send Grid_SetEntryState self DFFALSE
95204>>>>> end_procedure
95205>>>>> send fill_list
95206>>>>> function hCurrentFTS returns integer
95209>>>>> integer liBase
95209>>>>> if (item_count(self)) begin
95211>>>>> get Grid_BaseItem self to liBase
95212>>>>> function_return (aux_value(self,liBase))
95213>>>>> end
95213>>>>>>
95213>>>>> function_return 0
95214>>>>> end_function
95215>>>>> end_object // oGrid
95216>>>>> procedure close_panel_ok
95219>>>>> set pbResult to true
95220>>>>> send close_panel
95221>>>>> end_procedure
95222>>>>> object oBtn1 is a aps.Multi_Button
95224>>>>> on_item "Open" send close_panel_ok
95225>>>>> set peAnchors to (anBottom+anRight)
95226>>>>> end_object
95227>>>>> object oBtn2 is a aps.Multi_Button
95229>>>>> on_item "Cancel" send close_panel
95230>>>>> set peAnchors to (anBottom+anRight)
95231>>>>> end_object
95232>>>>> send aps_locate_multi_buttons
95233>>>>> function hPopup returns integer
95236>>>>> integer lhFTS lbOpen
95236>>>>> string lsPrefix
95236>>>>> set pbResult to false
95237>>>>> send fill_list of oExisting
95238>>>>> send popup
95239>>>>> if (pbResult(self)) begin
95241>>>>> get hCurrentFTS of oControllerGrid to lhFTS
95242>>>>> get sCurrentPrefix of oExisting to lsPrefix
95243>>>>> if (lhFTS<>0 and lsPrefix<>"") begin
95245>>>>> set psRootNamePrefix of (phTableAccessObject(lhFTS)) to lsPrefix
95246>>>>> get DoOpenTables of (phTableAccessObject(lhFTS)) to lbOpen
95247>>>>> ifnot lbOpen begin
95249>>>>> error 214 "tables could not be opened"
95250>>>>>>
95250>>>>> move 0 to lbOpen
95251>>>>> move 0 to lhFTS
95252>>>>> end
95252>>>>>>
95252>>>>> end
95252>>>>>>
95252>>>>> else begin
95253>>>>> error 213 "No tables found"
95254>>>>>>
95254>>>>> move 0 to lhFTS
95255>>>>> end
95255>>>>>>
95255>>>>> end
95255>>>>>>
95255>>>>> else move 0 to lhFTS
95257>>>>> function_return lhFTS
95258>>>>> end_function
95259>>>>> procedure aps_beautify
95262>>>>> send aps_align_inside_container_by_sizing (oYellow(self)) SL_ALIGN_RIGHT
95263>>>>> end_procedure
95264>>>>>end_object // oFTS_OpenTablesDialog
95265>>>>>
95265>>>>>object oFTS_ControlView is a aps.View label "FTS Control Panel"
95268>>>>>
95268>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
95269>>>>> set Window_Style to WS_MAXIMIZEBOX 1
95270>>>>> on_key kCancel send close_panel
95271>>>>> property integer phFTS_SystemObject public (oDefaultFTS_System(self))
95273>>>>> function hTableAccessObject returns integer
95276>>>>> integer lhFTS
95276>>>>> get phFTS_SystemObject to lhFTS
95277>>>>> function_return (phTableAccessObject(lhFTS))
95278>>>>> end_function
95279>>>>>
95279>>>>> object oPrefix is a aps.Form label "FTS tables name prefix:" abstract AFT_ASCII2
95283>>>>> set p_extra_internal_width to 10
95284>>>>> set enabled_state to false
95285>>>>> end_object
95286>>>>> object oFTSObjectName is a aps.Form label "FTS controller object:" abstract AFT_ASCII80 snap SL_RIGHT_SPACE
95291>>>>> set p_extra_internal_width to -120
95292>>>>> set enabled_state to false
95293>>>>> set peAnchors to (anTop+anLeft+anRight)
95294>>>>> end_object
95295>>>>>
95295>>>>> object oOpenBtn is a aps.Multi_Button
95297>>>>> on_item "Open tables" send DoFtsTablesOpen
95298>>>>> set peAnchors to (anTop+anRight)
95299>>>>> end_object
95300>>>>> object oDropBtn is a aps.Multi_Button
95302>>>>> on_item "Drop tables" send DoFtsTablesDrop
95303>>>>> set peAnchors to (anTop+anRight)
95304>>>>> end_object
95305>>>>> object oCloseBtn is a aps.Multi_Button
95307>>>>> on_item "Close tables" send DoFtsTablesClose
95308>>>>> set enabled_state to false
95309>>>>> set peAnchors to (anTop+anRight)
95310>>>>> end_object
95311>>>>> send aps_locate_multi_buttons
95312>>>>>
95312>>>>> send aps_goto_max_row
95313>>>>> send aps_make_row_space 5
95314>>>>>
95314>>>>> object oTabs is a aps.TabDialog
95316>>>>> set peAnchors to (anTop+anRight+anBottom+anLeft)
95317>>>>> set p_auto_column to 0
95318>>>>> object oTableAccessTab is a aps.TabPage label "Table Access"
95321>>>>>
95321>>>>> object oLabel1 is a aps.TextBox label "These tables are currently opened:"
95324>>>>> set fixed_size to 10 200
95325>>>>> set Fontweight to 900
95326>>>>> end_object
95327>>>>> send aps_goto_max_row
95328>>>>> object oGrid is a aps.Grid
95330>>>>> send GridPrepare_AddColumn "Table" AFT_ASCII10
95331>>>>> send GridPrepare_AddColumn "User display name" AFT_ASCII32
95332>>>>> send GridPrepare_AddColumn "Filelist" AFT_NUMERIC4.0
95333>>>>> send GridPrepare_AddColumn "# Records" AFT_NUMERIC8.0
95334>>>>> send GridPrepare_Apply self
95335>>>>> set select_mode to NO_SELECT
95336>>>>> on_key KNEXT_ITEM send switch
95337>>>>> on_key KPREVIOUS_ITEM send switch_back
95338>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
95339>>>>> set peResizeColumn to rcSelectedColumn // make sure mode is correct
95340>>>>> set piResizeColumn to 1 // this is the column to resize
95341>>>>> set size to 62 0
95342>>>>> procedure fill_list
95345>>>>> integer liMax liRow lhTableAccess liFile liRecords
95345>>>>> string lsValue
95345>>>>> get hTableAccessObject to lhTableAccess
95346>>>>> send delete_data
95347>>>>> get row_count of lhTableAccess to liMax
95348>>>>> decrement liMax
95349>>>>> for liRow from 0 to liMax
95355>>>>>>
95355>>>>> if (piOpenState.i(lhTableAccess,liRow)) begin
95357>>>>> get piFile.i of lhTableAccess liRow to liFile
95358>>>>> if liFile get_attribute DF_FILE_LOGICAL_NAME of liFile to lsValue
95363>>>>> else move "" to lsValue
95365>>>>> send add_item MSG_NONE (lowercase(lsValue))
95366>>>>> if liFile get_attribute DF_FILE_DISPLAY_NAME of liFile to lsValue
95371>>>>> move (rtrim(lsValue)) to lsValue
95372>>>>> send add_item MSG_NONE (lowercase(lsValue))
95373>>>>> send add_item MSG_NONE (string(liFile))
95374>>>>> get_attribute DF_FILE_RECORDS_USED of liFile to liRecords
95377>>>>> send add_item MSG_NONE (string(liRecords))
95378>>>>> end
95378>>>>>>
95378>>>>> loop
95379>>>>>>
95379>>>>> send Grid_SetEntryState self false
95380>>>>> end_procedure
95381>>>>> end_object // oGrid
95382>>>>> send aps_goto_max_row
95383>>>>> send aps_make_row_space 10
95384>>>>> procedure DoRebuildIndex
95387>>>>> integer lbOK
95387>>>>> get MB_Verify4 "This will rebuild the FTS index from scratch. It may" "therefore be a lengthy operation that" "you hereby agree to. By the way, do you?" "" 0 to lbOK
95388>>>>> if lbOK begin
95390>>>>> send DoRebuildFtsIndex of (phFTS_SystemObject(self))
95391>>>>> send fill_list of oGrid
95392>>>>> send obs "Rebuild complete"
95393>>>>> end
95393>>>>>>
95393>>>>> end_procedure
95394>>>>> procedure DoRefreshGrid
95397>>>>> send fill_list of oGrid
95398>>>>> end_procedure
95399>>>>> object oRefreshBtn is a aps.Button
95401>>>>> set peAnchors to (anLeft+anBottom+anRight)
95402>>>>> on_item "Refresh list" send DoRefreshGrid
95403>>>>> end_object
95404>>>>> send aps_goto_max_row
95405>>>>> object oRebuildBtn is a aps.Button
95407>>>>> set peAnchors to (anLeft+anBottom+anRight)
95408>>>>> on_item "Rebuild index" send DoRebuildIndex
95409>>>>> end_object
95410>>>>> procedure aps_beautify
95413>>>>> send aps_align_inside_container_by_moving (oGrid(self)) SL_ALIGN_CENTER
95414>>>>> send aps_align_inside_container_by_moving (oRefreshBtn(self)) SL_ALIGN_CENTER
95415>>>>> send aps_align_inside_container_by_moving (oRebuildBtn(self)) SL_ALIGN_CENTER
95416>>>>> end_procedure
95417>>>>> end_object // oTableAccessTab
95418>>>>>
95418>>>>>
95418>>>>> object oSearchTab is a aps.TabPage label "Search"
95421>>>>> object oSearchString is a aps.Form label "Search value:" abstract AFT_ASCII80
95425>>>>> set p_extra_internal_width to -200
95426>>>>> end_object
95427>>>>> object oBtn is a aps.Button snap SL_RIGHT_SPACE
95430>>>>> on_item "Search" send DoSearch
95431>>>>> end_object
95432>>>>> send aps_goto_max_row
95433>>>>> object oGrid is a aps.Grid
95435>>>>> set size to 200 0
95436>>>>> send GridPrepare_AddColumn "Field" AFT_NUMERIC3.0
95437>>>>> send GridPrepare_AddColumn "Name" AFT_ASCII15
95438>>>>> send GridPrepare_AddColumn "Value" AFT_ASCII60
95439>>>>> send GridPrepare_Apply self
95440>>>>> set select_mode to NO_SELECT
95441>>>>> on_key KNEXT_ITEM send switch
95442>>>>> on_key KPREVIOUS_ITEM send switch_back
95443>>>>> procedure fill_list
95446>>>>> integer liFile liField liMax lhTableAccessObject lhSearcherObject liError
95446>>>>> string lsValue
95446>>>>> send delete_data
95447>>>>> send UpdateError ""
95448>>>>> get hTableAccessObject to lhTableAccessObject
95449>>>>> move (phSearcherObject(phFTS_SystemObject(self))) to lhSearcherObject
95450>>>>> if (pbAllTablesAreOpen(lhTableAccessObject)) begin
95452>>>>> get value of oSearchString to lsValue
95453>>>>>
95453>>>>> send DoCreateSearch of lhSearcherObject -1 lsValue 0 0 0
95454>>>>> get piFile.i of lhTableAccessObject FTSTABLE_SEARCH to liFile
95455>>>>>
95455>>>>> get_attribute DF_FILE_NUMBER_FIELDS of liFile to liMax
95458>>>>> for liField from 1 to liMax
95464>>>>>>
95464>>>>> send add_item MSG_NONE liField
95465>>>>> get_attribute DF_FIELD_NAME of liFile liField to lsValue
95468>>>>> send add_item MSG_NONE lsValue
95469>>>>> get_field_value liFile liField to lsValue
95472>>>>> send add_item MSG_NONE lsValue
95473>>>>> loop
95474>>>>>>
95474>>>>> send Grid_SetEntryState self DFFALSE
95475>>>>> get_field_value liFile 11 to liError // ERROR_CODE
95478>>>>> get FT_ErrorText liError to lsValue
95479>>>>> send UpdateError lsValue
95480>>>>> end
95480>>>>>>
95480>>>>> else send obs "Tables need to be opened"
95482>>>>> end_procedure
95483>>>>> end_object
95484>>>>> send aps_goto_max_row
95485>>>>> object oErrorMessage is a aps.Form abstract AFT_ASCII40
95488>>>>> set enabled_state to false
95489>>>>> end_object
95490>>>>> procedure UpdateError string lsValue
95493>>>>> set value of oErrorMessage to lsValue
95494>>>>> end_procedure
95495>>>>> send aps_size_identical_max (oGrid(Self)) (oErrorMessage(self)) SL_HORIZONTAL
95496>>>>> procedure DoSearch
95499>>>>> send fill_list of oGrid
95500>>>>> end_procedure
95501>>>>> end_object // oSearch
95502>>>>> object oWordSplitterTab is a aps.TabPage label "Test Word Splitter"
95505>>>>> object oLetters is a aps.Form abstract AFT_ASCII255 label "Legal letters"
95509>>>>> set peAnchors to (anTop+anLeft+anRight)
95510>>>>> set p_extra_internal_width to -900
95511>>>>> procedure DoDefaultValue
95514>>>>> string lsValue
95514>>>>> set delegation_mode to DELEGATE_TO_PARENT
95515>>>>> get psLetters of (phWordsplitterObject(phFTS_SystemObject(self))) to lsValue
95516>>>>> set value item 0 to (FTS_Parameter(FTS_WORDCHARACTERS))
95517>>>>> end_procedure
95518>>>>> procedure OnChange
95521>>>>> send update_list
95522>>>>> end_procedure
95523>>>>> end_object
95524>>>>> procedure MakeLettersDanish
95527>>>>> set value of oLetters to FTS_WORDCHARACTERS_DANISH
95528>>>>> end_procedure
95529>>>>> procedure MakeLettersEnglish
95532>>>>> set value of oLetters to FTS_WORDCHARACTERS_ENGLISH
95533>>>>> end_procedure
95534>>>>> send aps_goto_max_row
95535>>>>> object oBtn_DK is a aps.Button
95537>>>>> set peAnchors to (anTop+anRight)
95538>>>>> on_item "Danish" send MakeLettersDanish
95539>>>>> end_object
95540>>>>> object oBtn_UK is a aps.Button snap SL_RIGHT
95543>>>>> set peAnchors to (anTop+anRight)
95544>>>>> on_item "English" send MakeLettersEnglish
95545>>>>> end_object
95546>>>>> object oBelow32 is a aps.CheckBox label "Paragraphs can be trusted to not include CR/LF characters" snap SL_RIGHT_SPACE
95550>>>>> set peAnchors to (anTop+anLeft)
95551>>>>> procedure DoDefaultValue
95554>>>>> integer lbState
95554>>>>> set delegation_mode to DELEGATE_TO_PARENT
95555>>>>> get pbCrLfCanBeTrusted of (phWordsplitterObject(phFTS_SystemObject(self))) to lbState
95556>>>>> set checked_state to lbState
95557>>>>> end_procedure
95558>>>>> procedure OnChange
95561>>>>> send update_list
95562>>>>> end_procedure
95563>>>>> end_object
95564>>>>> send aps_goto_max_row
95565>>>>> object oText is a aps.Edit label "Test this text (cut and paste something here):"
95568>>>>> set peAnchors to (anTop+anRight+anBottom+anLeft)
95569>>>>> set label_justification_mode to JMODE_TOP
95570>>>>> set size to 180 220
95571>>>>> procedure OnChange
95574>>>>> send update_list
95575>>>>> end_procedure
95576>>>>> end_object
95577>>>>> object oResultGrid is a aps.Grid snap SL_RIGHT
95580>>>>> set peAnchors to (anTop+anRight+anBottom)
95581>>>>> set size to 160 0
95582>>>>> send GridPrepare_AddColumn "#" AFT_ASCII4
95583>>>>> send GridPrepare_AddColumn "Word" AFT_ASCII40
95584>>>>> send GridPrepare_Apply self
95585>>>>> set select_mode to NO_SELECT
95586>>>>> on_key KNEXT_ITEM send switch
95587>>>>> on_key KPREVIOUS_ITEM send switch_back
95588>>>>> on_key KEY_CTRL+KEY_R send sort_data
95589>>>>>
95589>>>>> function iSpecialSortValueOnColumn.i integer column# returns integer
95592>>>>> if column# eq 0 function_Return 1
95595>>>>> end_function
95596>>>>>
95596>>>>> function sSortValue.ii integer column# integer itm# returns string
95599>>>>> if column# eq 0 function_return (IntToStrR(value(self,itm#),4))
95602>>>>> end_function
95603>>>>>
95603>>>>> procedure sort_data.i integer column#
95606>>>>> send Grid_SortByColumn self column#
95607>>>>> end_procedure
95608>>>>>
95608>>>>> procedure sort_data
95611>>>>> integer cc#
95611>>>>> get Grid_CurrentColumn self to cc#
95612>>>>> send sort_data.i cc#
95613>>>>> end_procedure
95614>>>>>
95614>>>>> procedure header_mouse_click integer itm#
95617>>>>> send sort_data.i itm#
95618>>>>> forward send header_mouse_click itm#
95620>>>>> end_procedure
95621>>>>>
95621>>>>> procedure fill_list
95624>>>>> integer lbBelow32 lhWordSplitter liRow liMax
95624>>>>> string lsLetters lsText lsWord
95624>>>>> set dynamic_update_state to DFFALSE
95625>>>>> send delete_data
95626>>>>>
95626>>>>> get value of oLetters to lsLetters
95627>>>>> get checked_state of oBelow32 to lbBelow32
95628>>>>> get Text_EditObjectValue (oText(self)) to lsText
95629>>>>>
95629>>>>> get phWordsplitterObject of (phFTS_SystemObject(self)) to lhWordSplitter
95630>>>>> set psLetters of lhWordSplitter to lsLetters
95631>>>>> set pbCrLfCanBeTrusted of lhWordSplitter to lbBelow32
95632>>>>>
95632>>>>> send DoReset of lhWordSplitter
95633>>>>> send DoAddText of lhWordSplitter lsText
95634>>>>>
95634>>>>> get row_count of lhWordSplitter to liMax
95635>>>>> decrement liMax
95636>>>>> for liRow from 0 to liMax
95642>>>>>>
95642>>>>> send add_item MSG_NONE (liRow+1)
95643>>>>> send add_item MSG_NONE (psWord.i(lhWordSplitter,liRow))
95644>>>>> loop
95645>>>>>>
95645>>>>>
95645>>>>> send Grid_SetEntryState self DFFALSE
95646>>>>> send update_totals (liMax+1)
95647>>>>> set dynamic_update_state to DFTRUE
95648>>>>> end_procedure
95649>>>>> end_object // oResultGrid
95650>>>>> object oTotalWords is a aps.Form abstract AFT_ASCII40 snap SL_DOWN
95654>>>>> set peAnchors to (anRight+anBottom)
95655>>>>> set enabled_state to false
95656>>>>> end_object
95657>>>>> send aps_size_identical_max (oTotalWords(self)) (oResultGrid(self)) SL_HORIZONTAL
95658>>>>>
95658>>>>> procedure update_totals integer liWordCount
95661>>>>> set value of oTotalWords to ("Total words: "+string(liWordCount))
95662>>>>> end_procedure
95663>>>>> procedure update_list
95666>>>>> send fill_list of oResultGrid
95667>>>>> end_procedure
95668>>>>> end_object // oWordSplitterTab
95669>>>>> end_object // oTabs
95670>>>>>
95670>>>>> procedure DoFtsTablesClose
95673>>>>> integer lhTableAccess
95673>>>>> get hTableAccessObject to lhTableAccess
95674>>>>> send DoCloseTables of lhTableAccess
95675>>>>> set value of oPrefix to ""
95676>>>>> set value of oFTSObjectName to ""
95677>>>>> send fill_list of (oGrid(oTableAccessTab(oTabs(self))))
95678>>>>> set enabled_state of oCloseBtn to false
95679>>>>> set enabled_state of oOpenBtn to true
95680>>>>> set enabled_state of oDropBtn to true
95681>>>>> end_procedure
95682>>>>> procedure DoFtsTablesDrop
95685>>>>> integer lhFTS
95685>>>>> move (oDefaultFTS_System(self)) to lhFTS
95686>>>>> send Popup_FTS_DropTablesWizard lhFTS
95687>>>>> end_procedure
95688>>>>> procedure DoFtsTablesOpen
95691>>>>> integer lhFTS
95691>>>>> get hPopup of oFTS_OpenTablesDialog to lhFTS
95692>>>>> if lhFTS begin
95694>>>>> set phFTS_SystemObject to lhFTS
95695>>>>> send fill_list of (oGrid(oTableAccessTab(oTabs(self))))
95696>>>>> set value of oPrefix to (psRootNamePrefix(phTableAccessObject(lhFTS)))
95697>>>>> set value of oFTSObjectName to (name(lhFTS))
95698>>>>> set enabled_state of oCloseBtn to true
95699>>>>> set enabled_state of oOpenBtn to false
95700>>>>> set enabled_state of oDropBtn to false
95701>>>>> end
95701>>>>>>
95701>>>>> end_procedure
95702>>>>> procedure popup
95705>>>>> broadcast recursive send DoDefaultValue
95707>>>>> forward send popup
95709>>>>> end_procedure
95710>>>>> object oCloseBtn is a aps.Multi_Button
95712>>>>> set peAnchors to (anRight+anBottom)
95713>>>>> on_item "Close" send close_panel
95714>>>>> end_object
95715>>>>> procedure aps_beautify
95718>>>>> send aps_beautify of (oTableAccessTab(oTabs(self)))
95719>>>>> end_procedure
95720>>>>> send aps_locate_multi_buttons
95721>>>>>end_object // oFTS_ControlView
95722>>>>>send aps_SetMinimumDialogSize (oFTS_ControlView(self))
95723>>>>>
95723>>>>>procedure Popup_FTS_ControlPanel
95726>>>>> send popup of oFTS_ControlView
95727>>>>>end_procedure
95728>>>>>
95728>>> //Use FastView.pkg
95728>>>
95728>>> Use FvDynamo.pkg // Part that generates the view based on vw-definition
Including file: fvdynamo.pkg (C:\Apps\VDFQuery\AppSrc\fvdynamo.pkg)
95728>>>>>// This FvDynamo.pkg package MUST be used at Main-ClientArea level!!!
95728>>>>>// Use FvDynamo.pkg // Part that generates the view based on vw-definition
95728>>>>>
95728>>>>>Use Dynamo.utl // Dynamic creation of objects for VDF
95728>>>>>Use FvVwDefn.pkg // FastView, View definition cls (cFastView_ViewDefinition)
Including file: fvvwdefn.pkg (C:\Apps\VDFQuery\AppSrc\fvvwdefn.pkg)
95728>>>>>>>// Use FvVwDefn.pkg // FastView, View definition cls (cFastView_ViewDefinition)
95728>>>>>>>
95728>>>>>>>Use Files.utl // Utilities for handling file related stuff
95728>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
95728>>>>>>>Use FvHomDir.pkg // Dialogs for saving and opening FastViews
Including file: fvhomdir.pkg (C:\Apps\VDFQuery\AppSrc\fvhomdir.pkg)
95728>>>>>>>>>// Use FvHomDir.pkg // Dialogs for saving and opening FastViews
95728>>>>>>>>>
95728>>>>>>>>>Use Files.utl // Utilities for handling file related stuff
95728>>>>>>>>>Use ItemProp.nui // ITEM_PROPERTY command for use within arrays
95728>>>>>>>>>Use WildCard.nui // WildCardMatch function
95728>>>>>>>>>Use WinUser.nui // User_Windows_User_Name function
95728>>>>>>>>>
95728>>>>>>>>>desktop_section
95733>>>>>>>>> object oFastViewsOnDisk is a cArray
95735>>>>>>>>> property string psCurrentDirectory public ""
95737>>>>>>>>> property string psCurrentMask public ""
95739>>>>>>>>> property integer piCurrentSortOrder public 0
95741>>>>>>>>> item_property_list
95741>>>>>>>>> item_property string psFileName.i
95741>>>>>>>>> item_property integer piMainFile.i
95741>>>>>>>>> item_property integer piChildFile.i
95741>>>>>>>>> item_property integer piViewType.i
95741>>>>>>>>> item_property string psViewTitle.i
95741>>>>>>>>> item_property string psMainFileName.i
95741>>>>>>>>> item_property number pnDateTime.i
95741>>>>>>>>> item_property integer piSize.i
95741>>>>>>>>> end_item_property_list
#REM 95796 DEFINE FUNCTION PISIZE.I INTEGER LIROW RETURNS INTEGER
#REM 95801 DEFINE PROCEDURE SET PISIZE.I INTEGER LIROW INTEGER VALUE
#REM 95806 DEFINE FUNCTION PNDATETIME.I INTEGER LIROW RETURNS NUMBER
#REM 95811 DEFINE PROCEDURE SET PNDATETIME.I INTEGER LIROW NUMBER VALUE
#REM 95816 DEFINE FUNCTION PSMAINFILENAME.I INTEGER LIROW RETURNS STRING
#REM 95821 DEFINE PROCEDURE SET PSMAINFILENAME.I INTEGER LIROW STRING VALUE
#REM 95826 DEFINE FUNCTION PSVIEWTITLE.I INTEGER LIROW RETURNS STRING
#REM 95831 DEFINE PROCEDURE SET PSVIEWTITLE.I INTEGER LIROW STRING VALUE
#REM 95836 DEFINE FUNCTION PIVIEWTYPE.I INTEGER LIROW RETURNS INTEGER
#REM 95841 DEFINE PROCEDURE SET PIVIEWTYPE.I INTEGER LIROW INTEGER VALUE
#REM 95846 DEFINE FUNCTION PICHILDFILE.I INTEGER LIROW RETURNS INTEGER
#REM 95851 DEFINE PROCEDURE SET PICHILDFILE.I INTEGER LIROW INTEGER VALUE
#REM 95856 DEFINE FUNCTION PIMAINFILE.I INTEGER LIROW RETURNS INTEGER
#REM 95861 DEFINE PROCEDURE SET PIMAINFILE.I INTEGER LIROW INTEGER VALUE
#REM 95866 DEFINE FUNCTION PSFILENAME.I INTEGER LIROW RETURNS STRING
#REM 95871 DEFINE PROCEDURE SET PSFILENAME.I INTEGER LIROW STRING VALUE
95877>>>>>>>>> procedure AddFile string lsFile string lsDir integer liSize number lnDateTime
95880>>>>>>>>> integer liFile liChannel liRow
95880>>>>>>>>> string lsViewTitle lsChildName
95880>>>>>>>>> if (WildCardMatch(lsFile)) begin
95882>>>>>>>>> get row_count to liRow
95883>>>>>>>>> set psFileName.i liRow to lsFile
95884>>>>>>>>> get SEQ_ComposeAbsoluteFileName lsDir lsFile to lsFile
95885>>>>>>>>> get SEQ_DirectInput lsFile to liChannel
95886>>>>>>>>> set pnDateTime.i liRow to lnDateTime
95887>>>>>>>>> set piSize.i liRow to liSize
95888>>>>>>>>> if (liChannel>-1) begin
95890>>>>>>>>> readln channel liChannel lsFile
95892>>>>>>>>> if (lsFile="FastView 1.0 - View definition") begin
95894>>>>>>>>> readln lsViewTitle
95895>>>>>>>>> set psViewTitle.i liRow to lsViewTitle
95896>>>>>>>>> readln liFile // ViewType
95897>>>>>>>>> set piViewType.i liRow to liFile // ViewType
95898>>>>>>>>> readln lsFile // Throw away UseGenericDD
95899>>>>>>>>> readln liFile // Main File
95900>>>>>>>>> set piMainFile.i liRow to liFile
95901>>>>>>>>> set psMainFileName.i liRow to (rtrim(FDX_AttrValue_FILE(ghFDX,DF_FILE_DISPLAY_NAME,liFile)))
95902>>>>>>>>> readln liFile // Child file
95903>>>>>>>>> set piChildFile.i liRow to liFile
95904>>>>>>>>> if (lsViewTitle="") begin
95906>>>>>>>>> get piMainFile.i liRow to liFile
95907>>>>>>>>> get FDX_AttrValue_FILELIST ghFDX DF_FILE_DISPLAY_NAME liFile to lsViewTitle
95908>>>>>>>>> move (rtrim(lsViewTitle)) to lsViewTitle
95909>>>>>>>>> get piChildFile.i liRow to liFile
95910>>>>>>>>> if liFile begin
95912>>>>>>>>> get FDX_AttrValue_FILELIST ghFDX DF_FILE_DISPLAY_NAME liFile to lsChildName
95913>>>>>>>>> move (rtrim(lsChildName)) to lsChildName
95914>>>>>>>>> move (lsViewTitle*"/"*lsChildName) to lsViewTitle
95915>>>>>>>>> end
95915>>>>>>>>>>
95915>>>>>>>>> set psViewTitle.i liRow to lsViewTitle
95916>>>>>>>>> end
95916>>>>>>>>>>
95916>>>>>>>>> end
95916>>>>>>>>>>
95916>>>>>>>>> send SEQ_CloseInput liChannel
95917>>>>>>>>> end
95917>>>>>>>>>>
95917>>>>>>>>> end
95917>>>>>>>>>>
95917>>>>>>>>> end_procedure
95918>>>>>>>>> procedure DoSort integer liColumn
95921>>>>>>>>> set piCurrentSortOrder to liColumn
95922>>>>>>>>> send sort_rows liColumn
95923>>>>>>>>> end_procedure
95924>>>>>>>>> procedure ReadDirectory string lsDir string lsMask
95927>>>>>>>>> send WildCardMatchPrepare lsMask
95928>>>>>>>>> send delete_data
95929>>>>>>>>> set psCurrentDirectory to lsDir
95930>>>>>>>>> set psCurrentMask to lsMask
95931>>>>>>>>> send SEQ_Load_ItemsInDir lsDir
95932>>>>>>>>> send SEQ_CallBack_ItemsInDir SEQCB_FILES_ONLY MSG_AddFile self
95933>>>>>>>>> end_procedure
95934>>>>>>>>> procedure ReReadDir
95937>>>>>>>>> send ReadDirectory (psCurrentDirectory(self)) (psCurrentMask(self))
95938>>>>>>>>> send DoSort (piCurrentSortOrder(self))
95939>>>>>>>>> end_procedure
95940>>>>>>>>>
95940>>>>>>>>> // ------------------------------------------------------------
95940>>>>>>>>> // From here on down (inside this object) is only concerned with
95940>>>>>>>>> // the CopyFilesFromRootToUser procedure (and has nothing to do
95940>>>>>>>>> // with the above).
95940>>>>>>>>> property integer piFileCount public 0
95942>>>>>>>>> property string psTargetPath public ""
95944>>>>>>>>>
95944>>>>>>>>> procedure HandleFileCount string lsFile string lsPath
95947>>>>>>>>> if (WildCardMatch(lsFile)) set piFileCount to (piFileCount(self)+1)
95950>>>>>>>>> end_procedure
95951>>>>>>>>> procedure HandleFileCopy string lsFile string lsPath
95954>>>>>>>>> integer lbHopefullySuccess
95954>>>>>>>>> string lsTargetPath
95954>>>>>>>>> if (WildCardMatch(lsFile)) begin
95956>>>>>>>>> get Files_AppendPath lsPath lsFile to lsPath
95957>>>>>>>>> get psTargetPath to lsTargetPath
95958>>>>>>>>> get Files_AppendPath lsTargetPath lsFile to lsTargetPath
95959>>>>>>>>> get SEQ_CopyFile lsPath lsTargetPath to lbHopefullySuccess
95960>>>>>>>>> end
95960>>>>>>>>>>
95960>>>>>>>>> end_procedure
95961>>>>>>>>>
95961>>>>>>>>> procedure CopyFilesFromRootToUser string lsRootPath string lsPath
95964>>>>>>>>> set piFileCount to 0
95965>>>>>>>>> send SEQ_Load_ItemsInDir lsRootPath
95966>>>>>>>>> send WildCardMatchPrepare "*.fvw" // Views
95967>>>>>>>>> send SEQ_CallBack_ItemsInDir SEQCB_FILES_ONLY MSG_HandleFileCount self
95968>>>>>>>>> send WildCardMatchPrepare "*.fvc" // Collections
95969>>>>>>>>> send SEQ_CallBack_ItemsInDir SEQCB_FILES_ONLY MSG_HandleFileCount self
95970>>>>>>>>> if (piFileCount(self)) begin // Only if there were any files at all
95972>>>>>>>>> if (MB_Verify("Do you want to copy the view definitions of the previous version of FastView?",1)) begin
95974>>>>>>>>> set psTargetPath to lsPath
95975>>>>>>>>> send WildCardMatchPrepare "*.fvw" // Views
95976>>>>>>>>> send SEQ_CallBack_ItemsInDir SEQCB_FILES_ONLY MSG_HandleFileCopy self
95977>>>>>>>>> send WildCardMatchPrepare "*.fvc" // Collections
95978>>>>>>>>> send SEQ_CallBack_ItemsInDir SEQCB_FILES_ONLY MSG_HandleFileCopy self
95979>>>>>>>>> end
95979>>>>>>>>>>
95979>>>>>>>>> end
95979>>>>>>>>>>
95979>>>>>>>>> end_procedure
95980>>>>>>>>>
95980>>>>>>>>> end_object // oFastViewsOnDisk
95981>>>>>>>>>end_desktop_section
95986>>>>>>>>>
95986>>>>>>>>>function FastView_HomeDirectory global returns string
95988>>>>>>>>> function_return (psCurrentDirectory(oFastViewsOnDisk(self)))
95989>>>>>>>>>end_function
95990>>>>>>>>>function FastView_RootDirectory global returns string
95992>>>>>>>>> string lsRval
95992>>>>>>>>> get FastView_HomeDirectory to lsRval
95993>>>>>>>>> if (lsRval<>"") get SEQ_ExtractPathFromFileName lsRval to lsRval
95996>>>>>>>>> function_return lsRval
95997>>>>>>>>>end_function
95998>>>>>>>>>
95998>>>>>>>>>procedure FastView_SetupHomeDirectory global returns integer
96000>>>>>>>>> integer liExists lbCreateError lhChannel lbFastViewRootFolderExists
96000>>>>>>>>> string lsFileListPath lsPath lsReadMe lsUser lsRootPath
96000>>>>>>>>> set psCurrentDirectory of (oFastViewsOnDisk(self)) to ""
96001>>>>>>>>> get SEQ_FindFileAlongDFPath "filelist.cfg" to lsPath
96002>>>>>>>>> get Files_AppendPath lsPath "FastView" to lsPath
96003>>>>>>>>> get SEQ_FileExists lsPath to lbFastViewRootFolderExists
96004>>>>>>>>> move lsPath to lsRootPath
96005>>>>>>>>>
96005>>>>>>>>>// move (SEQ_ComposeAbsoluteFileName(lsPath,"FastView")) to lsPath
96005>>>>>>>>> get User_Windows_User_Name to lsUser
96006>>>>>>>>> get Files_AppendPath lsPath lsUser to lsPath
96007>>>>>>>>>
96007>>>>>>>>> get SEQ_FileExists lsPath to liExists
96008>>>>>>>>> if (liExists=SEQIT_NONE) begin
96010>>>>>>>>> if (MB_Verify4("FastView needs to create a folder for saving view definitions.","","The folder will be located under the 'data' folder at this location:",lsPath,DFTRUE)) begin
96012>>>>>>>>>
96012>>>>>>>>> ifnot lbFastViewRootFolderExists begin // First we create the root folder if necessary-
96014>>>>>>>>> get wvaWin32_CreateDirectory (ToAnsi(lsRootPath)) to lbCreateError
96015>>>>>>>>> if lbCreateError begin
96017>>>>>>>>> send obs "Sorry! Folder could not be created." lsPath "View definitions can not be saved to disk"
96018>>>>>>>>> function_return DFFALSE
96019>>>>>>>>> end
96019>>>>>>>>>>
96019>>>>>>>>> end
96019>>>>>>>>>>
96019>>>>>>>>>
96019>>>>>>>>> get wvaWin32_CreateDirectory (ToAnsi(lsPath)) to lbCreateError
96020>>>>>>>>> if lbCreateError begin
96022>>>>>>>>> send obs "Sorry! Folder could not be created." lsPath "View definitions can not be saved to disk."
96023>>>>>>>>> function_return DFFALSE
96024>>>>>>>>> end
96024>>>>>>>>>>
96024>>>>>>>>> else begin
96025>>>>>>>>> get SEQ_ComposeAbsoluteFileName lsPath "ReadMe.txt" to lsReadMe
96026>>>>>>>>> move (SEQ_DirectOutput(lsReadMe)) to lhChannel
96027>>>>>>>>> if (lhChannel>=0) begin
96029>>>>>>>>> writeln channel lhChannel ; "This folder was created by the FastView program as a placeholder"
96032>>>>>>>>> writeln "for FastView definitions and associated files."
96034>>>>>>>>> writeln ""
96036>>>>>>>>> writeln "Extensions are as follows:"
96038>>>>>>>>> writeln ""
96040>>>>>>>>> writeln " *.fvw Files containing the definition of a View"
96042>>>>>>>>> writeln ""
96044>>>>>>>>> writeln " *.fvc Such a file defines a group of views (and thus"
96046>>>>>>>>> writeln " .fvw files) that may be opened in one go using"
96048>>>>>>>>> writeln " the 'Open View Collection' feature of FastView."
96050>>>>>>>>> writeln " Deleting such a file does not delete the view "
96052>>>>>>>>> writeln " definitions themselves, only the grouping of them."
96054>>>>>>>>> writeln ""
96056>>>>>>>>> writeln " Default.fvc If this file is present FastView automatically"
96058>>>>>>>>> writeln " load this on starting the program."
96060>>>>>>>>> writeln ""
96062>>>>>>>>> writeln " FastLoad.fdx This file is used if the 'fast load' option is"
96064>>>>>>>>> writeln " enabled. Deleting the file will simply disable"
96066>>>>>>>>> writeln " 'fast load'. It may be re-enabled by selecting"
96068>>>>>>>>> writeln " 'File'->'WS Options'->'Fastload'"
96070>>>>>>>>> writeln ""
96072>>>>>>>>> writeln "This folder may safely be removed if the FastView program is no"
96074>>>>>>>>> writeln "longer used."
96076>>>>>>>>> send SEQ_CloseOutput lhChannel
96077>>>>>>>>> end
96077>>>>>>>>>>
96077>>>>>>>>> if lbFastViewRootFolderExists begin
96079>>>>>>>>> // Here we ask the user if he wants to copy the previous contents of
96079>>>>>>>>> // the FastView folder into the new folder.
96079>>>>>>>>> send CopyFilesFromRootToUser of oFastViewsOnDisk lsRootPath lsPath
96080>>>>>>>>> end
96080>>>>>>>>>>
96080>>>>>>>>> end
96080>>>>>>>>>>
96080>>>>>>>>> set psCurrentDirectory of (oFastViewsOnDisk(self)) to lsPath
96081>>>>>>>>> function_return DFTRUE
96082>>>>>>>>> end
96082>>>>>>>>>>
96082>>>>>>>>> else function_return DFFALSE
96084>>>>>>>>> end
96084>>>>>>>>>>
96084>>>>>>>>> if (liExists=SEQIT_FILE) begin
96086>>>>>>>>> send obs "Path must be a folder (and not a file)" lsPath "View definitions can not be saved to disk"
96087>>>>>>>>> function_return DFFALSE
96088>>>>>>>>> end
96088>>>>>>>>>>
96088>>>>>>>>> if (liExists=SEQIT_DIRECTORY) begin
96090>>>>>>>>> set psCurrentDirectory of (oFastViewsOnDisk(self)) to lsPath
96091>>>>>>>>> function_return DFTRUE
96092>>>>>>>>> end
96092>>>>>>>>>>
96092>>>>>>>>>end_procedure
96093>>>>>>>>>
96093>>>>>>>>>desktop_section
96098>>>>>>>>>object oFastViewOpenFileSL is a aps.ModalPanel label "Open FastView definition"
96101>>>>>>>>> set locate_mode to CENTER_ON_SCREEN
96102>>>>>>>>> on_key ksave_record send close_panel_ok
96103>>>>>>>>> on_key kcancel send close_panel
96104>>>>>>>>> property integer piResult public DFFALSE
96106>>>>>>>>> object oLst is a aps.Grid
96108>>>>>>>>>// send GridPrepare_AddCheckBoxColumn
96108>>>>>>>>> send GridPrepare_AddColumn "View title" AFT_ASCII30
96109>>>>>>>>> send GridPrepare_AddColumn "Type" AFT_ASCII3
96110>>>>>>>>> send GridPrepare_AddColumn "Main table" AFT_ASCII20
96111>>>>>>>>> send GridPrepare_AddColumn "File name" AFT_ASCII20
96112>>>>>>>>> send GridPrepare_AddColumn "Size" AFT_NUMERIC4.0
96113>>>>>>>>> send GridPrepare_AddColumn "Modified" AFT_ASCII20
96114>>>>>>>>> send GridPrepare_Apply self
96115>>>>>>>>> on_key KEY_CTRL+KEY_R send sort_data
96116>>>>>>>>> on_key KEY_CTRL+KEY_W send DoWriteToFile
96117>>>>>>>>> on_key kEnter send close_panel_ok
96118>>>>>>>>>
96118>>>>>>>>> procedure mouse_click integer liItem integer liGrb
96121>>>>>>>>> if ((liItem-1)<item_count(self)) send close_panel_ok
96124>>>>>>>>> end_procedure
96125>>>>>>>>>
96125>>>>>>>>> procedure DoWriteToFile
96128>>>>>>>>> send Grid_DoWriteToFile self
96129>>>>>>>>> end_procedure
96130>>>>>>>>>
96130>>>>>>>>> procedure request_delete
96133>>>>>>>>> integer lbDelete liRow liError
96133>>>>>>>>> string lsFile lsPath
96133>>>>>>>>> if (item_count(self)) begin
96135>>>>>>>>> get Grid_CurrentRow (oLst(self)) to liRow
96136>>>>>>>>> get psFileName.i of (oFastViewsOnDisk(self)) liRow to lsFile
96137>>>>>>>>> get FastView_HomeDirectory to lsPath
96138>>>>>>>>> get SEQ_ComposeAbsoluteFileName lsPath lsFile to lsFile
96139>>>>>>>>> if (SEQ_FileExists(lsFile)=SEQIT_FILE) begin
96141>>>>>>>>> get MB_Verify "Delete view definition?" 0 to lbDelete
96142>>>>>>>>> if lbDelete begin
96144>>>>>>>>> get wvaWin32_ShDeleteFile lsFile to liError
96145>>>>>>>>> broadcast recursive send FastView_DefinitionsOnDiskChanged to desktop
96147>>>>>>>>> end
96147>>>>>>>>>>
96147>>>>>>>>> end
96147>>>>>>>>>>
96147>>>>>>>>> send ReReadDir to (oFastViewsOnDisk(self))
96148>>>>>>>>> send fill_list
96149>>>>>>>>> end
96149>>>>>>>>>>
96149>>>>>>>>> end_procedure
96150>>>>>>>>>
96150>>>>>>>>> on_key kdelete_record send request_delete
96151>>>>>>>>>
96151>>>>>>>>> procedure SortByColumn integer liColumn
96154>>>>>>>>> integer liArrayColumn
96154>>>>>>>>> if (liColumn=0) move 4 to liArrayColumn
96157>>>>>>>>> if (liColumn=1) move 3 to liArrayColumn
96160>>>>>>>>> if (liColumn=2) move 5 to liArrayColumn
96163>>>>>>>>> if (liColumn=3) move 0 to liArrayColumn
96166>>>>>>>>> if (liColumn=4) move 7 to liArrayColumn
96169>>>>>>>>> if (liColumn=5) move 6 to liArrayColumn
96172>>>>>>>>> send DoSort to (oFastViewsOnDisk(self)) liArrayColumn
96173>>>>>>>>> send fill_list
96174>>>>>>>>> end_procedure
96175>>>>>>>>> procedure sort_data
96178>>>>>>>>> integer cc#
96178>>>>>>>>> get Grid_CurrentColumn self to cc#
96179>>>>>>>>> send SortByColumn cc#
96180>>>>>>>>> end_procedure
96181>>>>>>>>> procedure header_mouse_click integer itm#
96184>>>>>>>>> send SortByColumn itm#
96185>>>>>>>>> forward send header_mouse_click itm#
96187>>>>>>>>> end_procedure
96188>>>>>>>>> procedure fill_list
96191>>>>>>>>> integer lhObj liRow liMax liViewType
96191>>>>>>>>> string lsValue
96191>>>>>>>>> send delete_data
96192>>>>>>>>> move (oFastViewsOnDisk(self)) to lhObj
96193>>>>>>>>> get row_count of lhObj to liMax
96194>>>>>>>>> set dynamic_update_state to DFFALSE
96195>>>>>>>>> decrement liMax
96196>>>>>>>>> for liRow from 0 to liMax
96202>>>>>>>>>>
96202>>>>>>>>>// send Grid_AddCheckBoxItem self DFFALSE
96202>>>>>>>>> get psViewTitle.i of lhObj liRow to lsValue
96203>>>>>>>>> send add_item MSG_NONE lsValue
96204>>>>>>>>> get piViewType.i of lhObj liRow to liViewType
96205>>>>>>>>> if (liViewType=0) move "F" to lsValue
96208>>>>>>>>> if (liViewType=1) move "G" to lsValue
96211>>>>>>>>> if (liViewType=2) move "H/D" to lsValue
96214>>>>>>>>> send add_item MSG_NONE lsValue
96215>>>>>>>>> send add_item MSG_NONE (psMainFileName.i(lhObj,liRow))
96216>>>>>>>>> send add_item MSG_NONE (psFileName.i(lhObj,liRow))
96217>>>>>>>>> send add_item MSG_NONE (piSize.i(lhObj,liRow))
96218>>>>>>>>> send add_item MSG_NONE (TS_ConvertToString(pnDateTime.i(lhObj,liRow)))
96219>>>>>>>>> loop
96220>>>>>>>>>>
96220>>>>>>>>> send Grid_SetEntryState self DFFALSE
96221>>>>>>>>> set dynamic_update_state to DFTRUE
96222>>>>>>>>> end_procedure
96223>>>>>>>>> end_object // oLst
96224>>>>>>>>> object oBtn1 is a aps.Multi_Button
96226>>>>>>>>> on_item t.btn.ok send close_panel_ok
96227>>>>>>>>> end_object
96228>>>>>>>>> object oBtn2 is a aps.Multi_Button
96230>>>>>>>>> on_item t.btn.delete send request_delete to (oLst(self))
96231>>>>>>>>> end_object
96232>>>>>>>>> object oBtn3 is a aps.Multi_Button
96234>>>>>>>>> on_item t.btn.cancel send close_panel
96235>>>>>>>>> end_object
96236>>>>>>>>> send aps_locate_multi_buttons
96237>>>>>>>>> procedure close_panel_ok
96240>>>>>>>>> set piResult to DFTRUE
96241>>>>>>>>> send close_panel
96242>>>>>>>>> end_procedure
96243>>>>>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
96244>>>>>>>>> procedure aps_onResize integer delta_rw# integer delta_cl#
96247>>>>>>>>> send aps_resize (oLst(self)) delta_rw# 0 // delta_cl#
96248>>>>>>>>> send aps_register_multi_button (oBtn1(self))
96249>>>>>>>>> send aps_register_multi_button (oBtn2(self))
96250>>>>>>>>> send aps_register_multi_button (oBtn3(self))
96251>>>>>>>>> send aps_locate_multi_buttons
96252>>>>>>>>> send aps_auto_size_container
96253>>>>>>>>> end_procedure
96254>>>>>>>>> function sPopup.s string lsCaption returns string
96257>>>>>>>>> integer liRow
96257>>>>>>>>> string lsFile lsPath
96257>>>>>>>>> set label to lsCaption
96258>>>>>>>>> set piResult to DFFALSE
96259>>>>>>>>> get FastView_HomeDirectory to lsPath
96260>>>>>>>>> set label to (lsCaption+" ("+lsPath+")")
96261>>>>>>>>> send DoSort to (oFastViewsOnDisk(self)) 1
96262>>>>>>>>> send fill_list to (oLst(self))
96263>>>>>>>>> send popup
96264>>>>>>>>> if (piResult(self)) begin
96266>>>>>>>>> get Grid_CurrentRow (oLst(self)) to liRow
96267>>>>>>>>> get psFileName.i of (oFastViewsOnDisk(self)) liRow to lsFile
96268>>>>>>>>> get SEQ_ComposeAbsoluteFileName lsPath lsFile to lsFile
96269>>>>>>>>> function_return lsFile
96270>>>>>>>>> end
96270>>>>>>>>>>
96270>>>>>>>>> function_return ""
96271>>>>>>>>> end_procedure
96272>>>>>>>>>end_object // oFastViewOpenFileSL
96273>>>>>>>>>end_desktop_section
96278>>>>>>>>>
96278>>>>>>>>>function FastView_SelectViewDefinition global returns string
96280>>>>>>>>> string lsPath
96280>>>>>>>>> get FastView_HomeDirectory to lsPath
96281>>>>>>>>> if (lsPath="") begin
96283>>>>>>>>> send obs "FastView folder not found." "This feature is not available"
96284>>>>>>>>> function_return ""
96285>>>>>>>>> end
96285>>>>>>>>>>
96285>>>>>>>>> send ReadDirectory to (oFastViewsOnDisk(self)) lsPath "*.fvw"
96286>>>>>>>>> function_return (sPopup.s(oFastViewOpenFileSL(self),"Open existing FastView definition"))
96287>>>>>>>>>end_function
96288>>>>>>>>>
96288>>>>>>>>>desktop_section
96293>>>>>>>>>object oFastViewSaveFileSL is a aps.ModalPanel
96295>>>>>>>>> set locate_mode to CENTER_ON_SCREEN
96296>>>>>>>>> on_key ksave_record send close_panel_ok
96297>>>>>>>>> on_key kcancel send close_panel
96298>>>>>>>>> property integer piResult public DFFALSE
96300>>>>>>>>> property string psExt public ""
96302>>>>>>>>> object oFrm is a aps.Form abstract AFT_ASCII80 label "File name:"
96306>>>>>>>>> set p_extra_internal_width to -160
96307>>>>>>>>> end_object
96308>>>>>>>>> object oBtn1 is a aps.Multi_Button
96310>>>>>>>>> on_item t.btn.ok send close_panel_ok
96311>>>>>>>>> end_object
96312>>>>>>>>> object oBtn2 is a aps.Multi_Button
96314>>>>>>>>> on_item t.btn.cancel send close_panel
96315>>>>>>>>> end_object
96316>>>>>>>>> function iValidateFileName returns integer
96319>>>>>>>>> string lsFileName lsExt
96319>>>>>>>>> get psExt to lsExt
96320>>>>>>>>> get value of (oFrm(self)) item 0 to lsFileName
96321>>>>>>>>> if (lsFileName="") error 341 "Missing file name"
96324>>>>>>>>> else begin
96325>>>>>>>>> if (pos(" ",lsFileName)) error 342 "Spaces are not allowed in file name"
96328>>>>>>>>> else begin
96329>>>>>>>>> if (pos("\",lsFileName)) error 343 "Back slashes are not allowed in file name"
96332>>>>>>>>> else begin
96333>>>>>>>>> if (pos(".",lsFileName)) begin
96335>>>>>>>>> send WildCardMatchPrepare ("*."+lsExt)
96336>>>>>>>>> ifnot (WildCardMatch(lsFileName)) error 344 "Dots (.) are not allowed in file name"
96339>>>>>>>>> else function_return DFTRUE
96341>>>>>>>>> end
96341>>>>>>>>>>
96341>>>>>>>>> else begin
96342>>>>>>>>> set value of (oFrm(self)) item 0 to (lsFileName+"."+psExt(self))
96343>>>>>>>>> function_return DFTRUE
96344>>>>>>>>> end
96344>>>>>>>>>>
96344>>>>>>>>> end
96344>>>>>>>>>>
96344>>>>>>>>> end
96344>>>>>>>>>>
96344>>>>>>>>> end
96344>>>>>>>>>>
96344>>>>>>>>> function_return DFFALSE
96345>>>>>>>>> end_function
96346>>>>>>>>> send aps_locate_multi_buttons
96347>>>>>>>>> procedure close_panel_ok
96350>>>>>>>>> integer lbOK
96350>>>>>>>>> get iValidateFileName to lbOK
96351>>>>>>>>> if lbOK begin
96353>>>>>>>>> set piResult to DFTRUE
96354>>>>>>>>> send close_panel
96355>>>>>>>>> end
96355>>>>>>>>>>
96355>>>>>>>>> end_procedure
96356>>>>>>>>> function sPopup.sss string lsCaption string lsCurrentName string lsExt returns string
96359>>>>>>>>> integer liRow
96359>>>>>>>>> string lsFile lsPath
96359>>>>>>>>> set piResult to DFFALSE
96360>>>>>>>>> set psExt to lsExt
96361>>>>>>>>> get FastView_HomeDirectory to lsPath
96362>>>>>>>>> set value of (oFrm(self)) item 0 to lsCurrentName
96363>>>>>>>>> set label to lsCaption
96364>>>>>>>>> send popup
96365>>>>>>>>> if (piResult(self)) begin
96367>>>>>>>>> get value of (oFrm(self)) item 0 to lsFile
96368>>>>>>>>> get SEQ_ComposeAbsoluteFileName lsPath lsFile to lsFile
96369>>>>>>>>> function_return lsFile
96370>>>>>>>>> end
96370>>>>>>>>>>
96370>>>>>>>>> function_return ""
96371>>>>>>>>> end_procedure
96372>>>>>>>>>end_object // oFastViewSaveFileSL
96373>>>>>>>>>end_desktop_section
96378>>>>>>>>>
96378>>>>>>>>>// For saving
96378>>>>>>>>>function FastView_SelectDiskFileName global string lsCaption string lsCurrentFile string lsExt returns string
96380>>>>>>>>> function_return (sPopup.sss(oFastViewSaveFileSL(self),lsCaption,lsCurrentFile,lsExt))
96381>>>>>>>>>end_function
96382>>>>>>>>>
96382>>>>>>>>>desktop_section
96387>>>>>>>>>object oFastViewCollectionOpenSL is a aps.ModalPanel label "Open FastView collection"
96390>>>>>>>>> set locate_mode to CENTER_ON_SCREEN
96391>>>>>>>>> on_key ksave_record send close_panel_ok
96392>>>>>>>>> on_key kcancel send close_panel
96393>>>>>>>>> property integer piResult public DFFALSE
96395>>>>>>>>> object oLst is a aps.Grid
96397>>>>>>>>> send GridPrepare_AddColumn "File name" AFT_ASCII30
96398>>>>>>>>> send GridPrepare_AddColumn "Size" AFT_NUMERIC4.0
96399>>>>>>>>> send GridPrepare_AddColumn "Modified" AFT_ASCII20
96400>>>>>>>>> send GridPrepare_Apply self
96401>>>>>>>>> on_key KEY_CTRL+KEY_R send sort_data
96402>>>>>>>>> on_key KEY_CTRL+KEY_W send DoWriteToFile
96403>>>>>>>>> on_key kEnter send close_panel_ok
96404>>>>>>>>> on_key kdelete_record send request_delete
96405>>>>>>>>>
96405>>>>>>>>> procedure mouse_click integer liItem integer liGrb
96408>>>>>>>>> if ((liItem-1)<item_count(self)) send close_panel_ok
96411>>>>>>>>> end_procedure
96412>>>>>>>>>
96412>>>>>>>>> procedure request_delete
96415>>>>>>>>> integer lbDelete liRow liError
96415>>>>>>>>> string lsFile lsPath
96415>>>>>>>>> if (item_count(self)) begin
96417>>>>>>>>> get FastView_HomeDirectory to lsPath
96418>>>>>>>>> get sCurrentFile to lsFile
96419>>>>>>>>> get SEQ_ComposeAbsoluteFileName lsPath lsFile to lsFile
96420>>>>>>>>> if (SEQ_FileExists(lsFile)=SEQIT_FILE) begin
96422>>>>>>>>> get MB_Verify "Delete view collection?" 0 to lbDelete
96423>>>>>>>>> if lbDelete get wvaWin32_ShDeleteFile lsFile to liError
96426>>>>>>>>> end
96426>>>>>>>>>>
96426>>>>>>>>> send fill_list.s lsPath
96427>>>>>>>>> end
96427>>>>>>>>>>
96427>>>>>>>>> end_procedure
96428>>>>>>>>>
96428>>>>>>>>> procedure DoWriteToFile
96431>>>>>>>>> send Grid_DoWriteToFile self
96432>>>>>>>>> end_procedure
96433>>>>>>>>>
96433>>>>>>>>> procedure SortByColumn integer liColumn
96436>>>>>>>>> send Grid_SortByColumn self liColumn
96437>>>>>>>>> end_procedure
96438>>>>>>>>> procedure sort_data
96441>>>>>>>>> integer cc#
96441>>>>>>>>> get Grid_CurrentColumn self to cc#
96442>>>>>>>>> send SortByColumn cc#
96443>>>>>>>>> end_procedure
96444>>>>>>>>> procedure header_mouse_click integer itm#
96447>>>>>>>>> send SortByColumn itm#
96448>>>>>>>>> forward send header_mouse_click itm#
96450>>>>>>>>> end_procedure
96451>>>>>>>>> procedure fill_list_help string lsFile string lsDir integer liSize number lnDateTime
96454>>>>>>>>> string lsViewTitle
96454>>>>>>>>> if (WildCardMatch(lsFile)) begin
96456>>>>>>>>> send add_item MSG_NONE lsFile
96457>>>>>>>>> get SEQ_ComposeAbsoluteFileName lsDir lsFile to lsFile
96458>>>>>>>>> send add_item MSG_NONE liSize
96459>>>>>>>>> send add_item MSG_NONE (TS_ConvertToString(lnDateTime))
96460>>>>>>>>> end
96460>>>>>>>>>>
96460>>>>>>>>> end_procedure
96461>>>>>>>>> procedure fill_list.s string lsDir
96464>>>>>>>>> send delete_data
96465>>>>>>>>> set dynamic_update_state to DFFALSE
96466>>>>>>>>> send WildCardMatchPrepare "*.fvc"
96467>>>>>>>>> send SEQ_Load_ItemsInDir lsDir
96468>>>>>>>>> send SEQ_CallBack_ItemsInDir SEQCB_FILES_ONLY MSG_fill_list_help self
96469>>>>>>>>> send Grid_SetEntryState self DFFALSE
96470>>>>>>>>> set dynamic_update_state to DFTRUE
96471>>>>>>>>> end_procedure
96472>>>>>>>>> function sCurrentFile returns string
96475>>>>>>>>> integer liBase
96475>>>>>>>>> string lsFile
96475>>>>>>>>> if (item_count(self)) begin
96477>>>>>>>>> get Grid_BaseItem self to liBase
96478>>>>>>>>> get value item liBase to lsFile
96479>>>>>>>>> end
96479>>>>>>>>>>
96479>>>>>>>>> else move "" to lsFile
96481>>>>>>>>> function_return lsFile
96482>>>>>>>>> end_function
96483>>>>>>>>> end_object
96484>>>>>>>>> object oBtn1 is a aps.Multi_Button
96486>>>>>>>>> on_item t.btn.ok send close_panel_ok
96487>>>>>>>>> end_object
96488>>>>>>>>> object oBtn2 is a aps.Multi_Button
96490>>>>>>>>> on_item t.btn.delete send request_delete to (oLst(self))
96491>>>>>>>>> end_object
96492>>>>>>>>> object oBtn3 is a aps.Multi_Button
96494>>>>>>>>> on_item t.btn.cancel send close_panel
96495>>>>>>>>> end_object
96496>>>>>>>>> send aps_locate_multi_buttons
96497>>>>>>>>> procedure close_panel_ok
96500>>>>>>>>> set piResult to DFTRUE
96501>>>>>>>>> send close_panel
96502>>>>>>>>> end_procedure
96503>>>>>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
96504>>>>>>>>> procedure aps_onResize integer delta_rw# integer delta_cl#
96507>>>>>>>>> send aps_resize (oLst(self)) delta_rw# 0 // delta_cl#
96508>>>>>>>>> send aps_register_multi_button (oBtn1(self))
96509>>>>>>>>> send aps_register_multi_button (oBtn2(self))
96510>>>>>>>>> send aps_register_multi_button (oBtn3(self))
96511>>>>>>>>> send aps_locate_multi_buttons
96512>>>>>>>>> send aps_auto_size_container
96513>>>>>>>>> end_procedure
96514>>>>>>>>> function sPopup.s string lsCaption returns string
96517>>>>>>>>> integer liRow
96517>>>>>>>>> string lsFile lsPath
96517>>>>>>>>> set label to lsCaption
96518>>>>>>>>> set piResult to DFFALSE
96519>>>>>>>>> get FastView_HomeDirectory to lsPath
96520>>>>>>>>> set label to (lsCaption+" ("+lsPath+")")
96521>>>>>>>>> send fill_list.s to (oLst(self)) lsPath
96522>>>>>>>>> send popup
96523>>>>>>>>> if (piResult(self)) begin
96525>>>>>>>>> get sCurrentFile of (oLst(self)) to lsFile
96526>>>>>>>>> function_return lsFile
96527>>>>>>>>> end
96527>>>>>>>>>>
96527>>>>>>>>> function_return ""
96528>>>>>>>>> end_procedure
96529>>>>>>>>>end_object // oFastViewCollectionOpenSL
96530>>>>>>>>>end_desktop_section
96535>>>>>>>>>
96535>>>>>>>>>function FastView_OpenViewCollection global returns string
96537>>>>>>>>> string lsPath
96537>>>>>>>>> get FastView_HomeDirectory to lsPath
96538>>>>>>>>> if (lsPath="") begin
96540>>>>>>>>> send obs "FastView folder not found." "This feature is not available"
96541>>>>>>>>> function_return ""
96542>>>>>>>>> end
96542>>>>>>>>>>
96542>>>>>>>>> function_return (sPopup.s(oFastViewCollectionOpenSL(self),"Open FastView collection"))
96543>>>>>>>>>end_function
96544>>>>>>>>>
96544>>>>>>>>>function FastView_FileFullName global string lsFile returns string
96546>>>>>>>>> string lsPath
96546>>>>>>>>> get FastView_RootDirectory to lsPath
96547>>>>>>>>> if (lsPath<>"") begin
96549>>>>>>>>> get SEQ_ComposeAbsoluteFileName lsPath lsFile to lsFile
96550>>>>>>>>> function_return lsFile
96551>>>>>>>>> end
96551>>>>>>>>>>
96551>>>>>>>>> function_return ""
96552>>>>>>>>>end_function
96553>>>>>>>>>
96553>>>>>>>>>function FastView_FileExists global string lsFile returns integer
96555>>>>>>>>> string lsPath
96555>>>>>>>>> get FastView_RootDirectory to lsPath
96556>>>>>>>>> if (lsPath<>"") begin
96558>>>>>>>>> get SEQ_ComposeAbsoluteFileName lsPath lsFile to lsFile
96559>>>>>>>>> function_return (SEQ_FileExists(lsFile))
96560>>>>>>>>> end
96560>>>>>>>>>>
96560>>>>>>>>> function_return DFFALSE
96561>>>>>>>>>end_procedure
96562>>>>>>>>>function FastView_DirectInput global string lsFile returns integer
96564>>>>>>>>> string lsPath
96564>>>>>>>>> get FastView_RootDirectory to lsPath
96565>>>>>>>>> if (lsPath<>"") begin
96567>>>>>>>>> get SEQ_ComposeAbsoluteFileName lsPath lsFile to lsFile
96568>>>>>>>>> function_return (SEQ_DirectInput(lsFile))
96569>>>>>>>>> end
96569>>>>>>>>>>
96569>>>>>>>>> function_return -1
96570>>>>>>>>>end_procedure
96571>>>>>>>>>function FastView_DirectOutput global string lsFile returns integer
96573>>>>>>>>> string lsPath
96573>>>>>>>>> get FastView_RootDirectory to lsPath
96574>>>>>>>>> if (lsPath<>"") begin
96576>>>>>>>>> get SEQ_ComposeAbsoluteFileName lsPath lsFile to lsFile
96577>>>>>>>>> function_return (SEQ_DirectOutput(lsFile))
96578>>>>>>>>> end
96578>>>>>>>>>>
96578>>>>>>>>> function_return -1
96579>>>>>>>>>end_procedure
96580>>>>>>>>>
96580>>>>>>>Use Version.nui
96580>>>>>>>
96580>>>>>>>desktop_section
96585>>>>>>>object oFastViewDefArray is a cArray
96587>>>>>>> item_property_list
96587>>>>>>> item_property integer phDefinition.i
96587>>>>>>> end_item_property_list
#REM 96621 DEFINE FUNCTION PHDEFINITION.I INTEGER LIROW RETURNS INTEGER
#REM 96626 DEFINE PROCEDURE SET PHDEFINITION.I INTEGER LIROW INTEGER VALUE
96632>>>>>>> procedure AddDef integer lhDef
96635>>>>>>> set phDefinition.i (row_count(self)) to lhDef
96636>>>>>>> end_procedure
96637>>>>>>>end_object // oFastViewDefArray
96638>>>>>>>object oFastViewArray is a cArray
96640>>>>>>> item_property_list
96640>>>>>>> item_property integer phView.i
96640>>>>>>> end_item_property_list
#REM 96674 DEFINE FUNCTION PHVIEW.I INTEGER LIROW RETURNS INTEGER
#REM 96679 DEFINE PROCEDURE SET PHVIEW.I INTEGER LIROW INTEGER VALUE
96685>>>>>>> procedure AddView integer lhView
96688>>>>>>> set phView.i (row_count(self)) to lhView
96689>>>>>>> end_procedure
96690>>>>>>>end_object // oFastViewArray
96691>>>>>>>end_desktop_section
96696>>>>>>>
96696>>>>>>>enumeration_list
96696>>>>>>> define VT_SIMPLE
96696>>>>>>> define VT_GRID
96696>>>>>>> define VT_HEADER_DETAIL
96696>>>>>>>end_enumeration_list
96696>>>>>>>
96696>>>>>>>class cFastView_Fields is a cArray
96697>>>>>>> procedure construct_object
96699>>>>>>> forward send construct_object
96701>>>>>>> property integer pbChildFieldsState public DFFALSE
96702>>>>>>> property integer pbSideCarFieldsState public DFFALSE
96703>>>>>>> end_procedure
96704>>>>>>> item_property_list
96704>>>>>>> item_property integer piClass.i // Create an object of this class
96704>>>>>>> item_property integer piDDOFile.i // Use this server (not used)
96704>>>>>>> item_property integer piFile.i // Files separated by space
96704>>>>>>> item_property integer piField.i // Fields separated by space
96704>>>>>>> item_property string psLabel.i // Custom label
96704>>>>>>> item_property integer pbNoLabel.i // Disable label
96704>>>>>>> item_property integer piSnap.i // Snap it like this
96704>>>>>>> item_property integer piLastObjectRow.i // relative to this
96704>>>>>>> item_property integer piSizeX.i
96704>>>>>>> item_property integer piSizeY.i
96704>>>>>>> item_property integer piExtraIntWidth.i // Sizing information
96704>>>>>>> item_property integer piExtraExtWidth.i // Sizing information
96704>>>>>>> item_property integer pbForceNoenter.i // Make item noenter
96704>>>>>>> item_property string pbCapslock.i // Capslock this field
96704>>>>>>> item_property string pbDefaultSL.i // Prompt button for DefaultPromptList
96704>>>>>>> item_property string phObjectID.i // Object ID's after creation
96704>>>>>>>
96704>>>>>>> item_property string piTmpViewRow.i // Temporary for applying
96704>>>>>>> item_property string piTmpViewAnchor.i // anchoring stuff.
96704>>>>>>>
96704>>>>>>> item_property string pbNotUsed06.i
96704>>>>>>> item_property string pbNotUsed07.i
96704>>>>>>> item_property string pbNotUsed08.i
96704>>>>>>> item_property string pbNotUsed09.i
96704>>>>>>> item_property string pbNotUsed10.i
96704>>>>>>> // Not used:
96704>>>>>>> item_property integer phDEO_List.i // If container, call this list
96704>>>>>>> end_item_property_list_extended cFastView_Fields
#REM 96972 DEFINE FUNCTION PHDEO_LIST.I INTEGER LIROW RETURNS INTEGER
#REM 96976 DEFINE PROCEDURE SET PHDEO_LIST.I INTEGER LIROW INTEGER VALUE
#REM 96980 DEFINE FUNCTION PBNOTUSED10.I INTEGER LIROW RETURNS STRING
#REM 96984 DEFINE PROCEDURE SET PBNOTUSED10.I INTEGER LIROW STRING VALUE
#REM 96988 DEFINE FUNCTION PBNOTUSED09.I INTEGER LIROW RETURNS STRING
#REM 96992 DEFINE PROCEDURE SET PBNOTUSED09.I INTEGER LIROW STRING VALUE
#REM 96996 DEFINE FUNCTION PBNOTUSED08.I INTEGER LIROW RETURNS STRING
#REM 97000 DEFINE PROCEDURE SET PBNOTUSED08.I INTEGER LIROW STRING VALUE
#REM 97004 DEFINE FUNCTION PBNOTUSED07.I INTEGER LIROW RETURNS STRING
#REM 97008 DEFINE PROCEDURE SET PBNOTUSED07.I INTEGER LIROW STRING VALUE
#REM 97012 DEFINE FUNCTION PBNOTUSED06.I INTEGER LIROW RETURNS STRING
#REM 97016 DEFINE PROCEDURE SET PBNOTUSED06.I INTEGER LIROW STRING VALUE
#REM 97020 DEFINE FUNCTION PITMPVIEWANCHOR.I INTEGER LIROW RETURNS STRING
#REM 97024 DEFINE PROCEDURE SET PITMPVIEWANCHOR.I INTEGER LIROW STRING VALUE
#REM 97028 DEFINE FUNCTION PITMPVIEWROW.I INTEGER LIROW RETURNS STRING
#REM 97032 DEFINE PROCEDURE SET PITMPVIEWROW.I INTEGER LIROW STRING VALUE
#REM 97036 DEFINE FUNCTION PHOBJECTID.I INTEGER LIROW RETURNS STRING
#REM 97040 DEFINE PROCEDURE SET PHOBJECTID.I INTEGER LIROW STRING VALUE
#REM 97044 DEFINE FUNCTION PBDEFAULTSL.I INTEGER LIROW RETURNS STRING
#REM 97048 DEFINE PROCEDURE SET PBDEFAULTSL.I INTEGER LIROW STRING VALUE
#REM 97052 DEFINE FUNCTION PBCAPSLOCK.I INTEGER LIROW RETURNS STRING
#REM 97056 DEFINE PROCEDURE SET PBCAPSLOCK.I INTEGER LIROW STRING VALUE
#REM 97060 DEFINE FUNCTION PBFORCENOENTER.I INTEGER LIROW RETURNS INTEGER
#REM 97064 DEFINE PROCEDURE SET PBFORCENOENTER.I INTEGER LIROW INTEGER VALUE
#REM 97068 DEFINE FUNCTION PIEXTRAEXTWIDTH.I INTEGER LIROW RETURNS INTEGER
#REM 97072 DEFINE PROCEDURE SET PIEXTRAEXTWIDTH.I INTEGER LIROW INTEGER VALUE
#REM 97076 DEFINE FUNCTION PIEXTRAINTWIDTH.I INTEGER LIROW RETURNS INTEGER
#REM 97080 DEFINE PROCEDURE SET PIEXTRAINTWIDTH.I INTEGER LIROW INTEGER VALUE
#REM 97084 DEFINE FUNCTION PISIZEY.I INTEGER LIROW RETURNS INTEGER
#REM 97088 DEFINE PROCEDURE SET PISIZEY.I INTEGER LIROW INTEGER VALUE
#REM 97092 DEFINE FUNCTION PISIZEX.I INTEGER LIROW RETURNS INTEGER
#REM 97096 DEFINE PROCEDURE SET PISIZEX.I INTEGER LIROW INTEGER VALUE
#REM 97100 DEFINE FUNCTION PILASTOBJECTROW.I INTEGER LIROW RETURNS INTEGER
#REM 97104 DEFINE PROCEDURE SET PILASTOBJECTROW.I INTEGER LIROW INTEGER VALUE
#REM 97108 DEFINE FUNCTION PISNAP.I INTEGER LIROW RETURNS INTEGER
#REM 97112 DEFINE PROCEDURE SET PISNAP.I INTEGER LIROW INTEGER VALUE
#REM 97116 DEFINE FUNCTION PBNOLABEL.I INTEGER LIROW RETURNS INTEGER
#REM 97120 DEFINE PROCEDURE SET PBNOLABEL.I INTEGER LIROW INTEGER VALUE
#REM 97124 DEFINE FUNCTION PSLABEL.I INTEGER LIROW RETURNS STRING
#REM 97128 DEFINE PROCEDURE SET PSLABEL.I INTEGER LIROW STRING VALUE
#REM 97132 DEFINE FUNCTION PIFIELD.I INTEGER LIROW RETURNS INTEGER
#REM 97136 DEFINE PROCEDURE SET PIFIELD.I INTEGER LIROW INTEGER VALUE
#REM 97140 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 97144 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
#REM 97148 DEFINE FUNCTION PIDDOFILE.I INTEGER LIROW RETURNS INTEGER
#REM 97152 DEFINE PROCEDURE SET PIDDOFILE.I INTEGER LIROW INTEGER VALUE
#REM 97156 DEFINE FUNCTION PICLASS.I INTEGER LIROW RETURNS INTEGER
#REM 97160 DEFINE PROCEDURE SET PICLASS.I INTEGER LIROW INTEGER VALUE
97165>>>>>>>
97165>>>>>>> // The function returns DFTRUE if an object has been set to adopt to
97165>>>>>>> // vertical size changes.
97165>>>>>>> // It only makes sense to call this function if not grid.
97165>>>>>>> function iDoAnchors integer lbAllowVertical returns integer
97167>>>>>>> integer liLine liMaxLine liMax liRow liClass liSnap liVerticalEaterRow
97167>>>>>>> integer liHorizontalEaterRow liBestBidRow liBestBidLength liLength
97167>>>>>>> integer lhObject liAnyHorizontalEaterRow
97167>>>>>>>
97167>>>>>>> move -1 to liAnyHorizontalEaterRow
97168>>>>>>>
97168>>>>>>> get row_count to liMax
97169>>>>>>> decrement liMax
97170>>>>>>>
97170>>>>>>> // First we figure out which objects are on which 'lines'
97170>>>>>>> move 0 to liLine
97171>>>>>>> for liRow from 0 to liMax
97177>>>>>>>>
97177>>>>>>> get piSnap.i liRow to liSnap
97178>>>>>>> if (liRow>0) begin
97180>>>>>>> if (liSnap=SL_DOWN) increment liLine
97183>>>>>>> if (liSnap=0) increment liLine
97186>>>>>>> end
97186>>>>>>>>
97186>>>>>>> set piTmpViewRow.i liRow to liLine
97187>>>>>>> loop
97188>>>>>>>>
97188>>>>>>> move liLine to liMaxLine
97189>>>>>>>
97189>>>>>>> // If lbAllowVertical we then look for an dbEdit (the last)
97189>>>>>>> move -1 to liVerticalEaterRow
97190>>>>>>> if lbAllowVertical begin
97192>>>>>>> for liRow from 0 to liMax
97198>>>>>>>>
97198>>>>>>> get piClass.i liRow to liClass
97199>>>>>>> if (liClass=class.dbEdit) move liRow to liVerticalEaterRow
97202>>>>>>> loop
97203>>>>>>>>
97203>>>>>>>// if (liVerticalEaterRow>=0) set piTmpViewAnchor.i liVerticalEaterRow to anAll
97203>>>>>>> end
97203>>>>>>>>
97203>>>>>>>
97203>>>>>>> // Now we calculate the anchors one View-line at a time
97203>>>>>>> for liLine from 0 to liMaxLine // 'View lines'
97209>>>>>>>>
97209>>>>>>>
97209>>>>>>> //First find the object that qualifies for being horizontal eater
97209>>>>>>> move -1 to liHorizontalEaterRow
97210>>>>>>> move -1 to liBestBidRow
97211>>>>>>> move -1 to liBestBidLength
97212>>>>>>>
97212>>>>>>> for liRow from 0 to liMax
97218>>>>>>>>
97218>>>>>>> if (liLine=piTmpViewRow.i(self,liRow)) begin // Only if it's the view row we are currently handling
97220>>>>>>> get phObjectID.i liRow to lhObject
97221>>>>>>> get piClass.i liRow to liClass
97222>>>>>>> get size of lhObject to liLength
97223>>>>>>> move (low(liLength)) to liLength
97224>>>>>>> if (liClass=class.dbEdit) move (liLength*1000) to liLength // If edit we overdo the size
97227>>>>>>> if (liLength>=liBestBidLength) begin
97229>>>>>>> move liLength to liBestBidLength
97230>>>>>>> move liRow to liBestBidRow
97231>>>>>>> end
97231>>>>>>>>
97231>>>>>>> end
97231>>>>>>>>
97231>>>>>>> loop
97232>>>>>>>>
97232>>>>>>>
97232>>>>>>> // Did we find one worthy?
97232>>>>>>> if (liBestBidRow>=0 and liBestBidLength>100) move liBestBidRow to liHorizontalEaterRow
97235>>>>>>> if (liHorizontalEaterRow<>-1) move liHorizontalEaterRow to liAnyHorizontalEaterRow
97238>>>>>>>
97238>>>>>>> // Assign anchor values:
97238>>>>>>> //
97238>>>>>>> // Before liVerticalEaterRow
97238>>>>>>> // Before liHorizontalEaterRow Left Top
97238>>>>>>> // On liHorizontalEaterRow Left Top Right
97238>>>>>>> // After liHorizontalEaterRow Top Right
97238>>>>>>> // On liVerticalEaterRow Left Top Right Bottom (All)
97238>>>>>>> // After liVerticalEaterRow
97238>>>>>>> // Before liHorizontalEaterRow Left Bottom
97238>>>>>>> // On liHorizontalEaterRow Left Bottom Right
97238>>>>>>> // After liHorizontalEaterRow Bottom Right
97238>>>>>>> //
97238>>>>>>> // If there is no Vertial eater row, all objects should be considered 'Before'
97238>>>>>>> if (liVerticalEaterRow=-1) move 1000000 to liVerticalEaterRow
97241>>>>>>> // If there is no Horizontal eater row, all objects should be considered 'Before'
97241>>>>>>> if (liHorizontalEaterRow=-1) move 1000000 to liHorizontalEaterRow
97244>>>>>>>
97244>>>>>>>
97244>>>>>>> for liRow from 0 to liMax
97250>>>>>>>>
97250>>>>>>> // If there is no Vertial eater row, all objects should be considered 'Before'
97250>>>>>>> // If there is no Horizontal eater row, all objects should be considered 'Before'
97250>>>>>>> if (liLine=piTmpViewRow.i(self,liRow)) begin // Only if it's the view row we are currently handling
97252>>>>>>>
97252>>>>>>> if (liRow<liVerticalEaterRow) begin
97254>>>>>>> if (liRow<liHorizontalEaterRow) set piTmpViewAnchor.i liRow to (anLeft+anTop)
97257>>>>>>> if (liRow=liHorizontalEaterRow) set piTmpViewAnchor.i liRow to (anLeft+anTop+anRight)
97260>>>>>>> if (liRow>liHorizontalEaterRow) set piTmpViewAnchor.i liRow to (anTop+anRight)
97263>>>>>>> end
97263>>>>>>>>
97263>>>>>>> if (liRow=liVerticalEaterRow) set piTmpViewAnchor.i liRow to anAll
97266>>>>>>> if (liRow>liVerticalEaterRow) begin
97268>>>>>>> if (liRow<liHorizontalEaterRow) set piTmpViewAnchor.i liRow to (anLeft+anBottom)
97271>>>>>>> if (liRow=liHorizontalEaterRow) set piTmpViewAnchor.i liRow to (anLeft+anBottom+anRight)
97274>>>>>>> if (liRow>liHorizontalEaterRow) set piTmpViewAnchor.i liRow to (anBottom+anRight)
97277>>>>>>> end
97277>>>>>>>>
97277>>>>>>> end
97277>>>>>>>>
97277>>>>>>> loop
97278>>>>>>>>
97278>>>>>>> if (liVerticalEaterRow=1000000) move -1 to liVerticalEaterRow // Clean up
97281>>>>>>> loop
97282>>>>>>>>
97282>>>>>>>
97282>>>>>>> // Finally, assign the anchors to the objects:
97282>>>>>>> for liRow from 0 to liMax
97288>>>>>>>>
97288>>>>>>> get phObjectID.i liRow to lhObject
97289>>>>>>> set peAnchors of lhObject to (piTmpViewAnchor.i(self,liRow))
97290>>>>>>> loop
97291>>>>>>>>
97291>>>>>>>
97291>>>>>>> move (liVerticalEaterRow<>-1) to liVerticalEaterRow
97292>>>>>>> move (liAnyHorizontalEaterRow<>-1) to liAnyHorizontalEaterRow
97293>>>>>>> function_return (liVerticalEaterRow*65536+liAnyHorizontalEaterRow)
97294>>>>>>> end_function
97295>>>>>>>
97295>>>>>>> function piFileField.i integer liRow returns integer
97297>>>>>>> function_return (piFile.i(self,liRow)*65536+piField.i(self,liRow))
97298>>>>>>> end_function
97299>>>>>>> procedure set piFileField.i integer liRow integer liFileField
97301>>>>>>> set piFile.i liRow to (liFileField/65536)
97302>>>>>>> set piField.i liRow to (mod(liFileField,65536))
97303>>>>>>> end_procedure
97304>>>>>>> function sWarningQuestion.iiii integer liFile integer liField integer liRelFile integer liRelField returns string
97306>>>>>>> string lsRval lsName lsRelName
97306>>>>>>> move "You have selected to add field #/nthat relates to parent field #./nIt really would be better to use the parent field./nDo you want to use the parent field instead?" to lsRval
97307>>>>>>> get FDX_FieldName ghFDX liFile liField DFTRUE to lsName
97308>>>>>>> get FDX_FieldName ghFDX liRelFile liRelField DFTRUE to lsRelName
97309>>>>>>> move (replace("#",lsRval,lsName)) to lsRval
97310>>>>>>> move (replace("#",lsRval,lsRelName)) to lsRval
97311>>>>>>> move (replaces("/n",lsRval,character(10))) to lsRval
97312>>>>>>> function_return lsRval
97313>>>>>>> end_function
97314>>>>>>>
97314>>>>>>> function iPreferredClass integer liFile integer liField returns integer
97316>>>>>>> string lsClass
97316>>>>>>> get FastView_DDProbe liFile liField DDP_CLASS to lsClass
97317>>>>>>> if (lsClass<>"") begin
97319>>>>>>> if (lsClass="dbComboForm") function_return class.dbComboForm
97322>>>>>>> if (lsClass="dbSpinForm") function_return class.dbSpinForm
97325>>>>>>> if (lsClass="dbCheckBox") function_return class.dbCheckBox
97328>>>>>>> end
97328>>>>>>>>
97328>>>>>>> function_return -1
97329>>>>>>> end_function
97330>>>>>>>
97330>>>>>>> procedure add_field_no_bullshit integer liFile integer liField ; integer liClass integer liSnap ; integer lbNoLabel
97332>>>>>>> integer liRow liRelFile liRelField liTmp
97332>>>>>>> string lsQuestion
97332>>>>>>> get FDX_AttrValue_FIELD ghFDX DF_FIELD_RELATED_FILE liFile liField to liRelFile
97333>>>>>>> if liRelFile begin
97335>>>>>>> get FDX_AttrValue_FIELD ghFDX DF_FIELD_RELATED_FIELD liFile liField to liRelField
97336>>>>>>> get sWarningQuestion.iiii liFile liField liRelFile liRelField to lsQuestion
97337>>>>>>> if (MB_Verify(lsQuestion,DFTRUE)) begin
97339>>>>>>> move liRelFile to liFile
97340>>>>>>> move liRelField to liField
97341>>>>>>> end
97341>>>>>>>>
97341>>>>>>> end
97341>>>>>>>>
97341>>>>>>> get iPreferredClass liFile liField to liTmp
97342>>>>>>> if (liTmp<>-1) move liTmp to liClass
97345>>>>>>> get row_count to liRow
97346>>>>>>> set piFile.i liRow to liFile
97347>>>>>>> set piField.i liRow to liField
97348>>>>>>> set piClass.i liRow to liClass
97349>>>>>>> set pbNoLabel.i liRow to lbNoLabel
97350>>>>>>> set piSnap.i liRow to liSnap
97351>>>>>>> if (liClass=class.dbEdit) begin
97353>>>>>>> set piSizeX.i liRow to 50
97354>>>>>>> set piSizeY.i liRow to 200
97355>>>>>>> end
97355>>>>>>>>
97355>>>>>>> end_procedure
97356>>>>>>>
97356>>>>>>> function iEffectiveIsGrid returns integer
97358>>>>>>> integer liViewType
97358>>>>>>> if (pbSideCarFieldsState(self)) function_return DFFALSE
97361>>>>>>> else begin
97362>>>>>>> get piViewType to liViewType
97363>>>>>>>
97363>>>>>>> if (pbChildFieldsState(self)) begin
97365>>>>>>> if (liViewType=VT_SIMPLE) function_return DFFALSE // N/A really
97368>>>>>>> if (liViewType=VT_GRID) function_return DFFALSE // N/A really
97371>>>>>>> if (liViewType=VT_HEADER_DETAIL) function_return DFTRUE
97374>>>>>>> end
97374>>>>>>>>
97374>>>>>>> else begin
97375>>>>>>> if (liViewType=VT_SIMPLE) function_return DFFALSE
97378>>>>>>> if (liViewType=VT_GRID) function_return DFTRUE
97381>>>>>>> if (liViewType=VT_HEADER_DETAIL) function_return DFFALSE
97384>>>>>>> end
97384>>>>>>>>
97384>>>>>>> end
97384>>>>>>>>
97384>>>>>>> function_return DFFALSE // Never exits here anyway!
97385>>>>>>> end_function
97386>>>>>>>
97386>>>>>>> function iEffectiveFile returns integer
97388>>>>>>> integer liFile liViewType
97388>>>>>>> get piViewType to liViewType
97389>>>>>>> if (pbSideCarFieldsState(self)) begin
97391>>>>>>> if (liViewType=VT_SIMPLE) function_return 0
97394>>>>>>> if (liViewType=VT_GRID) get piMainFile to liFile
97397>>>>>>> if (liViewType=VT_HEADER_DETAIL) get piChildFile to liFile
97400>>>>>>> end
97400>>>>>>>>
97400>>>>>>> else begin
97401>>>>>>> if (pbChildFieldsState(self)) begin
97403>>>>>>> if (liViewType=VT_HEADER_DETAIL) get piChildFile to liFile
97406>>>>>>> else function_return 0
97408>>>>>>> end
97408>>>>>>>>
97408>>>>>>> else get piMainFile to liFile
97410>>>>>>> end
97410>>>>>>>>
97410>>>>>>> function_return liFile
97411>>>>>>> end_function
97412>>>>>>>
97412>>>>>>> procedure add_field integer liFile integer liField
97414>>>>>>> integer liType liSegment liLen liClass liRelFile liRelField
97414>>>>>>> string lsType lsName lsFields lsQuestion
97414>>>>>>> get FDX_AttrValue_FIELD ghFDX DF_FIELD_TYPE liFile liField to liType
97415>>>>>>>
97415>>>>>>> get FDX_AttrValue_FIELD ghFDX DF_FIELD_RELATED_FILE liFile liField to liRelFile
97416>>>>>>> if liRelFile begin
97418>>>>>>> get FDX_AttrValue_FIELD ghFDX DF_FIELD_RELATED_FIELD liFile liField to liRelField
97419>>>>>>> get sWarningQuestion.iiii liFile liField liRelFile liRelField to lsQuestion
97420>>>>>>> if (MB_Verify(lsQuestion,DFTRUE)) begin
97422>>>>>>> move liRelFile to liFile
97423>>>>>>> move liRelField to liField
97424>>>>>>> end
97424>>>>>>>>
97424>>>>>>> end
97424>>>>>>>>
97424>>>>>>> if (liType<>DF_BINARY and (not(iEffectiveIsGrid(self)) or liType<>DF_TEXT)) begin
97426>>>>>>> if (liType<>DF_OVERLAP) begin
97428>>>>>>> if (liType=DF_TEXT) move class.dbEdit to liClass
97431>>>>>>> else move class.dbForm to liClass
97433>>>>>>> send add_field_no_bullshit liFile liField liClass 0 DFFALSE
97434>>>>>>> end
97434>>>>>>>>
97434>>>>>>> else begin
97435>>>>>>> // If an overlap field was selected, we add all the fields in it:
97435>>>>>>> get FDX_FieldsInOverlap ghFDX liFile liField to lsFields
97436>>>>>>> move (length(lsFields)+3/4) to liLen
97437>>>>>>> for liSegment from 1 to liLen
97443>>>>>>>>
97443>>>>>>> move (mid(lsFields,4,liSegment-1*4+1)) to liField
97444>>>>>>>
97444>>>>>>> move class.dbForm to liClass
97445>>>>>>> if (liSegment=1) send add_field_no_bullshit liFile liField liClass 0 DFFALSE
97448>>>>>>> else send add_field_no_bullshit liFile liField liClass SL_RIGHT DFTRUE
97450>>>>>>> loop
97451>>>>>>>>
97451>>>>>>> end
97451>>>>>>>>
97451>>>>>>> end
97451>>>>>>>>
97451>>>>>>> else begin
97452>>>>>>> get FDX_AttrValue_FIELD ghFDX DF_FIELD_NAME liFile liField to lsName
97453>>>>>>> if (liType=DF_TEXT) move "is of type TEXT (not allowed in grid)" to lsType
97456>>>>>>> if (liType=DF_BINARY) move "is of type BINARY" to lsType
97459>>>>>>> send obs "Illegal field type!" lsName lsType
97460>>>>>>> end
97460>>>>>>>>
97460>>>>>>> end_procedure
97461>>>>>>>end_class // cFastView_Fields
97462>>>>>>>
97462>>>>>>>class cFastView_ViewDefinition is a cArray
97463>>>>>>> procedure construct_object
97465>>>>>>> integer lhSelf
97465>>>>>>> forward send construct_object
97467>>>>>>> property string psViewTitle public ""
97468>>>>>>> property string psDiskFileName public ""
97469>>>>>>> property integer piViewType public VT_SIMPLE
97470>>>>>>> property integer pbUseGenericDD public DFTRUE
97471>>>>>>> property integer piMainFile public 0
97472>>>>>>> property integer piChildFile public 0
97473>>>>>>> property string psAuthor public ""
97474>>>>>>> property string psPurpose public ""
97475>>>>>>> property string psNotUsed1 public ""
97476>>>>>>> property string psNotUsed2 public ""
97477>>>>>>> property string psNotUsed3 public ""
97478>>>>>>> object oMainFileFields is a cFastView_Fields
97480>>>>>>> end_object
97481>>>>>>> object oChildFileFields is a cFastView_Fields
97483>>>>>>> set pbChildFieldsState to DFTRUE
97484>>>>>>> end_object
97485>>>>>>> object oGridSideCarFields is a cFastView_Fields
97487>>>>>>> set pbSideCarFieldsState to DFTRUE
97488>>>>>>> end_object
97489>>>>>>> object oNotUsedArray1 is a cArray
97491>>>>>>> end_object
97492>>>>>>> object oNotUsedArray2 is a cArray
97494>>>>>>> end_object
97495>>>>>>> object oNotUsedArray3 is a cArray
97497>>>>>>> end_object
97498>>>>>>> move self to lhSelf
97499>>>>>>> send AddDef to (oFastViewDefArray(self)) lhSelf
97500>>>>>>> end_procedure
97501>>>>>>> procedure DoCopyFromOtherDefObject integer lhSourceDef
97503>>>>>>> send reset
97504>>>>>>> set psViewTitle to (psViewTitle(lhSourceDef))
97505>>>>>>> set psDiskFileName to (psDiskFileName(lhSourceDef))
97506>>>>>>> set piViewType to (piViewType(lhSourceDef))
97507>>>>>>> set pbUseGenericDD to (pbUseGenericDD(lhSourceDef))
97508>>>>>>> set piMainFile to (piMainFile(lhSourceDef))
97509>>>>>>> set piChildFile to (piChildFile(lhSourceDef))
97510>>>>>>> set psAuthor to (psAuthor(lhSourceDef))
97511>>>>>>> set psPurpose to (psPurpose(lhSourceDef))
97512>>>>>>> set psNotUsed1 to (psNotUsed1(lhSourceDef))
97513>>>>>>> set psNotUsed2 to (psNotUsed2(lhSourceDef))
97514>>>>>>> set psNotUsed3 to (psNotUsed3(lhSourceDef))
97515>>>>>>> send Clone_Array (oMainFileFields(lhSourceDef)) (oMainFileFields(self))
97516>>>>>>> send Clone_Array (oChildFileFields(lhSourceDef)) (oChildFileFields(self))
97517>>>>>>> send Clone_Array (oGridSideCarFields(lhSourceDef)) (oGridSideCarFields(self))
97518>>>>>>> send Clone_Array (oNotUsedArray1(lhSourceDef)) (oNotUsedArray1(self))
97519>>>>>>> send Clone_Array (oNotUsedArray2(lhSourceDef)) (oNotUsedArray2(self))
97520>>>>>>> send Clone_Array (oNotUsedArray3(lhSourceDef)) (oNotUsedArray3(self))
97521>>>>>>> end_procedure
97522>>>>>>> procedure SEQ_Read_FileName string lsFileName
97524>>>>>>> integer liChannel
97524>>>>>>> string lsVersion
97524>>>>>>> get SEQ_DirectInput lsFileName to liChannel
97525>>>>>>> if (liChannel>=0) begin
97527>>>>>>> send reset
97528>>>>>>> readln channel liChannel lsVersion
97530>>>>>>> set psViewTitle to (SEQ_ReadLn(liChannel))
97531>>>>>>> set piViewType to (SEQ_ReadLn(liChannel))
97532>>>>>>> set pbUseGenericDD to (SEQ_ReadLn(liChannel))
97533>>>>>>> set piMainFile to (SEQ_ReadLn(liChannel))
97534>>>>>>> set piChildFile to (SEQ_ReadLn(liChannel))
97535>>>>>>> set psAuthor to (SEQ_ReadLn(liChannel))
97536>>>>>>> set psPurpose to (SEQ_ReadLn(liChannel))
97537>>>>>>> set psNotUsed1 to (SEQ_ReadLn(liChannel))
97538>>>>>>> set psNotUsed2 to (SEQ_ReadLn(liChannel))
97539>>>>>>> set psNotUsed3 to (SEQ_ReadLn(liChannel))
97540>>>>>>> send SEQ_ReadArrayItems liChannel (oMainFileFields(self))
97541>>>>>>> send SEQ_ReadArrayItems liChannel (oChildFileFields(self))
97542>>>>>>> send SEQ_ReadArrayItems liChannel (oGridSideCarFields(self))
97543>>>>>>> send SEQ_ReadArrayItems liChannel (oNotUsedArray1(self))
97544>>>>>>> send SEQ_ReadArrayItems liChannel (oNotUsedArray2(self))
97545>>>>>>> send SEQ_ReadArrayItems liChannel (oNotUsedArray3(self))
97546>>>>>>> send SEQ_CloseInput liChannel
97547>>>>>>> set psDiskFileName to lsFileName
97548>>>>>>> end
97548>>>>>>>>
97548>>>>>>> end_procedure
97549>>>>>>> procedure DoOpenDefinition
97551>>>>>>> string lsFileName
97551>>>>>>> get FastView_SelectViewDefinition to lsFileName
97552>>>>>>>// get SEQ_SelectFileStartDir "Open fast-view definition" "Fast-view definition|*.fvw" "." to lsFileName
97552>>>>>>> if (lsFileName<>"") send SEQ_Read_FileName lsFileName
97555>>>>>>> end_procedure
97556>>>>>>>
97556>>>>>>> procedure FastView_DefinitionsOnDiskChanged
97558>>>>>>> end_procedure
97559>>>>>>> procedure SEQ_Write_FileName string lsFileName
97561>>>>>>> integer liChannel
97561>>>>>>> get SEQ_DirectOutput lsFileName to liChannel
97562>>>>>>> if (liChannel>=0) begin
97564>>>>>>> writeln channel liChannel "FastView 1.0 - View definition"
97567>>>>>>> writeln (psViewTitle(self))
97569>>>>>>> writeln (piViewType(self))
97571>>>>>>> writeln (pbUseGenericDD(self))
97573>>>>>>> writeln (piMainFile(self))
97575>>>>>>> writeln (piChildFile(self))
97577>>>>>>> writeln (psAuthor(self))
97579>>>>>>> writeln (psPurpose(self))
97581>>>>>>> writeln (psNotUsed1(self))
97583>>>>>>> writeln (psNotUsed2(self))
97585>>>>>>> writeln (psNotUsed3(self))
97587>>>>>>> send SEQ_WriteArrayItems liChannel (oMainFileFields(self))
97588>>>>>>> send SEQ_WriteArrayItems liChannel (oChildFileFields(self))
97589>>>>>>> send SEQ_WriteArrayItems liChannel (oGridSideCarFields(self))
97590>>>>>>> send SEQ_WriteArrayItems liChannel (oNotUsedArray1(self))
97591>>>>>>> send SEQ_WriteArrayItems liChannel (oNotUsedArray2(self))
97592>>>>>>> send SEQ_WriteArrayItems liChannel (oNotUsedArray3(self))
97593>>>>>>> send SEQ_CloseOutput liChannel
97594>>>>>>> set psDiskFileName to lsFileName
97595>>>>>>> broadcast recursive send FastView_DefinitionsOnDiskChanged to desktop
97597>>>>>>> end
97597>>>>>>>>
97597>>>>>>> end_procedure
97598>>>>>>> function sDefaultViewFileName returns string
97600>>>>>>> integer liViewType liFile
97600>>>>>>> string lsFileName lsMainFile lsChildFile
97600>>>>>>> get piViewType to liViewType
97601>>>>>>>
97601>>>>>>> get piMainFile to liFile
97602>>>>>>> get_attribute DF_FILE_LOGICAL_NAME of liFile to lsMainFile
97605>>>>>>>
97605>>>>>>> get piChildFile to liFile
97606>>>>>>> if liFile get_attribute DF_FILE_LOGICAL_NAME of liFile to lsChildFile
97611>>>>>>>
97611>>>>>>> if (liViewType=VT_SIMPLE) move lsMainFile to lsFileName
97614>>>>>>> if (liViewType=VT_GRID) move (lsMainFile+"_grid") to lsFileName
97617>>>>>>> if (liViewType=VT_HEADER_DETAIL) move (lsMainFile+"_"+lsChildFile+"_hd") to lsFileName
97620>>>>>>> function_return (lowercase(lsFileName))
97621>>>>>>> end_function
97622>>>>>>> procedure DoSaveDefinitionAs
97624>>>>>>> string lsFileName lsDiskFileName
97624>>>>>>> get psDiskFileName to lsDiskFileName
97625>>>>>>> if (lsDiskFileName="") begin
97627>>>>>>> get sDefaultViewFileName to lsDiskFileName
97628>>>>>>>
97628>>>>>>> end
97628>>>>>>>>
97628>>>>>>> get FastView_SelectDiskFileName "Save FastView definition" lsDiskFileName "fvw" to lsFileName
97629>>>>>>> if (lsFileName<>"") send SEQ_Write_FileName lsFileName
97632>>>>>>> end_procedure
97633>>>>>>> procedure DoSaveDefinition
97635>>>>>>> string lsFileName
97635>>>>>>> get psDiskFileName to lsFileName
97636>>>>>>> if (lsFileName<>"") send SEQ_Write_FileName lsFileName
97639>>>>>>> else send DoSaveDefinitionAs
97641>>>>>>> end_procedure
97642>>>>>>> procedure reset
97644>>>>>>> set psViewTitle to ""
97645>>>>>>> set piViewType to VT_SIMPLE
97646>>>>>>> set pbUseGenericDD to DFTRUE
97647>>>>>>> set piMainFile to 0
97648>>>>>>> set piChildFile to 0
97649>>>>>>> set psAuthor to ""
97650>>>>>>> set psPurpose to ""
97651>>>>>>> set psNotUsed1 to ""
97652>>>>>>> set psNotUsed2 to ""
97653>>>>>>> set psNotUsed3 to ""
97654>>>>>>> send delete_data to (oMainFileFields(self))
97655>>>>>>> send delete_data to (oChildFileFields(self))
97656>>>>>>> send delete_data to (oGridSideCarFields(self))
97657>>>>>>> send delete_data to (oNotUsedArray1(self))
97658>>>>>>> send delete_data to (oNotUsedArray2(self))
97659>>>>>>> send delete_data to (oNotUsedArray3(self))
97660>>>>>>> end_procedure
97661>>>>>>> register_object oFastViewCreator
97661>>>>>>> function iCreateView returns integer
97663>>>>>>> integer lhSelf lhVw lhDynamo
97663>>>>>>> move self to lhSelf
97664>>>>>>> if (piMainFile(lhSelf)) begin
97666>>>>>>> move (oFastViewCreator(self)) to lhDynamo
97667>>>>>>>// get iCreateFastView of lhDynamo lhSelf to lhVw
97667>>>>>>> get iFastViewCreatePanel lhSelf to lhVw
97668>>>>>>> send AddView to (oFastViewArray(self)) lhVw
97669>>>>>>> end
97669>>>>>>>>
97669>>>>>>> else move 0 to lhVw
97671>>>>>>> function_return lhVw
97672>>>>>>> end_function
97673>>>>>>> function iPopupPanel returns integer
97675>>>>>>> integer lhVw
97675>>>>>>> get iCreateView to lhVw
97676>>>>>>> if lhVw send popup to lhVw
97679>>>>>>> function_return lhVw
97680>>>>>>> end_function
97681>>>>>>> procedure PopupPanel
97683>>>>>>> integer lhVw
97683>>>>>>> get iPopupPanel to lhVw
97684>>>>>>> end_procedure
97685>>>>>>> procedure DoReload integer lhVw
97687>>>>>>> integer liLocation
97687>>>>>>> string lsFileName
97687>>>>>>> get psDiskFileName to lsFileName
97688>>>>>>> if (lsFileName<>"") begin
97690>>>>>>> get location of lhVw to liLocation
97691>>>>>>> send close_panel to lhVw
97692>>>>>>> send SEQ_Read_FileName lsFileName
97693>>>>>>> get iCreateView to lhVw
97694>>>>>>> set location of lhVw to (hi(liLocation)) (low(liLocation))
97695>>>>>>> send popup to lhVw
97696>>>>>>> end
97696>>>>>>>>
97696>>>>>>> else send obs "This definition can not reload because it has never been saved."
97698>>>>>>> end_procedure
97699>>>>>>>end_class // cFastView_ViewDefinition
97700>>>>>>>
97700>>>>>>>class cFastView_LuckyViewDefinition is a cFastView_ViewDefinition
97701>>>>>>> procedure construct_object
97703>>>>>>> integer lhSelf
97703>>>>>>> forward send construct_object
97705>>>>>>> end_procedure
97706>>>>>>> procedure I_Feel_Lucky_Select_Fields integer liFile integer liDontSelectFromThisFile
97708>>>>>>> end_procedure
97709>>>>>>> procedure I_Feel_Lucky integer liViewType integer liMainFile integer liChildFile
97711>>>>>>> set piViewType to liViewType
97712>>>>>>> set pbUseGenericDD to DFTRUE
97713>>>>>>> set piMainFile to liMainFile
97714>>>>>>> set piChildFile to liChildFile
97715>>>>>>>
97715>>>>>>> if (liViewType=VT_SIMPLE) begin
97717>>>>>>> end
97717>>>>>>>>
97717>>>>>>> if (liViewType=VT_GRID) begin
97719>>>>>>> end
97719>>>>>>>>
97719>>>>>>> if (liViewType=VT_HEADER_DETAIL) begin
97721>>>>>>> end
97721>>>>>>>>
97721>>>>>>>
97721>>>>>>> end_procedure
97722>>>>>>>end_class // cFastView_LuckyViewDefinition
97723>>>>>>>
97723>>>>>>>function FastView_CreateViewDefinition global returns integer
97725>>>>>>> integer lhDef
97725>>>>>>> object oFastView_ViewDefinition is a cFastView_LuckyViewDefinition
97727>>>>>>> move self to lhDef
97728>>>>>>> send reset
97729>>>>>>> end_object
97730>>>>>>> function_return lhDef
97731>>>>>>>end_function
97732>>>>>Use FvLayout.pkg //
Including file: fvlayout.pkg (C:\Apps\VDFQuery\AppSrc\fvlayout.pkg)
97732>>>>>>>
97732>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
97732>>>>>>>Use FvHomDir.pkg // Dialogs for saving and opening FastViews
97732>>>>>>>
97732>>>>>>>string gsViewCollectionFileName
97732>>>>>>>move "Default.fvc" to gsViewCollectionFileName
97733>>>>>>>
97733>>>>>>>desktop_section
97738>>>>>>> object oFastViewLayout is a cArray
97740>>>>>>> item_property_list
97740>>>>>>> item_property string psFileName.i
97740>>>>>>> item_property integer piMainFileRecnum.i
97740>>>>>>> item_property integer piChildFileRecnum.i
97740>>>>>>> item_property integer piPosX.i
97740>>>>>>> item_property integer piPosY.i
97740>>>>>>> item_property integer piViewMode.i
97740>>>>>>> end_item_property_list
#REM 97789 DEFINE FUNCTION PIVIEWMODE.I INTEGER LIROW RETURNS INTEGER
#REM 97794 DEFINE PROCEDURE SET PIVIEWMODE.I INTEGER LIROW INTEGER VALUE
#REM 97799 DEFINE FUNCTION PIPOSY.I INTEGER LIROW RETURNS INTEGER
#REM 97804 DEFINE PROCEDURE SET PIPOSY.I INTEGER LIROW INTEGER VALUE
#REM 97809 DEFINE FUNCTION PIPOSX.I INTEGER LIROW RETURNS INTEGER
#REM 97814 DEFINE PROCEDURE SET PIPOSX.I INTEGER LIROW INTEGER VALUE
#REM 97819 DEFINE FUNCTION PICHILDFILERECNUM.I INTEGER LIROW RETURNS INTEGER
#REM 97824 DEFINE PROCEDURE SET PICHILDFILERECNUM.I INTEGER LIROW INTEGER VALUE
#REM 97829 DEFINE FUNCTION PIMAINFILERECNUM.I INTEGER LIROW RETURNS INTEGER
#REM 97834 DEFINE PROCEDURE SET PIMAINFILERECNUM.I INTEGER LIROW INTEGER VALUE
#REM 97839 DEFINE FUNCTION PSFILENAME.I INTEGER LIROW RETURNS STRING
#REM 97844 DEFINE PROCEDURE SET PSFILENAME.I INTEGER LIROW STRING VALUE
97850>>>>>>> procedure WS_OnCloseWorkSpace string lsOldWS
97853>>>>>>> send delete_data
97854>>>>>>> end_procedure
97855>>>>>>> procedure RegisterView integer lhView
97858>>>>>>> integer liRow lhDef liRecnum lhDD liViewMode
97858>>>>>>> string lsLabel
97858>>>>>>> if (active_state(lhView)) begin
97860>>>>>>> get row_count to liRow
97861>>>>>>> get phDefinitionObject of lhView to lhDef
97862>>>>>>> if (psDiskFileName(lhDef)<>"") begin
97864>>>>>>> set psFileName.i liRow to (psDiskFileName(lhDef))
97865>>>>>>> get server of lhView to lhDD
97866>>>>>>> get current_record of lhDD to liRecnum
97867>>>>>>> set piMainFileRecnum.i liRow to liRecnum
97868>>>>>>> get phChildDD of lhView to lhDD
97869>>>>>>> if lhDD begin
97871>>>>>>> get current_record of lhDD to liRecnum
97872>>>>>>> set piChildFileRecnum.i liRow to liRecnum
97873>>>>>>> end
97873>>>>>>>>
97873>>>>>>> set piPosX.i liRow to (hi(location(lhView)))
97874>>>>>>> set piPosY.i liRow to (low(location(lhView)))
97875>>>>>>> get view_mode of lhView to liViewMode
97876>>>>>>> set piViewMode.i liRow to liViewMode
97877>>>>>>> end
97877>>>>>>>>
97877>>>>>>> else begin
97878>>>>>>> get label of lhView to lsLabel
97879>>>>>>> send obs ("View '"+lsLabel+"' can not be part of the collection") "because the definition has not been saved separately"
97880>>>>>>> end
97880>>>>>>>>
97880>>>>>>> end
97880>>>>>>>>
97880>>>>>>> end_procedure
97881>>>>>>> procedure OpenLayouts
97884>>>>>>> integer liRow liMax lhDef lhView
97884>>>>>>> string lsFileName lsPath
97884>>>>>>> get FastView_HomeDirectory to lsPath
97885>>>>>>> get row_count to liMax
97886>>>>>>> decrement liMax
97887>>>>>>> for liRow from 0 to liMax
97893>>>>>>>>
97893>>>>>>> get FastView_CreateViewDefinition to lhDef
97894>>>>>>> get psFileName.i liRow to lsFileName
97895>>>>>>> get SEQ_RemovePathFromFileName lsFileName to lsFileName
97896>>>>>>> get SEQ_ComposeAbsoluteFileName lsPath lsFileName to lsFileName
97897>>>>>>>// send SEQ_Read_FileName to lhDef (psFileName.i(self,liRow))
97897>>>>>>> send SEQ_Read_FileName to lhDef lsFileName
97898>>>>>>> get iCreateView of lhDef to lhView
97899>>>>>>> if lhView begin
97901>>>>>>> set location of lhView to (piPosX.i(self,liRow)) (piPosY.i(self,liRow))
97902>>>>>>> send popup to lhView
97903>>>>>>> set view_mode of lhView to (piViewMode.i(self,liRow))
97904>>>>>>> end
97904>>>>>>>>
97904>>>>>>> loop
97905>>>>>>>>
97905>>>>>>> end_procedure
97906>>>>>>> procedure WS_OnOpenWorkSpace
97909>>>>>>> move "Default.fvc" to gsViewCollectionFileName
97910>>>>>>> end_procedure
97911>>>>>>> end_object // oFastViewLayout
97912>>>>>>>end_desktop_section
97917>>>>>>>
97917>>>>>>>procedure FastView_RegisterWithLayout global integer lhView
97919>>>>>>> send RegisterView to (oFastViewLayout(self)) lhView
97920>>>>>>>end_procedure
97921>>>>>>>
97921>>>>>>>procedure FastView_OpenLayout
97924>>>>>>> string lsPath lsFile
97924>>>>>>> integer liChannel
97924>>>>>>> get FastView_HomeDirectory to lsPath
97925>>>>>>> if (lsPath="") send obs "FastView folder could not be located." "This feature is not available"
97928>>>>>>> else begin
97929>>>>>>> get FastView_OpenViewCollection to lsFile
97930>>>>>>> if (lsFile<>"") begin
97932>>>>>>> move lsFile to gsViewCollectionFileName
97933>>>>>>> get SEQ_ComposeAbsoluteFileName lsPath lsFile to lsFile
97934>>>>>>> get SEQ_DirectInput lsFile to liChannel
97935>>>>>>> if (liChannel>=0) begin
97937>>>>>>> send SEQ_ReadArrayItems liChannel (oFastViewLayout(self))
97938>>>>>>> send SEQ_CloseInput liChannel
97939>>>>>>> send OpenLayouts to (oFastViewLayout(self))
97940>>>>>>> end
97940>>>>>>>>
97940>>>>>>> end
97940>>>>>>>>
97940>>>>>>> end
97940>>>>>>>>
97940>>>>>>>end_procedure
97941>>>>>>>procedure FastView_SaveLayout
97944>>>>>>> string lsPath lsFile
97944>>>>>>> integer liChannel
97944>>>>>>> send delete_data to (oFastViewLayout(self))
97945>>>>>>> broadcast recursive send DoRegisterWithFvLayoutObjectReset to desktop
97947>>>>>>> broadcast recursive send DoRegisterWithFvLayoutObject to desktop
97949>>>>>>> if (row_count(oFastViewLayout(self))) begin
97951>>>>>>>// send obs (row_count(oFastViewLayout(self)))
97951>>>>>>> get FastView_HomeDirectory to lsPath
97952>>>>>>> if (lsPath="") send obs "FastView folder fould not be located." "This feature is not available"
97955>>>>>>> else begin
97956>>>>>>> get FastView_SelectDiskFileName "Save view collection (of currently open views)" gsViewCollectionFileName "fvc" to lsFile
97957>>>>>>> if (lsFile<>"") begin
97959>>>>>>> get SEQ_ComposeAbsoluteFileName lsPath lsFile to lsFile
97960>>>>>>> get SEQ_DirectOutput lsFile to liChannel
97961>>>>>>> if (liChannel>=0) begin
97963>>>>>>> send SEQ_WriteArrayItems liChannel (oFastViewLayout(self))
97964>>>>>>> send SEQ_CloseOutput liChannel
97965>>>>>>> end
97965>>>>>>>>
97965>>>>>>> end
97965>>>>>>>>
97965>>>>>>> end
97965>>>>>>>>
97965>>>>>>> end
97965>>>>>>>>
97965>>>>>>> else send obs "There are no active views to be part of a collection!"
97967>>>>>>>end_procedure
97968>>>>>>>
97968>>>>>>>
97968>>>>>
97968>>>>>// First we define a special dbView and dbEdit classes for the Dynamo to use
97968>>>>>class cFastView_dbView is a aps.dbView
97969>>>>> procedure Load_Environment
97971>>>>> end_procedure
97972>>>>> procedure ReloadDefinition
97974>>>>> integer lhDefinitionObject lhSelf
97974>>>>> move self to lhSelf
97975>>>>> get phDefinitionObject to lhDefinitionObject
97976>>>>> send DoReload to lhDefinitionObject lhSelf
97977>>>>> end_procedure
97978>>>>> procedure SaveDefinition
97980>>>>> integer lhDefinitionObject
97980>>>>> get phDefinitionObject to lhDefinitionObject
97981>>>>> send DoSaveDefinition to lhDefinitionObject
97982>>>>> end_procedure
97983>>>>> procedure SaveDefinitionAs
97985>>>>> integer lhDefinitionObject
97985>>>>> get phDefinitionObject to lhDefinitionObject
97986>>>>> send DoSaveDefinitionAs to lhDefinitionObject
97987>>>>> end_procedure
97988>>>>> procedure EditProperties
97990>>>>> integer lhDefinitionObject lhSelf
97990>>>>> move self to lhSelf
97991>>>>> get phDefinitionObject to lhDefinitionObject
97992>>>>> send Activate_FastViewPropertyEdit lhDefinitionObject lhSelf
97993>>>>> end_procedure
97994>>>>> procedure Request_CloneView
97996>>>>> integer lhDefinitionObject liLocation lhVw
97996>>>>> get location to liLocation
97997>>>>> get phDefinitionObject to lhDefinitionObject
97998>>>>> get iCreateView of lhDefinitionObject to lhVw
97999>>>>> set location of lhVw to (hi(liLocation)+13) (low(liLocation)+13)
98000>>>>> send popup to lhVw
98001>>>>> end_procedure
98002>>>>> procedure construct_object
98004>>>>> forward send construct_object
98006>>>>> property integer phDefinitionObject public 0
98007>>>>> on_key key_ctrl+key_f send Request_Popup_DefaultPromptList
98008>>>>> on_key key_ctrl+key_d send Request_Popup_Calendar
98009>>>>> on_key key_ctrl+key_p send Request_CreateNewQuery
98010>>>>> on_key key_ctrl+key_n send Request_CloneView
98011>>>>> on_key key_alt+key_f2 send Request_Save_No_Clear
98012>>>>> property integer phChildDD public 0
98013>>>>> set p_auto_column to 1
98014>>>>> object oPopupMenu is a FloatingPopupMenu
98016>>>>> send Add_Item MSG_ReloadDefinition "Re-load definition"
98017>>>>> send Add_Item MSG_Request_CloneView "Clone view"
98018>>>>> send Add_Item MSG_None ""
98019>>>>> send Add_Item MSG_SaveDefinition "Save definition"
98020>>>>> send Add_Item MSG_SaveDefinitionAs "Save definition as"
98021>>>>> send Add_Item MSG_None ""
98022>>>>> send Add_Item MSG_EditProperties "Properties"
98023>>>>> end_object
98024>>>>> property integer pbAlreadyRegistered public DFFALSE
98025>>>>> send tab_column_define 1 60 55 JMODE_LEFT
98026>>>>> send tab_column_define 2 120 55 JMODE_RIGHT
98027>>>>> send tab_column_define 3 180 55 JMODE_RIGHT
98028>>>>> send tab_column_define 4 240 55 JMODE_RIGHT
98029>>>>> send tab_column_define 5 300 55 JMODE_RIGHT
98030>>>>> send tab_column_define 6 360 55 JMODE_RIGHT
98031>>>>> send tab_column_define 7 420 55 JMODE_RIGHT
98032>>>>> send tab_column_define 8 480 55 JMODE_RIGHT
98033>>>>> end_procedure
98034>>>>> procedure DoRegisterWithFvLayoutObjectReset
98036>>>>> set pbAlreadyRegistered to DFFALSE
98037>>>>> end_procedure
98038>>>>> procedure DoRegisterWithFvLayoutObject
98040>>>>> integer lhView
98040>>>>> set delegation_mode to DELEGATE_TO_PARENT
98041>>>>> ifnot (pbAlreadyRegistered(self)) begin
98043>>>>> move self to lhView
98044>>>>> send FastView_RegisterWithLayout lhView
98045>>>>> set pbAlreadyRegistered to DFTRUE
98046>>>>> end
98046>>>>>>
98046>>>>> end_procedure
98047>>>>> procedure DoPopupMenu
98049>>>>>if (FV_AdminMode()) begin
98051>>>>> send popup to (oPopupMenu(self))
98052>>>>>end
98052>>>>>>
98052>>>>> end_procedure
98053>>>>> procedure Mouse_Up2 // Right click
98055>>>>> send DoPopupMenu
98056>>>>> end_procedure
98057>>>>> procedure Close_Query_View
98059>>>>> set delegation_mode to DELEGATE_TO_PARENT
98060>>>>> send close_panel
98061>>>>> end_procedure
98062>>>>> procedure close_panel
98064>>>>> forward send close_panel
98066>>>>> send request_destroy_object // Not sent if Escape is used
98067>>>>> end_procedure
98068>>>>>end_class // cFastView_dbView
98069>>>>>
98069>>>>>class cFastView_dbEdit is a aps.dbEdit
98070>>>>> procedure construct_object
98072>>>>> forward send construct_object
98074>>>>> end_procedure
98075>>>>> procedure end_construct_object
98077>>>>> integer liFile liField
98077>>>>> forward send end_construct_object
98079>>>>> get Data_File item 0 to liFile
98080>>>>> get Data_Field item 0 to liField
98081>>>>> Set File_Name to ("DBMS:FS" - string(liFile) - "," - string(liField) )
98082>>>>> end_procedure
98083>>>>> function TooltipHint returns string
98085>>>>> function_return "tool tip string" // or property, or expression etc.
98086>>>>> end_function
98087>>>>>end_class
98088>>>>>
98088>>>>>class cFastView_dbGroup is a aps.dbGroup
98089>>>>> procedure construct_object
98091>>>>> forward send construct_object
98093>>>>> property integer phParentGrid
98094>>>>> send tab_column_define 1 60 55 JMODE_LEFT
98095>>>>> send tab_column_define 2 120 55 JMODE_RIGHT
98096>>>>> send tab_column_define 3 180 55 JMODE_RIGHT
98097>>>>> send tab_column_define 4 240 55 JMODE_RIGHT
98098>>>>> send tab_column_define 5 300 55 JMODE_RIGHT
98099>>>>> send tab_column_define 6 360 55 JMODE_RIGHT
98100>>>>> send tab_column_define 7 420 55 JMODE_RIGHT
98101>>>>> send tab_column_define 8 480 55 JMODE_RIGHT
98102>>>>> on_key key_alt+key_f2 send Request_Save_No_Clear
98103>>>>> end_procedure
98104>>>>> procedure Mouse_Up2 // Right click
98106>>>>> send DoPopupMenu
98107>>>>> end_procedure
98108>>>>> procedure request_save
98110>>>>> send request_save to (phParentGrid(self))
98111>>>>> end_procedure
98112>>>>> procedure request_clear
98114>>>>>// if (should_save(self)) send request_clear to (phParentGrid(self))
98114>>>>>// else send request_clear_all
98114>>>>> send request_clear to (phParentGrid(self))
98115>>>>> end_procedure
98116>>>>> procedure request_delete
98118>>>>> send request_delete to (phParentGrid(self))
98119>>>>> end_procedure
98120>>>>>end_class
98121>>>>>
98121>>>>>object oDeltaColumnWidths is a cArray
98123>>>>>end_object
98124>>>>>
98124>>>>>register_object ToolTipTimer
98124>>>>>
98124>>>>>class cFastView_dbGrid is a aps.dbGrid
98125>>>>> procedure construct_object
98127>>>>> forward send construct_object
98129>>>>> set highlight_row_state to DFTRUE
98130>>>>> //set highlight_row_color to (rgb(0,255,255))
98130>>>>> //set current_item_color to (rgb(0,255,255))
98130>>>>>
98130>>>>>// set CurrentCellColor to clHighlight
98130>>>>>// set CurrentCellTextColor to clHighlightText
98130>>>>> set CurrentRowColor to clHighlight
98131>>>>> set CurrentRowTextColor to clHighlightText
98132>>>>>
98132>>>>> on_key key_alt+key_f2 send Request_Save_No_Clear
98133>>>>> end_procedure
98134>>>>> procedure ActivateFirstFocusableItem
98136>>>>> integer liBase liColumns liMaxItem liItem
98136>>>>> get base_item to liBase
98137>>>>> get Grid_Columns self to liColumns
98138>>>>> move (liBase+liColumns-1) to liMaxItem
98139>>>>> move liBase to liItem
98140>>>>> while (liItem<=liMaxItem)
98144>>>>> ifnot (shadow_state(self,liItem)) begin
98146>>>>> send activate
98147>>>>> set current_item to liItem
98148>>>>> procedure_return
98149>>>>> end
98149>>>>>>
98149>>>>> increment liItem
98150>>>>> end
98151>>>>>>
98151>>>>> end_procedure
98152>>>>> procedure request_delete
98154>>>>> integer liRecnum
98154>>>>> get current_record of (server(self)) to liRecnum
98155>>>>> forward send request_delete
98157>>>>> if (liRecnum<>current_record(server(self))) send ActivateFirstFocusableItem
98160>>>>> end_procedure
98161>>>>> procedure request_save
98163>>>>> forward send request_save
98165>>>>> ifnot (should_save(self)) send ActivateFirstFocusableItem
98168>>>>> end_procedure
98169>>>>> function aps_ColumnCorrection integer liColumn returns integer
98171>>>>> integer liDeltaLen
98171>>>>> get value of (oDeltaColumnWidths(self)) liColumn to liDeltaLen
98172>>>>> function_return liDeltaLen
98173>>>>> end_function
98174>>>>>//function TooltipHint returns string
98174>>>>>// function_return "tool tip string" // or property, or expression etc.
98174>>>>>//end_function
98174>>>>>//Procedure OnMouseDown Integer eButton Integer x Integer y Integer fKeys
98174>>>>>// send CheckRemoveToolTip of ToolTipTimer
98174>>>>>//end_procedure
98174>>>>>end_class
98175>>>>>class cFastView_dbForm is a aps.dbForm
98176>>>>>//function TooltipHint returns string
98176>>>>>// function_return "tool tip string" // or property, or expression etc.
98176>>>>>//end_function
98176>>>>>//Procedure OnMouseDown Integer eButton Integer x Integer y Integer fKeys
98176>>>>>// send CheckRemoveToolTip of ToolTipTimer
98176>>>>>//end_procedure
98176>>>>>end_class
98177>>>>>class cFastView_dbCheckBox is a aps.dbCheckBox
98178>>>>>//function TooltipHint returns string
98178>>>>>// function_return "tool tip string" // or property, or expression etc.
98178>>>>>//end_function
98178>>>>>//Procedure OnMouseDown Integer eButton Integer x Integer y Integer fKeys
98178>>>>>// send CheckRemoveToolTip of ToolTipTimer
98178>>>>>//end_procedure
98178>>>>>end_class
98179>>>>>class cFastView_dbComboForm is a aps.dbComboForm
98180>>>>> procedure construct_object
98182>>>>> forward send construct_object
98184>>>>> set entry_state item 0 to false
98185>>>>> end_procedure
98186>>>>>//function TooltipHint returns string
98186>>>>>// function_return "tool tip string" // or property, or expression etc.
98186>>>>>//end_function
98186>>>>>//Procedure OnMouseDown Integer eButton Integer x Integer y Integer fKeys
98186>>>>>// send CheckRemoveToolTip of ToolTipTimer
98186>>>>>//end_procedure
98186>>>>>end_class
98187>>>>>
98187>>>>>integer ghWhyThis?
98187>>>>>
98187>>>>>object oFastViewCreator is a aps_ObjectDynamo
98189>>>>> set value item class.dbView to U_cFastView_dbView // Use special class
98190>>>>> set value item class.dbEdit to U_cFastView_dbEdit // Use special class
98191>>>>> set value item class.dbGroup to U_cFastView_dbGroup // Use special class
98192>>>>> set value item class.dbGrid to U_cFastView_dbGrid // Use special class
98193>>>>> set value item class.dbForm to U_cFastView_dbForm // Use special class
98194>>>>> set value item class.dbCheckBox to U_cFastView_dbCheckBox
98195>>>>> set value item class.dbComboForm to U_cFastView_dbComboForm
98196>>>>> procedure DoDDFieldSetup integer lhFormList integer lhServer
98199>>>>> integer liRow liMax liFile liField lhGrid lbNoEnter lbCaps lbPrompt lhPrompt
98199>>>>> get row_count of lhFormList to liMax
98200>>>>> decrement liMax
98201>>>>> for liRow from 0 to liMax // Set DataDictionary values
98207>>>>>>
98207>>>>> get piFile.i of lhFormList liRow to liFile
98208>>>>> get piField.i of lhFormList liRow to liField
98209>>>>> get pbForceNoenter.i of lhFormList liRow to lbNoEnter
98210>>>>> get pbCapslock.i of lhFormList liRow to lbCaps
98211>>>>> get pbDefaultSL.i of lhFormList liRow to lbPrompt
98212>>>>>
98212>>>>> if lbPrompt begin
98214>>>>> get File_Field_Property of lhServer liFile liField GET_Field_Prompt_Object to lhPrompt
98215>>>>> ifnot lhPrompt set File_Field_Property of lhServer liFile liField SET_Field_Prompt_Object to (DefaultPromptList(self))
98218>>>>> end
98218>>>>>>
98218>>>>> if lbNoEnter begin
98220>>>>> set File_Field_Property of lhServer liFile liField SET_Field_Options to DD_NOENTER
98221>>>>> end
98221>>>>>>
98221>>>>> if lbCaps begin
98223>>>>> set File_Field_Property of lhServer liFile liField SET_Field_Options to DD_CAPSLOCK
98224>>>>> end
98224>>>>>>
98224>>>>> loop
98225>>>>>>
98225>>>>> end_function
98226>>>>>
98226>>>>> procedure CreateForms integer lhContainer integer lhFormList integer lhServer
98229>>>>> integer liRow liMax liFile liField lhClass lhForm liSnap liSnapRow
98229>>>>> string lsLabel
98229>>>>> send DoDDFieldSetup lhFormList lhServer
98230>>>>>
98230>>>>> get row_count of lhFormList to liMax
98231>>>>> decrement liMax
98232>>>>>
98232>>>>> for liRow from 0 to liMax
98238>>>>>>
98238>>>>> get piClass.i of lhFormList liRow to lhClass
98239>>>>>
98239>>>>> get piSnap.i of lhFormList liRow to liSnap
98240>>>>> if (liSnap>=0 or liRow>0) begin // No relative snaps on row 0!
98242>>>>> if (liSnap<>0) begin
98244>>>>> send add_top_message set_p_snap_location liSnap
98245>>>>> get piLastObjectRow.i of lhFormList liRow to liSnapRow
98246>>>>> if (liSnap=SL_DOWN) begin
98248>>>>> send add_top_message set_label_justification_mode JMODE_RIGHT
98249>>>>> send add_top_message set_label_offset 0 0
98250>>>>> end
98250>>>>>>
98250>>>>> // We do nothing with it
98250>>>>> // get piSnap.i of lhFormList liRow to liSnap
98250>>>>>
98250>>>>> end
98250>>>>>>
98250>>>>> else begin
98251>>>>> if (liRow>0 and piClass.i(lhFormList,liRow-1)=class.dbEdit) begin
98253>>>>> send aps_goto_max_row to lhContainer
98254>>>>> end
98254>>>>>>
98254>>>>> end
98254>>>>>>
98254>>>>> end
98254>>>>>>
98254>>>>> // Label handling
98254>>>>> if (pbNoLabel.i(lhFormList,liRow)) begin
98256>>>>> send add_top_message set_label ""
98257>>>>> send add_top_message set_p_auto_label_state DFFALSE
98258>>>>> end
98258>>>>>>
98258>>>>> else begin
98259>>>>> get psLabel.i of lhFormList liRow to lsLabel
98260>>>>> if (lsLabel<>"") begin
98262>>>>> send add_top_message set_label lsLabel
98263>>>>> send add_top_message set_p_auto_label_state DFFALSE
98264>>>>> end
98264>>>>>>
98264>>>>> end
98264>>>>>>
98264>>>>>
98264>>>>> // Size handling
98264>>>>> if (piSizeX.i(lhFormList,liRow)) begin
98266>>>>> if (piSizeY.i(lhFormList,liRow)) begin
98268>>>>> send add_top_message set_p_auto_size_control_state DFFALSE
98269>>>>> send add_top_message set_size (piSizeX.i(lhFormList,liRow)) (piSizeY.i(lhFormList,liRow))
98270>>>>> end
98270>>>>>>
98270>>>>> else send add_top_message set_size (piSizeX.i(lhFormList,liRow)) 0
98272>>>>> end
98272>>>>>>
98272>>>>> else if (piSizeY.i(lhFormList,liRow)) send add_top_message set_size 0 (piSizeY.i(lhFormList,liRow))
98276>>>>> if (piExtraIntWidth.i(lhFormList,liRow)) send add_top_message set_p_extra_internal_width (piExtraIntWidth.i(lhFormList,liRow))
98279>>>>> if (piExtraExtWidth.i(lhFormList,liRow)) send add_top_message set_p_extra_external_width (piExtraExtWidth.i(lhFormList,liRow))
98282>>>>>
98282>>>>> if (pbForceNoenter.i(lhFormList,liRow) and lhClass=class.dbEdit) send add_top_message set_enabled_state DFFALSE
98285>>>>>
98285>>>>> send push_data_field (piFile.i(lhFormList,liRow)) (piField.i(lhFormList,liRow))
98286>>>>> if (lhClass=class.dbComboForm) begin
98288>>>>> send add_top_message set_p_abstract (0-((piFile.i(lhFormList,liRow)*4096)+piField.i(lhFormList,liRow)))
98289>>>>> end
98289>>>>>>
98289>>>>> get icreate_dynamo_object lhClass to lhForm
98290>>>>> set phObjectID.i of lhFormList liRow to lhForm
98291>>>>> loop
98292>>>>>>
98292>>>>> end_procedure
98293>>>>>
98293>>>>> function CreateGrid integer lhFormList integer lhServer returns integer
98296>>>>> integer liRow liMax liFile liField lhGrid lbNoLabel liOrdering liDeltaLen
98296>>>>> string lsLabel
98296>>>>> get row_count of lhFormList to liMax
98297>>>>> if (liMax>20) begin
98299>>>>> send obs ("You have specified "+string(liMax)+" fields in a Grid object.") "FastView is only capable of handling 20. The remainder will be ignored."
98300>>>>> move 20 to liMax
98301>>>>> end
98301>>>>>>
98301>>>>> send DoDDFieldSetup lhFormList lhServer
98302>>>>> decrement liMax
98303>>>>> for liRow from 0 to liMax // Add the data fields
98309>>>>>>
98309>>>>> get piFile.i of lhFormList liRow to liFile
98310>>>>> get piField.i of lhFormList liRow to liField
98311>>>>> get pbNoLabel.i of lhFormList liRow to lbNoLabel
98312>>>>> get psLabel.i of lhFormList liRow to lsLabel
98313>>>>> get piExtraIntWidth.i of lhFormList liRow to liDeltaLen
98314>>>>> set value of (oDeltaColumnWidths(self)) liRow to liDeltaLen
98315>>>>> if lbNoLabel send add_bottom_message SET_Header_Label liRow ""
98318>>>>> else if (lsLabel<>"") send add_bottom_message SET_Header_Label liRow lsLabel
98322>>>>> send push_data_field liFile liField
98323>>>>> loop
98324>>>>>>
98324>>>>> send add_top_message set_server lhServer
98325>>>>> get FDX_IndexFindPrimary ghFDX (main_file(lhServer)) to liOrdering
98326>>>>> send add_top_message set_ordering liOrdering
98327>>>>> get icreate_dynamo_object class.dbGrid to lhGrid
98328>>>>> function_return lhGrid
98329>>>>> end_function
98330>>>>>
98330>>>>> function CreateGridSidecarFields integer lhFormList integer lhParentGrid integer lhServer returns integer
98333>>>>> integer lhGroup
98333>>>>> if (row_count(lhFormList)) begin
98335>>>>> get icreate_dynamo_object class.dbGroup to lhGroup
98336>>>>> set label of lhGroup to "Current row data"
98337>>>>> set server of lhGroup to lhServer
98338>>>>> set phParentGrid of lhGroup to lhParentGrid
98339>>>>> send CreateForms lhGroup lhFormList lhServer
98340>>>>> send pop_object // dbGroup
98341>>>>> end
98341>>>>>>
98341>>>>> else move 0 to lhGroup
98343>>>>> function_return lhGroup
98344>>>>> end_function
98345>>>>>
98345>>>>> function iCreateFastView integer lhDef returns integer
98348>>>>> integer lhVw liMainFile liChildFile lhMainDD lhChildDD lhGrid liViewType
98348>>>>> integer lbUseGeneric lhGroup liTmp
98348>>>>> integer lbVerticalAbsorberFound lbHorizontalAbsorberFound
98348>>>>>
98348>>>>> move DFFALSE to lbVerticalAbsorberFound
98349>>>>> move DFFALSE to lbHorizontalAbsorberFound
98350>>>>>
98350>>>>> move 0 to lhGrid
98351>>>>> move 0 to lhGroup
98352>>>>>
98352>>>>> send add_top_message set_label (psViewTitle(lhDef))
98353>>>>> get icreate_dynamo_object class.dbView to lhVw
98354>>>>> // Indentation indicates that the object was pushed on the
98354>>>>> // container stack
98354>>>>>
98354>>>>> set phDefinitionObject of lhVw to lhDef
98355>>>>>
98355>>>>> get piViewType of lhDef to liViewType
98356>>>>>
98356>>>>> // Create DDO objects:
98356>>>>> get piMainFile of lhDef to liMainFile
98357>>>>> get pbUseGenericDD of lhDef to lbUseGeneric
98358>>>>> ifnot (FastView_GenericDDsApplicable()) move DFFALSE to lbUseGeneric
98361>>>>> get DDC_CreateDDOStructure lhVw liMainFile lbUseGeneric U_DataDictionary to lhMainDD
98362>>>>>
98362>>>>> if (not(integer(FVSetupValue(FVSETUP_USER_CHG_DATA)))) set read_only_state of lhMainDD to DFTRUE
98365>>>>>
98365>>>>> if (liViewType=VT_HEADER_DETAIL) begin
98367>>>>> get piChildFile of lhDef to liChildFile
98368>>>>> get DDC_CreateChildDDOStructure liChildFile to lhChildDD
98369>>>>> if (not(integer(FVSetupValue(FVSETUP_USER_CHG_DATA)))) set read_only_state of lhChildDD to DFTRUE
98372>>>>> set constrain_file of lhChildDD to liMainFile
98373>>>>> set phChildDD of lhVw to lhChildDD
98374>>>>> end
98374>>>>>>
98374>>>>> set server of lhVw to lhMainDD
98375>>>>> set main_dd of lhVw to lhMainDD
98376>>>>>
98376>>>>> if (liViewType=VT_GRID) begin
98378>>>>> set p_auto_column of lhVw to DFFALSE
98379>>>>> get CreateGrid (oMainFileFields(lhDef)) lhMainDD to lhGrid
98380>>>>> send aps_goto_max_row to lhVw
98381>>>>> get CreateGridSidecarFields (oGridSideCarFields(lhDef)) lhGrid lhMainDD to lhGroup
98382>>>>> move DFTRUE to lbVerticalAbsorberFound
98383>>>>> move DFTRUE to lbHorizontalAbsorberFound
98384>>>>> set peAnchors of lhGrid to anAll
98385>>>>> set peResizeColumn of lhGrid to rcAll
98386>>>>> if lhGroup set peAnchors of lhGroup to anBottomLeftRight
98389>>>>> get iDoAnchors of (oGridSideCarFields(lhDef)) DFFALSE to liTmp
98390>>>>> end
98390>>>>>>
98390>>>>> else begin
98391>>>>> // Create Form things:
98391>>>>> send CreateForms lhVw (oMainFileFields(lhDef)) lhMainDD
98392>>>>>
98392>>>>> // Create grid:
98392>>>>> if (liViewType=VT_HEADER_DETAIL) begin
98394>>>>> set p_auto_column of lhVw to DFFALSE
98395>>>>> send aps_goto_max_row to lhVw
98396>>>>> get CreateGrid (oChildFileFields(lhDef)) lhChildDD to lhGrid
98397>>>>> set child_table_state of lhGrid to TRUE // Saves when exit object
98398>>>>> send aps_goto_max_row to lhVw
98399>>>>> get CreateGridSidecarFields (oGridSideCarFields(lhDef)) lhGrid lhChildDD to lhGroup
98400>>>>> move DFTRUE to lbVerticalAbsorberFound
98401>>>>> move DFTRUE to lbHorizontalAbsorberFound
98402>>>>> set peAnchors of lhGrid to anAll
98403>>>>> set peResizeColumn of lhGrid to rcAll
98404>>>>> if lhGroup set peAnchors of lhGroup to anBottomLeftRight
98407>>>>> get iDoAnchors of (oMainFileFields(lhDef)) DFFALSE to liTmp
98408>>>>> get iDoAnchors of (oGridSideCarFields(lhDef)) DFFALSE to liTmp
98409>>>>> end
98409>>>>>>
98409>>>>> else begin // Simple dimple
98410>>>>> get iDoAnchors of (oMainFileFields(lhDef)) DFTRUE to liTmp
98411>>>>> move (hi(liTmp)) to lbVerticalAbsorberFound
98412>>>>> move (low(liTmp)) to lbHorizontalAbsorberFound
98413>>>>> end
98413>>>>>>
98413>>>>> end
98413>>>>>>
98413>>>>> send pop_object // dbView
98414>>>>> if (lbVerticalAbsorberFound or lbHorizontalAbsorberFound) begin
98416>>>>> set Border_Style of lhVw to BORDER_THICK // Make panel resizeable
98417>>>>> set piMinSize of lhVw to (hi(size(lhVw))) (low(size(lhVw)))
98418>>>>> ifnot lbVerticalAbsorberFound ; set piMaxSize of lhVw to (hi(size(lhVw))) 65535
98421>>>>> else begin
98422>>>>> ifnot lbHorizontalAbsorberFound ; set piMaxSize of lhVw to 65535 (low(size(lhVw)))
98425>>>>> else set Window_Style of lhVw to WS_MAXIMIZEBOX 1
98427>>>>> end
98427>>>>>>
98427>>>>> end
98427>>>>>>
98427>>>>> function_return lhVw
98428>>>>> end_function
98429>>>>> move self to ghWhyThis?
98430>>>>>end_object
98431>>>>>
98431>>>>>function iFastViewCreatePanel global integer lhDef returns integer
98433>>>>> function_return (iCreateFastView(ghWhyThis?,lhDef))
98434>>>>>end_function
98435>>>>>
98435>>> Use FvVwDefn.pkg // FastView, View definition cls (cFastView_ViewDefinition)
98435>>> Use FvWizard.pkg // FastView, Wizard for creating a FastView
Including file: fvwizard.pkg (C:\Apps\VDFQuery\AppSrc\fvwizard.pkg)
98435>>>>>// Use FvWizard.pkg // FastView, Wizard for creating a FastView
98435>>>>>Use ApsWiz.pkg // APS wizard classes
98435>>>>>Use FvVwEdit.pkg // Classes and objects for editing FastView-views
Including file: fvvwedit.pkg (C:\Apps\VDFQuery\AppSrc\fvvwedit.pkg)
98435>>>>>>>// Use FvVwEdit.pkg // Classes and objects for editing FastView-views
98435>>>>>>>Use Aps
98435>>>>>>>Use FdxUiCls.pkg // UI classes for displaying FDX data
98435>>>>>>>Use Classes.pkg // UI Classes for class selection
Including file: classes.pkg (C:\Apps\VDFQuery\AppSrc\classes.pkg)
98435>>>>>>>>>// Use Classes.pkg // UI Classes for class selection
98435>>>>>>>>>
98435>>>>>>>>>Use Classes.nui // Class characteristics
98435>>>>>>>>>
98435>>>>>>>>>Use APS // Auto Positioning and Sizing classes for VDF
98435>>>>>>>>>Use Buttons.utl // Button texts
98435>>>>>>>>>
98435>>>>>>>>>object oSelectUiClass is a aps.ModalPanel label "Select class"
98438>>>>>>>>> set locate_mode to CENTER_ON_SCREEN
98439>>>>>>>>> on_key ksave_record send close_panel_ok
98440>>>>>>>>> on_key kcancel send close_panel
98441>>>>>>>>> property integer piResult public DFFALSE
98443>>>>>>>>> object oLst is a aps.List
98445>>>>>>>>> set size to 200 200
98446>>>>>>>>> procedure mouse_click integer liItem integer liGrb
98449>>>>>>>>> if ((liItem-1)<item_count(self)) send close_panel_ok
98452>>>>>>>>> end_procedure
98453>>>>>>>>>
98453>>>>>>>>> procedure fill_list_help.i integer liClass
98456>>>>>>>>> send add_item MSG_NONE (Cls_ClassName(liClass))
98457>>>>>>>>> set aux_value item (item_count(self)-1) to liClass
98458>>>>>>>>> end_procedure
98459>>>>>>>>> procedure fill_list.iiii integer liClass integer liFieldType integer liLen integer liDec
98462>>>>>>>>> integer liMax liItm
98462>>>>>>>>> send delete_data
98463>>>>>>>>> if (liFieldType=DF_ASCII) begin
98465>>>>>>>>> send fill_list_help.i class.dbForm
98466>>>>>>>>> send fill_list_help.i class.dbComboForm
98467>>>>>>>>> end
98467>>>>>>>>>>
98467>>>>>>>>> if (liFieldType=DF_BCD) begin
98469>>>>>>>>> send fill_list_help.i class.dbForm
98470>>>>>>>>> send fill_list_help.i class.dbComboForm
98471>>>>>>>>> send fill_list_help.i class.dbSpinForm
98472>>>>>>>>> if (liDec=0) send fill_list_help.i class.dbCheckBox
98475>>>>>>>>> end
98475>>>>>>>>>>
98475>>>>>>>>> if (liFieldType=DF_DATE) begin
98477>>>>>>>>> send fill_list_help.i class.dbForm
98478>>>>>>>>> send fill_list_help.i class.dbComboForm
98479>>>>>>>>> send fill_list_help.i class.dbSpinForm
98480>>>>>>>>> end
98480>>>>>>>>>>
98480>>>>>>>>> if (liFieldType=DF_TEXT) begin
98482>>>>>>>>> send fill_list_help.i class.dbEdit
98483>>>>>>>>> end
98483>>>>>>>>>>
98483>>>>>>>>> get item_count to liMax
98484>>>>>>>>> decrement liMax
98485>>>>>>>>> for liItm from 0 to liMax
98491>>>>>>>>>>
98491>>>>>>>>> if (liClass=integer(aux_value(self,liItm))) set current_item to liItm
98494>>>>>>>>> loop
98495>>>>>>>>>>
98495>>>>>>>>> end_procedure
98496>>>>>>>>> end_object
98497>>>>>>>>> object oBtn1 is a aps.Multi_Button
98499>>>>>>>>> on_item t.btn.ok send close_panel_ok
98500>>>>>>>>> end_object
98501>>>>>>>>> object oBtn2 is a aps.Multi_Button
98503>>>>>>>>> on_item t.btn.cancel send close_panel
98504>>>>>>>>> end_object
98505>>>>>>>>> send aps_locate_multi_buttons
98506>>>>>>>>> procedure close_panel_ok
98509>>>>>>>>> set piResult to DFTRUE
98510>>>>>>>>> send close_panel
98511>>>>>>>>> end_procedure
98512>>>>>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
98513>>>>>>>>> procedure aps_onResize integer delta_rw# integer delta_cl#
98516>>>>>>>>> send aps_resize (oLst(self)) delta_rw# 0 // delta_cl#
98517>>>>>>>>> send aps_register_multi_button (oBtn1(self))
98518>>>>>>>>> send aps_register_multi_button (oBtn2(self))
98519>>>>>>>>> send aps_locate_multi_buttons
98520>>>>>>>>> send aps_auto_size_container
98521>>>>>>>>> end_procedure
98522>>>>>>>>> function iPopup.iiii integer liClass integer liFieldType integer liLen integer liDec returns integer
98525>>>>>>>>> set piResult to DFFALSE
98526>>>>>>>>> send fill_list.iiii to (oLst(self)) liClass liFieldType liLen liDec
98527>>>>>>>>> send popup
98528>>>>>>>>> if (piResult(self)) begin
98530>>>>>>>>> get aux_value of (oLst(self)) item CURRENT to liClass
98531>>>>>>>>> function_return liClass
98532>>>>>>>>> end
98532>>>>>>>>>>
98532>>>>>>>>> function_return -1 // None selected
98533>>>>>>>>> end_procedure
98534>>>>>>>>>end_object // oSelectUiClass
98535>>>>>>>>>
98535>>>>>>>>>function Cls_SelectForm global integer liClass integer liFieldType integer liLen integer liDec returns integer
98537>>>>>>>>> function_return (iPopup.iiii(oSelectUiClass(self),liClass,liFieldType,liLen,liDec))
98538>>>>>>>>>end_function
98539>>>>>>>Use FvDynamo.pkg // Part that generates the view based on vw-definition
98539>>>>>>>Use Fdx2.utl // FDX aware object for displaying a table definition
98539>>>>>>>Use Version.nui
98539>>>>>>>
98539>>>>>>>function sSnapText.i global integer liSnap returns string
98541>>>>>>> if liSnap le 0 begin
98543>>>>>>> if liSnap eq 0 function_return "NewLine"
98546>>>>>>> if liSnap eq SL_DOWN function_return "Down"
98549>>>>>>> if liSnap eq SL_LEFT function_return "Left"
98552>>>>>>> if liSnap eq SL_LOWER_RIGHT_CORNER_EXTEND_ROW function_return "lrcer"
98555>>>>>>> if liSnap eq SL_CURRENT_POS_NO_LABEL_ADJUST function_return "X"
98558>>>>>>> if liSnap eq SL_RIGHT function_return "Right"
98561>>>>>>> if liSnap eq SL_UP function_return "Up"
98564>>>>>>> if liSnap eq SL_LOWER_RIGHT_CORNER function_return "X"
98567>>>>>>> if liSnap eq SL_XRIGHT function_return "X"
98570>>>>>>> if liSnap eq SL_UPPER_RIGHT_CORNER_EXTEND_COLUMN function_return "urcec"
98573>>>>>>> if liSnap eq SL_RIGHT_SPACE function_return "Space"
98576>>>>>>> if liSnap eq SL_CURRENT_POS function_return "X"
98579>>>>>>> end
98579>>>>>>>>
98579>>>>>>> else function_return ("Tab "+string(liSnap))
98581>>>>>>>end_function
98582>>>>>>>
98582>>>>>>>object oSnap_SL is a aps.ModalPanel label "Select snap"
98585>>>>>>> set locate_mode to CENTER_ON_SCREEN
98586>>>>>>> on_key ksave_record send close_panel_ok
98587>>>>>>> on_key kcancel send close_panel
98588>>>>>>> property integer piResult public DFFALSE
98590>>>>>>> object oLst is a aps.List
98592>>>>>>> set size to 200 200
98593>>>>>>>
98593>>>>>>> procedure mouse_click integer liItem integer liGrb
98596>>>>>>> if ((liItem-1)<item_count(self)) send close_panel_ok
98599>>>>>>> end_procedure
98600>>>>>>> procedure fill_list_help integer liSnap string lsText
98603>>>>>>> send add_item MSG_NONE lsText
98604>>>>>>> set aux_value item (item_count(self)-1) to liSnap
98605>>>>>>> end_procedure
98606>>>>>>> procedure fill_list.ii integer liCurSnap integer liMaxTab
98609>>>>>>> integer liSnap liMax liItm
98609>>>>>>> send delete_data
98610>>>>>>> send fill_list_help SL_RIGHT (sSnapText.i(SL_RIGHT))
98611>>>>>>> send fill_list_help SL_RIGHT_SPACE (sSnapText.i(SL_RIGHT_SPACE))
98612>>>>>>> send fill_list_help SL_DOWN (sSnapText.i(SL_DOWN))
98613>>>>>>> send fill_list_help 0 (sSnapText.i(0))
98614>>>>>>> for liSnap from 1 to liMaxTab
98620>>>>>>>>
98620>>>>>>> send fill_list_help liSnap (sSnapText.i(liSnap))
98621>>>>>>> loop
98622>>>>>>>>
98622>>>>>>> get item_count to liMax
98623>>>>>>> decrement liMax
98624>>>>>>> for liItm from 0 to liMax
98630>>>>>>>>
98630>>>>>>> if (liCurSnap=aux_value(self,liItm)) set current_item to liItm
98633>>>>>>> loop
98634>>>>>>>>
98634>>>>>>> end_procedure
98635>>>>>>> end_object
98636>>>>>>> object oBtn1 is a aps.Multi_Button
98638>>>>>>> on_item t.btn.ok send close_panel_ok
98639>>>>>>> end_object
98640>>>>>>> object oBtn2 is a aps.Multi_Button
98642>>>>>>> on_item t.btn.cancel send close_panel
98643>>>>>>> end_object
98644>>>>>>> send aps_locate_multi_buttons
98645>>>>>>> procedure close_panel_ok
98648>>>>>>> set piResult to DFTRUE
98649>>>>>>> send close_panel
98650>>>>>>> end_procedure
98651>>>>>>> function iPopup.ii integer liSnap integer liMaxTab returns integer
98654>>>>>>> set piResult to DFFALSE
98655>>>>>>> send fill_list.ii to (oLst(self)) liSnap liMaxTab
98656>>>>>>> send popup
98657>>>>>>> if (piResult(self)) begin
98659>>>>>>> get aux_value of (oLst(self)) item CURRENT to liSnap
98660>>>>>>> function_return liSnap
98661>>>>>>> end
98661>>>>>>>>
98661>>>>>>> function_return -999
98662>>>>>>> end_function
98663>>>>>>>end_object // oSnap_SL
98664>>>>>>>
98664>>>>>>>class cFastView_BasicFieldsGrid is a aps.Grid
98665>>>>>>> procedure construct_object
98667>>>>>>> forward send construct_object
98669>>>>>>> property integer phServer public 0 // handle to cFastView_Fields object
98670>>>>>>> set select_mode to MULTI_SELECT
98671>>>>>>> on_key key_ctrl+key_up_arrow send MoveRowUp
98672>>>>>>> on_key key_ctrl+key_down_arrow send MoveRowDown
98673>>>>>>> set auto_top_item_state to false
98674>>>>>>> on_key kuser send popup_field_selector
98675>>>>>>> on_key kDelete_Record send DeleteRow
98676>>>>>>> on_key KEY_CTRL+KEY_I send DisplayTableDefinition
98677>>>>>>> on_key KEY_CTRL+KEY_W send DoWriteToFile
98678>>>>>>> end_procedure // cFastView_FieldsGridSmall
98679>>>>>>>
98679>>>>>>> procedure DoWriteToFile
98681>>>>>>> send Grid_DoWriteToFile self
98682>>>>>>> end_procedure
98683>>>>>>>
98683>>>>>>> procedure AddRow integer liRow integer lhFieldsObject
98685>>>>>>> end_procedure
98686>>>>>>> procedure fill_list
98688>>>>>>> integer liMax liRow lhObj
98688>>>>>>> set dynamic_update_state to DFFALSE
98689>>>>>>> send delete_data
98690>>>>>>> get phServer to lhObj
98691>>>>>>> get row_count of lhObj to liMax
98692>>>>>>> decrement liMax
98693>>>>>>> for liRow from 0 to liMax
98699>>>>>>>>
98699>>>>>>> send AddRow liRow lhObj
98700>>>>>>> loop
98701>>>>>>>>
98701>>>>>>> set dynamic_update_state to DFTRUE
98702>>>>>>> end_procedure
98703>>>>>>>
98703>>>>>>> procedure RowFromGridToArray integer liRow integer liBase
98705>>>>>>> end_procedure
98706>>>>>>> procedure MoveGridToArray
98708>>>>>>> integer liMax liRow lhServer liBase
98708>>>>>>> get phServer to lhServer
98709>>>>>>> get row_count of lhServer to liMax
98710>>>>>>> decrement liMax
98711>>>>>>> for liRow from 0 to liMax
98717>>>>>>>>
98717>>>>>>> get Grid_RowBaseItem self liRow to liBase
98718>>>>>>> send RowFromGridToArray liRow liBase
98719>>>>>>> loop
98720>>>>>>>>
98720>>>>>>> end_procedure
98721>>>>>>> procedure DisplayTableDefinition
98723>>>>>>> integer liRow liFile
98723>>>>>>> if (item_count(self)) begin
98725>>>>>>> get Grid_CurrentRow self to liRow
98726>>>>>>> get piFile.i of (phServer(self)) liRow to liFile
98727>>>>>>> send FDX_ModalDisplayFileAttributes ghFDX liFile
98728>>>>>>> end
98728>>>>>>>>
98728>>>>>>> end_procedure
98729>>>>>>>
98729>>>>>>> procedure Add_Field integer liFile integer liField
98731>>>>>>> send add_field to (phServer(self)) liFile liField
98732>>>>>>> send fill_list
98733>>>>>>> set Grid_CurrentRow self to (row_count(phServer(self))-1)
98734>>>>>>> end_procedure
98735>>>>>>>
98735>>>>>>> procedure DeleteRow
98737>>>>>>> integer liRow lhServer liMax
98737>>>>>>> get phServer to lhServer
98738>>>>>>> if (item_count(self)) begin
98740>>>>>>> get Grid_CurrentRow self to liRow
98741>>>>>>> send MoveGridToArray
98742>>>>>>> send delete_row to lhServer liRow
98743>>>>>>> send fill_list
98744>>>>>>> get row_count of lhServer to liMax
98745>>>>>>> if liMax begin
98747>>>>>>> if (liRow<liMax) set Grid_CurrentRow self to liRow
98750>>>>>>> else set Grid_CurrentRow self to (liRow-1)
98752>>>>>>> end
98752>>>>>>>>
98752>>>>>>> end
98752>>>>>>>>
98752>>>>>>> end_procedure
98753>>>>>>>
98753>>>>>>> procedure MoveRowUp
98755>>>>>>> integer liRow lhServer
98755>>>>>>> get phServer to lhServer
98756>>>>>>> if (item_count(self)) begin
98758>>>>>>> get Grid_CurrentRow self to liRow
98759>>>>>>> if (liRow>0) begin
98761>>>>>>> send MoveGridToArray
98762>>>>>>> send swap_rows to lhServer liRow (liRow-1)
98763>>>>>>> send fill_list
98764>>>>>>> set Grid_CurrentRow self to (liRow-1)
98765>>>>>>> end
98765>>>>>>>>
98765>>>>>>> end
98765>>>>>>>>
98765>>>>>>> end_procedure
98766>>>>>>>
98766>>>>>>> procedure MoveRowDown
98768>>>>>>> integer liRow lhServer
98768>>>>>>> get phServer to lhServer
98769>>>>>>> if (item_count(self)) begin
98771>>>>>>> get Grid_CurrentRow self to liRow
98772>>>>>>> if (liRow<(row_count(lhServer)-1)) begin
98774>>>>>>> send MoveGridToArray
98775>>>>>>> send swap_rows to lhServer liRow (liRow+1)
98776>>>>>>> send fill_list
98777>>>>>>> set Grid_CurrentRow self to (liRow+1)
98778>>>>>>> end
98778>>>>>>>>
98778>>>>>>> end
98778>>>>>>>>
98778>>>>>>> end_procedure
98779>>>>>>> procedure popup_field_selector
98781>>>>>>> integer liFile lhServer liLen liPos liField liMax liViewType
98781>>>>>>> string lsFields lsFileField
98781>>>>>>> get phServer to lhServer
98782>>>>>>> get iEffectiveFile of lhServer to liFile
98783>>>>>>> if liFile begin
98785>>>>>>> get FDX_PopupFdxTreeViewFieldSelector ghFDX liFile DFTRUE to lsFields
98786>>>>>>> move (length(lsFields)) to liLen
98787>>>>>>> move (liLen/8) to liMax
98788>>>>>>> for liPos from 1 to liMax
98794>>>>>>>>
98794>>>>>>> move (mid(lsFields,8,liPos-1*8+1)) to lsFileField
98795>>>>>>> move (left(lsFileField,4)) to liFile
98796>>>>>>> move (right(lsFileField,4)) to liField
98797>>>>>>> send add_field liFile liField
98798>>>>>>> loop
98799>>>>>>>>
98799>>>>>>> end
98799>>>>>>>>
98799>>>>>>> else send obs "No associated table"
98801>>>>>>> end_procedure
98802>>>>>>> procedure next
98804>>>>>>> integer liItem
98804>>>>>>> get current_item to liItem
98805>>>>>>> if (liItem<(item_count(self)-1)) set current_item to (liItem+1)
98808>>>>>>> else send switch
98810>>>>>>> end_procedure
98811>>>>>>> procedure previous
98813>>>>>>> integer liItem
98813>>>>>>> get current_item to liItem
98814>>>>>>> if (liItem>0) set current_item to (liItem-1)
98817>>>>>>> else send switch_back
98819>>>>>>> end_procedure
98820>>>>>>>end_class // cFastView_BasicFieldsGrid
98821>>>>>>>
98821>>>>>>>class cFastView_FieldsGridSmall is a cFastView_BasicFieldsGrid
98822>>>>>>> procedure construct_object
98824>>>>>>> forward send construct_object
98826>>>>>>> send GridPrepare_AddColumn "#" AFT_ASCII4
98827>>>>>>> send GridPrepare_AddColumn "Selected fields" AFT_ASCII25
98828>>>>>>> send GridPrepare_Apply self
98829>>>>>>> end_procedure
98830>>>>>>> procedure RowFromGridToArray integer liRow integer liBase
98832>>>>>>> integer lhFieldsObject
98832>>>>>>> get phServer to lhFieldsObject
98833>>>>>>> set piFileField.i of lhFieldsObject liRow to (aux_value(self,liBase+1))
98834>>>>>>> end_procedure
98835>>>>>>> procedure AddRow integer liRow integer lhFieldsObject
98837>>>>>>> integer liBase
98837>>>>>>> get item_count to liBase
98838>>>>>>> send add_item MSG_NONE (string(liRow+1))
98839>>>>>>> send add_item MSG_NONE (FDX_FieldName(ghFDX,piFile.i(lhFieldsObject,liRow),piField.i(lhFieldsObject,liRow),DFTRUE))
98840>>>>>>> set aux_value item (liBase+1) to (piFileField.i(lhFieldsObject,liRow))
98841>>>>>>> set entry_state item liBase to DFFALSE
98842>>>>>>> set entry_state item (liBase+1) to DFFALSE
98843>>>>>>> end_procedure
98844>>>>>>>end_class // cFastView_FieldsGridSmall
98845>>>>>>>
98845>>>>>>>class cFastView_FieldsGridBig is a cFastView_BasicFieldsGrid
98846>>>>>>> procedure construct_object
98848>>>>>>> forward send construct_object
98850>>>>>>> send GridPrepare_AddColumn "#" AFT_ASCII4 // 0
98851>>>>>>> send GridPrepare_AddColumn "Fields" AFT_ASCII25 // 1
98852>>>>>>> send GridPrepare_AddColumn "Label" AFT_ASCII25 // 2
98853>>>>>>> send GridPrepare_AddColumn "No lbl" AFT_ASCII3 // 3
98854>>>>>>> send GridPrepare_AddColumn "Snap" AFT_ASCII6 // 4
98855>>>>>>> send GridPrepare_AddColumn "SzX" AFT_NUMERIC3.0 // 5
98856>>>>>>> send GridPrepare_AddColumn "SzY" AFT_NUMERIC3.0 // 6
98857>>>>>>> send GridPrepare_AddColumn "Delta X" AFT_NUMERIC4.0 // 7
98858>>>>>>> send GridPrepare_AddColumn "NoEnter" AFT_ASCII3 // 8
98859>>>>>>> send GridPrepare_AddColumn "Caps" AFT_ASCII3 // 9
98860>>>>>>> send GridPrepare_AddColumn "Prompt" AFT_ASCII3 // 10
98861>>>>>>> send GridPrepare_AddColumn "Class" AFT_ASCII5 // 11
98862>>>>>>> send GridPrepare_Apply self
98863>>>>>>> set aps_fixed_column_width 2 to 75 // Label column
98864>>>>>>> set select_mode to MULTI_SELECT
98865>>>>>>> on_key kPrompt send prompt
98866>>>>>>> on_key kNext_Item send next
98867>>>>>>> on_key kPrevious_Item send previous
98868>>>>>>> end_procedure
98869>>>>>>>
98869>>>>>>> procedure prompt_add_fields
98871>>>>>>> send popup_field_selector
98872>>>>>>> end_procedure
98873>>>>>>>
98873>>>>>>> procedure prompt_snap
98875>>>>>>> integer liRow liSnap liBase lhServer liItem
98875>>>>>>> get Grid_CurrentRow self to liRow
98876>>>>>>> get Grid_RowBaseItem self liRow to liBase
98877>>>>>>> move (liBase+4) to liItem
98878>>>>>>> ifnot (shadow_state(self,liItem)) begin
98880>>>>>>> get aux_value item liItem to liSnap
98881>>>>>>> get phServer to lhServer // Max Tab
98882>>>>>>> get iPopup.ii of (oSnap_SL(self)) liSnap 8 to liSnap
98883>>>>>>> if (liSnap<>-999) begin
98885>>>>>>> set aux_value item liItem to liSnap
98886>>>>>>> set value item liItem to (sSnapText.i(liSnap))
98887>>>>>>> send RowFromGridToArray liRow liBase
98888>>>>>>> end
98888>>>>>>>>
98888>>>>>>> end
98888>>>>>>>>
98888>>>>>>> end_procedure
98889>>>>>>>
98889>>>>>>> procedure prompt_class
98891>>>>>>> integer liFile liField liType liLen liDec liRow liClass liBase lhServer liItem
98891>>>>>>> get Grid_CurrentRow self to liRow
98892>>>>>>> get Grid_RowBaseItem self liRow to liBase
98893>>>>>>> move (liBase+11) to liItem
98894>>>>>>> ifnot (shadow_state(self,liItem)) begin
98896>>>>>>> get aux_value item liItem to liClass
98897>>>>>>> get phServer to lhServer
98898>>>>>>> get piFile.i of lhServer liRow to liFile
98899>>>>>>> get piField.i of lhServer liRow to liField
98900>>>>>>> get FDX_AttrValue_FIELD ghFDX DF_FIELD_TYPE liFile liField to liType
98901>>>>>>> get FDX_AttrValue_FIELD ghFDX DF_FIELD_LENGTH liFile liField to liLen
98902>>>>>>> get FDX_AttrValue_FIELD ghFDX DF_FIELD_PRECISION liFile liField to liDec
98903>>>>>>> get Cls_SelectForm liClass liType liLen liDec to liClass
98904>>>>>>> if (liClass<>-1) begin
98906>>>>>>> set aux_value item liItem to liClass
98907>>>>>>> set value item liItem to (Cls_ClassName(liClass))
98908>>>>>>> send RowFromGridToArray liRow liBase
98909>>>>>>> end
98909>>>>>>>>
98909>>>>>>> end
98909>>>>>>>>
98909>>>>>>> end_procedure
98910>>>>>>> procedure prompt
98912>>>>>>> integer liColumn liClass
98912>>>>>>> if (item_count(self)) begin
98914>>>>>>> get Grid_CurrentColumn self to liColumn
98915>>>>>>> if (liColumn=1) send prompt_add_fields
98918>>>>>>> if (liColumn=11) send prompt_class
98921>>>>>>> if (liColumn=4) send prompt_snap
98924>>>>>>> end
98924>>>>>>>>
98924>>>>>>> end_procedure
98925>>>>>>> procedure mouse_click integer liItem integer liGrb
98927>>>>>>> integer liColumn
98927>>>>>>> if ((liItem-1)<item_count(self)) begin
98929>>>>>>> get Grid_CurrentColumn self to liColumn
98930>>>>>>> if (liColumn=1) send prompt_add_fields
98933>>>>>>> if (liColumn=11) send prompt_class
98936>>>>>>> if (liColumn=4) send prompt_snap
98939>>>>>>> end
98939>>>>>>>>
98939>>>>>>> end_procedure
98940>>>>>>> procedure header_mouse_click integer itm#
98942>>>>>>> forward send header_mouse_click itm#
98944>>>>>>> send prompt
98945>>>>>>> end_procedure
98946>>>>>>> procedure select_toggling integer liItem integer i#
98948>>>>>>> integer liColumn
98948>>>>>>> get Grid_ItemColumn self liItem to liColumn
98949>>>>>>> if (liColumn=3 or liColumn=8 or liColumn=9 or liColumn=10) forward send select_toggling liItem i#
98953>>>>>>> end_procedure
98954>>>>>>> procedure RowFromGridToArray integer liRow integer liBase
98956>>>>>>> integer lhFieldsObject
98956>>>>>>> get phServer to lhFieldsObject
98957>>>>>>> set piFileField.i of lhFieldsObject liRow to (aux_value(self,liBase+1))
98958>>>>>>> set psLabel.i of lhFieldsObject liRow to (value(self,liBase+2))
98959>>>>>>> set pbNoLabel.i of lhFieldsObject liRow to (select_state(self,liBase+3))
98960>>>>>>> set piSnap.i of lhFieldsObject liRow to (aux_value(self,liBase+4))
98961>>>>>>> set piSizeX.i of lhFieldsObject liRow to (value(self,liBase+5))
98962>>>>>>> set piSizeY.i of lhFieldsObject liRow to (value(self,liBase+6))
98963>>>>>>> set piExtraIntWidth.i of lhFieldsObject liRow to (value(self,liBase+7))
98964>>>>>>> set pbForceNoenter.i of lhFieldsObject liRow to (select_state(self,liBase+8))
98965>>>>>>> set pbCapslock.i of lhFieldsObject liRow to (select_state(self,liBase+9))
98966>>>>>>> set pbDefaultSL.i of lhFieldsObject liRow to (select_state(self,liBase+10))
98967>>>>>>> set piClass.i of lhFieldsObject liRow to (aux_value(self,liBase+11))
98968>>>>>>>// set piLastObjectRow.i of lhFieldsObject liRow to (value(self,liBase+11))
98968>>>>>>> end_procedure
98969>>>>>>>
98969>>>>>>>// "#" 0
98969>>>>>>>// "Fields" 1
98969>>>>>>>// "Label" 2
98969>>>>>>>// "No lbl" 3
98969>>>>>>>// "Snap" 4
98969>>>>>>>// "SzX" 5
98969>>>>>>>// "SzY" 6
98969>>>>>>>// "Delta X" 7
98969>>>>>>>// "NoEnter" 8
98969>>>>>>>// "Caps" 9
98969>>>>>>>// "Prompt" 10
98969>>>>>>>// "Class" 11
98969>>>>>>>
98969>>>>>>> procedure DoAutoShadeRow integer liBase
98971>>>>>>> integer lbGrid liClass liFieldType liFile liField liMainIndex
98971>>>>>>> get aux_value item (liBase+11) to liClass
98972>>>>>>> get iEffectiveIsGrid of (phServer(self)) to lbGrid
98973>>>>>>> get aux_value (liBase+1) to liFile
98974>>>>>>> move (mod(liFile,65536)) to liField
98975>>>>>>> move (liFile/65536) to liFile
98976>>>>>>> get FDX_AttrValue_FIELD ghFDX DF_FIELD_TYPE liFile liField to liFieldType
98977>>>>>>> get FDX_AttrValue_FIELD ghFDX DF_FIELD_INDEX liFile liField to liMainIndex
98978>>>>>>>
98978>>>>>>> // Column 0 #
98978>>>>>>> set entry_state item (liBase+0) to DFFALSE
98979>>>>>>> // Column 1 Field
98979>>>>>>> set entry_state item (liBase+1) to DFFALSE
98980>>>>>>> // Column 2 Label
98980>>>>>>> // Column 3 NoLabel
98980>>>>>>> set shadow_state item (liBase+3) to lbGrid
98981>>>>>>> // Column 4 Snap
98981>>>>>>> set entry_state item (liBase+4) to DFFALSE
98982>>>>>>> set shadow_state item (liBase+4) to lbGrid
98983>>>>>>> // Column 5 Size X
98983>>>>>>> set shadow_state item (liBase+5) to (lbGrid or liClass<>class.dbEdit)
98984>>>>>>> // Column 6 Size Y
98984>>>>>>> set shadow_state item (liBase+6) to (lbGrid or liClass<>class.dbEdit)
98985>>>>>>> // Column 7 Delta X
98985>>>>>>> set shadow_state item (liBase+7) to DFFALSE // lbGrid
98986>>>>>>> // Column 8 NoEnter
98986>>>>>>> // Column 9 Capslock
98986>>>>>>> set shadow_state item (liBase+9) to (liFieldType<>DF_ASCII)
98987>>>>>>> // Column 10 PromptList
98987>>>>>>> set shadow_state item (liBase+10) to (liMainIndex=0)
98988>>>>>>> // Column 11 Class
98988>>>>>>> set entry_state item (liBase+11) to DFFALSE
98989>>>>>>> set shadow_state item (liBase+11) to lbGrid
98990>>>>>>> end_procedure
98991>>>>>>>
98991>>>>>>>
98991>>>>>>> procedure AddRow integer liRow integer lhFieldsObject
98993>>>>>>> integer liBase liClass
98993>>>>>>> get item_count to liBase
98994>>>>>>>
98994>>>>>>> // Column 0 #
98994>>>>>>> send add_item MSG_NONE (string(liRow+1))
98995>>>>>>> // Column 1 Field
98995>>>>>>> send add_item MSG_prompt (FDX_FieldName(ghFDX,piFile.i(lhFieldsObject,liRow),piField.i(lhFieldsObject,liRow),DFTRUE))
98996>>>>>>> set aux_value item (liBase+1) to (piFileField.i(lhFieldsObject,liRow))
98997>>>>>>> // Column 2 Label
98997>>>>>>> send add_item MSG_NONE (psLabel.i(lhFieldsObject,liRow))
98998>>>>>>> // Column 3 NoLabel
98998>>>>>>> send add_item MSG_NONE ""
98999>>>>>>> set checkbox_item_state item (liBase+3) to DFTRUE
99000>>>>>>> set select_state item (liBase+3) to (pbNoLabel.i(lhFieldsObject,liRow))
99001>>>>>>> // Column 4 Snap
99001>>>>>>> send add_item MSG_prompt (sSnapText.i(piSnap.i(lhFieldsObject,liRow)))
99002>>>>>>> set aux_value item (liBase+4) to (piSnap.i(lhFieldsObject,liRow))
99003>>>>>>> // Column 5 Size X
99003>>>>>>> send add_item MSG_NONE (piSizeX.i(lhFieldsObject,liRow))
99004>>>>>>> // Column 6 Size Y
99004>>>>>>> send add_item MSG_NONE (piSizeY.i(lhFieldsObject,liRow))
99005>>>>>>> // Column 7 Delta X
99005>>>>>>> send add_item MSG_NONE (piExtraIntWidth.i(lhFieldsObject,liRow))
99006>>>>>>> // Column 8 NoEnter
99006>>>>>>> send add_item MSG_NONE ""
99007>>>>>>> set checkbox_item_state item (liBase+8) to DFTRUE
99008>>>>>>> set select_state item (liBase+8) to (pbForceNoenter.i(lhFieldsObject,liRow))
99009>>>>>>> // Column 9 Capslock
99009>>>>>>> send add_item MSG_NONE ""
99010>>>>>>> set checkbox_item_state item (liBase+9) to DFTRUE
99011>>>>>>> set select_state item (liBase+9) to (pbCapslock.i(lhFieldsObject,liRow))
99012>>>>>>> // Column 10 PromptList
99012>>>>>>> send add_item MSG_NONE ""
99013>>>>>>> set checkbox_item_state item (liBase+10) to DFTRUE
99014>>>>>>> set select_state item (liBase+10) to (pbDefaultSL.i(lhFieldsObject,liRow))
99015>>>>>>> // Column 11 Class
99015>>>>>>> get piClass.i of lhFieldsObject liRow to liClass
99016>>>>>>> send add_item MSG_prompt (Cls_ClassName(liClass))
99017>>>>>>> set aux_value item (liBase+11) to liClass
99018>>>>>>>
99018>>>>>>> send DoAutoShadeRow liBase
99019>>>>>>>
99019>>>>>>>// set entry_state item (liBase+0) to DFFALSE
99019>>>>>>>// set entry_state item (liBase+1) to DFFALSE
99019>>>>>>>// set entry_state item (liBase+2) to DFFALSE
99019>>>>>>>// set entry_state item (liBase+3) to DFTRUE
99019>>>>>>>// set entry_state item (liBase+4) to DFTRUE
99019>>>>>>>// set entry_state item (liBase+5) to DFTRUE
99019>>>>>>>// set entry_state item (liBase+6) to DFTRUE
99019>>>>>>>// set entry_state item (liBase+7) to DFTRUE
99019>>>>>>>// set entry_state item (liBase+8) to DFTRUE
99019>>>>>>>// set entry_state item (liBase+9) to DFTRUE
99019>>>>>>>// set entry_state item (liBase+10) to DFFALSE
99019>>>>>>> end_procedure
99020>>>>>>>end_class // cFastView_FieldsGridBig
99021>>>>>>>
99021>>>>>>>class cFastView.TableSelectorForm is a aps.ComboFormAux
99022>>>>>>> procedure construct_object
99024>>>>>>> forward send construct_object
99026>>>>>>> set combo_sort_state to false
99027>>>>>>> set entry_state item 0 to false
99028>>>>>>> set allow_blank_state to true
99029>>>>>>> property integer priv.pbOK
99030>>>>>>> on_key KEY_CTRL+KEY_I send DisplayTableDefinition
99031>>>>>>> end_procedure
99032>>>>>>> procedure DisplayTableDefinition
99034>>>>>>> integer liFile
99034>>>>>>> get Combo_Current_Aux_Value to liFile
99035>>>>>>> send FDX_ModalDisplayFileAttributes ghFDX liFile
99036>>>>>>> end_procedure
99037>>>>>>> procedure fill_list
99039>>>>>>> integer liFile
99039>>>>>>> string lsValue
99039>>>>>>> send Combo_Delete_Data
99040>>>>>>> move 0 to liFile
99041>>>>>>> repeat
99041>>>>>>>>
99041>>>>>>> get_attribute df_file_next_used of liFile to liFile
99044>>>>>>> if liFile begin
99046>>>>>>> get_attribute DF_FILE_DISPLAY_NAME of liFile to lsValue
99049>>>>>>> send combo_add_item (rtrim(lsValue)) liFile
99050>>>>>>> end
99050>>>>>>>>
99050>>>>>>> until liFile eq 0
99052>>>>>>>// set value item 0 to lsValue
99052>>>>>>> end_procedure
99053>>>>>>> procedure HandleFile integer liType integer liFromFile integer liFromField integer liToFile integer liToField
99055>>>>>>> // We assume that ToFile.ToField is uniquely indexed
99055>>>>>>> integer liIndex
99055>>>>>>> string lsValue
99055>>>>>>> get FDX_IndexFindMatching ghFDX liFromFile (FDX_FieldsTranslateOverlaps(ghFDX,liFromFile,liFromField)) 0 to liIndex
99056>>>>>>> if liIndex begin
99058>>>>>>> get_attribute DF_FILE_DISPLAY_NAME of liFromFile to lsValue
99061>>>>>>> send combo_add_item (rtrim(lsValue)) liFromFile
99062>>>>>>> end
99062>>>>>>>>
99062>>>>>>> end_procedure
99063>>>>>>> procedure fill_list.i integer liConstrainFile
99065>>>>>>> send Combo_Delete_Data
99066>>>>>>> if liConstrainFile send Callback_Relations to ghFDX MSG_HandleFile self FDX_RELORIG_GENERIC 0 liConstrainFile
99069>>>>>>> end_procedure
99070>>>>>>>
99070>>>>>>> procedure HandleFileX integer liType integer liFromFile integer liFromField integer liToFile integer liToField
99072>>>>>>> // We assume that ToFile.ToField is uniquely indexed
99072>>>>>>> ifnot (priv.pbOK(self)) begin
99074>>>>>>> integer liIndex
99074>>>>>>> string lsValue
99074>>>>>>> get FDX_IndexFindMatching ghFDX liFromFile (FDX_FieldsTranslateOverlaps(ghFDX,liFromFile,liFromField)) 0 to liIndex
99075>>>>>>> if liIndex set priv.pbOK to DFTRUE
99078>>>>>>> end
99078>>>>>>>>
99078>>>>>>> end_procedure
99079>>>>>>> procedure fill_list_parents_only
99081>>>>>>> integer liFile
99081>>>>>>> string lsValue
99081>>>>>>> send Combo_Delete_Data
99082>>>>>>> move 0 to liFile
99083>>>>>>> repeat
99083>>>>>>>>
99083>>>>>>> get_attribute df_file_next_used of liFile to liFile
99086>>>>>>> if liFile begin
99088>>>>>>> set priv.pbOK to DFFALSE
99089>>>>>>> send Callback_Relations to ghFDX MSG_HandleFileX self FDX_RELORIG_GENERIC 0 liFile
99090>>>>>>> if (priv.pbOK(self)) begin
99092>>>>>>> get_attribute DF_FILE_DISPLAY_NAME of liFile to lsValue
99095>>>>>>> send combo_add_item (rtrim(lsValue)) liFile
99096>>>>>>> end
99096>>>>>>>>
99096>>>>>>> end
99096>>>>>>>>
99096>>>>>>> until liFile eq 0
99098>>>>>>> end_procedure
99099>>>>>>>end_class // cFastView.TableSelector
99100>>>>>>>
99100>>>>>>>object oFastView_PropertyEdit is a aps.ModalPanel label "Edit FastView properties"
99103>>>>>>> set locate_mode to CENTER_ON_SCREEN
99104>>>>>>> on_key ksave_record send close_panel_ok
99105>>>>>>> on_key kcancel send close_panel
99106>>>>>>> property integer piResult public DFFALSE
99108>>>>>>> property integer phDefinition public 0
99110>>>>>>> property integer phViewObject public 0
99112>>>>>>> property integer piChildFileTmp public 0
99114>>>>>>>
99114>>>>>>> object oWorkingDef is a cFastView_ViewDefinition
99116>>>>>>> end_object
99117>>>>>>>
99117>>>>>>> send tab_column_define 1 40 35 JMODE_LEFT // Default column setting
99118>>>>>>>
99118>>>>>>> set p_auto_column to 1
99119>>>>>>> object oViewTitle is a aps.Form abstract AFT_ASCII60 label "View title:"
99123>>>>>>> end_object
99124>>>>>>> object oRad is a aps.RadioContainer
99126>>>>>>> set enabled_state to DFFALSE
99127>>>>>>> object oRad1 is a aps.Radio label "Form based view"
99130>>>>>>> end_object
99131>>>>>>> object oRad2 is a aps.Radio label "Grid view" snap SL_RIGHT_SPACE
99135>>>>>>> end_object
99136>>>>>>> object oRad3 is a aps.Radio label "Header/Detail view" snap SL_RIGHT_SPACE
99140>>>>>>> end_object
99141>>>>>>> end_object
99142>>>>>>>// send aps_goto_max_row
99142>>>>>>>// send aps_make_row_space 5
99142>>>>>>> register_object oChildFile
99142>>>>>>>
99142>>>>>>> object oMainFile is a cFastView.TableSelectorForm abstract AFT_ASCII30 label "Main table:"
99146>>>>>>> set enabled_state to DFFALSE
99147>>>>>>> procedure OnChange
99150>>>>>>> integer liFile
99150>>>>>>> get Combo_Current_Aux_Value to liFile
99151>>>>>>> send fill_list.i to (oChildFile(self)) liFile
99152>>>>>>> set piMainFile of (phDefinition(self)) to (Combo_Current_Aux_Value(self))
99153>>>>>>> end_procedure
99154>>>>>>> procedure select_table
99157>>>>>>> integer liFile
99157>>>>>>> string lsValue
99157>>>>>>> get Combo_Current_Aux_Value to liFile
99158>>>>>>> move (iFdxSelectOneFileValidate(0,liFile,0,0)) to liFile
99159>>>>>>> if liFile begin
99161>>>>>>> get_attribute DF_FILE_DISPLAY_NAME of liFile to lsValue
99164>>>>>>> set value item 0 to (rtrim(lsValue))
99165>>>>>>> end
99165>>>>>>>>
99165>>>>>>> end_procedure
99166>>>>>>> set p_extra_external_width to 70
99167>>>>>>> end_object
99168>>>>>>> procedure AdvancedTableOpen
99171>>>>>>> send select_table to (oMainFile(self))
99172>>>>>>> end_procedure
99173>>>>>>>
99173>>>>>>>//object oToolButton is a aps.ToolButton snap SL_RIGHT
99173>>>>>>>// set p_extra_external_width to 1
99173>>>>>>>// send Add_Button ICO_STD_FIND msg_AdvancedTableOpen
99173>>>>>>>// send Add_ToolTip t.DfQuery.tt.AdvTableOpen
99173>>>>>>>//end_object
99173>>>>>>>
99173>>>>>>> object oSaveOnExit is a aps.CheckBox label "Automatically save definition on exit" snap SL_RIGHT_SPACE
99177>>>>>>> set checked_state to DFTRUE
99178>>>>>>> end_object
99179>>>>>>> object oChildFile is a cFastView.TableSelectorForm abstract AFT_ASCII30 label "Child table:"
99183>>>>>>> set enabled_state to DFFALSE
99184>>>>>>> procedure OnChange
99187>>>>>>> set piChildFile of (phDefinition(self)) to (Combo_Current_Aux_Value(self))
99188>>>>>>> end_procedure
99189>>>>>>> end_object
99190>>>>>>> object oCb is a aps.CheckBox label "Use Workspace DD objects (if available)"
99193>>>>>>> if (FVSetupValue(FVSETUP_WORKSPACE_NAME)="") set enabled_state to DFFALSE
99196>>>>>>> procedure WS_OnOpenWorkSpace string lsWS
99199>>>>>>> if (integer(FVSetupValue(FVSETUP_USER_BYPASS_WS_DD))) begin
99201>>>>>>> if (FVSetupValue(FVSETUP_WORKSPACE_NAME)<>"") set enabled_state to (FastView_GenericDDsApplicable())
99204>>>>>>> end
99204>>>>>>>>
99204>>>>>>> else begin
99205>>>>>>> set checked_state to DFTRUE
99206>>>>>>> set enabled_state to DFFALSE
99207>>>>>>> end
99207>>>>>>>>
99207>>>>>>> end_procedure
99208>>>>>>> end_object
99209>>>>>>> object oDiskFileName is a aps.Form snap SL_RIGHT_SPACE abstract AFT_ASCII80 label "Saved as:"
99214>>>>>>> set p_extra_internal_width to -150
99215>>>>>>> set enabled_state to DFFALSE
99216>>>>>>> end_object
99217>>>>>>> send aps_goto_max_row
99218>>>>>>> send aps_make_row_space 4
99219>>>>>>> set p_auto_column to 0
99220>>>>>>> object oTabs is a aps.TabDialog
99222>>>>>>> object oTab1 is a aps.TabPage label "Main table fields"
99225>>>>>>> set p_auto_column to 0
99226>>>>>>> object oGrid is a cFastView_FieldsGridBig //snap SL_RIGHT
99228>>>>>>> set size to 150 0
99229>>>>>>> set phServer to (oMainFileFields(oWorkingDef(self)))
99230>>>>>>> end_object
99231>>>>>>> object oBtn1 is a aps.Multi_Button
99233>>>>>>> on_item "Add fields" send prompt_add_fields to (oGrid(self))
99234>>>>>>> set psExtraLabel to "Ctrl+A"
99235>>>>>>> end_object
99236>>>>>>> object oBtn2 is a aps.Multi_Button
99238>>>>>>> on_item "Delete field" send DeleteRow to (oGrid(self))
99239>>>>>>> set psExtraLabel to "Shift+F2"
99240>>>>>>> end_object
99241>>>>>>> object oBtn3 is a aps.Multi_Button
99243>>>>>>> on_item "Move up" send MoveRowUp to (oGrid(self))
99244>>>>>>> set psExtraLabel to "Ctrl+Up"
99245>>>>>>> end_object
99246>>>>>>> object oBtn4 is a aps.Multi_Button
99248>>>>>>> on_item "Move down" send MoveRowDown to (oGrid(self))
99249>>>>>>> set psExtraLabel to "Ctrl+Down"
99250>>>>>>> end_object
99251>>>>>>> object oBtn5 is a aps.Multi_Button
99253>>>>>>> on_item "Change class" send prompt_class to (oGrid(self))
99254>>>>>>> set psExtraLabel to "Ctrl+C"
99255>>>>>>> end_object
99256>>>>>>> object oBtn6 is a aps.Multi_Button
99258>>>>>>> on_item "Change snap" send prompt_snap to (oGrid(self))
99259>>>>>>> set psExtraLabel to "Ctrl+S"
99260>>>>>>> end_object
99261>>>>>>> send aps_locate_multi_buttons
99262>>>>>>> on_key KEY_CTRL+KEY_A send prompt_add_fields to (oGrid(self))
99263>>>>>>> on_key KEY_CTRL+KEY_C send prompt_class to (oGrid(self))
99264>>>>>>> on_key KEY_CTRL+KEY_S send prompt_snap to (oGrid(self))
99265>>>>>>> end_object
99266>>>>>>> object oTab2 is a aps.TabPage label "Child table fields"
99269>>>>>>> set p_auto_column to 0
99270>>>>>>> object oGrid is a cFastView_FieldsGridBig //snap SL_RIGHT
99272>>>>>>> set size to 150 0
99273>>>>>>> set phServer to (oChildFileFields(oWorkingDef(self)))
99274>>>>>>> end_object
99275>>>>>>> object oBtn1 is a aps.Multi_Button
99277>>>>>>> on_item "Add fields" send prompt_add_fields to (oGrid(self))
99278>>>>>>> set psExtraLabel to "Ctrl+A"
99279>>>>>>> end_object
99280>>>>>>> object oBtn2 is a aps.Multi_Button
99282>>>>>>> on_item "Delete field" send DeleteRow to (oGrid(self))
99283>>>>>>> set psExtraLabel to "Shift+F2"
99284>>>>>>> end_object
99285>>>>>>> object oBtn3 is a aps.Multi_Button
99287>>>>>>> on_item "Move up" send MoveRowUp to (oGrid(self))
99288>>>>>>> set psExtraLabel to "Ctrl+Up"
99289>>>>>>> end_object
99290>>>>>>> object oBtn4 is a aps.Multi_Button
99292>>>>>>> on_item "Move down" send MoveRowDown to (oGrid(self))
99293>>>>>>> set psExtraLabel to "Ctrl+Down"
99294>>>>>>> end_object
99295>>>>>>> send aps_locate_multi_buttons
99296>>>>>>> on_key KEY_CTRL+KEY_A send prompt_add_fields to (oGrid(self))
99297>>>>>>> end_object
99298>>>>>>> object oTab3 is a aps.TabPage label "Grid sidecar fields"
99301>>>>>>> set p_auto_column to 0
99302>>>>>>> object oGrid is a cFastView_FieldsGridBig // snap SL_RIGHT
99304>>>>>>> set size to 150 0
99305>>>>>>> set phServer to (oGridSideCarFields(oWorkingDef(self)))
99306>>>>>>> end_object
99307>>>>>>> object oBtn1 is a aps.Multi_Button
99309>>>>>>> on_item "Add fields" send prompt_add_fields to (oGrid(self))
99310>>>>>>> set psExtraLabel to "Ctrl+A"
99311>>>>>>> end_object
99312>>>>>>> object oBtn2 is a aps.Multi_Button
99314>>>>>>> on_item "Delete field" send DeleteRow to (oGrid(self))
99315>>>>>>> set psExtraLabel to "Shift+F2"
99316>>>>>>> end_object
99317>>>>>>> object oBtn3 is a aps.Multi_Button
99319>>>>>>> on_item "Move up" send MoveRowUp to (oGrid(self))
99320>>>>>>> set psExtraLabel to "Ctrl+Up"
99321>>>>>>> end_object
99322>>>>>>> object oBtn4 is a aps.Multi_Button
99324>>>>>>> on_item "Move down" send MoveRowDown to (oGrid(self))
99325>>>>>>> set psExtraLabel to "Ctrl+Down"
99326>>>>>>> end_object
99327>>>>>>> object oBtn5 is a aps.Multi_Button
99329>>>>>>> on_item "Change class" send prompt_class to (oGrid(self))
99330>>>>>>> set psExtraLabel to "Ctrl+C"
99331>>>>>>> end_object
99332>>>>>>> object oBtn6 is a aps.Multi_Button
99334>>>>>>> on_item "Change snap" send prompt_snap to (oGrid(self))
99335>>>>>>> set psExtraLabel to "Ctrl+S"
99336>>>>>>> end_object
99337>>>>>>> send aps_locate_multi_buttons
99338>>>>>>> on_key KEY_CTRL+KEY_A send prompt_add_fields to (oGrid(self))
99339>>>>>>> on_key KEY_CTRL+KEY_C send prompt_class to (oGrid(self))
99340>>>>>>> on_key KEY_CTRL+KEY_S send prompt_snap to (oGrid(self))
99341>>>>>>> end_object
99342>>>>>>> end_object
99343>>>>>>>
99343>>>>>>> procedure read_from_definition
99346>>>>>>> integer lhDef
99346>>>>>>> get phDefinition to lhDef
99347>>>>>>> set value of (oViewTitle(self)) to (psViewTitle(lhDef))
99348>>>>>>> set current_radio of (oRad(self)) to (piViewType(lhDef))
99349>>>>>>> send fill_list to (oMainFile(self))
99350>>>>>>> set Combo_Current_Aux_Value of (oMainFile(self)) to (piMainFile(lhDef))
99351>>>>>>> send fill_list.i to (oChildFile(self)) (piMainFile(lhDef))
99352>>>>>>> set Combo_Current_Aux_Value of (oChildFile(self)) to (piChildFile(lhDef))
99353>>>>>>> set piChildFileTmp to (piChildFile(lhDef))
99354>>>>>>> set Checked_State of (oCb(self)) to (pbUseGenericDD(lhDef))
99355>>>>>>> set value of (oDiskFileName(self)) item 0 to (psDiskFileName(lhDef))
99356>>>>>>> send fill_list to (oGrid(oTab1(oTabs(self))))
99357>>>>>>> send fill_list to (oGrid(oTab2(oTabs(self))))
99358>>>>>>> send fill_list to (oGrid(oTab3(oTabs(self))))
99359>>>>>>> end_procedure
99360>>>>>>>
99360>>>>>>> procedure write_to_definition
99363>>>>>>> integer lhDef
99363>>>>>>> get phDefinition to lhDef
99364>>>>>>> set psViewTitle of lhDef to (value(oViewTitle(self)))
99365>>>>>>> set piViewType of lhDef to (current_radio(oRad(self)))
99366>>>>>>> set piMainFile of lhDef to (Combo_Current_Aux_Value(oMainFile(self)))
99367>>>>>>>// set piChildFile of lhDef to (Combo_Current_Aux_Value(oChildFile(self)))
99367>>>>>>> set piChildFile of lhDef to (piChildFileTmp(self))
99368>>>>>>> set pbUseGenericDD of lhDef to (Checked_State(oCb(self)))
99369>>>>>>> send MoveGridToArray to (oGrid(oTab1(oTabs(self))))
99370>>>>>>> send MoveGridToArray to (oGrid(oTab2(oTabs(self))))
99371>>>>>>> send MoveGridToArray to (oGrid(oTab3(oTabs(self))))
99372>>>>>>> end_procedure
99373>>>>>>>
99373>>>>>>> procedure close_panel_ok
99376>>>>>>> set piResult to DFTRUE
99377>>>>>>> send close_panel
99378>>>>>>> end_procedure
99379>>>>>>> procedure SaveDefinition
99382>>>>>>> send write_to_definition
99383>>>>>>> send DoSaveDefinition to (phDefinition(self))
99384>>>>>>> end_procedure
99385>>>>>>> procedure SaveDefinitionAs
99388>>>>>>> send write_to_definition
99389>>>>>>> send DoSaveDefinitionAs to (phDefinition(self))
99390>>>>>>> end_procedure
99391>>>>>>> object oBtn1 is a aps.Multi_Button
99393>>>>>>> on_item "OK" send close_panel_ok
99394>>>>>>> end_object
99395>>>>>>> object oBtn2 is a aps.Multi_Button
99397>>>>>>> on_item "Cancel" send close_panel
99398>>>>>>> end_object
99399>>>>>>> send aps_locate_multi_buttons
99400>>>>>>>
99400>>>>>>> procedure popup.ii integer lhDef integer lhView
99403>>>>>>> integer liLocation
99403>>>>>>> send DoCopyFromOtherDefObject to (oWorkingDef(self)) lhDef
99404>>>>>>> set phDefinition to (oWorkingDef(self))
99405>>>>>>> set phViewObject to lhView
99406>>>>>>> set piResult to DFFALSE
99407>>>>>>> send read_from_definition
99408>>>>>>> send popup
99409>>>>>>> if (piResult(self)) begin
99411>>>>>>> send write_to_definition
99412>>>>>>> send DoCopyFromOtherDefObject to lhDef (oWorkingDef(self))
99413>>>>>>> if lhView begin
99415>>>>>>> get location of lhView to liLocation
99416>>>>>>> send close_panel to lhView
99417>>>>>>> get iPopupPanel of lhDef to lhView
99418>>>>>>> set location of lhView to (hi(liLocation)) (low(liLocation))
99419>>>>>>> if (checked_state(oSaveOnExit(self))) send SaveDefinition to lhView
99422>>>>>>> end
99422>>>>>>>>
99422>>>>>>> end
99422>>>>>>>>
99422>>>>>>> end_procedure
99423>>>>>>>end_object
99424>>>>>>>
99424>>>>>>>procedure Activate_FastViewPropertyEdit integer lhDef integer lhView
99427>>>>>>> send popup.ii to (oFastView_PropertyEdit(self)) lhDef lhView
99428>>>>>>>end_procedure
99429>>>>>>>
99429>>>>>
99429>>>>>object oFastViewWizard is a aps.WizardPanel label "Create new view"
99432>>>>> send make_nice_size WIZSIZE_NORMAL
99433>>>>> property integer phViewDefinition public 0
99435>>>>> object oPage1 is a aps.WizardPage
99437>>>>> object oLabel1 is a aps.TextBox label "Enter view title as it should appear in the caption bar:"
99440>>>>> set fixed_size to 10 200
99441>>>>> set Fontweight to 900
99442>>>>> end_object
99443>>>>> send aps_goto_max_row
99444>>>>>
99444>>>>> object oFrm1 is a aps.Form abstract AFT_ASCII60
99447>>>>> end_object
99448>>>>> send aps_goto_max_row
99449>>>>> send aps_make_row_space 15
99450>>>>> object oLabel2 is a aps.TextBox label "Specify view type:"
99453>>>>> set fixed_size to 10 80
99454>>>>> set Fontweight to 900
99455>>>>> end_object
99456>>>>> object oRad is a aps.RadioContainer
99458>>>>> object oRad1 is a aps.Radio label "Form based view (F)" snap SL_RIGHT_SPACE
99462>>>>> end_object
99463>>>>> object oRad2 is a aps.Radio label "Grid view (G)" snap SL_DOWN
99467>>>>> end_object
99468>>>>> object oRad3 is a aps.Radio label "Header/Detail view (H/D)" snap SL_DOWN
99472>>>>> end_object
99473>>>>> procedure notify_select_state integer to# integer from#
99476>>>>> end_procedure
99477>>>>> end_object
99478>>>>> send aps_goto_max_row
99479>>>>> send aps_make_row_space 15
99480>>>>> object oCb is a aps.CheckBox label "Use Workspace DD objects (if available)" snap 1
99484>>>>> if (FVSetupValue(FVSETUP_WORKSPACE_NAME)="") set enabled_state to DFFALSE
99487>>>>> procedure WS_OnOpenWorkSpace string lsWS
99490>>>>> if (integer(FVSetupValue(FVSETUP_USER_BYPASS_WS_DD))) begin
99492>>>>> if (FVSetupValue(FVSETUP_WORKSPACE_NAME)<>"") set enabled_state to (FastView_GenericDDsApplicable())
99495>>>>> end
99495>>>>>>
99495>>>>> else begin
99496>>>>> set checked_state to DFTRUE
99497>>>>> set enabled_state to DFFALSE
99498>>>>> end
99498>>>>>>
99498>>>>> end_procedure
99499>>>>> end_object
99500>>>>> end_object
99501>>>>> object oPage2 is a aps.WizardPage
99503>>>>> object oLabel1 is a aps.TextBox label "Select main table:"
99506>>>>> set fixed_size to 10 200
99507>>>>> set Fontweight to 900
99508>>>>> end_object
99509>>>>> send aps_goto_max_row
99510>>>>> register_object oChildFile
99510>>>>> object oMainFile is a cFastView.TableSelectorForm abstract AFT_ASCII40 snap 1
99514>>>>> procedure OnChange
99517>>>>> integer liFile
99517>>>>> get Combo_Current_Aux_Value to liFile
99518>>>>> send fill_list.i to (oChildFile(self)) liFile
99519>>>>> end_procedure
99520>>>>>
99520>>>>> function iFindAuxValue integer liFile returns integer
99523>>>>> integer liItem liMax lhObj
99523>>>>> move (oAux_Values(self)) to lhObj
99524>>>>> get item_count of lhObj to liMax
99525>>>>> decrement liMax
99526>>>>> for liItem from 0 to liMax
99532>>>>>>
99532>>>>> if (value(lhObj,liItem)=liFile) function_return liItem
99535>>>>> loop
99536>>>>>>
99536>>>>> function_return -1
99537>>>>> end_function
99538>>>>>
99538>>>>> function iValidateTable.i integer liFile returns integer
99541>>>>> function_return (iFindAuxValue(self,liFile)<>-1)
99542>>>>> end_function
99543>>>>>
99543>>>>> procedure select_table
99546>>>>> integer liFile lhSelf
99546>>>>> string lsValue
99546>>>>> move self to lhSelf
99547>>>>> get Combo_Current_Aux_Value to liFile
99548>>>>> move (iFdxSelectOneFileValidate(ghFDX,liFile,GET_iValidateTable.i,lhSelf)) to liFile
99549>>>>> if liFile begin
99551>>>>> get_attribute DF_FILE_DISPLAY_NAME of liFile to lsValue
99554>>>>> set value item 0 to (rtrim(lsValue))
99555>>>>> send OnChange
99556>>>>> end
99556>>>>>>
99556>>>>> end_procedure
99557>>>>> end_object
99558>>>>>
99558>>>>> procedure AdvancedTableOpen
99561>>>>> send select_table to (oMainFile(self))
99562>>>>> end_procedure
99563>>>>>
99563>>>>> object oToolButton is a aps.ToolButton snap SL_RIGHT
99566>>>>> set p_extra_external_width to 1
99567>>>>> send Add_Button ICO_STD_FIND msg_AdvancedTableOpen
99568>>>>> send Add_ToolTip t.DfQuery.tt.AdvTableOpen
99569>>>>> end_object
99570>>>>> send aps_goto_max_row
99571>>>>> send aps_make_row_space 15
99572>>>>> object oLabel2 is a aps.TextBox label "Select child table:"
99575>>>>> set fixed_size to 10 200
99576>>>>> set Fontweight to 900
99577>>>>> end_object
99578>>>>> send aps_goto_max_row
99579>>>>> object oChildFile is a cFastView.TableSelectorForm abstract AFT_ASCII40 snap 1
99583>>>>> end_object
99584>>>>>
99584>>>>> function iPageValidate returns integer
99587>>>>> integer liViewType liMainFile liChildFile lbRval
99587>>>>> get Combo_Current_Aux_Value of (oMainFile(self)) to liMainFile
99588>>>>> get Combo_Current_Aux_Value of (oChildFile(self)) to liChildFile
99589>>>>> get current_radio of (oRad(oPage1(self))) to liViewType
99590>>>>> if liMainFile begin
99592>>>>> if (liViewType=VT_HEADER_DETAIL) begin
99594>>>>> if liChildFile move DFTRUE to lbRval
99597>>>>> else begin
99598>>>>> error 202 "You must select child table"
99599>>>>>>
99599>>>>> move DFFALSE to lbRval
99600>>>>> end
99600>>>>>>
99600>>>>> end
99600>>>>>>
99600>>>>> else move DFTRUE to lbRval
99602>>>>> end
99602>>>>>>
99602>>>>> else begin
99603>>>>> error 201 "You must select main table"
99604>>>>>>
99604>>>>> move DFFALSE to lbRval
99605>>>>> end
99605>>>>>>
99605>>>>> function_return lbRval
99606>>>>> end_function
99607>>>>> procedure DoInitialize
99610>>>>> integer liViewType liCurrentAux
99610>>>>> get current_radio of (oRad(oPage1(self))) to liViewType
99611>>>>> set object_shadow_state of (oChildFile(self)) to (liViewType<>VT_HEADER_DETAIL)
99612>>>>> if (liViewType=VT_HEADER_DETAIL) begin
99614>>>>> send cursor_wait to (cursor_control(self))
99615>>>>> get Combo_Current_Aux_Value of (oMainFile(self)) to liCurrentAux
99616>>>>> send fill_list_parents_only to (oMainFile(self))
99617>>>>> if liCurrentAux set Combo_Current_Aux_Value of (oMainFile(self)) to liCurrentAux
99620>>>>> send cursor_ready to (cursor_control(self))
99621>>>>> end
99621>>>>>>
99621>>>>> else begin
99622>>>>> get Combo_Current_Aux_Value of (oMainFile(self)) to liCurrentAux
99623>>>>> send cursor_wait to (cursor_control(self))
99624>>>>> send fill_list to (oMainFile(self))
99625>>>>> send cursor_ready to (cursor_control(self))
99626>>>>> if liCurrentAux set Combo_Current_Aux_Value of (oMainFile(self)) to liCurrentAux
99629>>>>> send Combo_Delete_Data to (oChildFile(self))
99630>>>>> set value of (oChildFile(self)) item 0 to ""
99631>>>>> end
99631>>>>>>
99631>>>>> end_procedure
99632>>>>> procedure DoInitialize_PostPage // Called when the objects have been paged
99635>>>>> send OnChange to (oMainFile(self))
99636>>>>> end_procedure
99637>>>>> end_object // oPage2
99638>>>>> object oPage3 is a aps.WizardPage
99640>>>>> send aps_make_row_space -10
99641>>>>> object oLabel is a aps.TextBox label "Select fields from main table:"
99644>>>>> set fixed_size to 10 200
99645>>>>> set Fontweight to 900
99646>>>>> end_object
99647>>>>> send aps_goto_max_row
99648>>>>> object oTree is a Fdx.TreeViewFieldSelector
99650>>>>> set size to 133 160
99651>>>>> set pbMultiSelectState to DFFALSE
99652>>>>> set pbExcludeOverlaps to true
99653>>>>> set pbExcludeRelatingFields to true
99654>>>>> register_object oGrid
99654>>>>> procedure OnFieldSelect integer liFile integer liField
99657>>>>> send add_field to (oGrid(self)) liFile liField
99658>>>>> end_procedure
99659>>>>> end_object
99660>>>>> object oGrid is a cFastView_FieldsGridSmall
99662>>>>> set size to 115 0
99663>>>>> on_key KNEXT_ITEM send switch
99664>>>>> on_key KPREVIOUS_ITEM send switch_back
99665>>>>> end_object
99666>>>>> object oBtn1 is a aps.Button snap SL_DOWN
99669>>>>> set size to 14 50
99670>>>>> on_item "Delete" send DeleteRow to (oGrid(self))
99671>>>>> end_object
99672>>>>> object oBtn2 is a aps.Button snap SL_RIGHT
99675>>>>> set size to 14 50
99676>>>>> on_item "Move up" send MoveRowUp to (oGrid(self))
99677>>>>> end_object
99678>>>>> object oBtn3 is a aps.Button snap SL_RIGHT
99681>>>>> set size to 14 50
99682>>>>> on_item "Move down" send MoveRowDown to (oGrid(self))
99683>>>>> end_object
99684>>>>> procedure DoInitialize
99687>>>>> integer liFile
99687>>>>> send Write_view_definition
99688>>>>> get Combo_Current_Aux_Value of (oMainFile(oPage2(self))) to liFile
99689>>>>> send fill_list to (oTree(self)) ghFDX liFile DFTRUE
99690>>>>> send delete_data to (oGrid(self))
99691>>>>> send delete_data to (phServer(oGrid(self)))
99692>>>>> end_procedure
99693>>>>> function iPageValidate returns integer
99696>>>>> ifnot (item_count(oGrid(self))) begin
99698>>>>> error 203 "You have to select some fields!"
99699>>>>>>
99699>>>>> function_return DFFALSE
99700>>>>> end
99700>>>>>>
99700>>>>> function_return DFTRUE
99701>>>>> end_function
99702>>>>> end_object
99703>>>>> object oPage4 is a aps.WizardPage
99705>>>>> send aps_make_row_space -10
99706>>>>> object oLabel is a aps.TextBox label "Select fields from child table:"
99709>>>>> set fixed_size to 10 200
99710>>>>> set Fontweight to 900
99711>>>>> end_object
99712>>>>> send aps_goto_max_row
99713>>>>> object oTree is a Fdx.TreeViewFieldSelector
99715>>>>> set size to 133 160
99716>>>>> set pbMultiSelectState to DFFALSE
99717>>>>> set pbExcludeOverlaps to true
99718>>>>> set pbExcludeRelatingFields to true
99719>>>>> register_object oGrid
99719>>>>> procedure OnFieldSelect integer liFile integer liField
99722>>>>> send add_field to (oGrid(self)) liFile liField
99723>>>>> end_procedure
99724>>>>> end_object
99725>>>>> object oGrid is a cFastView_FieldsGridSmall
99727>>>>> set size to 115 0
99728>>>>> on_key KNEXT_ITEM send switch
99729>>>>> on_key KPREVIOUS_ITEM send switch_back
99730>>>>> end_object
99731>>>>> object oBtn1 is a aps.Button snap SL_DOWN
99734>>>>> set size to 14 50
99735>>>>> on_item "Delete" send DeleteRow to (oGrid(self))
99736>>>>> end_object
99737>>>>> object oBtn2 is a aps.Button snap SL_RIGHT
99740>>>>> set size to 14 50
99741>>>>> on_item "Move up" send MoveRowUp to (oGrid(self))
99742>>>>> end_object
99743>>>>> object oBtn3 is a aps.Button snap SL_RIGHT
99746>>>>> set size to 14 50
99747>>>>> on_item "Move down" send MoveRowDown to (oGrid(self))
99748>>>>> end_object
99749>>>>> procedure DoInitialize
99752>>>>> integer liFile
99752>>>>> get Combo_Current_Aux_Value of (oChildFile(oPage2(self))) to liFile
99753>>>>> send fill_list to (oTree(self)) ghFDX liFile DFTRUE
99754>>>>> send delete_data to (oGrid(self))
99755>>>>> send delete_data to (phServer(oGrid(self)))
99756>>>>> end_procedure
99757>>>>> function iPageValidate returns integer
99760>>>>> ifnot (item_count(oGrid(self))) begin
99762>>>>> error 204 "You have to select some fields!"
99763>>>>>>
99763>>>>> function_return DFFALSE
99764>>>>> end
99764>>>>>>
99764>>>>> function_return DFTRUE
99765>>>>> end_function
99766>>>>> end_object
99767>>>>> object oPage99 is a aps.WizardPage
99769>>>>> object oFinishText is an aps.Edit
99771>>>>> set size to 110 300
99772>>>>> set object_shadow_state to DFTRUE
99773>>>>> set border_style to BORDER_NONE
99774>>>>> set scroll_bar_visible_state to DFFALSE
99775>>>>> set value item 0 to 'Click the "Finish" button to create the view.'
99776>>>>> set value item 1 to ''
99777>>>>> set value item 2 to 'Afterwards you may right click the view panel to edit the fields list and/or save the definition to file.'
99778>>>>> set value item 3 to ''
99779>>>>> set value item 4 to 'You may also use the following keys:'
99780>>>>> set value item 5 to ' Ctrl+F for prompt lists in indexed fields'
99781>>>>> set value item 6 to ' Ctrl+P to run a report on the current table'
99782>>>>> set value item 7 to ' Ctrl+D for a calendar on date fields'
99783>>>>> set value item 8 to ' Ctrl+N to clone the current view'
99784>>>>> end_object
99785>>>>> send aps_goto_max_row
99786>>>>> set p_auto_column to 1
99787>>>>> send tab_column_define 1 90 85 JMODE_LEFT
99788>>>>> object oCb is a aps.CheckBox label "I want to save this definition to disk"
99791>>>>> end_object
99792>>>>> end_object
99793>>>>> procedure DisplayPage integer liPage
99796>>>>> integer liCurrentPage
99796>>>>> get piCurrentPage to liCurrentPage
99797>>>>> if (liPage=1) begin //
99799>>>>> if (liCurrentPage<1) send DoInitialize to (oPage2(self))
99802>>>>> end
99802>>>>>>
99802>>>>> if (liPage=2) begin // Select main file fields
99804>>>>> if (liCurrentPage<2) send DoInitialize to (oPage3(self))
99807>>>>> end
99807>>>>>>
99807>>>>> if (liPage=3) begin // Select main file fields
99809>>>>> if (liCurrentPage<3) send DoInitialize to (oPage4(self))
99812>>>>> end
99812>>>>>>
99812>>>>> forward send DisplayPage liPage
99814>>>>> if (liPage=1) begin //
99816>>>>> if (liCurrentPage<1) send DoInitialize_PostPage to (oPage2(self))
99819>>>>> end
99819>>>>>>
99819>>>>> end_procedure
99820>>>>> function iNextPage integer liCurrentPage returns integer
99823>>>>> integer liViewType
99823>>>>> get current_radio of (oRad(oPage1(self))) to liViewType
99824>>>>> if (liCurrentPage=2) begin
99826>>>>> if (liViewType=VT_HEADER_DETAIL) function_return 3
99829>>>>> function_return 4
99830>>>>> end
99830>>>>>>
99830>>>>> function_return (liCurrentPage+1)
99831>>>>> end_function
99832>>>>> procedure Write_view_definition // to definition object
99835>>>>> integer lhViewDefinition
99835>>>>> get phViewDefinition to lhViewDefinition
99836>>>>> set psViewTitle of lhViewDefinition to (value(oFrm1(oPage1(self)),0))
99837>>>>> set piViewType of lhViewDefinition to (current_radio(oRad(oPage1(self))))
99838>>>>> set pbUseGenericDD of lhViewDefinition to (checked_state(oCb(oPage1(self))))
99839>>>>>
99839>>>>> set piMainFile of lhViewDefinition to (Combo_Current_Aux_Value(oMainFile(oPage2(self))))
99840>>>>> set piChildFile of lhViewDefinition to (Combo_Current_Aux_Value(oChildFile(oPage2(self))))
99841>>>>> end_procedure
99842>>>>> procedure Read_view_definition // from definition object
99845>>>>> integer lhViewDefinition
99845>>>>> get phViewDefinition to lhViewDefinition
99846>>>>> set value of (oFrm1(oPage1(self))) item 0 to (psViewTitle(lhViewDefinition))
99847>>>>> set current_radio of (oRad(oPage1(self))) to (piViewType(lhViewDefinition))
99848>>>>> set checked_state of (oCb(oPage1(self))) to (pbUseGenericDD(lhViewDefinition))
99849>>>>>
99849>>>>> send Combo_Delete_Data to (oMainFile(oPage2(self)))
99850>>>>> send Combo_Delete_Data to (oChildFile(oPage2(self)))
99851>>>>>
99851>>>>> set phServer of (oGrid(oPage3(self))) to (oMainFileFields(lhViewDefinition))
99852>>>>> send fill_list to (oGrid(oPage3(self)))
99853>>>>>
99853>>>>> set phServer of (oGrid(oPage4(self))) to (oChildFileFields(lhViewDefinition))
99854>>>>> send fill_list to (oGrid(oPage4(self)))
99855>>>>>
99855>>>>>// set phServer of (oChildFile(oPage2(self))) to (oChildFileFields(lhViewDefinition))
99855>>>>> end_procedure
99856>>>>> procedure popup.i integer lhDef
99859>>>>> set phViewDefinition to lhDef
99860>>>>> send Read_view_definition
99861>>>>> send popup
99862>>>>> end_procedure
99863>>>>> procedure DoFinish
99866>>>>> integer lhVw
99866>>>>> send Write_view_definition
99867>>>>> get iPopupPanel of (phViewDefinition(self)) to lhVw
99868>>>>> if (checked_state(oCb(oPage99(self)))) send SaveDefinitionAs to lhVw
99871>>>>> end_procedure
99872>>>>>end_object // oFastViewWizard
99873>>>>>
99873>>>
99873>>> Use FvMenu.pkg // FastView menu system
Including file: fvmenu.pkg (C:\Apps\VDFQuery\AppSrc\fvmenu.pkg)
99873>>>>>// Use FvMenu.pkg // FastView menu system
99873>>>>>Use APS.pkg // Auto Positioning and Sizing classes for VDF
99873>>>>>Use Files.nui // Utilities for handling file related stuff (No User Interface)
99873>>>>>Use WildCard.nui // WildCardMatch function
99873>>>>>Use VdfQuery.utl // DFQUERY for Visual DataFlex
99873>>>>>
99873>>>>>class cFastMenuData is a cArray
99874>>>>> procedure construct_object
99876>>>>> forward send construct_object
99878>>>>> property string psExtraItem public ""
99879>>>>> property integer piExtraItemMenuItem private -1
99880>>>>> end_procedure
99881>>>>> item_property_list
99881>>>>> item_property integer piItemType.i
99881>>>>> item_property string psFile.i
99881>>>>> item_property string psTitle.i
99881>>>>> item_property integer piMenuItemNumber.i
99881>>>>> end_item_property_list cFastMenuData
#REM 99919 DEFINE FUNCTION PIMENUITEMNUMBER.I INTEGER LIROW RETURNS INTEGER
#REM 99923 DEFINE PROCEDURE SET PIMENUITEMNUMBER.I INTEGER LIROW INTEGER VALUE
#REM 99927 DEFINE FUNCTION PSTITLE.I INTEGER LIROW RETURNS STRING
#REM 99931 DEFINE PROCEDURE SET PSTITLE.I INTEGER LIROW STRING VALUE
#REM 99935 DEFINE FUNCTION PSFILE.I INTEGER LIROW RETURNS STRING
#REM 99939 DEFINE PROCEDURE SET PSFILE.I INTEGER LIROW STRING VALUE
#REM 99943 DEFINE FUNCTION PIITEMTYPE.I INTEGER LIROW RETURNS INTEGER
#REM 99947 DEFINE PROCEDURE SET PIITEMTYPE.I INTEGER LIROW INTEGER VALUE
99952>>>>> procedure add_menu_item integer liType string lsFile string lsTitle
99954>>>>> integer liRow
99954>>>>> get row_count to liRow
99955>>>>> set piItemType.i liRow to liType
99956>>>>> set psFile.i liRow to lsFile
99957>>>>> set psTitle.i liRow to lsTitle
99958>>>>> end_procedure
99959>>>>> procedure fill_menu integer lhMenu
99961>>>>> integer liMax liRow liItem
99961>>>>> string lsExtraItem
99961>>>>> get row_count to liMax
99962>>>>> set !$.piExtraItemMenuItem to -1
99963>>>>> decrement liMax
99964>>>>> for liRow from 0 to liMax
99970>>>>>>
99970>>>>> send add_item of lhMenu MSG_NONE (psTitle.i(self,liRow))
99971>>>>> get item_count of lhMenu to liItem
99972>>>>> set piMenuItemNumber.i liRow to (liItem-1)
99973>>>>> loop
99974>>>>>>
99974>>>>> get psExtraItem to lsExtraItem
99975>>>>> if (liMax=-1 and lsExtraItem="") begin
99977>>>>> send add_item of lhMenu MSG_NONE "No items"
99978>>>>> set shadow_state of lhMenu item 0 to true
99979>>>>> end
99979>>>>>>
99979>>>>> else begin
99980>>>>> if (liMax<>-1) send add_item of lhMenu MSG_NONE ""
99983>>>>> send add_item of lhMenu MSG_NONE lsExtraItem
99984>>>>> get item_count of lhMenu to liItem
99985>>>>> set !$.piExtraItemMenuItem to (liItem-1)
99986>>>>> end
99986>>>>>>
99986>>>>> end_procedure
99987>>>>>
99987>>>>> function FindItemRow integer liMenuItem returns integer
99989>>>>> integer liMax liRow
99989>>>>> if (liMenuItem=!$.piExtraItemMenuItem(self)) function_return -2 // -2 means "ExtraItem" was selected
99992>>>>> get row_count to liMax
99993>>>>> decrement liMax
99994>>>>> for liRow from 0 to liMax
100000>>>>>>
100000>>>>> if (piMenuItemNumber.i(self,liRow)=liMenuItem) function_return liRow
100003>>>>> loop
100004>>>>>>
100004>>>>> function_return -1
100005>>>>> end_function
100006>>>>>
100006>>>>> procedure onRowAction integer liRow
100008>>>>> end_procedure
100009>>>>> procedure item_action integer liMenuItem
100011>>>>> integer liRow
100011>>>>> get FindItemRow liMenuItem to liRow
100012>>>>> if (liRow<>-1) begin
100014>>>>> send onRowAction liRow
100015>>>>> end
100015>>>>>>
100015>>>>> else error 637 "Missing menu action"
100017>>>>> end_procedure
100018>>>>>
100018>>>>> procedure onFileFound string lsFile string lsFolder
100020>>>>> end_procedure
100021>>>>> procedure HandleFile string lsFile string lsFolder
100023>>>>> if (WildCardMatch(lsFile)) begin
100025>>>>> send onFileFound lsFile lsFolder
100026>>>>> end
100026>>>>>>
100026>>>>> end_procedure
100027>>>>> procedure read_data string lsFolder integer lbReload string lsMask
100029>>>>> send delete_data
100030>>>>> if (lsFolder<>"") begin
100032>>>>> if lbReload send SEQ_Load_ItemsInDir lsFolder
100035>>>>> send WildCardMatchPrepare lsMask
100036>>>>> send SEQ_CallBack_ItemsInDir SEQCB_FILES_ONLY MSG_HandleFile self
100037>>>>> end
100037>>>>>>
100037>>>>> end_procedure
100038>>>>>end_class // cFastMenuData
100039>>>>>
100039>>>>>
100039>>>>>object oSharedViewMenuData is a cFastMenuData
100041>>>>>end_object
100042>>>>>object oViewMenuData is a cFastMenuData
100044>>>>> set psExtraItem to "Create a view"
100045>>>>> procedure onRowAction integer liRow
100048>>>>> integer lhDef
100048>>>>> string lsFile
100048>>>>> if (liRow=-2) begin // -2: ExtraItem was selected
100050>>>>> send FastView_CreateNew
100051>>>>> end
100051>>>>>>
100051>>>>> else begin
100052>>>>> get psFile.i liRow to lsFile
100053>>>>> get FastView_CreateViewDefinition to lhDef
100054>>>>> send SEQ_Read_FileName of lhDef lsFile
100055>>>>> send PopupPanel to lhDef
100056>>>>> end
100056>>>>>>
100056>>>>> end_procedure
100057>>>>> procedure read_data
100060>>>>> integer lhFastViewsOnDisk liRow liMax
100060>>>>> string lsFolder lsFile
100060>>>>> send delete_data
100061>>>>> get FastView_HomeDirectory to lsFolder
100062>>>>> if (lsFolder<>"") begin
100064>>>>> move (oFastViewsOnDisk(self)) to lhFastViewsOnDisk
100065>>>>> send ReadDirectory to lhFastViewsOnDisk lsFolder "*.fvw"
100066>>>>> get row_count of lhFastViewsOnDisk to liMax
100067>>>>> decrement liMax
100068>>>>> for liRow from 0 to liMax
100074>>>>>>
100074>>>>> get Files_AppendPath lsFolder (psFileName.i(lhFastViewsOnDisk,liRow)) to lsFile
100075>>>>> send add_menu_item 0 lsFile (psViewTitle.i(lhFastViewsOnDisk,liRow))
100076>>>>> loop
100077>>>>>>
100077>>>>> send sort_rows 2 // By title
100078>>>>> end
100078>>>>>>
100078>>>>> end_procedure
100079>>>>> procedure delete_fieldinfo_data // Sent by FastView when a WS is selected
100082>>>>> send read_data
100083>>>>> end_procedure
100084>>>>>end_object
100085>>>>>object oQueryMenuData is a cFastMenuData
100087>>>>> set psExtraItem to "Create a query"
100088>>>>> procedure onRowAction integer liRow
100091>>>>> integer lhDef
100091>>>>> string lsFile
100091>>>>> if (liRow=-2) begin // -2: ExtraItem was selected
100093>>>>>// send FastView_CreateNewQ
100093>>>>> send Activate_Query_Vw
100094>>>>> end
100094>>>>>>
100094>>>>> else begin
100095>>>>> get psFile.i liRow to lsFile
100096>>>>> send Activate_Query_Vw lsFile
100097>>>>> end
100097>>>>>>
100097>>>>> end_procedure
100098>>>>> procedure read_data
100101>>>>> integer lhQry_DefArray liRow liMax liFile
100101>>>>> string lsFile lsTitle
100101>>>>> send delete_data
100102>>>>> move (oQry_DefArray(self)) to lhQry_DefArray
100103>>>>> send fill_array of lhQry_DefArray
100104>>>>> get row_count of lhQry_DefArray to liMax
100105>>>>> decrement liMax
100106>>>>> for liRow from 0 to liMax
100112>>>>>>
100112>>>>> get psFile.i of lhQry_DefArray liRow to lsFile
100113>>>>> get psTitle.i of lhQry_DefArray liRow to lsTitle
100114>>>>> get piMainFile.i of lhQry_DefArray liRow to liFile
100115>>>>> if (lsTitle="") get FDX_AttrValue_FILELIST ghFDX DF_FILE_DISPLAY_NAME liFile to lsTitle
100118>>>>> send add_menu_item 0 lsFile (rtrim(lsTitle))
100119>>>>> loop
100120>>>>>>
100120>>>>> send sort_rows 2 // By title
100121>>>>> end_procedure
100122>>>>> procedure delete_fieldinfo_data // Sent by FastView when a WS is selected
100125>>>>> send read_data
100126>>>>> end_procedure
100127>>>>>end_object
100128>>>>>object oCollectionMenuData is a cFastMenuData
100130>>>>>end_object
100131>>>>>
100131>>>>>procedure FastView_RefreshMenuData
100134>>>>> send read_data of oViewMenuData
100135>>>>> send read_data of oQueryMenuData
100136>>>>>end_procedure
100137>>>>>
100137>>>>>object oFV_BroadcastReceiver is a cArray
100139>>>>> procedure VDFQ_DefinitionsOnDiskChanged
100142>>>>> send read_data of oQueryMenuData
100143>>>>> end_procedure
100144>>>>> procedure FastView_DefinitionsOnDiskChanged
100147>>>>> send read_data of oViewMenuData
100148>>>>> end_procedure
100149>>>>>end_object
100150>>>
100150>>> set phMenuData of (ViewPullDown(main_menu(self))) to (oViewMenuData(self))
100151>>> set phMenuData of (QueryPullDown(main_menu(self))) to (oQueryMenuData(self))
100152>>>
100152>>> Use ObjTree.pkg // popup_objecttree procedure
Including file: objtree.pkg (C:\Apps\VDFQuery\AppSrc\objtree.pkg)
100152>>>>>// Use objtree.pkg // popup_objecttree procedure
100152>>>>>//
100152>>>>>// Purpose: Testing of tree class by generating a treeview of all objects
100152>>>>>// in the application
100152>>>>>//
100152>>>>>// Use: on_key KEY_CTRL+KEY_O send popup_objecttree
100152>>>>>//
100152>>>>>//
100152>>>>>use aps
100152>>>>>use objtree.nui // DoGenerateObjectTree procedure
Including file: objtree.nui (C:\Apps\VDFQuery\AppSrc\objtree.nui)
100152>>>>>>>// use objtree.nui // DoGenerateObjectTree procedure
100152>>>>>>>use treenode.nui // Defines the cTreeNode class.
Including file: treenode.nui (C:\Apps\VDFQuery\AppSrc\treenode.nui)
100152>>>>>>>>>//use treenode.nui // Defines the cTreeNode class.
100152>>>>>>>>>
100152>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
100152>>>>>>>>>
100152>>>>>>>>>class cTreeNodeDataObject is a cArray
100153>>>>>>>>> procedure DoReset
100155>>>>>>>>> // This needs to be defined because the cTreeNode will send this
100155>>>>>>>>> // message as preparation for destroying the object.
100155>>>>>>>>> end_procedure
100156>>>>>>>>> procedure SEQ_Read integer liChannel
100158>>>>>>>>> end_procedure
100159>>>>>>>>> procedure SEQ_Write integer liChannel
100161>>>>>>>>> end_procedure
100162>>>>>>>>> function TreeViewLabel returns string
100164>>>>>>>>> function_return "No label"
100165>>>>>>>>> end_function
100166>>>>>>>>>end_class // cTreeNodeDataObject
100167>>>>>>>>>
100167>>>>>>>>>class cTreeNode is a cArray
100168>>>>>>>>> //> The items of this array holds pointers to child nodes
100168>>>>>>>>> procedure construct_object
100170>>>>>>>>> forward send construct_object
100172>>>>>>>>> //> Pointer to the parent node. Only the ultimate parent will have a 0 value in this property
100172>>>>>>>>> property integer phParentNode public 0
100173>>>>>>>>>
100173>>>>>>>>> //> This Points to an object that holds the data of this particular node:
100173>>>>>>>>> property integer phDataObject public 0
100174>>>>>>>>>
100174>>>>>>>>> //> All data objects created as children of this object will be of this class:
100174>>>>>>>>> property integer phDataClass public U_cTreeNodeDataObject
100175>>>>>>>>>
100175>>>>>>>>> //> All child node objects created as children of this object will be of this class:
100175>>>>>>>>> property integer phNodeClass public U_cTreeNode
100176>>>>>>>>> end_procedure
100177>>>>>>>>>
100177>>>>>>>>> procedure insert_item integer liInsertItem
100179>>>>>>>>> // Insert an empty item in the list of childnodes (aux procedure for
100179>>>>>>>>> // the hInsertChildNode function.
100179>>>>>>>>> integer liItem liMax
100179>>>>>>>>> get item_count to liMax
100180>>>>>>>>> for_ex liItem from liMax down_to (liInsertItem+1)
100187>>>>>>>>> set value item liItem to (value(self,liItem-1))
100188>>>>>>>>> loop
100189>>>>>>>>>>
100189>>>>>>>>> set value item liInsertItem to 0
100190>>>>>>>>> end_procedure
100191>>>>>>>>>
100191>>>>>>>>> function hCreateChildNode returns integer
100193>>>>>>>>> integer lhObject lhClass
100193>>>>>>>>> get phNodeClass to lhClass
100194>>>>>>>>> name lhClass U_cTreeNodeClass
100194>>>>>>>>> object oTreeNode is a cTreeNodeClass NO_IMAGE
100196>>>>>>>>> move self to lhObject
100197>>>>>>>>> end_object
100198>>>>>>>>> function_return lhObject
100199>>>>>>>>> end_function
100200>>>>>>>>>
100200>>>>>>>>> //> Create and append a child node. The function returns the object id of the
100200>>>>>>>>> //> new child node.
100200>>>>>>>>> function hAddChildNode returns integer
100202>>>>>>>>> integer liItem lhObject
100202>>>>>>>>> get item_count to liItem
100203>>>>>>>>> get hCreateChildNode to lhObject
100204>>>>>>>>> set phParentNode of lhObject to self
100205>>>>>>>>> set value item liItem to lhObject
100206>>>>>>>>> function_return lhObject
100207>>>>>>>>> end_function
100208>>>>>>>>> //> Create and insert a node in the list of child nodes. The function returns the object
100208>>>>>>>>> //> id of the new child node.
100208>>>>>>>>> function hInsertChildNode integer liItem returns integer
100210>>>>>>>>> integer lhObject
100210>>>>>>>>> send insert_item liItem
100211>>>>>>>>>
100211>>>>>>>>> get hCreateChildNode to lhObject
100212>>>>>>>>>
100212>>>>>>>>> set phParentNode of lhObject to self
100213>>>>>>>>> set value item liItem to lhObject
100214>>>>>>>>> function_return lhObject
100215>>>>>>>>> end_function
100216>>>>>>>>>
100216>>>>>>>>> //> Delete and destroy all data referenced by this object (except the object itself).
100216>>>>>>>>> procedure DoReset
100218>>>>>>>>> integer liItem liMax
100218>>>>>>>>> get item_count to liMax
100219>>>>>>>>> decrement liMax
100220>>>>>>>>> for liItem from 0 to liMax
100226>>>>>>>>>>
100226>>>>>>>>> send DoDestroy to (integer(value(self,liItem)))
100227>>>>>>>>> loop
100228>>>>>>>>>>
100228>>>>>>>>> send delete_data
100229>>>>>>>>> end_procedure
100230>>>>>>>>>
100230>>>>>>>>> procedure DestroyDataObject
100232>>>>>>>>> integer lhData
100232>>>>>>>>> get phDataObject to lhData
100233>>>>>>>>> if lhData begin
100235>>>>>>>>> send DoReset to lhData // Prepare the object for destroying
100236>>>>>>>>> send request_destroy_object to lhData
100237>>>>>>>>> set phDataObject to 0
100238>>>>>>>>> end
100238>>>>>>>>>>
100238>>>>>>>>> end_procedure
100239>>>>>>>>>
100239>>>>>>>>> function iParentNodeIndex returns integer
100241>>>>>>>>> integer lhSelf lhParentNode liMax liItem
100241>>>>>>>>> move self to lhSelf
100242>>>>>>>>> get phParentNode to lhParentNode
100243>>>>>>>>> get item_count of lhParentNode to liMax
100244>>>>>>>>> decrement liMax
100245>>>>>>>>> for liItem from 0 to liMax
100251>>>>>>>>>>
100251>>>>>>>>> if (integer(value(lhParentNode,liItem))=lhSelf) function_return liItem
100254>>>>>>>>> loop
100255>>>>>>>>>>
100255>>>>>>>>> function_return -1
100256>>>>>>>>> end_function
100257>>>>>>>>>
100257>>>>>>>>> //> Function Request_SwitchUp will attempt to switch positions with the
100257>>>>>>>>> //> preceeding sibling. If successful, true will be returned.
100257>>>>>>>>> function Request_SwitchUp returns integer
100259>>>>>>>>>
100259>>>>>>>>> end_function
100260>>>>>>>>>
100260>>>>>>>>> procedure DoDestroy
100262>>>>>>>>> send DoReset
100263>>>>>>>>> send DestroyDataObject
100264>>>>>>>>> send request_destroy_object // Destroy yourself
100265>>>>>>>>> end_procedure
100266>>>>>>>>>
100266>>>>>>>>> procedure DoDestroyItem integer liItem
100268>>>>>>>>> send DoDestroy to (integer(value(self,liItem)))
100269>>>>>>>>> send delete_item liItem
100270>>>>>>>>> end_procedure
100271>>>>>>>>>
100271>>>>>>>>> //> Instantiate a data object for this node (of the cTreeNodeDataClass class)
100271>>>>>>>>> function hCreateDataObject returns integer
100273>>>>>>>>> integer lhObject lhDataClass
100273>>>>>>>>> get phDataObject to lhObject
100274>>>>>>>>> ifnot lhObject begin
100276>>>>>>>>> get phDataClass to lhDataClass
100277>>>>>>>>> name lhDataClass U_cTreeNodeDataClass
100277>>>>>>>>> object oTreeNodeDataClass is a cTreeNodeDataClass NO_IMAGE
100279>>>>>>>>> move self to lhObject
100280>>>>>>>>> end_object
100281>>>>>>>>> set phDataObject to lhObject
100282>>>>>>>>> end
100282>>>>>>>>>>
100282>>>>>>>>> function_return lhObject
100283>>>>>>>>> end_function
100284>>>>>>>>>
100284>>>>>>>>> //> This function may be used as a shortcut to retrieve data
100284>>>>>>>>> //> from an array based data object
100284>>>>>>>>> function DataObject_Array_Value integer liItem returns string
100286>>>>>>>>> integer lhObject
100286>>>>>>>>> get phDataObject to lhObject
100287>>>>>>>>> if lhObject function_return (value(lhObject,liItem))
100290>>>>>>>>> function_return ""
100291>>>>>>>>> end_function
100292>>>>>>>>> procedure set DataObject_Array_Value integer liItem string lsValue
100294>>>>>>>>> integer lhObject
100294>>>>>>>>> get phDataObject to lhObject
100295>>>>>>>>> ifnot lhObject get hCreateDataObject to lhObject
100298>>>>>>>>> set value of lhObject item liItem to lsValue
100299>>>>>>>>> end_procedure
100300>>>>>>>>>
100300>>>>>>>>> enumeration_list // Tree traverser order
100300>>>>>>>>> define TTO_PARENT_FIRST
100300>>>>>>>>> define TTO_CHILDREN_FIRST
100300>>>>>>>>> end_enumeration_list
100300>>>>>>>>>
100300>>>>>>>>> //> Send message lhMsg to this node object and all children.
100300>>>>>>>>> procedure BroadcastNodeMessage integer liTraverseOrder integer lhMsg integer liLevel
100302>>>>>>>>> integer liItem liMax lhChildNode lhSelf
100302>>>>>>>>> move self to lhSelf
100303>>>>>>>>> if (liTraverseOrder=TTO_PARENT_FIRST) send lhMsg liLevel lhSelf // The lhSelf parameter will be handy if the message is caught via delegation
100306>>>>>>>>> get item_count to liMax
100307>>>>>>>>> decrement liMax
100308>>>>>>>>> for liItem from 0 to liMax
100314>>>>>>>>>>
100314>>>>>>>>> get value item liItem to lhChildNode
100315>>>>>>>>> send BroadcastNodeMessage to lhChildNode liTraverseOrder lhMsg (liLevel+1)
100316>>>>>>>>> loop
100317>>>>>>>>>>
100317>>>>>>>>> if (liTraverseOrder=TTO_CHILDREN_FIRST) send lhMsg liLevel lhSelf // The lhSelf parameter will be handy if the message is caught via delegation
100320>>>>>>>>> end_procedure
100321>>>>>>>>>
100321>>>>>>>>> //> Send message lhMsg to the data object of this node and all of
100321>>>>>>>>> //> the children of this node. The message will only be sent
100321>>>>>>>>> //> if the nodes do actually have a data object.
100321>>>>>>>>> procedure BroadcastDataMessage integer liTraverseOrder integer lhMsg integer liLevel
100323>>>>>>>>> integer liItem liMax lhChildNode lhSelf lhDataObject
100323>>>>>>>>> get phDataObject to lhDataObject
100324>>>>>>>>> move self to lhSelf
100325>>>>>>>>> if lhDataObject begin
100327>>>>>>>>> if (liTraverseOrder=TTO_PARENT_FIRST) send lhMsg to lhDataObject liLevel lhSelf lhDataObject // The lhSelf and lhDataObject parameters will be handy if the message is via through delegation
100330>>>>>>>>> end
100330>>>>>>>>>>
100330>>>>>>>>> get item_count to liMax
100331>>>>>>>>> decrement liMax
100332>>>>>>>>> for liItem from 0 to liMax
100338>>>>>>>>>>
100338>>>>>>>>> get value item liItem to lhChildNode
100339>>>>>>>>> send BroadcastDataMessage to lhChildNode liTraverseOrder lhMsg (liLevel+1)
100340>>>>>>>>> loop
100341>>>>>>>>>>
100341>>>>>>>>> if lhDataObject begin
100343>>>>>>>>> if (liTraverseOrder=TTO_CHILDREN_FIRST) send lhMsg to lhDataObject liLevel lhSelf lhDataObject // The lhSelf and lhDataObject parameters will be handy if the message is via through delegation
100346>>>>>>>>> end
100346>>>>>>>>>>
100346>>>>>>>>> end_procedure
100347>>>>>>>>>
100347>>>>>>>>> function ChildCount returns integer
100349>>>>>>>>> function_return (item_count(self))
100350>>>>>>>>> end_function
100351>>>>>>>>> function ChildNodeObject integer liItem returns integer
100353>>>>>>>>> function_return (value(self,liItem))
100354>>>>>>>>> end_function
100355>>>>>>>>>end_class // cTreeNode
100356>>>>>>>>>
100356>>>>>>>>>
100356>>>>>>>>>//
100356>>>>>>>>>// --- Typical example of treenode subclassing
100356>>>>>>>>>//
100356>>>>>>>>>// enumeration_list // Popup Menu Data item
100356>>>>>>>>>// define PMD_TEXT // Menu item text
100356>>>>>>>>>// define PMD_MESSAGE // Message to be sent
100356>>>>>>>>>// define PMD_OBJECT // Object to receive the message
100356>>>>>>>>>// define PMD_PARAMETER // Parameters to be passed to object
100356>>>>>>>>>// end_enumeration_list
100356>>>>>>>>>//
100356>>>>>>>>>// class cPopupMenuDataObject is a cTreeNodeDataObject
100356>>>>>>>>>// end_class // cPopupMenuDataObject
100356>>>>>>>>>//
100356>>>>>>>>>// class cPopupMenuTreeNode is a cTreeNode
100356>>>>>>>>>// procedure construct_object
100356>>>>>>>>>// forward send construct_object
100356>>>>>>>>>//
100356>>>>>>>>>// set phNodeClass to U_cPopupMenuTreeNode
100356>>>>>>>>>// set phDataClass to U_cPopupMenuDataObject
100356>>>>>>>>>// end_procedure
100356>>>>>>>>>// end_class // cPopupMenuTreeNode
100356>>>>>>>>>
100356>>>>>>>>>//
100356>>>>>>>>>// --- Small test sample
100356>>>>>>>>>//
100356>>>>>>>>>// object oTestTree is a cTreeNode
100356>>>>>>>>>// procedure MakeThreeChildNodes integer lhNode
100356>>>>>>>>>// integer lhChildNode
100356>>>>>>>>>// get hAddChildNode of lhNode to lhChildNode
100356>>>>>>>>>// get hAddChildNode of lhNode to lhChildNode
100356>>>>>>>>>// get hAddChildNode of lhNode to lhChildNode
100356>>>>>>>>>// end_procedure
100356>>>>>>>>>//
100356>>>>>>>>>// procedure DoPopulate
100356>>>>>>>>>// integer lhChildNode lhGrandChildnode
100356>>>>>>>>>//
100356>>>>>>>>>// get hAddChildNode of self to lhChildNode
100356>>>>>>>>>// get hAddChildNode of lhChildNode to lhGrandChildnode
100356>>>>>>>>>// get hAddChildNode of lhChildNode to lhGrandChildnode
100356>>>>>>>>>// get hAddChildNode of lhChildNode to lhGrandChildnode
100356>>>>>>>>>// get hAddChildNode of self to lhChildNode
100356>>>>>>>>>// get hAddChildNode of lhChildNode to lhGrandChildnode
100356>>>>>>>>>// get hAddChildNode of lhChildNode to lhGrandChildnode
100356>>>>>>>>>// get hAddChildNode of lhChildNode to lhGrandChildnode
100356>>>>>>>>>// get hAddChildNode of lhChildNode to lhGrandChildnode
100356>>>>>>>>>// get hAddChildNode of self to lhChildNode
100356>>>>>>>>>// get hAddChildNode of lhChildNode to lhGrandChildnode
100356>>>>>>>>>// get hAddChildNode of lhChildNode to lhGrandChildnode
100356>>>>>>>>>// get hAddChildNode of lhChildNode to lhGrandChildnode
100356>>>>>>>>>// get hAddChildNode of lhChildNode to lhGrandChildnode
100356>>>>>>>>>// get hAddChildNode of lhChildNode to lhGrandChildnode
100356>>>>>>>>>// end_procedure
100356>>>>>>>>>//
100356>>>>>>>>>// procedure ShowlnYourself integer liLevel integer lhNode
100356>>>>>>>>>// showln (repeat(" ",liLevel)+string(lhNode))
100356>>>>>>>>>// end_procedure
100356>>>>>>>>>//
100356>>>>>>>>>// send DoPopulate
100356>>>>>>>>>// send BroadcastNodeMessage TTO_PARENT_FIRST MSG_ShowlnYourself 0
100356>>>>>>>>>// inkey windowindex
100356>>>>>>>>>// end_object
100356>>>>>>>>>
100356>>>>>>>use Strings.nui // String manipulation for VDF (No User Interface)
100356>>>>>>>Use ErrorHnd.nui // cErrorHandlerRedirector class and oErrorHandlerQuiet object (No User Interface)
100356>>>>>>>
100356>>>>>>>procedure report_to_object_tree for baseclass integer lhNode
100358>>>>>>> integer lhSelf
100358>>>>>>> move self to lhSelf
100359>>>>>>> send DoHandleObjectNode to lhNode lhSelf
100360>>>>>>>end_procedure
100361>>>>>>>
100361>>>>>>>
100361>>>>>>>enumeration_list
100361>>>>>>> define OBJT_OBJECT_ID
100361>>>>>>> define OBJT_NAME
100361>>>>>>> define OBJT_NAME_NO_PATH
100361>>>>>>> define OBJT_BASE_CLASS
100361>>>>>>> define OBJT_CLASS
100361>>>>>>>end_enumeration_list
100361>>>>>>>
100361>>>>>>>class cObjectData is a cTreeNodeDataObject
100362>>>>>>> function sObjectNameNoPath returns string
100364>>>>>>> integer lhObject lhParent
100364>>>>>>> string lsObjectName lsParentName
100364>>>>>>> get value item OBJT_OBJECT_ID to lhObject
100365>>>>>>> if (lhObject=DESKTOP) function_return "DESKTOP"
100368>>>>>>> get value item OBJT_NAME to lsObjectName
100369>>>>>>> if (lhObject>DESKTOP) begin
100371>>>>>>> get parent of lhObject to lhParent
100372>>>>>>> if (lhParent<>DESKTOP) begin
100374>>>>>>> send ErrorHnd_Quiet_Activate
100375>>>>>>> move (name(lhParent)) to lsParentName
100376>>>>>>> send ErrorHnd_Quiet_Deactivate
100377>>>>>>> move (replace(lsParentName+".",lsObjectName,"")) to lsObjectName
100378>>>>>>> end
100378>>>>>>>>
100378>>>>>>> end
100378>>>>>>>>
100378>>>>>>> function_return lsObjectName
100379>>>>>>> end_function
100380>>>>>>> procedure ReadDataFromObject integer lhObject
100382>>>>>>> integer liValue
100382>>>>>>> set value item OBJT_OBJECT_ID to lhObject
100383>>>>>>>
100383>>>>>>> send ErrorHnd_Quiet_Activate
100384>>>>>>> set value item OBJT_NAME to (name(lhObject))
100385>>>>>>> send ErrorHnd_Quiet_Deactivate
100386>>>>>>>
100386>>>>>>> set value item OBJT_NAME_NO_PATH to (sObjectNameNoPath(self))
100387>>>>>>> get base_class of lhObject to liValue
100388>>>>>>> set value item OBJT_BASE_CLASS to liValue
100389>>>>>>> get class of lhObject to liValue
100390>>>>>>> set value item OBJT_CLASS to liValue
100391>>>>>>> end_procedure
100392>>>>>>> function TreeViewLabel returns string
100394>>>>>>> integer lhObject liValue
100394>>>>>>> string lsName
100394>>>>>>> get value OBJT_NAME_NO_PATH item to lsName
100395>>>>>>> get StringUppercaseFirstLetters lsName to lsName
100396>>>>>>> get value item OBJT_OBJECT_ID to lhObject
100397>>>>>>> move (lsName+" ("+string(lhObject)+")") to lsName
100398>>>>>>>
100398>>>>>>> get value item OBJT_BASE_CLASS to liValue
100399>>>>>>> move (lsName+", "+string(liValue)) to lsName
100400>>>>>>> get value item OBJT_CLASS to liValue
100401>>>>>>> move (lsName+", "+string(liValue)) to lsName
100402>>>>>>>
100402>>>>>>> function_return lsName
100403>>>>>>> end_function
100404>>>>>>>end_class
100405>>>>>>>
100405>>>>>>>class cObjectTree is a cTreeNode
100406>>>>>>> procedure construct_object
100408>>>>>>> forward send construct_object
100410>>>>>>> set phNodeClass to U_cObjectTree
100411>>>>>>> set phDataClass to U_cObjectData
100412>>>>>>> end_procedure
100413>>>>>>>
100413>>>>>>> procedure DoHandleObjectNode integer lhObject
100415>>>>>>> integer lhChildNode lhChildDate
100415>>>>>>> get hAddChildNode to lhChildNode
100416>>>>>>>// get hCreateDataObject of lhChildNode to lhChildDate
100416>>>>>>>// send ReadDataFromObject to lhChildDate lhObject
100416>>>>>>> send build_object_tree to lhChildNode lhObject
100417>>>>>>> end_procedure
100418>>>>>>>
100418>>>>>>> procedure build_object_tree integer lhRootObject
100420>>>>>>> integer lhSelf lhData
100420>>>>>>> get hCreateDataObject to lhData
100421>>>>>>> send ReadDataFromObject to lhData lhRootObject
100422>>>>>>> move self to lhSelf
100423>>>>>>> broadcast send report_to_object_tree to lhRootObject lhSelf
100425>>>>>>> end_procedure
100426>>>>>>>
100426>>>>>>> // We need to keep the object tree itself from reporting back. Otherwise we
100426>>>>>>> // will create a potential infinate loop.
100426>>>>>>> procedure report_to_object_tree integer lhNode
100428>>>>>>> integer lhSelf
100428>>>>>>> if (phParentNode(self)=0) begin
100430>>>>>>> move self to lhSelf
100431>>>>>>> send DoHandleObjectNode to lhNode lhSelf
100432>>>>>>> end
100432>>>>>>>>
100432>>>>>>> end_procedure
100433>>>>>>>end_class // cObjectTree
100434>>>>>>>
100434>>>>>>>
100434>>>>>>>//object oItllPass1 is a cArray
100434>>>>>>>// object oItllPass2 is a cArray
100434>>>>>>>// object oItllPass3 is a cArray
100434>>>>>>>// end_object
100434>>>>>>>// end_object
100434>>>>>>>// object oItllPass4 is a cArray
100434>>>>>>>// end_object
100434>>>>>>>// object oItllPass5 is a cArray
100434>>>>>>>// end_object
100434>>>>>>>//end_object
100434>>>>>>>//
100434>>>>>>>object oObjectTree is a cObjectTree NO_IMAGE
100436>>>>>>>// procedure ShowlnYourself integer liLevel integer lhNode
100436>>>>>>>// string lsName lhObj
100436>>>>>>>// get DataObject_Array_Value of lhNode OBJT_OBJECT_ID to lhObj
100436>>>>>>>// get DataObject_Array_Value of lhNode OBJT_NAME to lsName
100436>>>>>>>// showln (repeat(" ",liLevel)+lsName+" "+string(lhObj))
100436>>>>>>>// end_procedure
100436>>>>>>>end_object
100437>>>>>>>
100437>>>>>>>procedure DoGenerateObjectTree global integer lhObject
100439>>>>>>> send build_object_tree to (oObjectTree(self)) lhObject
100440>>>>>>>// send BroadcastNodeMessage to (oObjectTree(self)) TTO_PARENT_FIRST MSG_ShowlnYourself 0
100440>>>>>>>end_procedure
100441>>>>>>>//
100441>>>>>>>//send DoGenerateObjectTree 2 //(oItllPass1(self))
100441>>>>>>>//inkey windowindex
100441>>>>>use treenode_treeview_class.pkg // cTreeNodeView class
Including file: treenode_treeview_class.pkg (C:\Apps\VDFQuery\AppSrc\treenode_treeview_class.pkg)
100441>>>>>>>// use treenode_treeview_class.pkg // cTreeNodeView class
100441>>>>>>>
100441>>>>>>>use dfallent
100441>>>>>>>use dftreevw
100441>>>>>>>use treenode.nui // Defines the cTreeNode class.
100441>>>>>>>
100441>>>>>>>class cTreeNodeView is a TreeView
100442>>>>>>> procedure construct_object
100444>>>>>>> forward send construct_object
100446>>>>>>> property integer phTreeNode
100447>>>>>>> end_procedure
100448>>>>>>>
100448>>>>>>> function iImageItems integer lhData returns integer // complex hi: "Image" low: "Selected Image"
100450>>>>>>> function_return 0
100451>>>>>>> end_function
100452>>>>>>> procedure DoAddNode integer lhNode integer lhParentItem
100454>>>>>>> integer lhItem lhData lhImage lhSelImage liMax liItem lhChildNode
100454>>>>>>> string lsLabel
100454>>>>>>> get phDataObject of lhNode to lhData
100455>>>>>>> if lhData begin
100457>>>>>>> get TreeViewLabel of lhData to lsLabel
100458>>>>>>> get iImageItems lhData to lhImage
100459>>>>>>> move (low(lhImage)) to lhSelImage
100460>>>>>>> move (hi(lhImage)) to lhSelImage
100461>>>>>>> end
100461>>>>>>>>
100461>>>>>>> else begin
100462>>>>>>> move "" to lsLabel
100463>>>>>>> move 0 to lhImage
100464>>>>>>> move 0 to lhSelImage
100465>>>>>>> end
100465>>>>>>>>
100465>>>>>>> get AddTreeItem lsLabel lhParentItem lhNode lhImage lhSelImage to lhItem
100466>>>>>>> get ChildCount of lhNode to liMax
100467>>>>>>> decrement liMax
100468>>>>>>> for liItem from 0 to liMax
100474>>>>>>>>
100474>>>>>>> get ChildNodeObject of lhNode liItem to lhChildNode
100475>>>>>>> send DoAddNode lhChildNode lhItem
100476>>>>>>> loop
100477>>>>>>>>
100477>>>>>>> end_procedure
100478>>>>>>> function ItemVisibleState integer lhItem returns integer
100480>>>>>>> integer lhRoot
100480>>>>>>> get RootItem to lhRoot
100481>>>>>>> while (lhItem<>lhRoot)
100485>>>>>>> get ParentItem lhItem to lhItem
100486>>>>>>> if lhItem begin
100488>>>>>>> ifnot (ItemExpandedState(self,lhItem)) function_return FALSE
100491>>>>>>> end
100491>>>>>>>>
100491>>>>>>> else function_return TRUE
100493>>>>>>> end
100494>>>>>>>>
100494>>>>>>> function_return TRUE
100495>>>>>>> end_function
100496>>>>>>> procedure DoAddTreeItems
100498>>>>>>> integer lhNode
100498>>>>>>> get phTreeNode to lhNode
100499>>>>>>> send DoAddNode lhNode 0
100500>>>>>>> send DoExpandItem (RootItem(self))
100501>>>>>>> end_procedure
100502>>>>>>>
100502>>>>>>> procedure OnCreateTree
100504>>>>>>> send DoAddTreeItems
100505>>>>>>> send DoExpandAll
100506>>>>>>> end_procedure
100507>>>>>>>end_class // cTreeNodeView
100508>>>>>>>
100508>>>>>>>use aps
100508>>>>>>>class aps.TreeNodeView is a cTreeNodeView startmac APS.STARTMAC_SNAP
100509>>>>>>> procedure construct_object
100511>>>>>>> forward send construct_object
100513>>>>>>> send define_aps_control_mx
100514>>>>>>> set p_auto_size_control_state to false
100515>>>>>>> end_procedure
100516>>>>>>> import_class_protocol aps_control_mx
100517>>>>>>> procedure end_construct_object
100519>>>>>>> forward send end_construct_object
100521>>>>>>> send end_define_aps_control_mx
100522>>>>>>> end_procedure
100523>>>>>>>end_class // aps.TreeNodeView
100524>>>>>>>
100524>>>>>>>class cTreeNodeViewEdit is a cTreeNodeView
100525>>>>>>> procedure construct_object
100527>>>>>>> forward send construct_object
100529>>>>>>> on_key KEY_CTRL+KEY_UP_ARROW send MoveItemUp
100530>>>>>>> on_key KEY_CTRL+KEY_DOWN_ARROW send MoveItemDown
100531>>>>>>> end_procedure
100532>>>>>>>
100532>>>>>>> procedure MoveItemUp.h handle lhItem
100534>>>>>>> integer lhNode lbSuccess
100534>>>>>>> get ItemData lhItem to lhNode
100535>>>>>>> get Request_SwitchUp of lhNode to lbSuccess
100536>>>>>>> if lbSuccess begin
100538>>>>>>> end
100538>>>>>>>>
100538>>>>>>> end_procedure
100539>>>>>>> procedure MoveItemDown.h handle lhItem
100541>>>>>>> // send obs "WayOdown" lhItem
100541>>>>>>> end_procedure
100542>>>>>>>
100542>>>>>>> procedure MoveItemUp
100544>>>>>>> handle lhItem
100544>>>>>>> get CurrentTreeItem to lhItem
100545>>>>>>> if (lhItem<>0) send MoveItemUp.h lhItem
100548>>>>>>> end_procedure
100549>>>>>>> procedure MoveItemDown
100551>>>>>>> handle lhItem
100551>>>>>>> get CurrentTreeItem to lhItem
100552>>>>>>> if (lhItem<>0) send MoveItemDown.h lhItem
100555>>>>>>> end_procedure
100556>>>>>>>
100556>>>>>>>end_class // cTreeNodeViewEdit
100557>>>>>>>
100557>>>>>>>class aps.TreeNodeViewEdit is a cTreeNodeViewEdit startmac APS.STARTMAC_SNAP
100558>>>>>>> procedure construct_object
100560>>>>>>> forward send construct_object
100562>>>>>>> send define_aps_control_mx
100563>>>>>>> set p_auto_size_control_state to false
100564>>>>>>> end_procedure
100565>>>>>>> import_class_protocol aps_control_mx
100566>>>>>>> procedure end_construct_object
100568>>>>>>> forward send end_construct_object
100570>>>>>>> send end_define_aps_control_mx
100571>>>>>>> end_procedure
100572>>>>>>>end_class // aps.TreeNodeView
100573>>>>>>>
100573>>>>>>>
100573>>>>>
100573>>>>>object oObjectTreePanel is a aps.ModalPanel label "All objects in the application"
100576>>>>> set locate_mode to CENTER_ON_SCREEN
100577>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
100578>>>>> on_key kcancel send close_panel
100579>>>>> object oTreeView is a aps.TreeNodeView
100581>>>>> set size to 200 200
100582>>>>> set phTreeNode to (oObjectTree(self))
100583>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
100584>>>>> end_object
100585>>>>> procedure report_to_object_tree integer lhNode // Do not display this panel itself
100588>>>>> end_procedure
100589>>>>> procedure DoRefresh
100592>>>>> end_procedure
100593>>>>> object oBtn1 is a aps.Multi_Button
100595>>>>> on_item "Refresh" send DoRefresh
100596>>>>> set peAnchors to (anRight+anBottom)
100597>>>>> end_object
100598>>>>> object oBtn2 is a aps.Multi_Button
100600>>>>> on_item "Close" send close_panel
100601>>>>> set peAnchors to (anRight+anBottom)
100602>>>>> end_object
100603>>>>> send aps_locate_multi_buttons
100604>>>>>end_object // oObjectTreePanel
100605>>>>>
100605>>>>>procedure popup_objecttree
100608>>>>> send cursor_wait of Cursor_Control
100609>>>>> send DoGenerateObjectTree desktop
100610>>>>> send cursor_ready of Cursor_Control
100611>>>>> send popup of oObjectTreePanel
100612>>>>>end_procedure
100613>>>
100613>>> Use DBD.vw
Including file: dbd.vw (C:\Apps\VDFQuery\AppSrc\dbd.vw)
100613>>>>>// * Show only commented fields
100613>>>>>// * Field_Not_Found are now colored red
100613>>>>>// * Ctrl+N Now creates a new view.
100613>>>>>//
100613>>>>>// To do:
100613>>>>>//
100613>>>>>// VPE interface til rapport
100613>>>>>// Impl. af ubenyttede felter (i DB*.DAT)
100613>>>>>// Hj‘lpeklasse med benyttelse af IE
100613>>>>>// Mulighed for at fjerne entries fra filelist.cfg
100613>>>>>//
100613>>>>>
100613>>>>>Use APS.pkg // Auto Positioning and Sizing classes for VDF
100613>>>>>Use ObjGroup.utl // Defining groups of objects
100613>>>>>Use DBD.pkg // cDBD_System, cDBD_TableAccess and cDBD_Updater classes
Including file: dbd.pkg (C:\Apps\VDFQuery\AppSrc\dbd.pkg)
100613>>>>>>>// Use dbd.pkg // Database Documentation, Ability to create tables and control a cDBD_System object
100613>>>>>>>
100613>>>>>>>Use DBD.nui // cDBD_System, cDBD_TableAccess and cDBD_Updater classes
Including file: dbd.nui (C:\Apps\VDFQuery\AppSrc\dbd.nui)
100613>>>>>>>>>// Use DBD.nui // cDBD_System, cDBD_TableAccess and cDBD_Updater classes
100613>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
100613>>>>>>>>>Use DBMS.nui // Basic DBMS functions (No User Interface)
100613>>>>>>>>>Use TblDynAc.nui // Table, dynamic access (cDynamicTableAccess class)
100613>>>>>>>>>Use FdxField.nui // FDX Field things
100613>>>>>>>>>Use OpenStat.nui // cTablesOpenStatus class (formely cFileAllFiles) (No User Interface)
100613>>>>>>>>>
100613>>>>>>>>>enumeration_list
100613>>>>>>>>> define DBDTABLE_SYSTEM
100613>>>>>>>>> define DBDTABLE_TABLE
100613>>>>>>>>> define DBDTABLE_FIELD
100613>>>>>>>>> define DBDTABLE_INDEX
100613>>>>>>>>>end_enumeration_list
100613>>>>>>>>>
100613>>>>>>>>>class cDBD_System is a cArray
100614>>>>>>>>> procedure construct_object integer liImg
100616>>>>>>>>> forward send construct_object liImg
100618>>>>>>>>> property integer phTableAccessObject // Opens the tables
100619>>>>>>>>> property integer phTableUpdater // Takes care of updating according to table definitions
100620>>>>>>>>> end_procedure
100621>>>>>>>>>end_class // cDBD_System
100622>>>>>>>>>
100622>>>>>>>>>class cDBD_TableAccess is a cDynamicTableAccess
100623>>>>>>>>> procedure construct_object
100625>>>>>>>>> forward send construct_object
100627>>>>>>>>>
100627>>>>>>>>> set psRootNamePrefix to "db"
100628>>>>>>>>>
100628>>>>>>>>> set TableBaseData DBDTABLE_SYSTEM to "system" "DBD - System" 0
100629>>>>>>>>> set TableBaseData DBDTABLE_TABLE to "table" "DBD - Tables" 0
100630>>>>>>>>> set TableBaseData DBDTABLE_FIELD to "field" "DBD - Fields" 0
100631>>>>>>>>> set TableBaseData DBDTABLE_INDEX to "index" "DBD - Indices" 0
100632>>>>>>>>> end_procedure
100633>>>>>>>>>
100633>>>>>>>>> procedure OnAllTablesOpened // Do the relationships on the newly opened tables
100635>>>>>>>>> integer liTableFile liFieldFile liIndexFile
100635>>>>>>>>> get piFile.i DBDTABLE_TABLE to liTableFile
100636>>>>>>>>> get piFile.i DBDTABLE_FIELD to liFieldFile
100637>>>>>>>>> get piFile.i DBDTABLE_INDEX to liIndexFile
100638>>>>>>>>> set_attribute DF_FIELD_RELATED_FILE of liFieldFile 1 to liTableFile
100641>>>>>>>>> set_attribute DF_FIELD_RELATED_FIELD of liFieldFile 1 to 1
100644>>>>>>>>> set_attribute DF_FIELD_RELATED_FILE of liIndexFile 1 to liTableFile
100647>>>>>>>>> set_attribute DF_FIELD_RELATED_FIELD of liIndexFile 1 to 1
100650>>>>>>>>> end_procedure
100651>>>>>>>>>
100651>>>>>>>>> procedure Callback_One_Table integer liFile integer lhMsg integer lhObj
100653>>>>>>>>> integer liTableFile
100653>>>>>>>>> integer liId liNot_found
100653>>>>>>>>> string lsName lsLogic_name lsPhysic_name lsOpenas_path lsDescription
100653>>>>>>>>> get piFile.i DBDTABLE_TABLE to liTableFile
100654>>>>>>>>> clear liTableFile
100655>>>>>>>>> set_field_value liTableFile 1 to liFile
100658>>>>>>>>> vfind liTableFile 1 EQ
100660>>>>>>>>> get_field_value liTableFile 1 to liId // dbTable.TBL_ID
100663>>>>>>>>> get_field_value liTableFile 2 to lsName // dbTable.TBL_NAME
100666>>>>>>>>> get_field_value liTableFile 3 to lsLogic_name // dbTable.TBL_LOGIC_NAME
100669>>>>>>>>> get_field_value liTableFile 4 to lsPhysic_name // dbTable.TBL_PHYSIC_NAME
100672>>>>>>>>> get_field_value liTableFile 5 to liNot_found // dbTable.TBL_NOT_FOUND
100675>>>>>>>>> get_field_value liTableFile 6 to lsOpenas_path // dbTable.TBL_OPENAS_PATH
100678>>>>>>>>> get_field_value liTableFile 7 to lsDescription // dbTable.TBL_DESCRIPTION
100681>>>>>>>>> send lhMsg to lhObj liId lsName lsLogic_name lsPhysic_name liNot_found lsOpenas_path lsDescription
100682>>>>>>>>> end_procedure
100683>>>>>>>>>
100683>>>>>>>>> procedure Callback_All_Tables integer lhMsg integer lhObj
100685>>>>>>>>> integer liTableFile lbFound
100685>>>>>>>>> integer liId liNot_found
100685>>>>>>>>> string lsName lsLogic_name lsPhysic_name lsOpenas_path lsDescription
100685>>>>>>>>> get piFile.i DBDTABLE_TABLE to liTableFile
100686>>>>>>>>> clear liTableFile
100687>>>>>>>>> repeat
100687>>>>>>>>>>
100687>>>>>>>>> vfind liTableFile 1 GT
100689>>>>>>>>> move (found) to lbFound
100690>>>>>>>>> if lbFound begin
100692>>>>>>>>> get_field_value liTableFile 1 to liId // dbTable.TBL_ID
100695>>>>>>>>> get_field_value liTableFile 2 to lsName // dbTable.TBL_NAME
100698>>>>>>>>> get_field_value liTableFile 3 to lsLogic_name // dbTable.TBL_LOGIC_NAME
100701>>>>>>>>> get_field_value liTableFile 4 to lsPhysic_name // dbTable.TBL_PHYSIC_NAME
100704>>>>>>>>> get_field_value liTableFile 5 to liNot_found // dbTable.TBL_NOT_FOUND
100707>>>>>>>>> get_field_value liTableFile 6 to lsOpenas_path // dbTable.TBL_OPENAS_PATH
100710>>>>>>>>> get_field_value liTableFile 7 to lsDescription // dbTable.TBL_DESCRIPTION
100713>>>>>>>>> send lhMsg to lhObj liId lsName lsLogic_name lsPhysic_name liNot_found lsOpenas_path lsDescription
100714>>>>>>>>> // procedure PrintTable integer liId string lsName string lsLogic_name string lsPhysic_name integer liNot_found string lsOpenas_path string lsDescription
100714>>>>>>>>> end
100714>>>>>>>>>>
100714>>>>>>>>> until (not(lbFound))
100716>>>>>>>>> end_procedure
100717>>>>>>>>>
100717>>>>>>>>> procedure Callback_TableFields integer liFile integer lhMsg integer lhObj integer liIndex
100719>>>>>>>>> integer liFieldFile liTest lbFound
100719>>>>>>>>> integer liTbl_Id liFld_Pos liFld_Not_Found
100719>>>>>>>>> string lsFld_Description lsSuggested_Label lsFld_Definition lsFld_Name
100719>>>>>>>>> get piFile.i DBDTABLE_FIELD to liFieldFile
100720>>>>>>>>> clear liFieldFile
100721>>>>>>>>> set_field_value liFieldFile 1 to liFile
100724>>>>>>>>> repeat
100724>>>>>>>>>>
100724>>>>>>>>> vfind liFieldFile liIndex GT // liIndex=1: Name liIndex=2: Pos
100726>>>>>>>>> move (found) to lbFound
100727>>>>>>>>> if lbFound begin
100729>>>>>>>>> get_field_value liFieldFile 1 to liTest
100732>>>>>>>>> move (liTest=liFile) to lbFound
100733>>>>>>>>> end
100733>>>>>>>>>>
100733>>>>>>>>> if lbFound begin
100735>>>>>>>>> get_field_value liFieldFile 1 to liTbl_Id // dbField.TBL_ID
100738>>>>>>>>> get_field_value liFieldFile 2 to liFld_Pos // dbField.FLD_POS
100741>>>>>>>>> get_field_value liFieldFile 3 to lsFld_Name // dbField.FLD_NAME
100744>>>>>>>>> get_field_value liFieldFile 4 to liFld_Not_Found // dbField.FLD_NOT_FOUND
100747>>>>>>>>> get_field_value liFieldFile 5 to lsFld_Description // dbField.FLD_DESCRIPTION
100750>>>>>>>>> get_field_value liFieldFile 6 to lsSuggested_Label // dbField.SUGGESTED_LABEL
100753>>>>>>>>> get_field_value liFieldFile 7 to lsFld_Definition // dbField.FLD_DEFINITION
100756>>>>>>>>> send lhMsg to lhObj liTbl_Id liFld_Pos lsFld_Name liFld_Not_Found lsFld_Description lsSuggested_Label lsFld_Definition
100757>>>>>>>>> // procedure PrintField integer liTbl_Id integer liFld_Pos string lsFld_Name integer liFld_Not_Found string lsFld_Description string lsSuggested_Label string lsFld_Definition
100757>>>>>>>>> end
100757>>>>>>>>>>
100757>>>>>>>>> until (not(lbFound))
100759>>>>>>>>> end_procedure
100760>>>>>>>>>
100760>>>>>>>>> function DoZerofileAllTables returns integer // (Except the system table)
100762>>>>>>>>> integer lbSuccess liFile
100762>>>>>>>>> move DFFALSE to lbSuccess
100763>>>>>>>>> if (pbAllTablesAreOpen(self)) begin
100765>>>>>>>>> send DoCloseTables
100766>>>>>>>>>
100766>>>>>>>>> if (DoOpenTablesExclusive(self)) begin
100768>>>>>>>>> get piFile.i DBDTABLE_TABLE to liFile
100769>>>>>>>>> zerofile liFile
100770>>>>>>>>> get piFile.i DBDTABLE_FIELD to liFile
100771>>>>>>>>> zerofile liFile
100772>>>>>>>>> get piFile.i DBDTABLE_INDEX to liFile
100773>>>>>>>>> zerofile liFile
100774>>>>>>>>> move DFTRUE to lbSuccess
100775>>>>>>>>> end
100775>>>>>>>>>>
100775>>>>>>>>> else send DeclareOpenError "Exclusive access could not be obtained (#)"
100777>>>>>>>>> ifnot (DoOpenTables(self)) send DeclareOpenError "DBD tables could not be re-opened (#)"
100780>>>>>>>>> end
100780>>>>>>>>>>
100780>>>>>>>>> function_return lbSuccess
100781>>>>>>>>> end_function
100782>>>>>>>>>
100782>>>>>>>>> function iNextAvailableFieldPosCurrentTable returns integer
100784>>>>>>>>> integer liTableFile liFieldFile liTableId liFieldTableId liPos lbFound
100784>>>>>>>>> get piFile.i DBDTABLE_TABLE to liTableFile
100785>>>>>>>>> get piFile.i DBDTABLE_FIELD to liFieldFile
100786>>>>>>>>> get_field_value liTableFile 1 to liTableId // dbTable.TBL_ID
100789>>>>>>>>> clear liFieldFile
100790>>>>>>>>> set_field_value liFieldFile 1 to liTableId // dbField.TBL_ID
100793>>>>>>>>> set_field_value liFieldFile 2 to 9999 // dbField.FLD_POS
100796>>>>>>>>> vfind liFieldFile 2 LT
100798>>>>>>>>> if (found) begin
100800>>>>>>>>> get_field_value liFieldFile 1 to liFieldTableId // dbField.TBL_ID
100803>>>>>>>>> indicate found as liFieldTableId eq liTableId
100804>>>>>>>>> end
100804>>>>>>>>>>
100804>>>>>>>>> get_field_value liFieldFile 2 to liPos // dbField.FLD_POS
100807>>>>>>>>> clear liFieldFile
100808>>>>>>>>> move (found) to lbFound
100809>>>>>>>>> ifnot lbFound function_return 1
100812>>>>>>>>> function_return (liPos+1)
100813>>>>>>>>> end_function
100814>>>>>>>>>
100814>>>>>>>>> procedure end_construct_object
100816>>>>>>>>> integer lhSelf
100816>>>>>>>>> forward send end_construct_object
100818>>>>>>>>> move self to lhSelf
100819>>>>>>>>> set phTableAccessObject to lhSelf // This is resolved in the encapsulating cDBD_System object
100820>>>>>>>>> end_procedure
100821>>>>>>>>>end_class // cDBD_TableAccess
100822>>>>>>>>>
100822>>>>>>>>>
100822>>>>>>>>>Use FdxGlObj.nui // Global FDX object (ghFDX)
100822>>>>>>>>>Use FdxField.nui // FDX Field things
100822>>>>>>>>>Use FdxIndex.nui // Index analysing functions
100822>>>>>>>>>
100822>>>>>>>>>object oDBD_PredefinedLibraries is a cArray
100824>>>>>>>>> // This object is just used for defining ghost tables that just acts
100824>>>>>>>>> // as place holders for libraries
100824>>>>>>>>> item_property_list
100824>>>>>>>>> item_property integer piTableNo.i
100824>>>>>>>>> item_property string psDisplayName.i
100824>>>>>>>>> item_property string psTableText.i
100824>>>>>>>>> item_property string psColumnHeader.i
100824>>>>>>>>> end_item_property_list
#REM 100867 DEFINE FUNCTION PSCOLUMNHEADER.I INTEGER LIROW RETURNS STRING
#REM 100872 DEFINE PROCEDURE SET PSCOLUMNHEADER.I INTEGER LIROW STRING VALUE
#REM 100877 DEFINE FUNCTION PSTABLETEXT.I INTEGER LIROW RETURNS STRING
#REM 100882 DEFINE PROCEDURE SET PSTABLETEXT.I INTEGER LIROW STRING VALUE
#REM 100887 DEFINE FUNCTION PSDISPLAYNAME.I INTEGER LIROW RETURNS STRING
#REM 100892 DEFINE PROCEDURE SET PSDISPLAYNAME.I INTEGER LIROW STRING VALUE
#REM 100897 DEFINE FUNCTION PITABLENO.I INTEGER LIROW RETURNS INTEGER
#REM 100902 DEFINE PROCEDURE SET PITABLENO.I INTEGER LIROW INTEGER VALUE
100908>>>>>>>>> procedure add_library integer liTable string lsName string lsText string lsColumnHeader
100911>>>>>>>>> integer liRow
100911>>>>>>>>> get row_count to liRow
100912>>>>>>>>> set piTableNo.i liRow to liTable
100913>>>>>>>>> set psDisplayName.i liRow to lsName
100914>>>>>>>>> set psTableText.i liRow to lsText
100915>>>>>>>>> set psColumnHeader.i liRow to lsColumnHeader
100916>>>>>>>>> end_procedure
100917>>>>>>>>>
100917>>>>>>>>> define DBDLIB_DICTIONARY for 5001
100917>>>>>>>>> define DBDLIB_CALENDAR for 5002
100917>>>>>>>>> define DBDLIB_ARTICLES for 5003
100917>>>>>>>>> send add_library DBDLIB_DICTIONARY "Dictionary" "Use to define terms that are used in describing this system." "Term"
100918>>>>>>>>> send add_library DBDLIB_CALENDAR "Calendar" "Use this to enter time-line related things about the system" "Date"
100919>>>>>>>>> send add_library DBDLIB_ARTICLES "Articles" "Use this to enter general articles about the system" "Name"
100920>>>>>>>>> procedure CreatePredefinedLibraries integer liTableFile
100923>>>>>>>>> integer liRow liMax liTable
100923>>>>>>>>> string lsName lsText lsColumnHeader
100923>>>>>>>>> get row_count to liMax
100924>>>>>>>>> decrement liMax
100925>>>>>>>>> for liRow from 0 to liMax
100931>>>>>>>>>>
100931>>>>>>>>> get piTableNo.i liRow to liTable
100932>>>>>>>>> get psDisplayName.i liRow to lsName
100933>>>>>>>>> get psTableText.i liRow to lsText
100934>>>>>>>>> get psColumnHeader.i liRow to lsColumnHeader
100935>>>>>>>>> clear liTableFile
100936>>>>>>>>> set_field_value liTableFile 1 to liTable // move liFile to dbTable.Tbl_Id
100939>>>>>>>>> vfind liTableFile 1 EQ // find eq dbTable by index.1
100941>>>>>>>>> set_field_value liTableFile 2 to lsName // move lsUserName to dbTable.tbl_name
100944>>>>>>>>> set_field_value liTableFile 3 to "N/A" // move lsDFName to dbTable.tbl_logic_name
100947>>>>>>>>> set_field_value liTableFile 4 to "N/A" // move lsRoot to dbTable.tbl_physic_name
100950>>>>>>>>> set_field_value liTableFile 5 to 0 // move 0 to dbTable.tbl_not_found
100953>>>>>>>>> set_field_value liTableFile 6 to "N/A" // dbTable.tbl_openas_path
100956>>>>>>>>> set_field_value liTableFile 7 to lsText // dbTable.tbl_description
100959>>>>>>>>> saverecord liTableFile // dbTable
100960>>>>>>>>> loop
100961>>>>>>>>>>
100961>>>>>>>>> end_procedure
100962>>>>>>>>> function iFindPredefinedTableRow integer liTable returns integer
100965>>>>>>>>> integer liRow liMax
100965>>>>>>>>> get row_count to liMax
100966>>>>>>>>> decrement liMax
100967>>>>>>>>> for liRow from 0 to liMax
100973>>>>>>>>>>
100973>>>>>>>>> if (piTableno.i(self,liRow)=liTable) function_return liRow
100976>>>>>>>>> loop
100977>>>>>>>>>>
100977>>>>>>>>> function_return -1 // Not found
100978>>>>>>>>> end_function
100979>>>>>>>>>end_object // oDBD_PredefinedLibraries
100980>>>>>>>>>
100980>>>>>>>>>class cDBD_Updater is a cArray
100981>>>>>>>>> procedure construct_object
100983>>>>>>>>> forward send construct_object
100985>>>>>>>>> property integer phFDX public ghFDX
100986>>>>>>>>> end_procedure
100987>>>>>>>>>
100987>>>>>>>>> procedure OnHandleTable string lsMsg
100989>>>>>>>>> end_procedure
100990>>>>>>>>> procedure OnHandleField string lsMsg
100992>>>>>>>>> end_procedure
100993>>>>>>>>> procedure OnHandleIndex string lsMsg
100995>>>>>>>>> end_procedure
100996>>>>>>>>> procedure OnUpdateBegin
100998>>>>>>>>> end_procedure
100999>>>>>>>>> procedure OnUpdateEnd
101001>>>>>>>>> end_procedure
101002>>>>>>>>>
101002>>>>>>>>> procedure HandleIndex integer liFile integer liIndex string lsIndexDef integer liIndexType
101004>>>>>>>>> integer liIndexFile lhFDX
101004>>>>>>>>> string lsValue
101004>>>>>>>>> get phFDX to lhFDX
101005>>>>>>>>> send OnHandleIndex ("Index: "+string(liIndex))
101006>>>>>>>>> get piFile.i of (phTableAccessObject(self)) DBDTABLE_INDEX to liIndexFile
101007>>>>>>>>>
101007>>>>>>>>> get FDX_FieldsTranslateOverlaps lhFdx liFile lsIndexDef to lsIndexDef
101008>>>>>>>>> get FDX_FieldNames lhFdx liFile lsIndexDef to lsValue
101009>>>>>>>>> lock
101010>>>>>>>>>>
101010>>>>>>>>> clear liIndexFile // clear dbIndex
101011>>>>>>>>> set_field_value liIndexFile 1 to liFile // move liFile to dbIndex.Tbl_Id
101014>>>>>>>>> set_field_value liIndexFile 2 to liIndex // move liIndex to dbIndex.Idx_Pos
101017>>>>>>>>> vfind liIndexFile 1 EQ // find eq dbIndex by index.1
101019>>>>>>>>> set_field_value liIndexFile 5 to 0 // move 0 to dbIndex.idx_not_found
101022>>>>>>>>> set_field_value liIndexFile 3 to lsValue // move lsValue to dbIndex.Idx_Name
101025>>>>>>>>> saverecord liIndexFile // saverecord dbIndex
101026>>>>>>>>> unlock
101027>>>>>>>>>>
101027>>>>>>>>> end_procedure
101028>>>>>>>>>
101028>>>>>>>>> procedure HandleField integer liFile integer liField string lsName integer liType integer liLen integer liPrec integer liRelFile integer liRelField integer liIndex integer liOffSet
101030>>>>>>>>> integer liFieldFile
101030>>>>>>>>> send OnHandleField ("Field: "+string(liField)*lsName)
101031>>>>>>>>> get piFile.i of (phTableAccessObject(self)) DBDTABLE_FIELD to liFieldFile
101032>>>>>>>>> lock
101033>>>>>>>>>>
101033>>>>>>>>> clear liFieldFile // clear dbField
101034>>>>>>>>> set_field_value liFieldFile 1 to liFile // move liFile to dbField.Tbl_Id
101037>>>>>>>>> set_field_value liFieldFile 3 to lsName // move lsName to dbField.Fld_Name
101040>>>>>>>>> vfind liFieldFile 1 EQ // find eq dbField by index.1
101042>>>>>>>>> set_field_value liFieldFile 2 to liField // move liField to dbField.Fld_Pos
101045>>>>>>>>> set_field_value liFieldFile 4 to 0 // move 0 to dbField.fld_not_found
101048>>>>>>>>> set_field_value liFieldFile 7 to (FDX_FieldTypeAndLengthName2(phFdx(self),liFile,liField))
101051>>>>>>>>> saverecord liFieldFile // saverecord dbField
101052>>>>>>>>> unlock
101053>>>>>>>>>>
101053>>>>>>>>> end_procedure
101054>>>>>>>>>
101054>>>>>>>>> procedure HandleTable integer liFile string lsRoot string lsDFName string lsUserName
101056>>>>>>>>> integer liTableFile lhFDX
101056>>>>>>>>> string lsPath
101056>>>>>>>>> if (liFile<>49 and liFile<>50) begin
101058>>>>>>>>> get phFDX to lhFDX
101059>>>>>>>>> if (iCanOpen.i(lhFdx,liFile)) begin
101061>>>>>>>>> send OnHandleTable ("Table: "+string(liFile)*lsDFName)
101062>>>>>>>>> get piFile.i of (phTableAccessObject(self)) DBDTABLE_TABLE to liTableFile
101063>>>>>>>>> get sDatPath.i of lhFdx liFile to lsPath
101064>>>>>>>>> lock
101065>>>>>>>>>>
101065>>>>>>>>> clear liTableFile // dbTable
101066>>>>>>>>> set_field_value liTableFile 1 to liFile // move liFile to dbTable.Tbl_Id
101069>>>>>>>>> vfind liTableFile 1 EQ // find eq dbTable by index.1
101071>>>>>>>>> set_field_value liTableFile 2 to lsUserName // move lsUserName to dbTable.tbl_name
101074>>>>>>>>> set_field_value liTableFile 3 to lsDFName // move lsDFName to dbTable.tbl_logic_name
101077>>>>>>>>> set_field_value liTableFile 4 to lsRoot // move lsRoot to dbTable.tbl_physic_name
101080>>>>>>>>> set_field_value liTableFile 5 to 0 // move 0 to dbTable.tbl_not_found
101083>>>>>>>>> set_field_value liTableFile 6 to lsPath // dbTable.tbl_openas_path
101086>>>>>>>>> saverecord liTableFile // dbTable
101087>>>>>>>>> unlock
101088>>>>>>>>>>
101088>>>>>>>>> send FDX_FieldCallBack lhFdx liFile MSG_HandleField self // Protected against relating file not present
101089>>>>>>>>> send FDX_IndexCallBack lhFdx liFile DF_INDEX_TYPE_ONLINE MSG_HandleIndex self
101090>>>>>>>>> send FDX_IndexCallback lhFdx liFile DF_INDEX_TYPE_BATCH MSG_HandleIndex self
101091>>>>>>>>> end
101091>>>>>>>>>>
101091>>>>>>>>> end
101091>>>>>>>>>>
101091>>>>>>>>> end_procedure
101092>>>>>>>>>
101092>>>>>>>>> procedure DoUpdateDatabase
101094>>>>>>>>> integer liTableFile liFieldFile lbFound lbSuccess
101094>>>>>>>>>
101094>>>>>>>>> send OnUpdateBegin
101095>>>>>>>>>
101095>>>>>>>>> // At this point we will flag all tables (except the DBD tables) read_only
101095>>>>>>>>> // in order not to lock the DB for too long (happened when running this
101095>>>>>>>>> // rutine in FastView towards a DF3.2 Linux system on a slow network)
101095>>>>>>>>>
101095>>>>>>>>> send OpenStat_RegisterFiles
101096>>>>>>>>> send OpenStat_CloseAllFiles
101097>>>>>>>>> get DoOpenTables of (phTableAccessObject(self)) to lbSuccess
101098>>>>>>>>> ifnot lbSuccess send obs "DoOpenTables of dbd.nui failed to fulfil its purpose." "What happens from now on is anybodys guess..." "(nothing that can damage the database, I promise)"
101101>>>>>>>>> else begin
101102>>>>>>>>> lock // First we mark everything as if it no longer exists:
101103>>>>>>>>>>
101103>>>>>>>>> get piFile.i of (phTableAccessObject(self)) DBDTABLE_TABLE to liTableFile
101104>>>>>>>>> clear liTableFile // s.reg_scan dbTable by index.1
101105>>>>>>>>> repeat // move 1 to dbTable.tbl_not_found
101105>>>>>>>>>>
101105>>>>>>>>> vfind liTableFile 1 GT // saverecord dbTable
101107>>>>>>>>> move (found) to lbFound // s.reg_scan dbTable loop
101108>>>>>>>>> if lbFound begin
101110>>>>>>>>> set_field_value liTableFile 5 to 1 // dbTable.tbl_not_found
101113>>>>>>>>> saverecord liTableFile
101114>>>>>>>>> end
101114>>>>>>>>>>
101114>>>>>>>>> until (not(lbFound))
101116>>>>>>>>>
101116>>>>>>>>> get piFile.i of (phTableAccessObject(self)) DBDTABLE_FIELD to liFieldFile
101117>>>>>>>>> clear liFieldFile // s.reg_scan dbField by index.1
101118>>>>>>>>> repeat // move 1 to dbField.fld_not_found
101118>>>>>>>>>>
101118>>>>>>>>> vfind liFieldFile 1 GT // saverecord dbField
101120>>>>>>>>> move (found) to lbFound // s.reg_scan dbField loop
101121>>>>>>>>> if lbFound begin
101123>>>>>>>>> set_field_value liFieldFile 4 to 1 // dbField.tbl_not_found
101126>>>>>>>>> saverecord liFieldFile
101127>>>>>>>>> end
101127>>>>>>>>>>
101127>>>>>>>>> until (not(lbFound))
101129>>>>>>>>> unlock
101130>>>>>>>>>>
101130>>>>>>>>> send Callback.ii to (phFDX(self)) MSG_HandleTable self
101131>>>>>>>>> // Here we finally make sure that a few standrad libraries are defined
101131>>>>>>>>> lock
101132>>>>>>>>>>
101132>>>>>>>>> send CreatePredefinedLibraries to (oDBD_PredefinedLibraries(self)) liTableFile
101133>>>>>>>>> unlock
101134>>>>>>>>>>
101134>>>>>>>>> send OnUpdateEnd
101135>>>>>>>>> end
101135>>>>>>>>>>
101135>>>>>>>>> send OpenStat_RestoreFiles
101136>>>>>>>>> end_procedure
101137>>>>>>>>>
101137>>>>>>>>> procedure DoUpdateCurrentDefinitions
101139>>>>>>>>> send FDXGL_ReadCurrentFileList FDX_ALL_FILES
101140>>>>>>>>> send DoUpdateDatabase
101141>>>>>>>>> end_procedure
101142>>>>>>>>>
101142>>>>>>>>> procedure end_construct_object
101144>>>>>>>>> integer lhSelf
101144>>>>>>>>> forward send end_construct_object
101146>>>>>>>>> move self to lhSelf
101147>>>>>>>>> set phTableUpdater to lhSelf // This is resolved in the encapsulating cDBD_System object
101148>>>>>>>>> end_procedure
101149>>>>>>>>>
101149>>>>>>>>>end_class // cDBD_Updater
101150>>>>>>>>>
101150>>>>>>>>> Use Flexml.pkg
101150>>>>>>>>>
101150>>>>>>>>> object dbDocBPOXML_Read is a BusinessProcess
101152>>>>>>>>> set Display_Error_State to TRUE
101153>>>>>>>>> set Status_Panel_State to TRUE
101154>>>>>>>>> property string psInFileName public "dbdoc.xml"
101156>>>>>>>>> property integer phTableAccessObject public 0
101158>>>>>>>>>
101158>>>>>>>>> procedure DoProcess_FileName string lsFile integer lhDBDSystem
101161>>>>>>>>> set psInFileName to lsFile
101162>>>>>>>>> set phTableAccessObject to (phTableAccessObject(lhDBDSystem))
101163>>>>>>>>> send DoProcess
101164>>>>>>>>> end_procedure
101165>>>>>>>>>
101165>>>>>>>>> function sXML_FieldValue handle hoNode string lsFieldName returns string
101168>>>>>>>>> handle hoTmp
101168>>>>>>>>> string lsValue
101168>>>>>>>>> get FindNode of hoNode lsFieldName to hoTmp
101169>>>>>>>>> if (hoTmp<>0) begin
101171>>>>>>>>> get psText of hoTmp to lsValue
101172>>>>>>>>> send destroy of hoTmp
101173>>>>>>>>> end
101173>>>>>>>>>>
101173>>>>>>>>> else move "" to lsValue
101175>>>>>>>>> function_return lsValue
101176>>>>>>>>> end_function
101177>>>>>>>>>
101177>>>>>>>>> procedure OnProcess
101180>>>>>>>>> integer lbTest lbFin
101180>>>>>>>>> integer lbOK liFile
101180>>>>>>>>> handle hoRoot hoXML hoFields hoIndices
101180>>>>>>>>> handle hoTable hoNextTable
101180>>>>>>>>> handle hoField hoNextField
101180>>>>>>>>> handle hoIndex hoNextIndex
101180>>>>>>>>> string lsInFile lsValue
101180>>>>>>>>> integer liTableFileNumber liFieldFileNumber liIndexFileNumber
101180>>>>>>>>>
101180>>>>>>>>> get piFile.i of (phTableAccessObject(self)) DBDTABLE_TABLE to liTableFileNumber
101181>>>>>>>>> get piFile.i of (phTableAccessObject(self)) DBDTABLE_FIELD to liFieldFileNumber
101182>>>>>>>>> get piFile.i of (phTableAccessObject(self)) DBDTABLE_INDEX to liIndexFileNumber
101183>>>>>>>>>
101183>>>>>>>>> get psInFileName to lsInFile
101184>>>>>>>>> get Create U_cXMLDOMDocument to hoXML
101185>>>>>>>>> set psDocumentName of hoXML to lsInFile
101186>>>>>>>>>
101186>>>>>>>>> set pbValidateOnParse of hoXML to True
101187>>>>>>>>> get LoadXMLDocument of hoXml to lbOK
101188>>>>>>>>>
101188>>>>>>>>> ifnot lbOK begin
101190>>>>>>>>> send BasicParseErrorReport of hoXml
101191>>>>>>>>> send Destroy of hoXML
101192>>>>>>>>> procedure_return
101193>>>>>>>>> end
101193>>>>>>>>>>
101193>>>>>>>>>
101193>>>>>>>>> get DocumentElement of hoXml to hoRoot
101194>>>>>>>>> if (hoRoot=0) begin
101196>>>>>>>>> error 10001 "Cannot get the root node for the XML document test.xml"
101197>>>>>>>>>>
101197>>>>>>>>> send Destroy of hoXml
101198>>>>>>>>> procedure_return
101199>>>>>>>>> end
101199>>>>>>>>>>
101199>>>>>>>>>
101199>>>>>>>>> lock
101200>>>>>>>>>>
101200>>>>>>>>> get firstchild of hoRoot to hoTable
101201>>>>>>>>> while (hoTable<>0)
101205>>>>>>>>>
101205>>>>>>>>> get sXML_FieldValue hoTable "TBL_ID" to liFile
101206>>>>>>>>> if liFile begin
101208>>>>>>>>>
101208>>>>>>>>> clear liTableFileNumber // clear dbTable
101209>>>>>>>>> set_field_value liTableFileNumber 1 to liFile // move liFile to dbTable.Tbl_Id
101212>>>>>>>>> vfind liTableFileNumber 1 EQ // find eq dbTable by index.1
101214>>>>>>>>>
101214>>>>>>>>> set_field_value liTableFileNumber 2 to (sXML_FieldValue(self,hoTable,"TBL_NAME" )) // get sXML_FieldValue hoTable "TBL_NAME" to dbTable.TBL_NAME
101217>>>>>>>>> set_field_value liTableFileNumber 3 to (sXML_FieldValue(self,hoTable,"TBL_LOGIC_NAME" )) // get sXML_FieldValue hoTable "TBL_LOGIC_NAME" to dbTable.TBL_LOGIC_NAME
101220>>>>>>>>> set_field_value liTableFileNumber 4 to (sXML_FieldValue(self,hoTable,"TBL_PHYSIC_NAME")) // get sXML_FieldValue hoTable "TBL_PHYSIC_NAME" to dbTable.TBL_PHYSIC_NAME
101223>>>>>>>>> set_field_value liTableFileNumber 5 to (sXML_FieldValue(self,hoTable,"TBL_NOT_FOUND" )) // get sXML_FieldValue hoTable "TBL_NOT_FOUND" to dbTable.TBL_NOT_FOUND
101226>>>>>>>>> set_field_value liTableFileNumber 6 to (sXML_FieldValue(self,hoTable,"TBL_OPENAS_PATH")) // get sXML_FieldValue hoTable "TBL_OPENAS_PATH" to dbTable.TBL_OPENAS_PATH
101229>>>>>>>>> get sXML_FieldValue hoTable "TBL_DESCRIPTION" to lsValue
101230>>>>>>>>> if (lsValue<>"") set_field_value liTableFileNumber 7 to lsValue // move lsValue to dbTable.tbl_description
101235>>>>>>>>> saverecord liTableFileNumber
101236>>>>>>>>>
101236>>>>>>>>> // *** FIELDS ***************************************************************
101236>>>>>>>>> get FindNode of hoTable "Fields" to hoFields
101237>>>>>>>>> if (hoFields<>0) begin
101239>>>>>>>>> get firstchild of hoFields to hoField
101240>>>>>>>>> while (hoField<>0)
101244>>>>>>>>>
101244>>>>>>>>> clear liFieldFileNumber // clear dbField
101245>>>>>>>>> set_field_value liFieldFileNumber 1 to (sXML_FieldValue(self,hoField,"TBL_ID")) // get sXML_FieldValue hoField "TBL_ID" to dbField.TBL_ID
101248>>>>>>>>> set_field_value liFieldFileNumber 3 to (sXML_FieldValue(self,hoField,"FLD_NAME")) // get sXML_FieldValue hoField "FLD_NAME" to dbField.FLD_NAME
101251>>>>>>>>> vfind liFieldFileNumber 1 EQ // find eq dbField by index.1
101253>>>>>>>>> set_field_value liFieldFileNumber 2 to (sXML_FieldValue(self,hoField,"FLD_POS")) // get sXML_FieldValue hoField "FLD_POS" to dbField.FLD_POS
101256>>>>>>>>> set_field_value liFieldFileNumber 4 to (sXML_FieldValue(self,hoField,"FLD_NOT_FOUND")) // get sXML_FieldValue hoField "FLD_NOT_FOUND" to dbField.FLD_NOT_FOUND
101259>>>>>>>>> get sXML_FieldValue hoField "FLD_DESCRIPTION" to lsValue
101260>>>>>>>>> if (lsValue<>"") set_field_value liFieldFileNumber 5 to lsValue // move lsValue to dbField.FLD_DESCRIPTION
101265>>>>>>>>> set_field_value liFieldFileNumber 6 to (sXML_FieldValue(self,hoField,"SUGGESTED_LABEL")) // get sXML_FieldValue hoField "SUGGESTED_LABEL" to dbField.SUGGESTED_LABEL
101268>>>>>>>>> set_field_value liFieldFileNumber 7 to (sXML_FieldValue(self,hoField,"FLD_DEFINITION")) // get sXML_FieldValue hoField "FLD_DEFINITION" to dbField.FLD_DEFINITION
101271>>>>>>>>> saverecord liFieldFileNumber
101272>>>>>>>>>
101272>>>>>>>>> get NextSibling of hoField to hoNextField
101273>>>>>>>>> send Destroy of hoField
101274>>>>>>>>> move hoNextField to hoField
101275>>>>>>>>> loop
101276>>>>>>>>>>
101276>>>>>>>>>
101276>>>>>>>>> send destroy of hoFields
101277>>>>>>>>> end
101277>>>>>>>>>>
101277>>>>>>>>>
101277>>>>>>>>> // *** INDICES *************************************************************
101277>>>>>>>>>
101277>>>>>>>>> get FindNode of hoTable "Indices" to hoIndices
101278>>>>>>>>> if (hoIndices<>0) begin
101280>>>>>>>>> get firstchild of hoIndices to hoIndex
101281>>>>>>>>> while (hoIndex<>0)
101285>>>>>>>>> clear liIndexFileNumber // clear dbIndex
101286>>>>>>>>> set_field_value liIndexFileNumber 1 to (sXML_FieldValue(self,hoIndex,"TBL_ID")) // get sXML_FieldValue hoIndex "TBL_ID" to dbIndex.TBL_ID
101289>>>>>>>>> set_field_value liIndexFileNumber 2 to (sXML_FieldValue(self,hoIndex,"IDX_POS")) // get sXML_FieldValue hoIndex "IDX_POS" to dbIndex.IDX_POS
101292>>>>>>>>> vfind liIndexFileNumber 1 EQ // find eq dbIndex by indexdfc.1
101294>>>>>>>>> get sXML_FieldValue hoIndex "IDX_DESCRIPTION" to lsValue
101295>>>>>>>>> if (lsValue<>"") set_field_value liIndexFileNumber 4 to lsValue // move lsValue to dbIndex.IDX_DESCRIPTION
101300>>>>>>>>> saverecord liIndexFileNumber
101301>>>>>>>>>
101301>>>>>>>>> get NextSibling of hoIndex to hoNextIndex
101302>>>>>>>>> send Destroy of hoIndex
101303>>>>>>>>> move hoNextIndex to hoIndex
101304>>>>>>>>> loop
101305>>>>>>>>>>
101305>>>>>>>>>
101305>>>>>>>>> send destroy of hoIndices
101306>>>>>>>>> end
101306>>>>>>>>>>
101306>>>>>>>>>
101306>>>>>>>>> end
101306>>>>>>>>>>
101306>>>>>>>>>
101306>>>>>>>>> get NextSibling of hoTable to hoNextTable
101307>>>>>>>>> send Destroy of hoTable
101308>>>>>>>>> move hoNextTable to hoTable
101309>>>>>>>>> loop
101310>>>>>>>>>>
101310>>>>>>>>> unlock
101311>>>>>>>>>>
101311>>>>>>>>>
101311>>>>>>>>> send Destroy of hoRoot
101312>>>>>>>>> send Destroy of hoXML
101313>>>>>>>>>
101313>>>>>>>>> end_procedure
101314>>>>>>>>> end_object // dbDocBPOXML_Read
101315>>>>>>>>>
101315>>>>>>>>> object dbDocBPOXML_Write is a BusinessProcess
101317>>>>>>>>> set Display_Error_State to TRUE
101318>>>>>>>>> set Status_Panel_State to TRUE
101319>>>>>>>>> property string psOutFileName public "dbdoc.xml"
101321>>>>>>>>> property integer phTableAccessObject public 0
101323>>>>>>>>>
101323>>>>>>>>> procedure DoProcess_FileName string lsFile integer lhDBDSystem
101326>>>>>>>>> set phTableAccessObject to (phTableAccessObject(lhDBDSystem))
101327>>>>>>>>> set psOutFileName to lsFile
101328>>>>>>>>> send DoProcess
101329>>>>>>>>> end_procedure
101330>>>>>>>>>
101330>>>>>>>>> Function Encode string sDat Returns string
101333>>>>>>>>> Move (Replaces("&",sDat,"&")) to sDat
101334>>>>>>>>> Move (Replaces("<",sDat,"<")) to sDat
101335>>>>>>>>> Move (Replaces(">",sDat,">")) to sDat
101336>>>>>>>>> Move (Replaces('"',sDat,""")) to sDat
101337>>>>>>>>> Function_Return sDat
101338>>>>>>>>> End_Function
101339>>>>>>>>>
101339>>>>>>>>> procedure AddRecord integer liFile string lsLogicName integer hoNode
101342>>>>>>>>> integer liField liFields liType
101342>>>>>>>>> handle hoRecord hoField
101342>>>>>>>>> string lsValue lsName
101342>>>>>>>>> showln "AddRecord " liFile " " hoNode
101347>>>>>>>>>// get_attribute DF_FILE_LOGICAL_NAME of liFile to lsValue
101347>>>>>>>>> move lsLogicName to lsValue
101348>>>>>>>>> move (trim(lsValue)) to lsValue
101349>>>>>>>>> get AddElement of hoNode lsValue "" to hoRecord
101350>>>>>>>>> showln " Value: " lsValue
101353>>>>>>>>> showln " hoRecord: " hoRecord
101356>>>>>>>>> get_attribute DF_FILE_NUMBER_FIELDS of liFile to liFields
101359>>>>>>>>> for liField from 1 to liFields
101365>>>>>>>>>>
101365>>>>>>>>> Get_Attribute DF_FIELD_TYPE of liFile liField to liType
101368>>>>>>>>>
101368>>>>>>>>> If (liType<>DF_OVERLAP) Begin
101370>>>>>>>>> get_field_value liFile liField to lsValue
101373>>>>>>>>> move (trim(lsValue)) to lsValue
101374>>>>>>>>> get_attribute DF_FIELD_NAME of liFile liField to lsName
101377>>>>>>>>>
101377>>>>>>>>> get AddElement of hoRecord lsName "" to hoField
101378>>>>>>>>> if (liType=DF_TEXT or liType=DF_ASCII) ; Send AddCDataSection of hoField lsValue
101381>>>>>>>>> Else Begin
101382>>>>>>>>> Get Encode lsValue to lsValue // encode < > ; and "
101383>>>>>>>>>
101383>>>>>>>>> Send AddChildTextNode of hoField lsValue
101384>>>>>>>>> End
101384>>>>>>>>>>
101384>>>>>>>>>
101384>>>>>>>>> //Send AddAttribute Of hoField "Field-number" iField
101384>>>>>>>>> //Send AddAttribute Of hoField "Name" sTag
101384>>>>>>>>> Send Destroy of hoField
101385>>>>>>>>>
101385>>>>>>>>> End
101385>>>>>>>>>>
101385>>>>>>>>> loop
101386>>>>>>>>>>
101386>>>>>>>>> send Destroy of hoRecord
101387>>>>>>>>> end_procedure
101388>>>>>>>>>
101388>>>>>>>>> procedure OnProcess
101391>>>>>>>>> integer lbTest lbFin
101391>>>>>>>>> integer lbAnythingOnRecord
101391>>>>>>>>> handle hoRoot hoXML hoFields hoIndices
101391>>>>>>>>> handle hoTable hoField hoIndex hoTmp
101391>>>>>>>>> string lsOutFile lsValue
101391>>>>>>>>> integer lbTableFound lbFieldFound lbIndexFound
101391>>>>>>>>> integer liTableFileNumber liFieldFileNumber liIndexFileNumber
101391>>>>>>>>>
101391>>>>>>>>> get piFile.i of (phTableAccessObject(self)) DBDTABLE_TABLE to liTableFileNumber
101392>>>>>>>>> get piFile.i of (phTableAccessObject(self)) DBDTABLE_FIELD to liFieldFileNumber
101393>>>>>>>>> get piFile.i of (phTableAccessObject(self)) DBDTABLE_INDEX to liIndexFileNumber
101394>>>>>>>>>
101394>>>>>>>>> get psOutFileName to lsOutFile
101395>>>>>>>>>
101395>>>>>>>>> get Create U_cXMLDOMDocument to hoXML
101396>>>>>>>>> set psDocumentName of hoXML to lsOutFile //(lsDataPath - "\dbdoc.xml")
101397>>>>>>>>> get CreateDocumentElement of hoXML "dbDoc" to hoRoot
101398>>>>>>>>>
101398>>>>>>>>> clear liTableFileNumber
101399>>>>>>>>> repeat
101399>>>>>>>>>>
101399>>>>>>>>> vfind liTableFileNumber 1 GT
101401>>>>>>>>> move (found) to lbTableFound
101402>>>>>>>>> if lbTableFound begin
101404>>>>>>>>>
101404>>>>>>>>> get AddElement of hoRoot "Table" "" to hoTable
101405>>>>>>>>> get_field_value liTableFileNumber 1 to lsValue // dbTable.TBL_ID
101408>>>>>>>>> send AddElement of hoTable "TBL_ID" (trim(lsValue))
101409>>>>>>>>> get_field_value liTableFileNumber 2 to lsValue // dbTable.TBL_NAME
101412>>>>>>>>> send AddElement of hoTable "TBL_NAME" (trim(lsValue))
101413>>>>>>>>> get_field_value liTableFileNumber 3 to lsValue // dbTable.TBL_LOGIC_NAME
101416>>>>>>>>> send AddElement of hoTable "TBL_LOGIC_NAME" (trim(lsValue))
101417>>>>>>>>> get_field_value liTableFileNumber 4 to lsValue // dbTable.TBL_PHYSIC_NAME
101420>>>>>>>>> send AddElement of hoTable "TBL_PHYSIC_NAME" (trim(lsValue))
101421>>>>>>>>> get_field_value liTableFileNumber 5 to lsValue // dbTable.TBL_NOT_FOUND
101424>>>>>>>>> send AddElement of hoTable "TBL_NOT_FOUND" lsValue
101425>>>>>>>>> get_field_value liTableFileNumber 6 to lsValue // dbTable.TBL_OPENAS_PATH
101428>>>>>>>>> send AddElement of hoTable "TBL_OPENAS_PATH" (trim(lsValue))
101429>>>>>>>>> get_field_value liTableFileNumber 7 to lsValue // dbTable.TBL_DESCRIPTION
101432>>>>>>>>> send AddElement of hoTable "TBL_DESCRIPTION" lsValue
101433>>>>>>>>> move (lsValue<>"") to lbAnythingOnRecord
101434>>>>>>>>>
101434>>>>>>>>> get AddElement of hoTable "Fields" "" to hoFields
101435>>>>>>>>> clear liFieldFileNumber
101436>>>>>>>>> repeat
101436>>>>>>>>>>
101436>>>>>>>>> vfind liFieldFileNumber 2 GT
101438>>>>>>>>> move (found) to lbFieldFound
101439>>>>>>>>> if lbFieldFound begin
101441>>>>>>>>> get_field_value liFieldFileNumber 5 to lsValue // dbField.TBL_DESCRIPTION
101444>>>>>>>>> if (lsValue<>"") begin
101446>>>>>>>>> send AddRecord liFieldFileNumber "Field" hoFields
101447>>>>>>>>> move true to lbAnythingOnRecord
101448>>>>>>>>> end
101448>>>>>>>>>>
101448>>>>>>>>> end
101448>>>>>>>>>>
101448>>>>>>>>> until (not(lbFieldFound))
101450>>>>>>>>> send Destroy of hoFields
101451>>>>>>>>>
101451>>>>>>>>> get AddElement of hoTable "Indices" "" to hoIndex
101452>>>>>>>>> clear liIndexFileNumber
101453>>>>>>>>> repeat
101453>>>>>>>>>>
101453>>>>>>>>> vfind liIndexFileNumber 1 GT
101455>>>>>>>>> move (found) to lbIndexFound
101456>>>>>>>>> if lbIndexFound begin
101458>>>>>>>>> get_field_value liFieldFileNumber 4 to lsValue // dbIndex.idx_description
101461>>>>>>>>> if (lsValue<>"") begin
101463>>>>>>>>> send AddRecord liIndexFileNumber "Index" hoIndex
101464>>>>>>>>> move true to lbAnythingOnRecord
101465>>>>>>>>> end
101465>>>>>>>>>>
101465>>>>>>>>> end
101465>>>>>>>>>>
101465>>>>>>>>> until (not(lbIndexFound))
101467>>>>>>>>> send Destroy of hoIndex
101468>>>>>>>>>
101468>>>>>>>>> ifnot lbAnythingOnRecord get RemoveNode of hoRoot hoTable to hoTable
101471>>>>>>>>>
101471>>>>>>>>> send Destroy of hoTable
101472>>>>>>>>> end
101472>>>>>>>>>>
101472>>>>>>>>> until (not(lbTableFound))
101474>>>>>>>>>
101474>>>>>>>>> send Destroy Of hoRoot
101475>>>>>>>>> get SaveXMLDocument of hoXML to lbTest
101476>>>>>>>>> send Destroy Of hoXML
101477>>>>>>>>> end_procedure
101478>>>>>>>>> end_object // dbDocBPOXML_Write
101479>>>>>>>>>
101479>>>>>>>>>
101479>>>>>>>Use FTSData.nui // cFTS_TableAccess class.
101479>>>>>>>Use TblCreate.pkg // cTableCreator class
101479>>>>>>>Use FList.nui // A lot of FLIST- procedures and functions
101479>>>>>>>
101479>>>>>>>object oDBD_TablePrefix is a aps.ModalPanel label "Create DBD tables" // "Root name prefix"
101482>>>>>>> set locate_mode to CENTER_ON_SCREEN
101483>>>>>>> on_key ksave_record send close_panel_ok
101484>>>>>>> on_key kcancel send close_panel
101485>>>>>>> property integer piResult public DFFALSE
101487>>>>>>> object oFrm is a aps.Form abstract AFT_ASCII2 label "Root name prefix (enter two letters)"
101491>>>>>>> set enabled_state to false
101492>>>>>>> end_object
101493>>>>>>> function iValidateValue returns integer
101496>>>>>>> integer liRval
101496>>>>>>> string lsValue
101496>>>>>>> move 1 to liRval
101497>>>>>>> get value of oFrm item 0 to lsValue
101498>>>>>>> move (trim(lowercase(lsValue))) to lsValue
101499>>>>>>> set value of oFrm item 0 to lsValue
101500>>>>>>> ifnot (length(lsValue)=2) move 0 to liRval
101503>>>>>>> ifnot ("abcdefghijklmnopqrstuvwxyz" contains left(lsValue,1)) move 0 to liRval
101506>>>>>>> ifnot ("abcdefghijklmnopqrstuvwxyz0123456789" contains right(lsValue,1)) move 0 to liRval
101509>>>>>>> ifnot liRval error 534 "Value must be two letters!"
101512>>>>>>> function_return liRval
101513>>>>>>> end_function
101514>>>>>>> object oBtn1 is a aps.Multi_Button
101516>>>>>>> on_item t.btn.ok send close_panel_ok
101517>>>>>>> end_object
101518>>>>>>> object oBtn2 is a aps.Multi_Button
101520>>>>>>> on_item t.btn.cancel send close_panel
101521>>>>>>> end_object
101522>>>>>>> send aps_locate_multi_buttons
101523>>>>>>> procedure close_panel_ok
101526>>>>>>> if (iValidateValue(self)) begin
101528>>>>>>> set piResult to DFTRUE
101529>>>>>>> send close_panel
101530>>>>>>> end
101530>>>>>>>>
101530>>>>>>> end_procedure
101531>>>>>>> function sPopup.s string lsValue returns string
101534>>>>>>> set piResult to DFFALSE
101535>>>>>>> set value of oFrm item 0 to lsValue
101536>>>>>>> send popup
101537>>>>>>> if (piResult(self)) function_return (value(oFrm(self),0))
101540>>>>>>> function_return ""
101541>>>>>>> end_procedure
101542>>>>>>>end_object // oDBD_TablePrefix
101543>>>>>>>
101543>>>>>>>object oDBD_TableDefinitions is a cArray
101545>>>>>>>
101545>>>>>>> object oTable_System is a cTableCreator
101547>>>>>>> set pbUpdateFilelist to true
101548>>>>>>> procedure OnDefine
101551>>>>>>> set piMaxRecords to 1
101552>>>>>>> send DoAddField "NAME" DF_ASCII 50
101553>>>>>>> send DoAddField "DESCRIPTION" DF_TEXT 12288
101554>>>>>>> send DoAddField "PREV_UPD_METHOD" DF_BCD 2 // 0=Current DB, 1=XML, 2=FDX
101555>>>>>>> send DoAddField "PREV_UPD_FILE" DF_ASCII 255
101556>>>>>>> send DoAddField "PREV_VDFQ_OUT" DF_ASCII 255
101557>>>>>>> send DoAddField "PREV_XML_OUT" DF_ASCII 255
101558>>>>>>> send DoAddField "DEF_LAST_UPD_DT" DF_DATE 0 // Date and time, when the DB's were last updated
101559>>>>>>> send DoAddField "DEF_LAST_UPD_TM" DF_ASCII 8 //
101560>>>>>>> end_procedure
101561>>>>>>> end_object
101562>>>>>>>
101562>>>>>>> object oTable_Table is a cTableCreator
101564>>>>>>> set pbUpdateFilelist to true
101565>>>>>>> procedure OnDefine
101568>>>>>>> set piMaxRecords to 10000
101569>>>>>>> send DoAddField "TBL_ID" DF_BCD 6 // 1
101570>>>>>>> send DoAddField "TBL_NAME" DF_ASCII 40 // 2
101571>>>>>>> send DoAddField "TBL_LOGIC_NAME" DF_ASCII 12 // 3
101572>>>>>>> send DoAddField "TBL_PHYSIC_NAME" DF_ASCII 80 // 4
101573>>>>>>> send DoAddField "TBL_NOT_FOUND" DF_BCD 2 // 5
101574>>>>>>> send DoAddField "TBL_OPENAS_PATH" DF_ASCII 255 // 6
101575>>>>>>> send DoAddField "TBL_DESCRIPTION" DF_TEXT 12288 // 7
101576>>>>>>> send DoAddField "TBL_OBSOLETE" DF_BCD 2 // 8
101577>>>>>>> send DoAddField "CRE_DATE" DF_DATE 0 //
101578>>>>>>> send DoAddField "CRE_TIME" DF_ASCII 5 //
101579>>>>>>> send DoAddField "CRE_USER" DF_ASCII 30 //
101580>>>>>>> send DoAddField "REV_DATE" DF_DATE 0 //
101581>>>>>>> send DoAddField "REV_TIME" DF_ASCII 5 //
101582>>>>>>> send DoAddField "REV_USER" DF_ASCII 30 //
101583>>>>>>> send DoAddOnlineIndex 1 "tbl_id"
101584>>>>>>> send DoAddOnlineIndex 2 "TBL_PHYSIC_NAME recnum" // Uppercase = Ignore case
101585>>>>>>> end_procedure
101586>>>>>>> end_object
101587>>>>>>>
101587>>>>>>> object oTable_Field is a cTableCreator
101589>>>>>>> set pbUpdateFilelist to true
101590>>>>>>> procedure OnDefine
101593>>>>>>> set piMaxRecords to 100000
101594>>>>>>> send DoAddField "TBL_ID" DF_BCD 6 // 1
101595>>>>>>> send DoAddField "FLD_POS" DF_BCD 4 // 2
101596>>>>>>> send DoAddField "FLD_NAME" DF_ASCII 15 // 3
101597>>>>>>> send DoAddField "FLD_NOT_FOUND" DF_BCD 2 // 4
101598>>>>>>> send DoAddField "FLD_DESCRIPTION" DF_TEXT 12288 // 5
101599>>>>>>> send DoAddField "SUGGESTED_LABEL" DF_ASCII 20 // 6
101600>>>>>>> send DoAddField "FLD_DEFINITION" DF_ASCII 20 // 7
101601>>>>>>> send DoAddField "FLD_OBSOLETE" DF_BCD 2 // 8
101602>>>>>>> send DoAddField "FLD_CALCULATED" DF_BCD 2 // 9
101603>>>>>>> send DoAddField "FLD_CREATE_DATE" DF_DATE 0 // 10
101604>>>>>>> send DoAddField "FLD_CREATE_TIME" DF_ASCII 8 // 11
101605>>>>>>> send DoAddField "FLD_EDIT_DATE" DF_DATE 0 // 12
101606>>>>>>> send DoAddField "FLD_EDIT_TIME" DF_ASCII 8 // 13
101607>>>>>>> send DoAddField "CRE_DATE" DF_DATE 0 //
101608>>>>>>> send DoAddField "CRE_TIME" DF_ASCII 5 //
101609>>>>>>> send DoAddField "CRE_USER" DF_ASCII 30 //
101610>>>>>>> send DoAddField "REV_DATE" DF_DATE 0 //
101611>>>>>>> send DoAddField "REV_TIME" DF_ASCII 5 //
101612>>>>>>> send DoAddField "REV_USER" DF_ASCII 30 //
101613>>>>>>> send DoAddOnlineIndex 1 "tbl_id FLD_NAME"
101614>>>>>>> send DoAddOnlineIndex 2 "tbl_id fld_not_found fld_pos recnum"
101615>>>>>>> end_procedure
101616>>>>>>> end_object
101617>>>>>>>
101617>>>>>>> object oTable_Index is a cTableCreator
101619>>>>>>> set pbUpdateFilelist to true
101620>>>>>>> procedure OnDefine
101623>>>>>>> set piMaxRecords to 10000
101624>>>>>>> send DoAddField "TBL_ID" DF_BCD 6
101625>>>>>>> send DoAddField "IDX_POS" DF_BCD 2
101626>>>>>>> send DoAddField "IDX_NAME" DF_ASCII 35
101627>>>>>>> send DoAddField "IDX_DESCRIPTION" DF_TEXT 12288
101628>>>>>>> send DoAddField "IDX_NOT_FOUND" DF_BCD 2
101629>>>>>>> send DoAddField "CRE_DATE" DF_DATE 0 //
101630>>>>>>> send DoAddField "CRE_TIME" DF_ASCII 5 //
101631>>>>>>> send DoAddField "CRE_USER" DF_ASCII 30 //
101632>>>>>>> send DoAddField "REV_DATE" DF_DATE 0 //
101633>>>>>>> send DoAddField "REV_TIME" DF_ASCII 5 //
101634>>>>>>> send DoAddField "REV_USER" DF_ASCII 30 //
101635>>>>>>> send DoAddOnlineIndex 1 "tbl_id idx_pos"
101636>>>>>>> end_procedure
101637>>>>>>> end_object
101638>>>>>>>
101638>>>>>>> procedure DoCreateTables integer lhTableAccess
101641>>>>>>> integer liFile lhAppDbTable lbSuccess
101641>>>>>>> string lsRoot lsLogical lsDisplay
101641>>>>>>>
101641>>>>>>> get piFile.i of lhTableAccess DBDTABLE_SYSTEM to liFile
101642>>>>>>> get psRootname.i of lhTableAccess DBDTABLE_SYSTEM to lsRoot
101643>>>>>>> get psLogicalName.i of lhTableAccess DBDTABLE_SYSTEM to lsLogical
101644>>>>>>> get psUserName.i of lhTableAccess DBDTABLE_SYSTEM to lsDisplay
101645>>>>>>> set FileListValues of oTable_System to liFile lsRoot lsLogical lsDisplay
101646>>>>>>> send DoDefine of oTable_System
101647>>>>>>> send CreateTable of oTable_System
101648>>>>>>>
101648>>>>>>> get piFile.i of lhTableAccess DBDTABLE_TABLE to liFile
101649>>>>>>> get psRootname.i of lhTableAccess DBDTABLE_TABLE to lsRoot
101650>>>>>>> get psLogicalName.i of lhTableAccess DBDTABLE_TABLE to lsLogical
101651>>>>>>> get psUserName.i of lhTableAccess DBDTABLE_TABLE to lsDisplay
101652>>>>>>> set FileListValues of oTable_Table to liFile lsRoot lsLogical lsDisplay
101653>>>>>>> send DoDefine of oTable_Table
101654>>>>>>> send CreateTable of oTable_Table
101655>>>>>>>
101655>>>>>>> get piFile.i of lhTableAccess DBDTABLE_FIELD to liFile
101656>>>>>>> get psRootname.i of lhTableAccess DBDTABLE_FIELD to lsRoot
101657>>>>>>> get psLogicalName.i of lhTableAccess DBDTABLE_FIELD to lsLogical
101658>>>>>>> get psUserName.i of lhTableAccess DBDTABLE_FIELD to lsDisplay
101659>>>>>>> set FileListValues of oTable_Field to liFile lsRoot lsLogical lsDisplay
101660>>>>>>> send DoDefine of oTable_Field
101661>>>>>>> send CreateTable of oTable_Field
101662>>>>>>>
101662>>>>>>> get piFile.i of lhTableAccess DBDTABLE_INDEX to liFile
101663>>>>>>> get psRootname.i of lhTableAccess DBDTABLE_INDEX to lsRoot
101664>>>>>>> get psLogicalName.i of lhTableAccess DBDTABLE_INDEX to lsLogical
101665>>>>>>> get psUserName.i of lhTableAccess DBDTABLE_INDEX to lsDisplay
101666>>>>>>> set FileListValues of oTable_Index to liFile lsRoot lsLogical lsDisplay
101667>>>>>>> send DoDefine of oTable_Index
101668>>>>>>> send CreateTable of oTable_Index
101669>>>>>>> end_procedure
101670>>>>>>>end_object // oDBD_TableDefinitions
101671>>>>>>>
101671>>>>>>>procedure DBD_CreateTables global integer lhTableAccess
101673>>>>>>> send DoCreateTables of oDBD_TableDefinitions lhTableAccess
101674>>>>>>>end_procedure
101675>>>>>>>
101675>>>>>>>
101675>>>>>>>object oDBDControlPanel is a aps.ModalPanel label "DBD - Control Panel"
101678>>>>>>> set locate_mode to CENTER_ON_SCREEN
101679>>>>>>> on_key KCANCEL send close_panel
101680>>>>>>> property integer phDbdSystem
101682>>>>>>> property integer pbNewTablesSelected
101684>>>>>>>
101684>>>>>>> procedure Write_XML_Output
101687>>>>>>> string lsFileName lsDataPath
101687>>>>>>> get psDataPath of (phoWorkspace(ghoApplication)) to lsDataPath
101688>>>>>>> //get CurrentDataPath of ghoWorkSpace to lsDataPath // VDF 7
101688>>>>>>> get SEQ_SelectOutFileStartDir "Select XML output filename" "XML files|*.xml|All files|*.*" lsDataPath to lsFileName
101689>>>>>>> if (lsFileName<>"") send DoProcess_FileName of dbDocBPOXML_Write lsFileName (phDbdSystem(self))
101692>>>>>>> end_procedure
101693>>>>>>>
101693>>>>>>> procedure Read_XML_Input
101696>>>>>>> string lsFileName lsDataPath
101696>>>>>>> get psDataPath of (phoWorkspace(ghoApplication)) to lsDataPath
101697>>>>>>> //get CurrentDataPath of ghoWorkSpace to lsDataPath // VDF 7
101697>>>>>>> get SEQ_SelectFileStartDir "Select XML input filename" "XML filer|*.xml|Alle filer|*.*" lsDataPath to lsFileName
101698>>>>>>> if (lsFileName<>"") send DoProcess_FileName of dbDocBPOXML_Read lsFileName (phDbdSystem(self))
101701>>>>>>> end_procedure
101702>>>>>>>
101702>>>>>>> procedure UpdateDefinitions
101705>>>>>>> integer lhUpdater
101705>>>>>>> move (phTableUpdater(phDbdSystem(self))) to lhUpdater
101706>>>>>>> send DoUpdateDatabase of lhUpdater
101707>>>>>>> end_procedure
101708>>>>>>>
101708>>>>>>> procedure DoZeroData
101711>>>>>>> integer lhTableAccess
101711>>>>>>> string lsTableFn lsFieldFn lsIndexFn
101711>>>>>>>
101711>>>>>>> move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess
101712>>>>>>>
101712>>>>>>> get DBMS_TablePath (piFile.i(lhTableAccess,DBDTABLE_TABLE)) to lsTableFn
101713>>>>>>> get DBMS_TablePath (piFile.i(lhTableAccess,DBDTABLE_FIELD)) to lsFieldFn
101714>>>>>>> get DBMS_TablePath (piFile.i(lhTableAccess,DBDTABLE_INDEX)) to lsIndexFn
101715>>>>>>>
101715>>>>>>> if (MB_Verify4("Delete ALL descriptions of your database from the tables below?",lsTableFn,lsFieldFn,lsIndexFn,0)) begin
101717>>>>>>> move (phTableAccessObject(phDbdSystem(self))) to lhTableAccess
101718>>>>>>> if (DoZerofileAllTables(lhTableAccess)) send obs "Data in tables have been deleted" //send request_clear_all
101721>>>>>>> end
101721>>>>>>>>
101721>>>>>>> end_procedure
101722>>>>>>> procedure UpdateFDX
101725>>>>>>> send obs "Not implemented yet!"
101726>>>>>>> end_procedure
101727>>>>>>>
101727>>>>>>> procedure CreateNewTables
101730>>>>>>> string lsPrefix lsOldPrefix
101730>>>>>>> integer lhTableAccess lbSuccess
101730>>>>>>> integer liBaseFile // this one is used to figure out file numbers were changed as a result of calling this procedure
101730>>>>>>>
101730>>>>>>> move (phTableAccessObject(phDbdSystem(self))) to lhTableAccess
101731>>>>>>> get psRootNamePrefix of lhTableAccess to lsOldPrefix
101732>>>>>>> get sPopup.s of oDBD_TablePrefix lsOldPrefix to lsPrefix
101733>>>>>>>
101733>>>>>>> get piFile.i of lhTableAccess DBDTABLE_SYSTEM to liBaseFile
101734>>>>>>>
101734>>>>>>> if (lsPrefix<>"") begin
101736>>>>>>> set psRootNamePrefix of lhTableAccess to lsPrefix
101737>>>>>>> send DoCloseTables of lhTableAccess
101738>>>>>>> get DoOpenTables of lhTableAccess to lbSuccess
101739>>>>>>> ifnot lbSuccess begin
101741>>>>>>> if (MB_Verify4("Tables not found!","Do you want to create","a new set of tables?","(with prefix: "+lsPrefix+")",0)) begin
101743>>>>>>> send DBD_CreateTables lhTableAccess
101744>>>>>>> send DoCloseTables of lhTableAccess
101745>>>>>>> get DoOpenTables of lhTableAccess to lbSuccess
101746>>>>>>> ifnot lbSuccess send obs "The program was not able to create a new set of tables."
101749>>>>>>> end
101749>>>>>>>>
101749>>>>>>> ifnot lbSuccess begin // OK! We try to open the previous ones
101751>>>>>>> set psRootNamePrefix of lhTableAccess to lsPrefix
101752>>>>>>> get DoOpenTables of lhTableAccess to lbSuccess
101753>>>>>>> ifnot lbSuccess begin
101755>>>>>>> send obs "The program failed re-open the previous set of tables." "The program will now terminate!"
101756>>>>>>> system
101757>>>>>>>>
101757>>>>>>> end
101757>>>>>>>>
101757>>>>>>> end
101757>>>>>>>>
101757>>>>>>> end
101757>>>>>>>>
101757>>>>>>> set pbNewTablesSelected to (liBaseFile<>piFile.i(lhTableAccess,DBDTABLE_SYSTEM))
101758>>>>>>> send close_panel
101759>>>>>>> end
101759>>>>>>>>
101759>>>>>>> end_procedure
101760>>>>>>> procedure DoRelocateFilelistEntries
101763>>>>>>>
101763>>>>>>> end_procedure
101764>>>>>>>//object oBtn1 is a aps.Button
101764>>>>>>>// set size to 16 200
101764>>>>>>>// on_item "Open new set of tables" send CreateNewTables
101764>>>>>>>//end_object
101764>>>>>>>//object oBtn2 is a aps.Button // snap SL_DOWN
101764>>>>>>>// set size to 16 200
101764>>>>>>>// on_item "Update tables according to current DB" send UpdateDefinitions
101764>>>>>>>//end_object
101764>>>>>>>//object oBtn3 is a aps.Button snap SL_DOWN
101764>>>>>>>// set size to 16 200
101764>>>>>>>// on_item "Update tables according to FDX file" send UpdateFDX
101764>>>>>>>//end_object
101764>>>>>>> object oBtn4 is a aps.Button // snap SL_DOWN
101766>>>>>>> set size to 16 200
101767>>>>>>> on_item "Delete all data in the description tables!" send DoZeroData
101768>>>>>>> end_object
101769>>>>>>> object oBtn5 is a aps.Button snap SL_DOWN
101772>>>>>>> set size to 16 200
101773>>>>>>> on_item "Export DB descriptions to XML" send Write_XML_Output
101774>>>>>>> end_object
101775>>>>>>> object oBtn6 is a aps.Button snap SL_DOWN
101778>>>>>>> set size to 16 200
101779>>>>>>> on_item "Import DB descriptions from XML" send Read_XML_Input
101780>>>>>>> end_object
101781>>>>>>> object oBtn7 is a aps.Button snap SL_DOWN
101784>>>>>>> set size to 16 200
101785>>>>>>> on_item "Relocate filelist entries" send DoRelocateFilelistEntries
101786>>>>>>> end_object
101787>>>>>>> send aps_goto_max_row
101788>>>>>>> send aps_make_row_space 10
101789>>>>>>> object oBtnCancel is a aps.Button
101791>>>>>>> set size to 16 200
101792>>>>>>> on_item "Cancel" send close_panel
101793>>>>>>> end_object
101794>>>>>>>end_object // oDBDControlPanel
101795>>>>>>>
101795>>>>>>>procedure Popup_DbdCreateTablesPanel integer lhDbdSystem
101798>>>>>>> set pbNewTablesSelected of oDBDControlPanel to false
101799>>>>>>> set phDbdSystem of oDBDControlPanel to lhDbdSystem
101800>>>>>>> send CreateNewTables of oDBDControlPanel
101801>>>>>>>end_function
101802>>>>>>>
101802>>>>>>>procedure Popup_DbdControlPanel integer lhDbdSystem
101805>>>>>>> set pbNewTablesSelected of oDBDControlPanel to false
101806>>>>>>> set phDbdSystem of oDBDControlPanel to lhDbdSystem
101807>>>>>>> send popup to oDBDControlPanel
101808>>>>>>>end_procedure
101809>>>>>>>
101809>>>>>>>function DbdControl_NewTablesSelected global returns integer
101811>>>>>>> function_return (pbNewTablesSelected(oDBDControlPanel(self)))
101812>>>>>>>end_function
101813>>>>>>>
101813>>>>>>>procedure DbdControl_ReadDatabaseDefinitions integer lhDbdSystem
101816>>>>>>> set phDbdSystem of oDBDControlPanel to lhDbdSystem
101817>>>>>>> send UpdateDefinitions to oDBDControlPanel
101818>>>>>>>end_procedure
101819>>>>>Use Files.utl // Utilities for handling file related stuff
101819>>>>>Use Spec0005.utl // Datadictionary object procedures ("DDUTIL_" prefix)
101819>>>>>Use Wait.utl // Something to put on screen while batching.
101819>>>>>Use TrckBr.pkg // TrackBar class
101819>>>>>
101819>>>>>Use DeoCnfrm.pkg // DEO confirm save/delete functions
Including file: deocnfrm.pkg (C:\Apps\VDFQuery\AppSrc\deocnfrm.pkg)
101819>>>>>>>// Use DeoCnfrm.pkg // DEO confirm save/delete functions
101819>>>>>>>
101819>>>>>>>use DFConfrm.Pkg // DAW package
101819>>>>>>>Use Nomencla.nui // Define nomenclature
Including file: nomencla.nui (C:\Apps\VDFQuery\AppSrc\nomencla.nui)
101819>>>>>>>>>// Use Nomencla.nui // Define nomenclature
101819>>>>>>>>>
101819>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
101819>>>>>>>>>Use Language // Default language setup
101819>>>>>>>>>
101819>>>>>>>>> define t.nomencla.record for "record"
101819>>>>>>>>> define t.nomencla.save_changes for "Save changes to this #?"
101819>>>>>>>>> define t.nomencla.create_new for "Create new #?"
101819>>>>>>>>> define t.nomencla.delete_this for "Delete this #?"
101819>>>>>>>>> define t.nomencla.no_active_delete for "There is no active # to delete."
101819>>>>>>>>> define t.nomencla.cpy_no_active for "No # to copy"
101819>>>>>>>>> define t.nomencla.cpy_save_before for "Save # before copying"
101819>>>>>>>>>
101819>>>>>>>>>desktop_section
101824>>>>>>>>> object oRecordNomenclature is a cArray NO_IMAGE
101826>>>>>>>>> item_property_list
101826>>>>>>>>> item_property string psRecordName_Singularis.i
101826>>>>>>>>> item_property string psRecordName_Pluralis.i
101826>>>>>>>>> end_item_property_list
#REM 101863 DEFINE FUNCTION PSRECORDNAME_PLURALIS.I INTEGER LIROW RETURNS STRING
#REM 101868 DEFINE PROCEDURE SET PSRECORDNAME_PLURALIS.I INTEGER LIROW STRING VALUE
#REM 101873 DEFINE FUNCTION PSRECORDNAME_SINGULARIS.I INTEGER LIROW RETURNS STRING
#REM 101878 DEFINE PROCEDURE SET PSRECORDNAME_SINGULARIS.I INTEGER LIROW STRING VALUE
101884>>>>>>>>> end_object
101885>>>>>>>>>end_desktop_section
101890>>>>>>>>>
101890>>>>>>>>>procedure set record_name_singularis global integer liFile string lsValue
101892>>>>>>>>> set psRecordName_Singularis.i of (oRecordNomenclature(self)) liFile to lsValue
101893>>>>>>>>>end_procedure
101894>>>>>>>>>procedure set record_name_pluralis global integer liFile string lsValue
101896>>>>>>>>> set psRecordName_Pluralis.i of (oRecordNomenclature(self)) liFile to lsValue
101897>>>>>>>>>end_procedure
101898>>>>>>>>>function record_name_singularis global integer liFile returns string
101900>>>>>>>>> function_return (psRecordName_Singularis.i(oRecordNomenclature(self),liFile))
101901>>>>>>>>>end_function
101902>>>>>>>>>function record_name_pluralis global integer liFile returns string
101904>>>>>>>>> function_return (psRecordName_Pluralis.i(oRecordNomenclature(self),liFile))
101905>>>>>>>>>end_function
101906>>>>>>>Use MsgBox.utl // obs procedure
101906>>>>>>>
101906>>>>>>>function Verify_Save_AutoName for baseclass returns integer
101908>>>>>>> integer lbNoWay lhServer liFile
101908>>>>>>> string lsRecordName lsQuestion
101908>>>>>>> get server to lhServer
101909>>>>>>> get main_file of lhServer to liFile
101910>>>>>>> get record_name_singularis liFile to lsRecordName
101911>>>>>>> if (lsRecordName="") move t.nomencla.record to lsRecordName
101914>>>>>>> if (current_record(lhServer)) move t.nomencla.save_changes to lsQuestion
101917>>>>>>> else move t.nomencla.create_new to lsQuestion
101919>>>>>>> move (replace("#",lsQuestion,lsRecordName)) to lsQuestion
101920>>>>>>> get confirm lsQuestion to lbNoWay
101921>>>>>>> function_return lbNoWay
101922>>>>>>>end_function
101923>>>>>>>
101923>>>>>>>function Verify_Delete_AutoName for baseclass returns integer
101925>>>>>>> integer lbNoWay lhServer liFile
101925>>>>>>> string lsRecordName lsQuestion
101925>>>>>>> get server to lhServer
101926>>>>>>> get main_file of lhServer to liFile
101927>>>>>>> get record_name_singularis liFile to lsRecordName
101928>>>>>>> if (lsRecordName="") move t.nomencla.record to lsRecordName
101931>>>>>>> if (current_record(lhServer)) begin
101933>>>>>>> move t.nomencla.delete_this to lsQuestion
101934>>>>>>> move (replace("#",lsQuestion,lsRecordName)) to lsQuestion
101935>>>>>>> get confirm lsQuestion to lbNoWay
101936>>>>>>> end
101936>>>>>>>>
101936>>>>>>> else begin
101937>>>>>>> move t.nomencla.no_active_delete to lsQuestion
101938>>>>>>> move (replace("#",lsQuestion,lsRecordName)) to lsQuestion
101939>>>>>>> send obs lsQuestion
101940>>>>>>> move DFTRUE to lbNoWay
101941>>>>>>> end
101941>>>>>>>>
101941>>>>>>> function_return lbNoWay
101942>>>>>>>end_function
101943>>>>>>>
101943>>>>>>>procedure request_save_no_confirm global integer lhDeo
101945>>>>>>> integer lhVerify_save_msg
101945>>>>>>> get verify_save_msg of lhDeo to lhVerify_save_msg
101946>>>>>>> set verify_save_msg of lhDeo to get_No_Confirmation
101947>>>>>>> send request_save to lhDeo
101948>>>>>>> set verify_save_msg of lhDeo to lhVerify_save_msg
101949>>>>>>>end_procedure
101950>>>>>>>procedure request_delete_no_confirm global integer lhDeo
101952>>>>>>> integer lhVerify_delete_msg
101952>>>>>>> get verify_delete_msg of lhDeo to lhVerify_delete_msg
101953>>>>>>> set verify_delete_msg of lhDeo to get_No_Confirmation
101954>>>>>>> send request_delete to lhDeo
101955>>>>>>> set verify_delete_msg of lhDeo to lhVerify_delete_msg
101956>>>>>>>end_procedure
101957>>>>>>>procedure request_clear_no_confirm global integer lhDeo
101959>>>>>>> integer lhVerify_data_loss_msg
101959>>>>>>> get verify_data_loss_msg of lhDeo to lhVerify_data_loss_msg
101960>>>>>>> set verify_data_loss_msg of lhDeo to get_No_Confirmation
101961>>>>>>> send request_clear to lhDeo
101962>>>>>>> set verify_data_loss_msg of lhDeo to lhVerify_data_loss_msg
101963>>>>>>>end_procedure
101964>>>>>>>
101964>>>>>Use dbd.rv // DBD - Report object
Including file: dbd.rv (C:\Apps\VDFQuery\AppSrc\dbd.rv)
101964>>>>>>>// Use dbd.rv // DBD - Report object
101964>>>>>>>
101964>>>>>>>Use APS.pkg // Auto Positioning and Sizing classes for VDF
101964>>>>>>>Use ApsRptVw.pkg // aps.ReportView
Including file: apsrptvw.pkg (C:\Apps\VDFQuery\AppSrc\apsrptvw.pkg)
101964>>>>>>>>>// Use ApsRptVw.pkg // aps.ReportView
101964>>>>>>>>>use APS
101964>>>>>>>>>use dfrptvw
101964>>>>>>>>>
101964>>>>>>>>>class aps.ReportView is a ReportView startmac APS.STARTMAC_LABEL
101965>>>>>>>>> procedure construct_object
101967>>>>>>>>> forward send construct_object
101969>>>>>>>>> send define_aps_container_mx
101970>>>>>>>>> send define_aps_panel_mx
101971>>>>>>>>> set p_right_margin to 8
101972>>>>>>>>> send aps_init
101973>>>>>>>>> end_procedure
101974>>>>>>>>> import_class_protocol aps_container_mx
101975>>>>>>>>> import_class_protocol aps_panel_mx
101976>>>>>>>>> procedure end_construct_object
101978>>>>>>>>> forward send end_construct_object
101980>>>>>>>>> send end_define_aps_container_mx
101981>>>>>>>>> send end_define_aps_panel_mx
101982>>>>>>>>> end_procedure
101983>>>>>>>>>end_class
101984>>>>>>>>>
101984>>>>>>>>>class aps.ReportPanel is a ReportPanel startmac APS.STARTMAC_LABEL
101985>>>>>>>>> procedure construct_object
101987>>>>>>>>> forward send construct_object
101989>>>>>>>>> send define_aps_container_mx
101990>>>>>>>>> send define_aps_panel_mx
101991>>>>>>>>> set p_right_margin to 8
101992>>>>>>>>> send aps_init
101993>>>>>>>>> end_procedure
101994>>>>>>>>> import_class_protocol aps_container_mx
101995>>>>>>>>> import_class_protocol aps_panel_mx
101996>>>>>>>>> procedure end_construct_object
101998>>>>>>>>> forward send end_construct_object
102000>>>>>>>>> send end_define_aps_container_mx
102001>>>>>>>>> send end_define_aps_panel_mx
102002>>>>>>>>> end_procedure
102003>>>>>>>>>end_class
102004>>>>>>>>>
102004>>>>>>>>>class Contraint_Value_ReportView_Mixin is a Mixin
102005>>>>>>>>> procedure Define_Contraint_Value_ReportView_Mixin
102007>>>>>>>>> object oConstraintValues is an array
102009>>>>>>>>> end_object
102010>>>>>>>>> end_procedure
102011>>>>>>>>> procedure set constraint_object integer itm# integer obj#
102013>>>>>>>>> set value of (oConstraintValues(self)) item itm# to obj#
102014>>>>>>>>> end_procedure
102015>>>>>>>>> function constraint_object integer itm# returns integer
102017>>>>>>>>> function_return (value(oConstraintValues(self),itm#))
102018>>>>>>>>> end_function
102019>>>>>>>>> procedure set constraint_value integer itm# string val#
102021>>>>>>>>> set value of (constraint_object(self,itm#)) item 0 to val#
102022>>>>>>>>> end_procedure
102023>>>>>>>>> function constraint_value integer itm# returns string
102025>>>>>>>>> function_return (value(constraint_object(self,itm#),0))
102026>>>>>>>>> end_function
102027>>>>>>>>>end_class
102028>>>>>>>>>
102028>>>>>>>>>class VpeReportView is a aps.ReportView
102029>>>>>>>>> procedure construct_object
102031>>>>>>>>> forward send construct_object
102033>>>>>>>>> send Define_Contraint_Value_ReportView_Mixin
102034>>>>>>>>> end_procedure
102035>>>>>>>>> import_class_protocol Contraint_Value_ReportView_Mixin
102036>>>>>>>>>end_class
102037>>>>>>>>>
102037>>>>>>>>>class VpeReportPanel is a aps.ReportPanel
102038>>>>>>>>> procedure construct_object
102040>>>>>>>>> forward send construct_object
102042>>>>>>>>> send Define_Contraint_Value_ReportView_Mixin
102043>>>>>>>>> property integer pPreviewCheckBox_Object public 0
102044>>>>>>>>> end_procedure
102045>>>>>>>>> import_class_protocol Contraint_Value_ReportView_Mixin
102046>>>>>>>>> Procedure Run_Report
102048>>>>>>>>> integer Obj# oPreviewCheckBox_Object#
102048>>>>>>>>> Get Report_Object_Id to Obj#
102049>>>>>>>>> If Obj# begin
102051>>>>>>>>> get pPreviewCheckBox_Object to oPreviewCheckBox_Object#
102052>>>>>>>>> if oPreviewCheckBox_Object# begin
102054>>>>>>>>> set pPreview of obj# to (select_state(oPreviewCheckBox_Object#,0))
102055>>>>>>>>> end
102055>>>>>>>>>>
102055>>>>>>>>> end
102055>>>>>>>>>>
102055>>>>>>>>> forward send run_report
102057>>>>>>>>> If Obj# set pPreview of obj# to -1
102060>>>>>>>>> End_procedure
102061>>>>>>>>>end_class
102062>>>>>>>>>
102062>>>>>>>>>register_procedure SetupPrinter
102062>>>>>>>>>register_procedure set pPreView string lsValue
102062>>>>>>>>>class VpePreviewCheckBox is a aps.CheckBox
102063>>>>>>>>> procedure construct_object
102065>>>>>>>>> integer self#
102065>>>>>>>>> forward send construct_object
102067>>>>>>>>> set label to "Vis udskrift"
102068>>>>>>>>> move self to self#
102069>>>>>>>>> set pPreviewCheckBox_Object to self#
102070>>>>>>>>> end_procedure
102071>>>>>>>>>end_class
102072>>>>>>>>>class VpePrinterSetButton is a aps.Button
102073>>>>>>>>> procedure construct_object
102075>>>>>>>>> forward send construct_object
102077>>>>>>>>> Set label to "V‘lg printer"
102078>>>>>>>>> On_Item "Only VPE" send none
102079>>>>>>>>> end_procedure
102080>>>>>>>>>end_class
102081>>>>>>>>>
102081>>>>>>>>>procedure register_constrain_object for baseclass integer itm#
102083>>>>>>>>> integer self# tmp#
102083>>>>>>>>> move self to self#
102084>>>>>>>>> if num_arguments gt 0 move itm# to tmp#
102087>>>>>>>>> else move (item_count(oConstraintValues(self))) to tmp#
102089>>>>>>>>> set constraint_object tmp# to self#
102090>>>>>>>>>end_procedure
102091>>>>>>>use cWinReport2.pkg
102091>>>>>>>Use WinPrint_ImageDefinition.pkg
Including file: WinPrint_ImageDefinition.pkg (C:\Apps\VDFQuery\AppSrc\WinPrint_ImageDefinition.pkg)
102091>>>>>>>>>// Use WinPrint_ImageDefinition.pkg
102091>>>>>>>>>
102091>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
102091>>>>>>>>>Use Strings.nui // String manipulation for VDF (No User Interface)
102091>>>>>>>>>
102091>>>>>>>>>Use DF_Print.pkg // Winprint system
102091>>>>>>>>>Use VpeBase3 // Virtual Print Engine
Including file: vpebase3.pkg (C:\Apps\VDFQuery\AppSrc\vpebase3.pkg)
102091>>>>>>>>>>>// **********************************************************************
102091>>>>>>>>>>>// Use VpeBase3
102091>>>>>>>>>>>//
102091>>>>>>>>>>>// Version: 1.0
102091>>>>>>>>>>>//
102091>>>>>>>>>>>// Create:
102091>>>>>>>>>>>// Update: 25/09/1998 - Implemented changes in procedures OpenDoc and
102091>>>>>>>>>>>// SetupPrinter. (Suggested by Peter Starkner, Nordteam)
102091>>>>>>>>>>>// 16/09/1998 - Fixed text vertical alignment.
102091>>>>>>>>>>>// 06/01/1999 - Changed vertical alignment.
102091>>>>>>>>>>>// 12/05/2000 - Updated to use VPE 3.x and changed name to VpeBase3.
102091>>>>>>>>>>>// Remove the AuxDoc in the process (uses rendering now).
102091>>>>>>>>>>>// All 3.x changes by Jakob Kruse.
102091>>>>>>>>>>>// 07/02/2002 - Compatibility with StarZen's VPE4VDF classes:
102091>>>>>>>>>>>// Commented out Procedure Vpe_Print (Peter van Mil).
102091>>>>>>>>>>>// 12/02/2002 - Uncommented Procedure Vpe_Print (Sture).
102091>>>>>>>>>>>// 27/02/2004 - Renamed procedure Vpe_Print to Vpe_Print_Print
102091>>>>>>>>>>>// 02/08/2004 - VpeWriteRTF error fixed
102091>>>>>>>>>>>// 29/07/2006 - Paper bin functions interfaced by David Lack (taken from the newsgroups)
102091>>>>>>>>>>>// Vpe_DevEnumPaperBins and Vpe_GetDevPaperBinName
102091>>>>>>>>>>>// ***********************************************************************
102091>>>>>>>>>>>
102091>>>>>>>>>>>Use VPE3X.pkg
Including file: vpe3x.pkg (C:\Apps\VDFQuery\AppSrc\vpe3x.pkg)
102091>>>>>>>>>>>>>// 2000/05/12 - Jakob Kruse
102091>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>// VPE3X.PKG Virtual Print Engine 3.x for Visual DataFlex
102091>>>>>>>>>>>>>// =========
102091>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>// The DLL-Interface for the "Virtual Print Engine" version 3.x
102091>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>// To be "use"d by the calling applications.
102091>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>// =========================================================================
102091>>>>>>>>>>>>>// Always call VpeLicense with the two serial strings as parameters when
102091>>>>>>>>>>>>>// you use a licensed copy of VPE.
102091>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>// Remember to set _VPEDLL_ to the name of the VPE version you have.
102091>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>// Please note that several DLL calls and many constants have changed since
102091>>>>>>>>>>>>>// VPE 2.x.
102091>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>// If you need to use a VPE function that needs a parameter of type RECT
102091>>>>>>>>>>>>>// (you don't) you must use the type defined in DAC package file DFTYPES.DLL.
102091>>>>>>>>>>>>>// =========================================================================
102091>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>// 07/02/2002 - Peter van Mil
102091>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>// Compatibility with StarZen's VPE4VDF classes.
102091>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>// When VPE_EDITION is defined, External_Functions aren't defined again.
102091>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>// 25/01/2004 - Peter van Mil
102091>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>// VPE version 3.50 uses VPE?3235.DLL in stead VPE?32.DLL
102091>>>>>>>>>>>>>
102091>>>>>>>>>>>>> use DfAllent // Everything (to get hold of external functions)
102091>>>>>>>>>>>>>
102091>>>>>>>>>>>>>// Valid values for _VPEDLL_ are:
102091>>>>>>>>>>>>> // Version 3.1:----------------
102091>>>>>>>>>>>>>// VPES32.DLL (for standard)
102091>>>>>>>>>>>>>// VPEX32.DLL (for enhanced)
102091>>>>>>>>>>>>>// VPEP32.DLL (for professional)
102091>>>>>>>>>>>>>// VPEE32.DLL (for enterprise)
102091>>>>>>>>>>>>> // Version 3.5:----------------
102091>>>>>>>>>>>>>// VPES3235.DLL (for standard)
102091>>>>>>>>>>>>>// VPEX3235.DLL (for enhanced)
102091>>>>>>>>>>>>>// VPEP3235.DLL (for professional)
102091>>>>>>>>>>>>>// VPEE3235.DLL (for enterprise)
102091>>>>>>>>>>>>> // Version 3.6:----------------
102091>>>>>>>>>>>>>// VPES3236.DLL (for standard)
102091>>>>>>>>>>>>>// VPEX3236.DLL (for enhanced)
102091>>>>>>>>>>>>>// VPEP3236.DLL (for professional)
102091>>>>>>>>>>>>>// VPEE3236.DLL (for enterprise)
102091>>>>>>>>>>>>> // Let everybody know which VPE version we use
102091>>>>>>>>>>>>>Define VPE_VERSION_3
102091>>>>>>>>>>>>>Use VPE3X.CFG
Including file: vpe3x.cfg (C:\Apps\VDFQuery\AppSrc\vpe3x.cfg)
102091>>>>>>>>>>>>>>>// !!!! Don't distribute this file with non-empty values !!!!
102091>>>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>>>// This package defines two symbols that are codes you receive when
102091>>>>>>>>>>>>>>>// purchasing a VPE license.
102091>>>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>>>// This package is used to inform the VPEBASE3.PKG which code to use
102091>>>>>>>>>>>>>>>// when opening the VPE 3.1 (or 3.5) dll.
102091>>>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>>>// If both names are empty the program will still run but a DEMO banner
102091>>>>>>>>>>>>>>>// will be part of all your previews.
102091>>>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>>>// Should you ever receive this file with non-empty values for the
102091>>>>>>>>>>>>>>>// constants VPE_SERIAL_CODE1 and VPE_SERIAL_CODE2, please understand
102091>>>>>>>>>>>>>>>// that it is an error and set both values to "demo"
102091>>>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>>>// Regular VPE code:
102091>>>>>>>>>>>>>>>//
102091>>>>>>>>>>>>>>>// Separate code to PDF enable VPE
102091>>>>>>>>>>>>>>>// (leave the "demo" value if you
102091>>>>>>>>>>>>>>>// do not have such a code):
102091>>>>>>>>>>>>> External_Function VpeMoveWindow "MoveWindow" User32.DLL dword hwnd integer x integer y integer width integer height integer repaint returns integer
102092>>>>>>>>>>>>> External_Function VpeOemToCharA "OemToCharA" User32.DLL Pointer hpszOem Pointer hpszWindow Returns Integer
102093>>>>>>>>>>>>> // Management functions
102093>>>>>>>>>>>>> External_Function VpeOpenDoc "VpeOpenDoc" _VPEDLL_ Handle hwnd String title DWord flags Returns DWord
102094>>>>>>>>>>>>> External_Function VpeOpenDocFile "VpeOpenDocFile" _VPEDLL_ Handle hwnd String file_name String title DWord flags Returns DWord
102095>>>>>>>>>>>>> External_Function VpeLicense "VpeLicense" _VPEDLL_ DWord hdoc String scode1 String scode2 Returns Integer
102096>>>>>>>>>>>>> External_Function VpeGetLastError "VpeGetLastError" _VPEDLL_ DWord hdoc Returns DWord
102097>>>>>>>>>>>>> External_Function VpeCloseDoc "VpeCloseDoc" _VPEDLL_ DWord hdoc Returns Integer
102098>>>>>>>>>>>>> External_Function VpePreviewDoc "VpePreviewDoc" _VPEDLL_ DWord hdoc Pointer recstruct Integer show_hide Returns Integer
102099>>>>>>>>>>>>> External_Function VpePreviewDocSP "VpePreviewDocSP" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Integer show_hide Returns Integer
102100>>>>>>>>>>>>> External_Function VpeCenterPreview "VpeCenterPreview" _VPEDLL_ DWord hdoc Integer width Integer height Handle parent_window Returns Integer
102101>>>>>>>>>>>>> External_Function VpeSetPreviewCtrl "VpeSetPreviewCtrl" _VPEDLL_ DWord hdoc Integer setting Returns Integer
102102>>>>>>>>>>>>> External_Function VpeClosePreview "VpeClosePreview" _VPEDLL_ DWord hdoc Returns Integer
102103>>>>>>>>>>>>> External_Function VpeIsPreviewVisible "VpeIsPreviewVisible" _VPEDLL_ DWord hdoc Returns Integer
102104>>>>>>>>>>>>> External_Function VpeGetVisualPage "VpeGetVisualPage" _VPEDLL_ DWord hdoc Returns Integer
102105>>>>>>>>>>>>> External_Function VpeGotoVisualPage "VpeGotoVisualPage" _VPEDLL_ DWord hdoc Integer page Returns Integer
102106>>>>>>>>>>>>> External_Function VpeDispatchAllMessages "VpeDispatchAllMessages" _VPEDLL_ DWord hdoc Returns Integer
102107>>>>>>>>>>>>> // Warning: uses UINT parameter and return value
102107>>>>>>>>>>>>> //External_Function VpeMapMessage "VpeMapMessage" _VPEDLL_ dword hdoc UINT message returns UINT
102107>>>>>>>>>>>>> External_Function VpeRefreshDoc "VpeRefreshDoc" _VPEDLL_ DWord hdoc Returns Integer
102108>>>>>>>>>>>>> External_Function VpeWriteDoc "VpeWriteDoc" _VPEDLL_ DWord hdoc String file_name Returns Integer
102109>>>>>>>>>>>>> External_Function VpeReadDoc "VpeReadDoc" _VPEDLL_ DWord hdoc String file_name Returns Integer
102110>>>>>>>>>>>>> External_Function VpeSetDocFileReadOnly "VpeSetDocFileReadOnly" _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
102111>>>>>>>>>>>>> External_Function VpeEnableAutoDelete "VpeEnableAutoDelete" _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
102112>>>>>>>>>>>>> External_Function VpeEnablePrintSetupDialog "VpeEnablePrintSetupDialog" _VPEDLL_ DWord hdoc Integer enabled Returns Integer
102113>>>>>>>>>>>>> External_Function VpeEnableMailButton "VpeEnableMailButton" _VPEDLL_ DWord hdoc Integer enabled Returns Integer
102114>>>>>>>>>>>>> External_Function VpeEnableCloseButton "VpeEnableCloseButton" _VPEDLL_ DWord hdoc Integer enabled Returns Integer
102115>>>>>>>>>>>>> External_Function VpeEnableMouseScaling "VpeEnableMouseScaling" _VPEDLL_ DWord hdoc Integer enabled Returns Integer
102116>>>>>>>>>>>>> External_Function VpeEnableHelpRouting "VpeEnableHelpRouting" _VPEDLL_ DWord hdoc Integer enabled Returns Integer
102117>>>>>>>>>>>>> External_Function VpeSetGridMode "VpeSetGridMode" _VPEDLL_ DWord hdoc Integer in_foreground Returns Integer
102118>>>>>>>>>>>>> External_Function VpeSetGridVisible "VpeSetGridVisible" _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
102119>>>>>>>>>>>>> External_Function VpeSetPreviewWithScrollers "VpeSetPreviewWithScrollers" _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
102120>>>>>>>>>>>>> External_Function VpeSetPaperView "VpeSetPaperView" _VPEDLL_ DWord hdoc Integer on_off Returns Integer
102121>>>>>>>>>>>>> External_Function VpeSetPageScrollerTracking "VpeSetPageScrollerTracking" _VPEDLL_ DWord hdoc Integer on_off Returns Integer
102122>>>>>>>>>>>>> External_Function VpeWriteStatusbar "VpeWriteStatusbar" _VPEDLL_ DWord hdoc String text Returns Integer
102123>>>>>>>>>>>>> External_Function VpeOpenProgressBar "VpeOpenProgressBar" _VPEDLL_ DWord hdoc Returns Integer
102124>>>>>>>>>>>>> External_Function VpeSetProgressBar "VpeSetProgressBar" _VPEDLL_ DWord hdoc Integer percent Returns Integer
102125>>>>>>>>>>>>> External_Function VpeCloseProgressBar "VpeCloseProgressBar" _VPEDLL_ DWord hdoc Returns Integer
102126>>>>>>>>>>>>> External_Function VpeSetBusyProgressBar "VpeSetBusyProgressBar" _VPEDLL_ DWord hdoc Integer visible Returns Integer
102127>>>>>>>>>>>>> External_Function VpeSetRulersMeasure "VpeSetRulersMeasure" _VPEDLL_ DWord hdoc Integer rulers_measure Returns Integer
102128>>>>>>>>>>>>> //External_Function VpeSetScale "VpeSetScale" _VPEDLL_ dword hdoc DOUBLE scale returns integer
102128>>>>>>>>>>>>> //External_Function VpeGetScale "VpeGetScale" _VPEDLL_ dword hdoc returns DOUBLE
102128>>>>>>>>>>>>> External_Function VpeSetScalePercent "VpeSetScalePercent" _VPEDLL_ DWord hdoc Integer scale Returns Integer
102129>>>>>>>>>>>>> External_Function VpeGetScalePercent "VpeGetScalePercent" _VPEDLL_ DWord hdoc Returns Integer
102130>>>>>>>>>>>>> //External_Function VpeSetMinScale "VpeSetMinScale" _VPEDLL_ dword hdoc DOUBLE min_scale returns integer
102130>>>>>>>>>>>>> External_Function VpeSetMinScalePercent "VpeSetMinScalePercent" _VPEDLL_ DWord hdoc Integer min_scale_percent Returns Integer
102131>>>>>>>>>>>>> //External_Function VpeSetMaxScale "VpeSetMaxScale" _VPEDLL_ dword hdoc DOUBLE max_scale returns integer
102131>>>>>>>>>>>>> External_Function VpeSetMaxScalePercent "VpeSetMaxScalePercent" _VPEDLL_ DWord hdoc Integer max_scale_percent Returns Integer
102132>>>>>>>>>>>>> //External_Function VpeSetScaleStep "VpeSetScaleStep" _VPEDLL_ dword hdoc DOUBLE scale_step returns integer
102132>>>>>>>>>>>>> External_Function VpeSetScaleStepPercent "VpeSetScaleStepPercent" _VPEDLL_ DWord hdoc Integer scale_step_percent Returns Integer
102133>>>>>>>>>>>>> External_Function VpeDefineKey "VpeDefineKey" _VPEDLL_ DWord hdoc Integer func Integer key_code Integer add_key_code1 Integer add_key_code2 Returns Integer
102134>>>>>>>>>>>>> External_Function VpeSendKey "VpeSendKey" _VPEDLL_ DWord hdoc Integer vkey Returns Integer
102135>>>>>>>>>>>>> External_Function VpeSetGUILanguage "VpeSetGUILanguage" _VPEDLL_ DWord hdoc Integer language Returns Integer
102136>>>>>>>>>>>>> External_Function VpeGetWindowHandle "VpeGetWindowHandle" _VPEDLL_ DWord hdoc Returns Handle
102137>>>>>>>>>>>>> External_Function VpeWindowHandle "VpeWindowHandle" _VPEDLL_ DWord hdoc Returns Handle
102138>>>>>>>>>>>>> External_Function VpeGetVersion "VpeGetVersion" _VPEDLL_ Returns DWord
102139>>>>>>>>>>>>> External_Function VpeGetEdition "VpeGetEdition" _VPEDLL_ Returns Integer
102140>>>>>>>>>>>>> External_Function VpeRegisterCtl3D "VpeRegisterCtl3D" _VPEDLL_ Handle hinstance Returns DWord
102141>>>>>>>>>>>>> External_Function VpeUnregisterCtl3D "VpeUnregisterCtl3D" _VPEDLL_ Handle hinstance Returns Integer
102142>>>>>>>>>>>>>
102142>>>>>>>>>>>>> // Printing Functions
102142>>>>>>>>>>>>> External_Function VpeSetupPrinter "VpeSetupPrinter" _VPEDLL_ DWord hdoc String file_name Integer dialog_control Returns Integer
102143>>>>>>>>>>>>> External_Function VpeSetPrintOptions "VpeSetPrintOptions" _VPEDLL_ DWord hdoc DWord flags Returns Integer
102144>>>>>>>>>>>>> External_Function VpeSetPrintPosMode "VpeSetPrintPosMode" _VPEDLL_ DWord hdoc Integer mode Returns Integer
102145>>>>>>>>>>>>> External_Function VpeSetPrintOffset "VpeSetPrintOffset" _VPEDLL_ DWord hdoc Integer offset_x Integer offset_y Returns Integer
102146>>>>>>>>>>>>> External_Function VpeSetPrintOffsetX "VpeSetPrintOffsetX" _VPEDLL_ DWord hdoc Integer offset_x Returns Integer
102147>>>>>>>>>>>>> External_Function VpeGetPrintOffsetX "VpeGetPrintOffsetX" _VPEDLL_ DWord hdoc Returns Integer
102148>>>>>>>>>>>>> External_Function VpeSetPrintOffsetY "VpeSetPrintOffsetY" _VPEDLL_ DWord hdoc Integer offset_y Returns Integer
102149>>>>>>>>>>>>> External_Function VpeGetPrintOffsetY "VpeGetPrintOffsetY" _VPEDLL_ DWord hdoc Returns Integer
102150>>>>>>>>>>>>> External_Function VpePrintDoc "VpePrintDoc" _VPEDLL_ DWord hdoc Integer with_setup Returns Integer
102151>>>>>>>>>>>>> External_Function VpeIsPrinting "VpeIsPrinting" _VPEDLL_ DWord hdoc Returns Integer
102152>>>>>>>>>>>>>
102152>>>>>>>>>>>>> // Device Control Properties
102152>>>>>>>>>>>>> External_Function VpeDevEnum "VpeDevEnum" _VPEDLL_ DWord hdoc Returns Integer
102153>>>>>>>>>>>>> External_Function VpeGetDevEntry "VpeGetDevEntry" _VPEDLL_ DWord hdoc Integer Index Pointer device Integer size Returns Integer
102154>>>>>>>>>>>>> External_Function VpeSetDevice "VpeSetDevice" _VPEDLL_ DWord hdoc String device Returns Integer
102155>>>>>>>>>>>>> External_Function VpeGetDevice "VpeGetDevice" _VPEDLL_ DWord hdoc Pointer device Integer size Returns Integer
102156>>>>>>>>>>>>> External_Function VpeSetDevOrientation "VpeSetDevOrientation" _VPEDLL_ DWord hdoc Integer orientation Returns Integer
102157>>>>>>>>>>>>> External_Function VpeGetDevOrientation "VpeGetDevOrientation" _VPEDLL_ DWord hdoc Returns Integer
102158>>>>>>>>>>>>> External_Function VpeSetDevPaperFormat "VpeSetDevPaperFormat" _VPEDLL_ DWord hdoc Integer iformat Returns Integer
102159>>>>>>>>>>>>> External_Function VpeGetDevPaperFormat "VpeGetDevPaperFormat" _VPEDLL_ DWord hdoc Returns Integer
102160>>>>>>>>>>>>> External_Function VpeSetDevPaperWidth "VpeSetDevPaperWidth" _VPEDLL_ DWord hdoc Integer width Returns Integer
102161>>>>>>>>>>>>> External_Function VpeGetDevPaperWidth "VpeGetDevPaperWidth" _VPEDLL_ DWord hdoc Returns Integer
102162>>>>>>>>>>>>> External_Function VpeSetDevPaperHeight "VpeSetDevPaperHeight" _VPEDLL_ DWord hdoc Integer height Returns Integer
102163>>>>>>>>>>>>> External_Function VpeGetDevPaperHeight "VpeGetDevPaperHeight" _VPEDLL_ DWord hdoc Returns Integer
102164>>>>>>>>>>>>> External_Function VpeSetDevScalePercent "VpeSetDevScalePercent" _VPEDLL_ DWord hdoc Integer scale Returns Integer
102165>>>>>>>>>>>>> External_Function VpeGetDevScalePercent "VpeGetDevScalePercent" _VPEDLL_ DWord hdoc Returns Integer
102166>>>>>>>>>>>>> External_Function VpeSetDevPrintQuality "VpeSetDevPrintQuality" _VPEDLL_ DWord hdoc Integer quality Returns Integer
102167>>>>>>>>>>>>> External_Function VpeGetDevPrintQuality "VpeGetDevPrintQuality" _VPEDLL_ DWord hdoc Returns Integer
102168>>>>>>>>>>>>> External_Function VpeSetDevYResolution "VpeSetDevYResolution" _VPEDLL_ DWord hdoc Integer yres Returns Integer
102169>>>>>>>>>>>>> External_Function VpeGetDevYResolution "VpeGetDevYResolution" _VPEDLL_ DWord hdoc Returns Integer
102170>>>>>>>>>>>>> External_Function VpeSetDevColor "VpeSetDevColor" _VPEDLL_ DWord hdoc Integer color Returns Integer
102171>>>>>>>>>>>>> External_Function VpeGetDevColor "VpeGetDevColor" _VPEDLL_ DWord hdoc Returns Integer
102172>>>>>>>>>>>>> External_Function VpeSetDevDuplex "VpeSetDevDuplex" _VPEDLL_ DWord hdoc Integer duplex Returns Integer
102173>>>>>>>>>>>>> External_Function VpeGetDevDuplex "VpeGetDevDuplex" _VPEDLL_ DWord hdoc Returns Integer
102174>>>>>>>>>>>>> External_Function VpeSetDevTTOption "VpeSetDevTTOption" _VPEDLL_ DWord hdoc Integer option Returns Integer
102175>>>>>>>>>>>>> External_Function VpeGetDevTTOption "VpeGetDevTTOption" _VPEDLL_ DWord hdoc Returns Integer
102176>>>>>>>>>>>>> External_Function VpeDevEnumPaperBins "VpeDevEnumPaperBins" _VPEDLL_ DWord hdoc Returns Integer
102177>>>>>>>>>>>>> External_Function VpeGetDevPaperBinName "VpeGetDevPaperBinName" _VPEDLL_ DWord hdoc Integer Index Pointer bin_name_address Integer size Returns Integer
102178>>>>>>>>>>>>> External_Function VpeGetDevPaperBinID "VpeGetDevPaperBinID" _VPEDLL_ DWord hdoc Integer Index Returns Integer
102179>>>>>>>>>>>>> External_Function VpeSetDevPaperBin "VpeSetDevPaperBin" _VPEDLL_ DWord hdoc Integer bin_id Returns Integer
102180>>>>>>>>>>>>> External_Function VpeGetDevPaperBin "VpeGetDevPaperBin" _VPEDLL_ DWord hdoc Returns Integer
102181>>>>>>>>>>>>> External_Function VpeGetDevPrinterOffsetX "VpeGetDevPrinterOffsetX" _VPEDLL_ DWord hdoc Returns Integer
102182>>>>>>>>>>>>> External_Function VpeGetDevPrinterOffsetY "VpeGetDevPrinterOffsetY" _VPEDLL_ DWord hdoc Returns Integer
102183>>>>>>>>>>>>> External_Function VpeGetDevPhysPageWidth "VpeGetDevPhysPageWidth" _VPEDLL_ DWord hdoc Returns Integer
102184>>>>>>>>>>>>> External_Function VpeGetDevPhysPageHeight "VpeGetDevPhysPageHeight" _VPEDLL_ DWord hdoc Returns Integer
102185>>>>>>>>>>>>> External_Function VpeSetDevCopies "VpeSetDevCopies" _VPEDLL_ DWord hdoc Integer copies Returns Integer
102186>>>>>>>>>>>>> External_Function VpeGetDevCopies "VpeGetDevCopies" _VPEDLL_ DWord hdoc Returns Integer
102187>>>>>>>>>>>>> External_Function VpeSetDevCollate "VpeSetDevCollate" _VPEDLL_ DWord hdoc Integer collate Returns Integer
102188>>>>>>>>>>>>> External_Function VpeGetDevCollate "VpeGetDevCollate" _VPEDLL_ DWord hdoc Returns Integer
102189>>>>>>>>>>>>> External_Function VpeSetDevFromPage "VpeSetDevFromPage" _VPEDLL_ DWord hdoc Integer from_page Returns Integer
102190>>>>>>>>>>>>> External_Function VpeGetDevFromPage "VpeGetDevFromPage" _VPEDLL_ DWord hdoc Returns Integer
102191>>>>>>>>>>>>> External_Function VpeSetDevToPage "VpeSetDevToPage" _VPEDLL_ DWord hdoc Integer to_page Returns Integer
102192>>>>>>>>>>>>> External_Function VpeGetDevToPage "VpeGetDevToPage" _VPEDLL_ DWord hdoc Returns Integer
102193>>>>>>>>>>>>> External_Function VpeSetDevToFile "VpeSetDevToFile" _VPEDLL_ DWord hdoc Integer to_file Returns Integer
102194>>>>>>>>>>>>> External_Function VpeGetDevToFile "VpeGetDevToFile" _VPEDLL_ DWord hdoc Returns Integer
102195>>>>>>>>>>>>> External_Function VpeSetDevFileName "VpeSetDevFileName" _VPEDLL_ DWord hdoc String file_name Returns Integer
102196>>>>>>>>>>>>> External_Function VpeGetDevFileName "VpeGetDevFileName" _VPEDLL_ DWord hdoc Pointer file_name_address Integer size Returns Integer
102197>>>>>>>>>>>>> External_Function VpeSetDevJobName "VpeSetDevJobName" _VPEDLL_ DWord hdoc String job_name Returns Integer
102198>>>>>>>>>>>>> External_Function VpeGetDevJobName "VpeGetDevJobName" _VPEDLL_ DWord hdoc Pointer job_name_address Integer size Returns Integer
102199>>>>>>>>>>>>> External_Function VpeDevSendData "VpeDevSendData" _VPEDLL_ DWord hdoc String data DWord size Returns Integer
102200>>>>>>>>>>>>> External_Function VpeWritePrinterSetup "VpeWritePrinterSetup" _VPEDLL_ DWord hdoc String file_name Returns Integer
102201>>>>>>>>>>>>> External_Function VpeReadPrinterSetup "VpeReadPrinterSetup" _VPEDLL_ DWord hdoc String file_name Returns Integer
102202>>>>>>>>>>>>>
102202>>>>>>>>>>>>> // Layout functions
102202>>>>>>>>>>>>> External_Function VpePageBreak "VpePageBreak" _VPEDLL_ DWord hdoc Returns Integer
102203>>>>>>>>>>>>> External_Function VpeSetAutoBreak "VpeSetAutoBreak" _VPEDLL_ DWord hdoc Integer mode Returns Integer
102204>>>>>>>>>>>>> External_Function VpeGetPageCount "VpeGetPageCount" _VPEDLL_ DWord hdoc Returns Integer
102205>>>>>>>>>>>>> External_Function VpeGetCurrentPage "VpeGetCurrentPage" _VPEDLL_ DWord hdoc Returns Integer
102206>>>>>>>>>>>>> External_Function VpeGotoPage "VpeGotoPage" _VPEDLL_ DWord hdoc Integer page Returns Integer
102207>>>>>>>>>>>>> External_Function VpeSetPageFormat "VpeSetPageFormat" _VPEDLL_ DWord hdoc Integer page_format Returns Integer
102208>>>>>>>>>>>>> External_Function VpeSetPageWidth "VpeSetPageWidth" _VPEDLL_ DWord hdoc Integer page_width Returns Integer
102209>>>>>>>>>>>>> External_Function VpeGetPageWidth "VpeGetPageWidth" _VPEDLL_ DWord hdoc Returns Integer
102210>>>>>>>>>>>>> External_Function VpeSetPageHeight "VpeSetPageHeight" _VPEDLL_ DWord hdoc Integer page_height Returns Integer
102211>>>>>>>>>>>>> External_Function VpeGetPageHeight "VpeGetPageHeight" _VPEDLL_ DWord hdoc Returns Integer
102212>>>>>>>>>>>>> External_Function VpeSetPageOrientation "VpeSetPageOrientation" _VPEDLL_ DWord hdoc Integer orientation Returns Integer
102213>>>>>>>>>>>>> External_Function VpeGetPageOrientation "VpeGetPageOrientation" _VPEDLL_ DWord hdoc Returns Integer
102214>>>>>>>>>>>>> External_Function VpeSetPaperBin "VpeSetPaperBin" _VPEDLL_ DWord hdoc Integer bin Returns Integer
102215>>>>>>>>>>>>> External_Function VpeGetPaperBin "VpeGetPaperBin" _VPEDLL_ DWord hdoc Returns Integer
102216>>>>>>>>>>>>> External_Function VpeStoreSet "VpeStoreSet" _VPEDLL_ DWord hdoc Integer id Returns Integer
102217>>>>>>>>>>>>> External_Function VpeUseSet "VpeUseSet" _VPEDLL_ DWord hdoc Integer id Returns Integer
102218>>>>>>>>>>>>> External_Function VpeRemoveSet "VpeRemoveSet" _VPEDLL_ DWord hdoc Integer id Returns Integer
102219>>>>>>>>>>>>> External_Function VpeGet "VpeGet" _VPEDLL_ DWord hdoc Integer what Returns Integer
102220>>>>>>>>>>>>> External_Function VpeSet "VpeSet" _VPEDLL_ DWord hdoc Integer what Integer value Returns Integer
102221>>>>>>>>>>>>> External_Function VpeSetDefOutRect "VpeSetDefOutRect" _VPEDLL_ DWord hdoc Pointer rect Returns Integer
102222>>>>>>>>>>>>> External_Function VpeSetDefOutRectSP "VpeSetDefOutRectSP" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Returns Integer
102223>>>>>>>>>>>>> External_Function VpeSetOutRect "VpeSetOutRect" _VPEDLL_ DWord hdoc Pointer rect Returns Integer
102224>>>>>>>>>>>>> External_Function VpeSetOutRectSP "VpeSetOutRectSP" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Returns Integer
102225>>>>>>>>>>>>> External_Function VpeGetOutRect "VpeGetOutRect" _VPEDLL_ DWord hdoc Pointer rect Returns Integer
102226>>>>>>>>>>>>> External_Function VpeSetPosRect "VpeSetPosRect" _VPEDLL_ DWord hdoc Pointer rect Returns Integer
102227>>>>>>>>>>>>> External_Function VpeGetPosRect "VpeGetPosRect" _VPEDLL_ DWord hdoc Pointer rect Returns Integer
102228>>>>>>>>>>>>> External_Function VpeStorePos "VpeStorePos" _VPEDLL_ DWord hdoc Returns Integer
102229>>>>>>>>>>>>> External_Function VpeRestorePos "VpeRestorePos" _VPEDLL_ DWord hdoc Returns Integer
102230>>>>>>>>>>>>> External_Function VpeSetRotation "VpeSetRotation" _VPEDLL_ DWord hdoc Integer angle Returns Integer
102231>>>>>>>>>>>>> External_Function VpeSetViewable "VpeSetViewable" _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
102232>>>>>>>>>>>>> External_Function VpeSetPrintable "VpeSetPrintable" _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
102233>>>>>>>>>>>>> External_Function VpeSetStreamable "VpeSetStreamable" _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
102234>>>>>>>>>>>>> External_Function VpeSetShadowed "VpeSetShadowed" _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
102235>>>>>>>>>>>>>
102235>>>>>>>>>>>>> // Rendering functions
102235>>>>>>>>>>>>> External_Function VpeRenderPrint "VpeRenderPrint" _VPEDLL_ DWord hdoc Integer x Integer y String s Returns Integer
102236>>>>>>>>>>>>> External_Function VpeRenderPrintBox "VpeRenderPrintBox" _VPEDLL_ DWord hdoc Integer x Integer y String s Returns Integer
102237>>>>>>>>>>>>> External_Function VpeRenderWrite "VpeRenderWrite" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String s Returns Integer
102238>>>>>>>>>>>>> External_Function VpeRenderWriteBox "VpeRenderWriteBox" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String s Returns Integer
102239>>>>>>>>>>>>> External_Function VpeRenderPicture "VpeRenderPicture" _VPEDLL_ DWord hdoc Integer width Integer height String file_name Integer flags Returns Integer
102240>>>>>>>>>>>>> //External_Function VpeRenderPictureResID "VpeRenderPictureResID" _VPEDLL_ dword hdoc integer width integer height handle hinstance UINT res_id returns integer
102240>>>>>>>>>>>>> External_Function VpeRenderPictureResName "VpeRenderPictureResName" _VPEDLL_ DWord hdoc Integer width Integer height Handle hinstance String res_name Returns Integer
102241>>>>>>>>>>>>> External_Function VpeRenderPictureDIB "VpeRenderPictureDIB" _VPEDLL_ DWord hdoc Integer width Integer height Handle hdib Returns Integer
102242>>>>>>>>>>>>> External_Function VpeRenderRTF "VpeRenderRTF" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String s Returns Integer
102243>>>>>>>>>>>>> External_Function VpeRenderBoxRTF "VpeRenderBoxRTF" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String s Returns Integer
102244>>>>>>>>>>>>> External_Function VpeRenderRTFFile "VpeRenderRTFFile" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String file_name Returns Integer
102245>>>>>>>>>>>>> External_Function VpeRenderBoxRTFFile "VpeRenderBoxRTFFile" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String file_name Returns Integer
102246>>>>>>>>>>>>>
102246>>>>>>>>>>>>> // Drawing functions
102246>>>>>>>>>>>>> External_Function VpeSetPen "VpeSetPen" _VPEDLL_ DWord hdoc Integer pen_size Integer pen_style Integer pen_color Returns Integer
102247>>>>>>>>>>>>> External_Function VpeNoPen "VpeNoPen" _VPEDLL_ DWord hdoc Returns Integer
102248>>>>>>>>>>>>> External_Function VpeSetPenSize "VpeSetPenSize" _VPEDLL_ DWord hdoc Integer pen_size Returns Integer
102249>>>>>>>>>>>>> External_Function VpePenSize "VpePenSize" _VPEDLL_ DWord hdoc Integer pen_size Returns Integer
102250>>>>>>>>>>>>> External_Function VpeGetPenSize "VpeGetPenSize" _VPEDLL_ DWord hdoc Returns Integer
102251>>>>>>>>>>>>> External_Function VpeSetPenStyle "VpeSetPenStyle" _VPEDLL_ DWord hdoc Integer pen_style Returns Integer
102252>>>>>>>>>>>>> External_Function VpePenStyle "VpePenStyle" _VPEDLL_ DWord hdoc Integer pen_style Returns Integer
102253>>>>>>>>>>>>> External_Function VpeSetPenColor "VpeSetPenColor" _VPEDLL_ DWord hdoc Integer color Returns Integer
102254>>>>>>>>>>>>> External_Function VpePenColor "VpePenColor" _VPEDLL_ DWord hdoc Integer color Returns Integer
102255>>>>>>>>>>>>> External_Function VpeLine "VpeLine" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Returns Integer
102256>>>>>>>>>>>>> External_Function VpePolyLine "VpePolyLine" _VPEDLL_ DWord hdoc DWord point_array Integer size Returns DWord
102257>>>>>>>>>>>>> External_Function VpeAddPolyPoint "VpeAddPolyPoint" _VPEDLL_ DWord hdoc DWord hpolyline Integer x Integer y Returns Integer
102258>>>>>>>>>>>>> External_Function VpeSetBkgMode "VpeSetBkgMode" _VPEDLL_ DWord hdoc Integer mode Returns Integer
102259>>>>>>>>>>>>> External_Function VpeSetBkgColor "VpeSetBkgColor" _VPEDLL_ DWord hdoc Integer color Returns Integer
102260>>>>>>>>>>>>> External_Function VpeSetBkgGradientStartColor "VpeSetBkgGradientStartColor" _VPEDLL_ DWord hdoc Integer color_start Returns Integer
102261>>>>>>>>>>>>> External_Function VpeSetBkgGradientEndColor "VpeSetBkgGradientEndColor" _VPEDLL_ DWord hdoc Integer color_end Returns Integer
102262>>>>>>>>>>>>> External_Function VpeSetBkgGradientRotation "VpeSetBkgGradientRotation" _VPEDLL_ DWord hdoc Integer angle Returns Integer
102263>>>>>>>>>>>>> External_Function VpeSetBkgGradientPrint "VpeSetBkgGradientPrint" _VPEDLL_ DWord hdoc Integer mode Returns Integer
102264>>>>>>>>>>>>> External_Function VpeSetBkgGradientPrintSolidColor "VpeSetBkgGradientPrintSolidColor" _VPEDLL_ DWord hdoc Integer color Returns Integer
102265>>>>>>>>>>>>> External_Function VpeSetTransparentMode "VpeSetTransparentMode" _VPEDLL_ DWord hdoc Integer on_off Returns Integer
102266>>>>>>>>>>>>> External_Function VpeSetHatchStyle "VpeSetHatchStyle" _VPEDLL_ DWord hdoc Integer style Returns Integer
102267>>>>>>>>>>>>> External_Function VpeSetHatchColor "VpeSetHatchColor" _VPEDLL_ DWord hdoc Integer color Returns Integer
102268>>>>>>>>>>>>> External_Function VpeBox "VpeBox" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer x3 Returns Integer
102269>>>>>>>>>>>>> External_Function VpePolygon "VpePolygon" _VPEDLL_ DWord hdoc DWord point_array Integer size Returns DWord
102270>>>>>>>>>>>>> External_Function VpeAddPolygonPoint "VpeAddPolygonPoint" _VPEDLL_ DWord hdoc DWord hpolygon Integer x Integer y Returns Integer
102271>>>>>>>>>>>>> External_Function VpeEllipse "VpeEllipse" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Returns Integer
102272>>>>>>>>>>>>> External_Function VpePie "VpePie" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Integer begin_angle Integer end_angle Returns Integer
102273>>>>>>>>>>>>>
102273>>>>>>>>>>>>> // Text functions
102273>>>>>>>>>>>>> External_Function VpeSetFont "VpeSetFont" _VPEDLL_ DWord hdoc String font_name Integer size Returns Integer
102274>>>>>>>>>>>>> External_Function VpeSelectFont "VpeSelectFont" _VPEDLL_ DWord hdoc String font_name Integer size Returns Integer
102275>>>>>>>>>>>>> External_Function VpeSetFontName "VpeSetFontName" _VPEDLL_ DWord hdoc String font_name Returns Integer
102276>>>>>>>>>>>>> External_Function VpeSetFontSize "VpeSetFontSize" _VPEDLL_ DWord hdoc Integer size Returns Integer
102277>>>>>>>>>>>>> External_Function VpeSetCharset "VpeSetCharset" _VPEDLL_ DWord hdoc DWord charset Returns Integer
102278>>>>>>>>>>>>> External_Function VpeSetFontAttr "VpeSetFontAttr" _VPEDLL_ DWord hdoc Integer alignment Integer bold Integer underlined Integer italic Integer strikeout Returns Integer
102279>>>>>>>>>>>>> External_Function VpeSetTextAlignment "VpeSetTextAlignment" _VPEDLL_ DWord hdoc Integer alignment Returns Integer
102280>>>>>>>>>>>>> External_Function VpeSetAlign "VpeSetAlign" _VPEDLL_ DWord hdoc Integer alignment Returns Integer
102281>>>>>>>>>>>>> External_Function VpeSetBold "VpeSetBold" _VPEDLL_ DWord hdoc Integer bold Returns Integer
102282>>>>>>>>>>>>> External_Function VpeSetUnderlined "VpeSetUnderlined" _VPEDLL_ DWord hdoc Integer underlined Returns Integer
102283>>>>>>>>>>>>> External_Function VpeSetItalic "VpeSetItalic" _VPEDLL_ DWord hdoc Integer italic Returns Integer
102284>>>>>>>>>>>>> External_Function VpeSetStrikeOut "VpeSetStrikeOut" _VPEDLL_ DWord hdoc Integer strikeout Returns Integer
102285>>>>>>>>>>>>> External_Function VpeSetTextColor "VpeSetTextColor" _VPEDLL_ DWord hdoc Integer color Returns Integer
102286>>>>>>>>>>>>> External_Function VpeWrite "VpeWrite" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String text Returns Integer
102287>>>>>>>>>>>>> External_Function VpeWriteBox "VpeWriteBox" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String text Returns Integer
102288>>>>>>>>>>>>> External_Function VpePrint "VpePrint" _VPEDLL_ DWord hdoc Integer x Integer y String text Returns Integer
102289>>>>>>>>>>>>> External_Function VpePrintBox "VpePrintBox" _VPEDLL_ DWord hdoc Integer x Integer y String text Returns Integer
102290>>>>>>>>>>>>> External_Function VpeDefineHeader "VpeDefineHeader" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String text Returns Integer
102291>>>>>>>>>>>>> External_Function VpeDefineFooter "VpeDefineFooter" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String text Returns Integer
102292>>>>>>>>>>>>> External_Function VpeSetCharPlacement "VpeSetCharPlacement" _VPEDLL_ DWord hdoc Integer distance Returns Integer
102293>>>>>>>>>>>>>
102293>>>>>>>>>>>>> // Picture functions
102293>>>>>>>>>>>>> External_Function VpeSetKeepPictureAspect "VpeSetKeepPictureAspect" _VPEDLL_ DWord hdoc Integer on_off Returns Integer
102294>>>>>>>>>>>>> //OBSOLETE: External_Function VpeKeepBitmapAspect "VpeKeepBitmapAspect" _VPEDLL_ dword hdoc integer on_off returns integer
102294>>>>>>>>>>>>> External_Function VpeSetDefaultPictureDPI "VpeSetDefaultPictureDPI" _VPEDLL_ DWord hdoc Integer dpix Integer dpiy Returns Integer
102295>>>>>>>>>>>>> //OBSOLETE: External_Function VpeDefaultBitmapDPI "VpeDefaultBitmapDPI" _VPEDLL_ dword hdoc integer dpix integer dpiy returns integer
102295>>>>>>>>>>>>> External_Function VpeSetPictureCacheSize "VpeSetPictureCacheSize" _VPEDLL_ DWord hdoc DWord size Returns Integer
102296>>>>>>>>>>>>> External_Function VpeGetPictureCacheSize "VpeGetPictureCacheSize" _VPEDLL_ DWord hdoc Returns DWord
102297>>>>>>>>>>>>> External_Function VpeGetPictureCacheUsed "VpeGetPictureCacheUsed" _VPEDLL_ DWord hdoc Returns DWord
102298>>>>>>>>>>>>> External_Function VpeGetPictureTypes "VpeGetPictureTypes" _VPEDLL_ DWord hdoc Integer with_filters Pointer s_address Integer size Returns Integer
102299>>>>>>>>>>>>> External_Function VpeSetPictureType "VpeSetPictureType" _VPEDLL_ DWord hdoc DWord type Returns Integer
102300>>>>>>>>>>>>> External_Function VpePicture "VpePicture" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String file_name Integer flags Returns Integer
102301>>>>>>>>>>>>> External_Function VpePictureResID "VpePictureResID" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Handle hinstance Integer res_id Integer flags Returns Integer
102302>>>>>>>>>>>>> External_Function VpePictureResName "VpePictureResName" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Handle hinstance String res_name Integer flags Returns Integer
102303>>>>>>>>>>>>> External_Function VpePictureDIB "VpePictureDIB" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 Handle hdib Integer flags Returns Integer
102304>>>>>>>>>>>>> External_Function VpeGetPicturePageCount "VpeGetPicturePageCount" _VPEDLL_ DWord hdoc String file_name Returns DWord
102305>>>>>>>>>>>>> External_Function VpeSetPicturePage "VpeSetPicturePage" _VPEDLL_ DWord hdoc DWord page_no Returns Integer
102306>>>>>>>>>>>>> External_Function VpeGetPicturePage "VpeGetPicturePage" _VPEDLL_ DWord hdoc Returns DWord
102307>>>>>>>>>>>>>
102307>>>>>>>>>>>>> // Barcode functions
102307>>>>>>>>>>>>> External_Function VpeSetBarcodeParms "VpeSetBarcodeParms" _VPEDLL_ DWord hdoc Integer top_bottom Integer add_top_bottom Returns Integer
102308>>>>>>>>>>>>> External_Function VpeSetBarcodeAlignment "VpeSetBarcodeAlignment" _VPEDLL_ DWord hdoc Integer alignment Returns Integer
102309>>>>>>>>>>>>> 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
102310>>>>>>>>>>>>>
102310>>>>>>>>>>>>> // Email functions
102310>>>>>>>>>>>>> External_Function VpeIsMAPIInstalled "VpeIsMAPIInstalled" _VPEDLL_ DWord hdoc Returns Integer
102311>>>>>>>>>>>>> External_Function VpeSetMailSender "VpeSetMailSender" _VPEDLL_ DWord hdoc String sender Returns Integer
102312>>>>>>>>>>>>> External_Function VpeAddMailReceiver "VpeAddMailReceiver" _VPEDLL_ DWord hdoc String receiver DWord recip_class Returns Integer
102313>>>>>>>>>>>>> External_Function VpeClearMailReceivers "VpeClearMailReceivers" _VPEDLL_ DWord hdoc Returns Integer
102314>>>>>>>>>>>>> External_Function VpeAddMailAttachment "VpeAddMailAttachment" _VPEDLL_ DWord hdoc String path String file_name Returns Integer
102315>>>>>>>>>>>>> External_Function VpeClearMailAttachments "VpeClearMailAttachments" _VPEDLL_ DWord hdoc Returns Integer
102316>>>>>>>>>>>>> External_Function VpeSetMailSubject "VpeSetMailSubject" _VPEDLL_ DWord hdoc String subject Returns Integer
102317>>>>>>>>>>>>> External_Function VpeSetMailText "VpeSetMailText" _VPEDLL_ DWord hdoc String text Returns Integer
102318>>>>>>>>>>>>> External_Function VpeSetMailWithDialog "VpeSetMailWithDialog" _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
102319>>>>>>>>>>>>> External_Function VpeMailDoc "VpeMailDoc" _VPEDLL_ DWord hdoc Returns Integer
102320>>>>>>>>>>>>>
102320>>>>>>>>>>>>> // RTF functions
102320>>>>>>>>>>>>> External_Function VpeWriteRTF "VpeWriteRTF" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String rtf_text Returns Integer
102321>>>>>>>>>>>>> External_Function VpeWriteBoxRTF "VpeWriteBoxRTF" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String rtf_text Returns Integer
102322>>>>>>>>>>>>> External_Function VpeWriteRTFFile "VpeWriteRTFFile" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String file_name Returns Integer
102323>>>>>>>>>>>>> External_Function VpeWriteBoxRTFFile "VpeWriteBoxRTFFile" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 String file_name Returns Integer
102324>>>>>>>>>>>>> External_Function VpeSetRTFFont "VpeSetRTFFont" _VPEDLL_ DWord hdoc Integer id String font_name Returns Integer
102325>>>>>>>>>>>>> External_Function VpeSetRTFColor "VpeSetRTFColor" _VPEDLL_ DWord hdoc Integer id DWord color Returns Integer
102326>>>>>>>>>>>>> External_Function VpeSetFirstIndent "VpeSetFirstIndent" _VPEDLL_ DWord hdoc Integer indent Returns Integer
102327>>>>>>>>>>>>> External_Function VpeSetLeftIndent "VpeSetLeftIndent" _VPEDLL_ DWord hdoc Integer indent Returns Integer
102328>>>>>>>>>>>>> External_Function VpeSetRightIndent "VpeSetRightIndent" _VPEDLL_ DWord hdoc Integer indent Returns Integer
102329>>>>>>>>>>>>> External_Function VpeSetSpaceBefore "VpeSetSpaceBefore" _VPEDLL_ DWord hdoc Integer space Returns Integer
102330>>>>>>>>>>>>> External_Function VpeSetSpaceAfter "VpeSetSpaceAfter" _VPEDLL_ DWord hdoc Integer space Returns Integer
102331>>>>>>>>>>>>> External_Function VpeSetSpaceBetween "VpeSetSpaceBetween" _VPEDLL_ DWord hdoc Integer space Returns Integer
102332>>>>>>>>>>>>> External_Function VpeSetDefaultTabSize "VpeSetDefaultTabSize" _VPEDLL_ DWord hdoc Integer default_tab_size Returns Integer
102333>>>>>>>>>>>>> External_Function VpeSetTab "VpeSetTab" _VPEDLL_ DWord hdoc Integer tab_position Integer reserved Returns Integer
102334>>>>>>>>>>>>> External_Function VpeClearTab "VpeClearTab" _VPEDLL_ DWord hdoc Integer tab_position Returns Integer
102335>>>>>>>>>>>>> External_Function VpeClearAllTabs "VpeClearAllTabs" _VPEDLL_ DWord hdoc Returns Integer
102336>>>>>>>>>>>>> External_Function VpeResetParagraph "VpeResetParagraph" _VPEDLL_ DWord hdoc Returns Integer
102337>>>>>>>>>>>>> External_Function VpeSetKeepLines "VpeSetKeepLines" _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
102338>>>>>>>>>>>>> External_Function VpeSetKeepNextParagraph "VpeSetKeepNextParagraph" _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
102339>>>>>>>>>>>>> External_Function VpeSetParagraphControl "VpeSetParagraphControl" _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
102340>>>>>>>>>>>>>
102340>>>>>>>>>>>>> // Interactive objects
102340>>>>>>>>>>>>> External_Function VpeEnableClickEvents "VpeEnableClickEvents" _VPEDLL_ DWord hdoc Integer yes_no Returns Integer
102341>>>>>>>>>>>>> External_Function VpeSetObjectID "VpeSetObjectID" _VPEDLL_ DWord hdoc DWord id Returns Integer
102342>>>>>>>>>>>>> External_Function VpeGetObjectID "VpeGetObjectID" _VPEDLL_ DWord hdoc Returns DWord
102343>>>>>>>>>>>>>
102343>>>>>>>>>>>>> // UDO
102343>>>>>>>>>>>>> External_Function VpeCreateUDO "VpeCreateUDO" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 DWord lparam Returns Integer
102344>>>>>>>>>>>>> External_Function VpeGetUDOlParam "VpeGetUDOlParam" _VPEDLL_ DWord hdoc Returns DWord
102345>>>>>>>>>>>>> External_Function VpeGetUDODC "VpeGetUDODC" _VPEDLL_ DWord hdoc Returns Handle
102346>>>>>>>>>>>>> External_Function VpeGetUDODrawRect "VpeGetUDODrawRect" _VPEDLL_ DWord hdoc Pointer rect_address Returns Integer
102347>>>>>>>>>>>>>
102347>>>>>>>>>>>>> // Picture export functions
102347>>>>>>>>>>>>> External_Function VpeSetPictureExportOptions "VpeSetPictureExportOptions" _VPEDLL_ DWord hdoc DWord options Returns Integer
102348>>>>>>>>>>>>> External_Function VpeSetPictureExportColorDepth "VpeSetPictureExportColorDepth" _VPEDLL_ DWord hdoc Integer depth Returns Integer
102349>>>>>>>>>>>>> External_Function VpeSetPictureExportDither "VpeSetPictureExportDither" _VPEDLL_ DWord hdoc Integer dither Returns Integer
102350>>>>>>>>>>>>> External_Function VpePictureExportPage "VpePictureExportPage" _VPEDLL_ DWord hdoc String file_name Integer page_no Returns Integer
102351>>>>>>>>>>>>> External_Function VpePictureExport "VpePictureExport" _VPEDLL_ DWord hdoc String file_name Integer page_no Integer x Integer y Integer x2 Integer y2 Returns Integer
102352>>>>>>>>>>>>>
102352>>>>>>>>>>>>> // Chart functions
102352>>>>>>>>>>>>> External_Function VpeInitCharts "VpeInitCharts" _VPEDLL_ DWord hdoc Returns Integer
102353>>>>>>>>>>>>> External_Function VpeChartDataCreate "VpeChartDataCreate" _VPEDLL_ DWord hdoc Integer columns Integer rows Returns DWord
102354>>>>>>>>>>>>> // Value parameter is really a double in the next function
102354>>>>>>>>>>>>> External_Function VpeChartDataAddValue "VpeChartDataAddValue" _VPEDLL_ DWord hdoc DWord hdata Integer column DWord value Returns Integer
102355>>>>>>>>>>>>> External_Function VpeChartDataAddLegend "VpeChartDataAddLegend" _VPEDLL_ DWord hdoc DWord hdata String legend Returns Integer
102356>>>>>>>>>>>>> External_Function VpeChartDataSetXAxisTitle "VpeChartDataSetXAxisTitle" _VPEDLL_ DWord hdoc DWord hdata String x_axis_title Returns Integer
102357>>>>>>>>>>>>> External_Function VpeChartDataSetYAxisTitle "VpeChartDataSetYAxisTitle" _VPEDLL_ DWord hdoc DWord hdata String y_axis_title Returns Integer
102358>>>>>>>>>>>>> External_Function VpeChartDataAddXLabel "VpeChartDataAddXLabel" _VPEDLL_ DWord hdoc DWord hdata String xlabel Returns Integer
102359>>>>>>>>>>>>> External_Function VpeChartDataAddYLabel "VpeChartDataAddYLabel" _VPEDLL_ DWord hdoc DWord hdata String ylabel Returns Integer
102360>>>>>>>>>>>>> External_Function VpeChartDataSetColor "VpeChartDataSetColor" _VPEDLL_ DWord hdoc DWord hdata Integer column DWord color Returns Integer
102361>>>>>>>>>>>>> External_Function VpeChartDataSetLineStyle "VpeChartDataSetLineStyle" _VPEDLL_ DWord hdoc DWord hdata Integer column Integer pen_style Returns Integer
102362>>>>>>>>>>>>> External_Function VpeChartDataSetHatchStyle "VpeChartDataSetHatchStyle" _VPEDLL_ DWord hdoc DWord hdata Integer column Integer style Returns Integer
102363>>>>>>>>>>>>> External_Function VpeChartDataSetPointType "VpeChartDataSetPointType" _VPEDLL_ DWord hdoc DWord hdata Integer column Integer pointtype Returns Integer
102364>>>>>>>>>>>>> // Parameter minimum is actually a double in the following function
102364>>>>>>>>>>>>> External_Function VpeChartDataSetMinimum "VpeChartDataSetMinimum" _VPEDLL_ DWord hdoc DWord hdata DWord minimum Returns Integer
102365>>>>>>>>>>>>> // Parameter maximum is actually a double in the following function
102365>>>>>>>>>>>>> External_Function VpeChartDataSetMaximum "VpeChartDataSetMaximum" _VPEDLL_ DWord hdoc DWord hdata DWord maximum Returns Integer
102366>>>>>>>>>>>>> External_Function VpeChartDataAddGap "VpeChartDataAddGap" _VPEDLL_ DWord hdoc DWord hdata Integer column Returns Integer
102367>>>>>>>>>>>>> External_Function VpeChartDataAddRow "VpeChartDataAddRow" _VPEDLL_ DWord hdoc DWord hdata Returns Integer
102368>>>>>>>>>>>>> External_Function VpeChartDataAddColumn "VpeChartDataAddColumn" _VPEDLL_ DWord hdoc DWord hdata Returns Integer
102369>>>>>>>>>>>>> External_Function VpeSetChartTitle "VpeSetChartTitle" _VPEDLL_ DWord hdoc String title Returns Integer
102370>>>>>>>>>>>>> External_Function VpeSetChartSubTitle "VpeSetChartSubTitle" _VPEDLL_ DWord hdoc String subtitle Returns Integer
102371>>>>>>>>>>>>> External_Function VpeSetChartFootNote "VpeSetChartFootNote" _VPEDLL_ DWord hdoc String footnote Returns Integer
102372>>>>>>>>>>>>> External_Function VpeSetChartRow "VpeSetChartRow" _VPEDLL_ DWord hdoc Integer row Returns Integer
102373>>>>>>>>>>>>> External_Function VpeSetChartGridBkgColor "VpeSetChartGridBkgColor" _VPEDLL_ DWord hdoc DWord bkgcolor Returns Integer
102374>>>>>>>>>>>>> External_Function VpeSetChartGridBkgMode "VpeSetChartGridBkgMode" _VPEDLL_ DWord hdoc Integer mode Returns Integer
102375>>>>>>>>>>>>> External_Function VpeSetChartGridType "VpeSetChartGridType" _VPEDLL_ DWord hdoc Integer gridtype Returns Integer
102376>>>>>>>>>>>>> External_Function VpeSetChartGridColor "VpeSetChartGridColor" _VPEDLL_ DWord hdoc DWord gridcolor Returns Integer
102377>>>>>>>>>>>>> // Parameter gridstepy is actually a double in the following function
102377>>>>>>>>>>>>> External_Function VpeSetChartYGridStep "VpeSetChartYGridStep" _VPEDLL_ DWord hdoc DWord gridstepy Returns Integer
102378>>>>>>>>>>>>> External_Function VpeSetChartYAutoGridStep "VpeSetChartYAutoGridStep" _VPEDLL_ DWord hdoc Returns Integer
102379>>>>>>>>>>>>> External_Function VpeSetChartLegendPosition "VpeSetChartLegendPosition" _VPEDLL_ DWord hdoc Integer legendpos Returns Integer
102380>>>>>>>>>>>>> External_Function VpeSetChartLegendBorderStat "VpeSetChartLegendBorderStat" _VPEDLL_ DWord hdoc Integer legendborderstat Returns Integer
102381>>>>>>>>>>>>> External_Function VpeSetChartXLabelState "VpeSetChartXLabelState" _VPEDLL_ DWord hdoc Integer xlabelstate Returns Integer
102382>>>>>>>>>>>>> External_Function VpeSetChartXLabelAngle "VpeSetChartXLabelAngle" _VPEDLL_ DWord hdoc Integer xlabelangle Returns Integer
102383>>>>>>>>>>>>> External_Function VpeSetChartXLabelStartValue "VpeSetChartXLabelStartValue" _VPEDLL_ DWord hdoc Integer xlabelstartvalue Returns Integer
102384>>>>>>>>>>>>> External_Function VpeSetChartYLabelState "VpeSetChartYLabelState" _VPEDLL_ DWord hdoc Integer ylabelstate Returns Integer
102385>>>>>>>>>>>>> External_Function VpeSetChartYLabelStep "VpeSetChartYLabelStep" _VPEDLL_ DWord hdoc Integer ylabelstep Returns Integer
102386>>>>>>>>>>>>> // Parameter ylabeldivisor is actually a double in the following function
102386>>>>>>>>>>>>> External_Function VpeSetChartYLabelDivisor "VpeSetChartYLabelDivisor" _VPEDLL_ DWord hdoc DWord ylabeldivisor Returns Integer
102387>>>>>>>>>>>>> External_Function VpeSetChartGridRotation "VpeSetChartGridRotation" _VPEDLL_ DWord hdoc Integer axisangle Returns Integer
102388>>>>>>>>>>>>> External_Function VpeSetChartYAxisAngle "VpeSetChartYAxisAngle" _VPEDLL_ DWord hdoc Integer yangle Returns Integer
102389>>>>>>>>>>>>> External_Function VpeSetChartXAxisAngle "VpeSetChartXAxisAngle" _VPEDLL_ DWord hdoc Integer xangle Returns Integer
102390>>>>>>>>>>>>> External_Function VpeChart "VpeChart" _VPEDLL_ DWord hdoc Integer x Integer y Integer x2 Integer y2 DWord hdata Integer chart_type Returns Integer
102391>>>>>>>>>>>>> //PDF-functions
102391>>>>>>>>>>>>> External_Function VpeAddBookmark "VpeAddBookmark" _VPEDLL_ DWord hdoc Integer parent String title Returns Integer
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VPE-constants : /////////////////////////////////////////////////////////
102392>>>>>>>>>>>>>//
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// Constants for internal use:
102392>>>>>>>>>>>>>Define VPE_NULL for $0000
102392>>>>>>>>>>>>>Define VPE_TRUE for 1
102392>>>>>>>>>>>>>Define VPE_FALSE for 0
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeOpenDoc - flags :
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>Define VPE_NO_TOOLBAR for 1
102392>>>>>>>>>>>>>Define VPE_NO_PRINTBUTTON for 8
102392>>>>>>>>>>>>>Define VPE_NO_MAILBUTTON for 16
102392>>>>>>>>>>>>>Define VPE_NO_SCALEBTNS for 32
102392>>>>>>>>>>>>>Define VPE_GRIDBUTTON for 64
102392>>>>>>>>>>>>>Define VPE_NO_MOVEBTNS for 128
102392>>>>>>>>>>>>>Define VPE_NO_HELPBUTTON for 256
102392>>>>>>>>>>>>>Define VPE_NO_INFOBUTTON for 512
102392>>>>>>>>>>>>>Define VPE_NO_USER_CLOSE for 1024
102392>>>>>>>>>>>>>Define VPE_NO_STATBAR for 2048
102392>>>>>>>>>>>>>Define VPE_NO_PAGESCROLLER for 4096
102392>>>>>>>>>>>>>Define VPE_NO_STATUSSEG for 8192
102392>>>>>>>>>>>>>Define VPE_NO_RULERS for 16384
102392>>>>>>>>>>>>>Define VPE_EMBEDDED for 32768
102392>>>>>>>>>>>>>Define VPE_DOCFILE_READONLY for 65536
102392>>>>>>>>>>>>>Define VPE_FIXED_MESSAGES for 131072
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeGetLastError - return values :
102392>>>>>>>>>>>>>Enum_List
102392>>>>>>>>>>>>> Define VERR_OK
102392>>>>>>>>>>>>> Define VERR_COMMON
102392>>>>>>>>>>>>> Define VERR_MEMORY for 100
102392>>>>>>>>>>>>> Define VERR_FILE_OPEN for 200
102392>>>>>>>>>>>>> Define VERR_FILE_DOCVERSION
102392>>>>>>>>>>>>> Define VERR_FILE_CREATE
102392>>>>>>>>>>>>> Define VERR_FILE_ACCESS
102392>>>>>>>>>>>>> Define VERR_FILE_READ
102392>>>>>>>>>>>>> Define VERR_FILE_WRITE
102392>>>>>>>>>>>>> Define VERR_PIC_IMPORT for 300
102392>>>>>>>>>>>>> Define VERR_PIC_NOLICENSE
102392>>>>>>>>>>>>> Define VERR_PIC_DXFCOORD
102392>>>>>>>>>>>>> Define VERR_PIC_EXPORT for 350
102392>>>>>>>>>>>>> Define VERR_MOD_GRAPH_IMP for 400
102392>>>>>>>>>>>>> Define VERR_MOD_GRAPH_PROC
102392>>>>>>>>>>>>> Define VERR_MOD_BARCODE
102392>>>>>>>>>>>>> Define VERR_MOD_CHART
102392>>>>>>>>>>>>> Define VERR_MAIL_LOAD_MAPI for 450
102392>>>>>>>>>>>>> Define VERR_MAIL_CREATE
102392>>>>>>>>>>>>> Define VERR_MAIL_USER_ABORT
102392>>>>>>>>>>>>> Define VERR_MAIL_FAILURE
102392>>>>>>>>>>>>> Define VERR_MAIL_LOGON_FAILURE
102392>>>>>>>>>>>>> Define VERR_MAIL_DISK_FULL
102392>>>>>>>>>>>>> Define VERR_MAIL_INSUFFICIENT_MEMORY
102392>>>>>>>>>>>>> Define VERR_MAIL_ACCESS_DENIED
102392>>>>>>>>>>>>> Define VERR_MAIL_RESERVED
102392>>>>>>>>>>>>> Define VERR_MAIL_TOO_MANY_SESSIONS
102392>>>>>>>>>>>>> Define VERR_MAIL_TOO_MANY_FILES
102392>>>>>>>>>>>>> Define VERR_MAIL_TOO_MANY_RECIPIENTS
102392>>>>>>>>>>>>> Define VERR_MAIL_ATTACHMENT_NOT_FOUND
102392>>>>>>>>>>>>> Define VERR_MAIL_ATTACHMENT_OPEN_FAILURE
102392>>>>>>>>>>>>> Define VERR_MAIL_ATTACHMENT_WRITE_FAILURE
102392>>>>>>>>>>>>> Define VERR_MAIL_UNKNOWN_RECIPIENT
102392>>>>>>>>>>>>> Define VERR_MAIL_BAD_RECIPTYPE
102392>>>>>>>>>>>>> Define VERR_MAIL_NO_MESSAGES
102392>>>>>>>>>>>>> Define VERR_MAIL_INVALID_MESSAGE
102392>>>>>>>>>>>>> Define VERR_MAIL_TEXT_TOO_LARGE
102392>>>>>>>>>>>>> Define VERR_MAIL_INVALID_SESSION
102392>>>>>>>>>>>>> Define VERR_MAIL_TYPE_NOT_SUPPORTED
102392>>>>>>>>>>>>> Define VERR_MAIL_AMBIGUOUS_RECIPIENT
102392>>>>>>>>>>>>> Define VERR_MAIL_MESSAGE_IN_USE
102392>>>>>>>>>>>>> Define VERR_MAIL_NETWORK_FAILURE
102392>>>>>>>>>>>>> Define VERR_MAIL_INVALID_EDITFIELDS
102392>>>>>>>>>>>>> Define VERR_MAIL_INVALID_RECIPS
102392>>>>>>>>>>>>> Define VERR_MAIL_NOT_SUPPORTED
102392>>>>>>>>>>>>> Define VERR_RTF_BRACES for 1000
102392>>>>>>>>>>>>> Define VERR_RTF_OVERFLOW
102392>>>>>>>>>>>>> Define VERR_RTF_FONTTBL
102392>>>>>>>>>>>>> Define VERR_RTF_COLORTBL
102392>>>>>>>>>>>>>End_Enum_List
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpePreviewDoc - parameters :
102392>>>>>>>>>>>>>Define VPE_SHOW_NORMAL for 1
102392>>>>>>>>>>>>>Define VPE_SHOW_MAXIMIZED for 2
102392>>>>>>>>>>>>>Define VPE_SHOW_HIDE for 3
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetPreviewCtrl - parameters :
102392>>>>>>>>>>>>>Define PREVIEW_STAY for 0
102392>>>>>>>>>>>>>Define PREVIEW_JUMPTOP for 1
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>> // VpeDefineKey/VpeDefineKey - parameters :
102392>>>>>>>>>>>>> Enum_List
102392>>>>>>>>>>>>> Define VKEY_SCROLL_LEFT
102392>>>>>>>>>>>>> DEFINE VKEY_SCROLL_PAGE_LEFT
102392>>>>>>>>>>>>> DEFINE VKEY_SCROLL_RIGHT
102392>>>>>>>>>>>>> DEFINE VKEY_SCROLL_PAGE_RIGHT
102392>>>>>>>>>>>>> DEFINE VKEY_SCROLL_UP
102392>>>>>>>>>>>>> DEFINE VKEY_SCROLL_PAGE_UP
102392>>>>>>>>>>>>> DEFINE VKEY_SCROLL_DOWN
102392>>>>>>>>>>>>> DEFINE VKEY_SCROLL_PAGE_DOWN
102392>>>>>>>>>>>>> DEFINE VKEY_SCROLL_TOP
102392>>>>>>>>>>>>> DEFINE VKEY_SCROLL_BOTTOM
102392>>>>>>>>>>>>> DEFINE VKEY_PRINT
102392>>>>>>>>>>>>> DEFINE VKEY_MAIL
102392>>>>>>>>>>>>> DEFINE VKEY_1_1
102392>>>>>>>>>>>>> DEFINE VKEY_FULL_PAGE
102392>>>>>>>>>>>>> DEFINE VKEY_ZOOM_IN
102392>>>>>>>>>>>>> DEFINE VKEY_ZOOM_OUT
102392>>>>>>>>>>>>> DEFINE VKEY_GRID
102392>>>>>>>>>>>>> DEFINE VKEY_PAGE_FIRST
102392>>>>>>>>>>>>> DEFINE VKEY_PAGE_LEFT
102392>>>>>>>>>>>>> DEFINE VKEY_PAGE_RIGHT
102392>>>>>>>>>>>>> DEFINE VKEY_PAGE_LAST
102392>>>>>>>>>>>>> DEFINE VKEY_HELP
102392>>>>>>>>>>>>> DEFINE VKEY_INFO
102392>>>>>>>>>>>>> DEFINE VKEY_CLOSE
102392>>>>>>>>>>>>> DEFINE VKEY_GOTO_PAGE
102392>>>>>>>>>>>>> End_Enum_List
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>> // VpeSetGUILanguage - parameters :
102392>>>>>>>>>>>>> Enum_List
102392>>>>>>>>>>>>> DEFINE VGUI_LANGUAGE_ENGLISH
102392>>>>>>>>>>>>> DEFINE VGUI_LANGUAGE_GERMAN
102392>>>>>>>>>>>>> DEFINE VGUI_LANGUAGE_FRENCH
102392>>>>>>>>>>>>> DEFINE VGUI_LANGUAGE_DUTCH
102392>>>>>>>>>>>>> DEFINE VGUI_LANGUAGE_SPANISH
102392>>>>>>>>>>>>> DEFINE VGUI_LANGUAGE_DANISH
102392>>>>>>>>>>>>> DEFINE VGUI_LANGUAGE_SWEDISH
102392>>>>>>>>>>>>> DEFINE VGUI_LANGUAGE_FINNISH
102392>>>>>>>>>>>>> DEFINE VGUI_LANGUAGE_ITALIAN
102392>>>>>>>>>>>>> DEFINE VGUI_LANGUAGE_NORWEGIAN
102392>>>>>>>>>>>>> End_Enum_List
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeGetEdition - return values :
102392>>>>>>>>>>>>>Define VEDITION_STANDARD for 1000
102392>>>>>>>>>>>>>Define VEDITION_ENHANCED for 2000
102392>>>>>>>>>>>>>Define VEDITION_PROFESSIONAL for 3000
102392>>>>>>>>>>>>>Define VEDITION_ENTERPRISE for 4000
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetupPrinter - parameters :
102392>>>>>>>>>>>>>Define PRINTDLG_NEVER for 0 // never show setup-dialog
102392>>>>>>>>>>>>>Define PRINTDLG_ONFAIL for 1 // show setup-dialog if file-read fail
102392>>>>>>>>>>>>>Define PRINTDLG_ALWAYS for 2 // show setup-dialog always
102392>>>>>>>>>>>>>Define PRINTDLG_FULL for 4 // show full dialog, add this to the other flags!
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetPrintOptions - parameters :
102392>>>>>>>>>>>>>Define PRINT_ALL for 0 // print all pages
102392>>>>>>>>>>>>>Define PRINT_EVEN for 1 // print only even pages
102392>>>>>>>>>>>>>Define PRINT_ODD for 2 // print only oss pages
102392>>>>>>>>>>>>>Define PRINT_NOABORTDLG for 4 // no abort/progress dialog
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetPrintPosMode - parameters :
102392>>>>>>>>>>>>>Define PRINTPOS_ABSOLUTE for 0
102392>>>>>>>>>>>>>Define PRINTPOS_RELATIVE for 1
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetDevOrientation - parameters, and
102392>>>>>>>>>>>>>// VpeSetPageOrientation - parameters, and
102392>>>>>>>>>>>>>// VpeGetPageOrientation - return values :
102392>>>>>>>>>>>>>Define VORIENTATION_PORTRAIT for 1
102392>>>>>>>>>>>>>Define VORIENTATION_LANDSCAPE for 2 // Formerly VPE_LANDSCAPE
102392>>>>>>>>>>>>>Define VPE_LANDSCAPE for 8192 // Just so we are able to compile
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetDevPaperFormat - parameters, and
102392>>>>>>>>>>>>>// VpeGetDevPaperFormat - return values, and
102392>>>>>>>>>>>>>// VpeSetPageFormat - parameters :
102392>>>>>>>>>>>>>Define VPAPER_A4 for -1 // Formerly: DIN_A_4
102392>>>>>>>>>>>>>Define VPAPER_LETTER for -2 // Formerly: US_LETTER
102392>>>>>>>>>>>>>Define VPAPER_LEGAL for -3
102392>>>>>>>>>>>>>Define VPAPER_CSHEET for -4
102392>>>>>>>>>>>>>Define VPAPER_DSHEET for -5
102392>>>>>>>>>>>>>Define VPAPER_ESHEET for -6
102392>>>>>>>>>>>>>Define VPAPER_LETTERSMALL for -7
102392>>>>>>>>>>>>>Define VPAPER_TABLOID for -8
102392>>>>>>>>>>>>>Define VPAPER_LEDGER for -9
102392>>>>>>>>>>>>>Define VPAPER_STATEMENT for -10
102392>>>>>>>>>>>>>Define VPAPER_EXECUTIVE for -11
102392>>>>>>>>>>>>>Define VPAPER_A3 for -12
102392>>>>>>>>>>>>>Define VPAPER_A4SMALL for -13
102392>>>>>>>>>>>>>Define VPAPER_A5 for -14
102392>>>>>>>>>>>>>Define VPAPER_B4 for -15
102392>>>>>>>>>>>>>Define VPAPER_B5 for -16
102392>>>>>>>>>>>>>Define VPAPER_FOLIO for -17
102392>>>>>>>>>>>>>Define VPAPER_QUARTO for -18
102392>>>>>>>>>>>>>Define VPAPER_10X14 for -19
102392>>>>>>>>>>>>>Define VPAPER_11X17 for -20
102392>>>>>>>>>>>>>Define VPAPER_NOTE for -21
102392>>>>>>>>>>>>>Define VPAPER_ENV_9 for -22
102392>>>>>>>>>>>>>Define VPAPER_ENV_10 for -23
102392>>>>>>>>>>>>>Define VPAPER_ENV_11 for -24
102392>>>>>>>>>>>>>Define VPAPER_ENV_12 for -25
102392>>>>>>>>>>>>>Define VPAPER_ENV_14 for -26
102392>>>>>>>>>>>>>Define VPAPER_ENV_DL for -27
102392>>>>>>>>>>>>>Define VPAPER_ENV_C5 for -28
102392>>>>>>>>>>>>>Define VPAPER_ENV_C3 for -29
102392>>>>>>>>>>>>>Define VPAPER_ENV_C4 for -30
102392>>>>>>>>>>>>>Define VPAPER_ENV_C6 for -31
102392>>>>>>>>>>>>>Define VPAPER_ENV_C65 for -32
102392>>>>>>>>>>>>>Define VPAPER_ENV_B4 for -33
102392>>>>>>>>>>>>>Define VPAPER_ENV_B5 for -34
102392>>>>>>>>>>>>>Define VPAPER_ENV_B6 for -35
102392>>>>>>>>>>>>>Define VPAPER_ENV_ITALY for -36
102392>>>>>>>>>>>>>Define VPAPER_ENV_MONARCH for -37
102392>>>>>>>>>>>>>Define VPAPER_ENV_PERSONAL for -38
102392>>>>>>>>>>>>>Define VPAPER_FANFOLD_US for -39
102392>>>>>>>>>>>>>Define VPAPER_FANFOLD_STD_GERMAN for -40
102392>>>>>>>>>>>>>Define VPAPER_FANFOLD_LGL_GERMAN for -41
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetDevPrintQuality - parameters, and
102392>>>>>>>>>>>>>// VpeGetDevPrintQuality - return values :
102392>>>>>>>>>>>>>Define VRES_DRAFT for -1
102392>>>>>>>>>>>>>Define VRES_LOW for -2
102392>>>>>>>>>>>>>Define VRES_MEDIUM for -3
102392>>>>>>>>>>>>>Define VRES_HIGH for -4
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetDevColor - parameters, and
102392>>>>>>>>>>>>>// VpeGetDevColor - return values :
102392>>>>>>>>>>>>>Define VCOLOR_MONOCHROME for 1
102392>>>>>>>>>>>>>Define VCOLOR_COLOR for 2
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetDevDuplex - parameters, and
102392>>>>>>>>>>>>>// VpeGetDevDuplex - return values :
102392>>>>>>>>>>>>>Define VDUP_SIMPLEX for 1
102392>>>>>>>>>>>>>Define VDUP_VERTICAL for 2
102392>>>>>>>>>>>>>Define VDUP_HORIZONTAL for 3
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetDevTTOption - parameters, and
102392>>>>>>>>>>>>>// VpeGetDevTTOption - return values :
102392>>>>>>>>>>>>>Define VTT_BITMAP for 1
102392>>>>>>>>>>>>>Define VTT_DOWNLOAD for 2
102392>>>>>>>>>>>>>Define VTT_SUBDEV for 3
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeGetDevPaperBinID - return values, and
102392>>>>>>>>>>>>>// VpeSetDevPaperBin - parameters, and
102392>>>>>>>>>>>>>// VpeGetDevPaperBin - return values, and
102392>>>>>>>>>>>>>// VpeSetPaperBin - parameters, and
102392>>>>>>>>>>>>>// VpeGetPaperBin - return values :
102392>>>>>>>>>>>>>Define VBIN_UNTOUCHED for -1 // not for the ...Dev... functions
102392>>>>>>>>>>>>>Define VBIN_UPPER for 1
102392>>>>>>>>>>>>>Define VBIN_ONLYONE for 1 // yes, also 1
102392>>>>>>>>>>>>>Define VBIN_LOWER for 2
102392>>>>>>>>>>>>>Define VBIN_MIDDLE for 3
102392>>>>>>>>>>>>>Define VBIN_MANUAL for 4
102392>>>>>>>>>>>>>Define VBIN_ENVELOPE for 5
102392>>>>>>>>>>>>>Define VBIN_ENVMANUAL for 6
102392>>>>>>>>>>>>>Define VBIN_AUTO for 7
102392>>>>>>>>>>>>>Define VBIN_TRACTOR for 8
102392>>>>>>>>>>>>>Define VBIN_SMALLFMT for 9
102392>>>>>>>>>>>>>Define VBIN_LARGEFMT for 10
102392>>>>>>>>>>>>>Define VBIN_LARGECAPACITY for 11
102392>>>>>>>>>>>>>Define VBIN_CASSETTE for 14
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetAutoBreak - parameters :
102392>>>>>>>>>>>>>Define AUTO_BREAK_ON for 0 // auto break
102392>>>>>>>>>>>>>Define AUTO_BREAK_OFF for 1 // limited positioning, rendering
102392>>>>>>>>>>>>>Define AUTO_BREAK_NO_LIMITS for 2 // none of above
102392>>>>>>>>>>>>>Define AUTO_BREAK_FULL for 3
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// Positioning codes, and
102392>>>>>>>>>>>>>// VpeGet - parameters :
102392>>>>>>>>>>>>>Define VFREE for -1 // not vpeget
102392>>>>>>>>>>>>>Define VLEFT for -2
102392>>>>>>>>>>>>>Define VRIGHT for -3
102392>>>>>>>>>>>>>Define VLEFTMARGIN for -4
102392>>>>>>>>>>>>>Define VRIGHTMARGIN for -5
102392>>>>>>>>>>>>>Define VTOP for -6
102392>>>>>>>>>>>>>Define VBOTTOM for -7
102392>>>>>>>>>>>>>Define VTOPMARGIN for -8
102392>>>>>>>>>>>>>Define VBOTTOMMARGIN for -9
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>Define VWIDTH for -100
102392>>>>>>>>>>>>>Define VHEIGHT for -101
102392>>>>>>>>>>>>>Define VRENDERWIDTH for -102
102392>>>>>>>>>>>>>Define VRENDERHEIGHT for -103
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>Define VUDO_LEFT for -104
102392>>>>>>>>>>>>>Define VUDO_RIGHT for -105
102392>>>>>>>>>>>>>Define VUDO_TOP for -106
102392>>>>>>>>>>>>>Define VUDO_BOTTOM for -107
102392>>>>>>>>>>>>>Define VUDO_WIDTH for -108
102392>>>>>>>>>>>>>Define VUDO_HEIGHT for -109
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeRender... - return values :
102392>>>>>>>>>>>>>Define RENDER_NO_BREAK for 0
102392>>>>>>>>>>>>>Define RENDER_BREAK for 1
102392>>>>>>>>>>>>>Define RENDER_SKIP_BREAK for 2
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetPen - parameters, and
102392>>>>>>>>>>>>>// VpeSetPenStyle - parameters, and
102392>>>>>>>>>>>>>// VpePenStyle - parameters, and
102392>>>>>>>>>>>>>// VpeChartDataSetLineStyle - parameters :
102392>>>>>>>>>>>>>Define PS_SOLID for 0
102392>>>>>>>>>>>>>Define PS_DASH for 1
102392>>>>>>>>>>>>>Define PS_DOT for 2
102392>>>>>>>>>>>>>Define PS_DASHDOT for 3
102392>>>>>>>>>>>>>Define PS_DASHDOTDOT for 4
102392>>>>>>>>>>>>>Define PS_NULL for 5
102392>>>>>>>>>>>>>//DEFINE PS_INSIDEFRAME for 6
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetBkgMode - parameters, and
102392>>>>>>>>>>>>>// VpeSetChartGridBkgMode - parameters :
102392>>>>>>>>>>>>>Define VBKG_SOLID for 0
102392>>>>>>>>>>>>>Define VBKG_TRANSPARENT for 1
102392>>>>>>>>>>>>>Define VBKG_GRD_LINE for 2
102392>>>>>>>>>>>>>Define VBKG_GRD_RECT for 3
102392>>>>>>>>>>>>>Define VBKG_GRD_ELLIPSE for 4
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetBkgGradientPrint - parameters :
102392>>>>>>>>>>>>>Define VGRD_PRINT_AUTO for 0
102392>>>>>>>>>>>>>Define VGRD_PRINT_GRADIENT for 1
102392>>>>>>>>>>>>>Define VGRD_PRINT_SOLID for 2
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetHatchStyle - parameters, and
102392>>>>>>>>>>>>>// VpeChartDataSetHatchStyle - parameters :
102392>>>>>>>>>>>>>Define HS_NONE for -1
102392>>>>>>>>>>>>>Define HS_HORIZONTAL for 0
102392>>>>>>>>>>>>>Define HS_VERTICAL for 1
102392>>>>>>>>>>>>>Define HS_FDIAGONAL for 2
102392>>>>>>>>>>>>>Define HS_BDIAGONAL for 3
102392>>>>>>>>>>>>>Define HS_CROSS for 4
102392>>>>>>>>>>>>>Define HS_DIAGCROSS for 5
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetCharset - parameters :
102392>>>>>>>>>>>>>Define ANSI_CHARSET for 0
102392>>>>>>>>>>>>>Define DEFAULT_CHARSET for 1
102392>>>>>>>>>>>>>Define SYMBOL_CHARSET for 2
102392>>>>>>>>>>>>>Define SHIFTJIS_CHARSET for 128
102392>>>>>>>>>>>>>Define HANGEUL_CHARSET for 129
102392>>>>>>>>>>>>>Define GB2312_CHARSET for 134
102392>>>>>>>>>>>>>Define CHINESEBIG5_CHARSET for 136
102392>>>>>>>>>>>>>Define OEM_CHARSET for 255
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>Define JOHAB_CHARSET for 130 // the following are only for win9x
102392>>>>>>>>>>>>>Define HEBREW_CHARSET for 177
102392>>>>>>>>>>>>>Define ARABIC_CHARSET for 178
102392>>>>>>>>>>>>>Define GREEK_CHARSET for 161
102392>>>>>>>>>>>>>Define TURKISH_CHARSET for 162
102392>>>>>>>>>>>>>Define THAI_CHARSET for 222
102392>>>>>>>>>>>>>Define EASTEUROPE_CHARSET for 238
102392>>>>>>>>>>>>>Define RUSSIAN_CHARSET for 204
102392>>>>>>>>>>>>>Define MAC_CHARSET for 77
102392>>>>>>>>>>>>>Define BALTIC_CHARSET for 186
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetFontAttr - parameters, and
102392>>>>>>>>>>>>>// VpeSetTextAlignment - parameters, and
102392>>>>>>>>>>>>>// VpeSetAlign - parameters :
102392>>>>>>>>>>>>>Define ALIGN_LEFT for 0
102392>>>>>>>>>>>>>Define ALIGN_RIGHT for 1
102392>>>>>>>>>>>>>Define ALIGN_CENTER for 2
102392>>>>>>>>>>>>>Define ALIGN_JUSTIFIED for 3
102392>>>>>>>>>>>>>//DEFINE ALIGN_PRINT for 4 // internal, do not use !
102392>>>>>>>>>>>>>Define ALIGN_JUSTIFIED_AB for 5
102392>>>>>>>>>>>>>Define ALIGN_LEFT_CUT for 7
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetPictureType - parameters :
102392>>>>>>>>>>>>>Define PIC_TYPE_AUTO for 255
102392>>>>>>>>>>>>>Define PIC_TYPE_BMP for 0
102392>>>>>>>>>>>>>Define PIC_TYPE_WMF for 5
102392>>>>>>>>>>>>>Define PIC_TYPE_EMF for 6
102392>>>>>>>>>>>>>Define PIC_TYPE_DXF for 7
102392>>>>>>>>>>>>>Define PIC_TYPE_TIFF for 64
102392>>>>>>>>>>>>>Define PIC_TYPE_GIF for 65
102392>>>>>>>>>>>>>Define PIC_TYPE_PCX for 66
102392>>>>>>>>>>>>>Define PIC_TYPE_FLT for 67
102392>>>>>>>>>>>>>Define PIC_TYPE_JPEG for 68
102392>>>>>>>>>>>>>Define PIC_TYPE_PNG for 69
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpePicture - parameters, and
102392>>>>>>>>>>>>>// VpePictureResID - parameters, and
102392>>>>>>>>>>>>>// VpePictureResName - parameters, and
102392>>>>>>>>>>>>>// VpePictureDIB - parameters :
102392>>>>>>>>>>>>>Define PIC_MERGE for 1
102392>>>>>>>>>>>>>Define PIC_KEEPIMAGE for 2 // Formerly: VPE_PIC_KEEPIMAGE
102392>>>>>>>>>>>>>Define PIC_DISCARD_DIB_DRAW for 4
102392>>>>>>>>>>>>>Define PIC_KEEP_DIB_PAGE for 8
102392>>>>>>>>>>>>>Define PIC_BESTFIT for 16
102392>>>>>>>>>>>>>Define PIC_IN_FILE for 32
102392>>>>>>>>>>>>>Define PIC_ALLOWLZW for 64
102392>>>>>>>>>>>>>Define PIC_X2YRESOLUTION for 128
102392>>>>>>>>>>>>>Define PIC_DXF_BW for 256
102392>>>>>>>>>>>>>Define PIC_SCALE2GRAY for 512
102392>>>>>>>>>>>>>Define PIC_SCALE2GRAY_FLOAT for 1024
102392>>>>>>>>>>>>>Define PIC_EXACT for 32768
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetBarcodeParms - parameters :
102392>>>>>>>>>>>>>Define BCP_BOTTOM for 0
102392>>>>>>>>>>>>>Define BCP_TOP for 1
102392>>>>>>>>>>>>>Define BCP_HIDE for 2
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeBarcode - parameters :
102392>>>>>>>>>>>>>Define BCT_EAN13 for 1
102392>>>>>>>>>>>>>Define BCT_EAN8 for 2
102392>>>>>>>>>>>>>Define BCT_UPCA for 3
102392>>>>>>>>>>>>>Define BCT_CODABAR for 5
102392>>>>>>>>>>>>>Define BCT_CODE39 for 6
102392>>>>>>>>>>>>>Define BCT_2OF5 for 7
102392>>>>>>>>>>>>>Define BCT_INTERLEAVED2OF5 for 8
102392>>>>>>>>>>>>>Define BCT_UPCE for 9
102392>>>>>>>>>>>>>Define BCT_EAN13_2 for 10
102392>>>>>>>>>>>>>Define BCT_EAN13_5 for 11
102392>>>>>>>>>>>>>Define BCT_EAN8_2 for 12
102392>>>>>>>>>>>>>Define BCT_EAN8_5 for 13
102392>>>>>>>>>>>>>Define BCT_UPCA_2 for 14
102392>>>>>>>>>>>>>Define BCT_UPCA_5 for 15
102392>>>>>>>>>>>>>Define BCT_UPCE_2 for 16
102392>>>>>>>>>>>>>Define BCT_UPCE_5 for 17
102392>>>>>>>>>>>>>Define BCT_EAN128A for 18
102392>>>>>>>>>>>>>Define BCT_EAN128B for 19
102392>>>>>>>>>>>>>Define BCT_EAN128C for 20
102392>>>>>>>>>>>>>Define BCT_CODE93 for 21
102392>>>>>>>>>>>>>Define BCT_POSTNET for 22
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeIsMAPIInstalled - return values :
102392>>>>>>>>>>>>>Define VMAPI_NOT_INSTALLED for 0
102392>>>>>>>>>>>>>Define VMAPI_INSTALLED for 1
102392>>>>>>>>>>>>>Define VMAPI_UNSURE for 2
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeAddMailReceiver - parameters :
102392>>>>>>>>>>>>>Define VMAIL_ORIG for 0
102392>>>>>>>>>>>>>Define VMAIL_TO for 1
102392>>>>>>>>>>>>>Define VMAIL_CC for 2
102392>>>>>>>>>>>>>Define VMAIL_BCC for 3
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// Colors :
102392>>>>>>>>>>>>>// ??? on page 239
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetPictureExportOptions - parameters :
102392>>>>>>>>>>>>>Define PICEXP_WRITE_COMPRESSED for 2
102392>>>>>>>>>>>>>Define PICEXP_TIFF_NOCOMP for 32
102392>>>>>>>>>>>>>Define PICEXP_TIFF_LZW for 64
102392>>>>>>>>>>>>>Define PICEXP_TIFF_CCITTRLE for 96
102392>>>>>>>>>>>>>Define PICEXP_TIFF_CCITTFAX3 for 128
102392>>>>>>>>>>>>>Define PICEXP_TIFF_CCITTFAX4 for 160
102392>>>>>>>>>>>>>Define PICEXP_TIFF_PACKBITS for 192
102392>>>>>>>>>>>>>Define PICEXP_TIFF_APPEND for 2097152
102392>>>>>>>>>>>>>Define PICEXP_ALLOWLZW for 1024
102392>>>>>>>>>>>>>Define PICEXP_JPEG_HIQUALITY for 61440
102392>>>>>>>>>>>>>Define PICEXP_JPEG_GOODQUALITY for 36864
102392>>>>>>>>>>>>>Define PICEXP_JPEG_MIDQUALITY for 12288
102392>>>>>>>>>>>>>Define PICEXP_JPEG_LOQUALITY for 4096
102392>>>>>>>>>>>>>Define PICEXP_PNG_INTERLACED for 65536
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetPictureExportColorDepth - parameters :
102392>>>>>>>>>>>>>Define PICEXP_COLOR_MONO for 1
102392>>>>>>>>>>>>>Define PICEXP_COLOR_16 for 4
102392>>>>>>>>>>>>>Define PICEXP_COLOR_256 for 8
102392>>>>>>>>>>>>>Define PICEXP_COLOR_HI for 16
102392>>>>>>>>>>>>>Define PICEXP_COLOR_TRUE for 24
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetPictureExportDither - parameters :
102392>>>>>>>>>>>>>Define PICEXP_DITHER_NONE for 0
102392>>>>>>>>>>>>>Define PICEXP_DITHER_MONO for 1
102392>>>>>>>>>>>>>Define PICEXP_DITHER_16 for 2
102392>>>>>>>>>>>>>Define PICEXP_DITHER_256 for 3
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeChartDataSetPointType - parameters :
102392>>>>>>>>>>>>>Define VCHART_SYMBOL_NONE for -1
102392>>>>>>>>>>>>>Define VCHART_SYMBOL_SQUARE for 0
102392>>>>>>>>>>>>>Define VCHART_SYMBOL_TRIANGLE for 1
102392>>>>>>>>>>>>>Define VCHART_SYMBOL_CIRCLE for 2
102392>>>>>>>>>>>>>Define VCHART_SYMBOL_CROSS for 3
102392>>>>>>>>>>>>>Define VCHART_SYMBOL_X for 4
102392>>>>>>>>>>>>>Define VCHART_SYMBOL_POINT for 5
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetChartGridType - parameters :
102392>>>>>>>>>>>>>Define VCHART_GRID_NONE for -1
102392>>>>>>>>>>>>>Define VCHART_GRID_BOTH_AXIS for 0
102392>>>>>>>>>>>>>Define VCHART_GRID_X_AXIS for 1
102392>>>>>>>>>>>>>Define VCHART_GRID_Y_AXIS for 2
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetChartLegendPosition - parameters :
102392>>>>>>>>>>>>>Define VCHART_LEGENDPOS_NONE for -1
102392>>>>>>>>>>>>>Define VCHART_LEGENDPOS_RIGHT for 0
102392>>>>>>>>>>>>>Define VCHART_LEGENDPOS_RIGHT_TOP for 1
102392>>>>>>>>>>>>>Define VCHART_LEGENDPOS_RIGHT_BOTTOM for 2
102392>>>>>>>>>>>>>Define VCHART_LEGENDPOS_LEFT for 3
102392>>>>>>>>>>>>>Define VCHART_LEGENDPOS_LEFT_TOP for 4
102392>>>>>>>>>>>>>Define VCHART_LEGENDPOS_LEFT_BOTTOM for 5
102392>>>>>>>>>>>>>Define VCHART_LEGENDPOS_TOP for 6
102392>>>>>>>>>>>>>Define VCHART_LEGENDPOS_BOTTOM for 7
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeSetChartXLabelState - parameters, and
102392>>>>>>>>>>>>>// VpeSetChartYLabelState - parameters :
102392>>>>>>>>>>>>>Define VCHART_LABEL_NONE for -1
102392>>>>>>>>>>>>>Define VCHART_LABEL_USER for 0
102392>>>>>>>>>>>>>Define VCHART_LABEL_AUTO for 1
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>// VpeChart - parameters :
102392>>>>>>>>>>>>>Define VCHART_POINT for 0
102392>>>>>>>>>>>>>Define VCHART_LINE for 1
102392>>>>>>>>>>>>>Define VCHART_BAR for 2
102392>>>>>>>>>>>>>Define VCHART_STACKED_BAR_ABSOLUTE for 3
102392>>>>>>>>>>>>>Define VCHART_STACKED_BAR_PERCENT for 4
102392>>>>>>>>>>>>>Define VCHART_3D_BAR for 5
102392>>>>>>>>>>>>>Define VCHART_3D_STACKED_BAR_ABSOLUTE for 6
102392>>>>>>>>>>>>>Define VCHART_3D_STACKED_BAR_PERCENT for 7
102392>>>>>>>>>>>>>Define VCHART_PIE for 8
102392>>>>>>>>>>>>>Define VCHART_3D_PIE for 9
102392>>>>>>>>>>>>>Define VCHART_AREA_ABSOLUTE for 10
102392>>>>>>>>>>>>>Define VCHART_AREA_PERCENT for 11
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>Integer Vpe$ReturnGrb#
102392>>>>>>>>>>>>>
102392>>>>>>>>>>>>>Function VPE_OemToChar Global String OemStr Returns String
102394>>>>>>>>>>>>> String CharStr
102394>>>>>>>>>>>>> Integer OemAdress CharAdress
102394>>>>>>>>>>>>> Append OemStr (Character(0))
102395>>>>>>>>>>>>> Move (Repeat(Character(0), (Length(OemStr)))) to CharStr
102396>>>>>>>>>>>>> GetAddress of OemStr to OemAdress
102397>>>>>>>>>>>>> GetAddress of CharStr to CharAdress
102398>>>>>>>>>>>>> Move (VpeOemToCharA(OemAdress, CharAdress)) to Vpe$ReturnGrb#
102399>>>>>>>>>>>>> Function_Return (CString(CharStr))
102400>>>>>>>>>>>>>End_Function
102401>>>>>>>>>>>>>
102401>>>>>>>>>>>>>// This function may be used in conjunction with the Win2Pdf product
102401>>>>>>>>>>>>>// from Dane Prairie Systems: "http://www.daneprairie.com"
102401>>>>>>>>>>>>>Function Vpe_PrintDocToPdf Global String lsVpeDocFile String lsPdfFileName String lsTitle Returns Integer
102403>>>>>>>>>>>>> Integer lhDoc lhGarbage
102403>>>>>>>>>>>>>
102403>>>>>>>>>>>>> Get VPE_OemToChar lsTitle to lsTitle
102404>>>>>>>>>>>>> Move (VpeOpenDocFile(0,lsVpeDocFile,"",DFFALSE)) to lhDoc
102405>>>>>>>>>>>>> Move (VpeLicense(lhDoc,VPE_SERIAL_CODE1,VPE_SERIAL_CODE2)) to lhGarbage
102406>>>>>>>>>>>>> Move (VpeSetDevice(lhDoc,"Win2PDF")) to lhGarbage // Use printer called "Win2PDF"
102407>>>>>>>>>>>>>
102407>>>>>>>>>>>>> Set_Registry_Root to HKEY_CURRENT_USER "Software"
102408>>>>>>>>>>>>> // This assigns a file name to the PDF file about to be generated
102408>>>>>>>>>>>>> Set_Foreign_Profile_String "VB and VBA Program Settings\Dane Prairie Systems" "Win2PDF" "PDFFileName" to lsPdfFileName
102411>>>>>>>>>>>>> Set_Foreign_Profile_String "VB and VBA Program Settings\Dane Prairie Systems" "Win2PDF" "PDFFileNameWas" to lsPdfFileName
102414>>>>>>>>>>>>> // Restore registry pointer:
102414>>>>>>>>>>>>> Set_Registry_Root to HKEY_LOCAL_MACHINE "SoftWare"
102415>>>>>>>>>>>>>
102415>>>>>>>>>>>>> Move (VpePrintDoc(lhDoc,DFFALSE)) to lhGarbage // DFFALSE=>No dialog
102416>>>>>>>>>>>>> Move (VpeCloseDoc(lhDoc)) to windowindex
102417>>>>>>>>>>>>> Function_Return lhGarbage
102418>>>>>>>>>>>>>End_Function
102419>>>>>>>>>>>Use VPE3X.CFG
102419>>>>>>>>>>>Use Files.utl // Utilities for handling file related stuff
102419>>>>>>>>>>>Use WinUser.nui // User_Windows_User_Name function
102419>>>>>>>>>>>Use FList.nui // A lot of FLIST- procedures and functions
102419>>>>>>>>>>> Use Macros.utl // Various macros (FOR_EX...)
102419>>>>>>>>>>> desktop_section
102424>>>>>>>>>>> Integer glMainClientId#
102424>>>>>>>>>>> Move 0 to glMainClientId#
102425>>>>>>>>>>> Procedure Set iGlobal_MainClient_Id Integer obj#
102428>>>>>>>>>>> Move obj# to glMainClientId#
102429>>>>>>>>>>> End_Procedure
102430>>>>>>>>>>> Function iGlobal_MainClient_Id Returns Integer
102433>>>>>>>>>>> Integer self#
102433>>>>>>>>>>> ifnot glMainClientId# Begin
102435>>>>>>>>>>> Move Self to self#
102436>>>>>>>>>>> Move (client_id(self#)) to glMainClientId#
102437>>>>>>>>>>> End
102437>>>>>>>>>>>>
102437>>>>>>>>>>> Function_Return glMainClientId#
102438>>>>>>>>>>> End_Function
102439>>>>>>>>>>> end_desktop_section
102444>>>>>>>>>>> Class cVPE is an Array
102445>>>>>>>>>>> Procedure construct_object
102447>>>>>>>>>>> Forward Send construct_object
102449>>>>>>>>>>> Set delegation_mode to delegate_to_parent
102450>>>>>>>>>>> Property DWord phDoc Public 0 // Document handle
102451>>>>>>>>>>> Property String pTitle Public "Preview"
102452>>>>>>>>>>> property string pCurFont public "Arial"
102453>>>>>>>>>>> Property Integer pCurFontSize public 12
102454>>>>>>>>>>> Property Integer pCurTopMargin public 200
102455>>>>>>>>>>> Property Integer pCurBottomMargin public 200
102456>>>>>>>>>>> Property Integer pCurLeftMargin public 200
102457>>>>>>>>>>> Property Integer pCurRightMargin public 200
102458>>>>>>>>>>> property string pFont public "Arial"
102459>>>>>>>>>>> Property Integer pFontSize public 12
102460>>>>>>>>>>> Property Integer pLeftMargin public 200
102461>>>>>>>>>>> Property Integer pRightMargin public 200
102462>>>>>>>>>>> Property Integer pTopMargin public 200
102463>>>>>>>>>>> Property Integer pBottomMargin public 200
102464>>>>>>>>>>> property integer pPageWidth public VPAPER_A4 // VPAPER_LETTER
102465>>>>>>>>>>> Property Integer pPageLength public 0
102466>>>>>>>>>>> Property DWord pOpenOptions public 0
102467>>>>>>>>>>> property integer pBold public 0
102468>>>>>>>>>>> Property Integer pUnderLine public 0
102469>>>>>>>>>>> Property Integer pItalics public 0
102470>>>>>>>>>>> property integer pLandscape public 0
102471>>>>>>>>>>> // The property pNewPageOnNextLine is tested and set by the following
102471>>>>>>>>>>> // three procedure: NewPage, Write and WriteLn. It was introduced to
102471>>>>>>>>>>> // handle continuos Write/WriteLn across more pages.
102471>>>>>>>>>>> Property Integer pNewPageOnNextLine public 0
102472>>>>>>>>>>> End_Procedure
102473>>>>>>>>>>> // VpeSetAutoBreak - parameters :
102473>>>>>>>>>>> // AUTO_BREAK_ON // auto break
102473>>>>>>>>>>> // AUTO_BREAK_OFF // limited positioning, rendering
102473>>>>>>>>>>> // AUTO_BREAK_NO_LIMITS // none of above
102473>>>>>>>>>>> // AUTO_BREAK_FULL
102473>>>>>>>>>>> Procedure Vpe_SetAutoBreak Integer liValue
102475>>>>>>>>>>> Integer liGrb
102475>>>>>>>>>>> DWord lhDoc
102475>>>>>>>>>>> Get phDoc to lhDoc
102476>>>>>>>>>>> Move (VpeSetAutoBreak(lhDoc,liValue)) to liGrb
102477>>>>>>>>>>> End_Procedure
102478>>>>>>>>>>> function sDefaultSetupFileName returns string
102480>>>>>>>>>>> Integer lbCreateError liChannel
102480>>>>>>>>>>> String lsUserName lsFolder
102480>>>>>>>>>>> Get User_Windows_User_Name to lsUserName
102481>>>>>>>>>>> Get FLIST_CurrentFileListFolder to lsFolder
102482>>>>>>>>>>> Get Files_AppendPath lsFolder "VpeSetup" to lsFolder
102483>>>>>>>>>>> If (SEQ_FileExists(lsFolder)=SEQIT_NONE) Begin
102485>>>>>>>>>>> Get wvaWin32_CreateDirectory (ToAnsi(lsFolder)) to lbCreateError
102486>>>>>>>>>>> If lbCreateError Function_Return "c:\vpe3.set"
102489>>>>>>>>>>> Get SEQ_DirectOutput (Files_AppendPath(lsFolder,"readme.txt")) to liChannel
102490>>>>>>>>>>> If (liChannel>=0) Begin
102492>>>>>>>>>>> Writeln channel liChannel "This folder was created automatically to store setup files for the"
102495>>>>>>>>>>> Writeln "Virtual Print Engine (VPE)."
102497>>>>>>>>>>> Writeln ""
102499>>>>>>>>>>> Writeln "These files contain information about the currently selected printer."
102501>>>>>>>>>>> Send SEQ_CloseOutput liChannel
102502>>>>>>>>>>> End
102502>>>>>>>>>>>>
102502>>>>>>>>>>> End
102502>>>>>>>>>>>>
102502>>>>>>>>>>> Get Files_AppendPath lsFolder (lsUserName+".set") to lsUserName // overload
102503>>>>>>>>>>> Function_Return lsUserName
102504>>>>>>>>>>> End_Function
102505>>>>>>>>>>> function Vpe_GetDevice returns string
102507>>>>>>>>>>> DWord lhDoc
102507>>>>>>>>>>> Pointer lpDevice
102507>>>>>>>>>>> String lsDevice
102507>>>>>>>>>>> Integer liGrb
102507>>>>>>>>>>> Move (pad("",255)) to lsDevice
102508>>>>>>>>>>> GetAddress of lsDevice to lpDevice
102509>>>>>>>>>>> send OpenDoc
102510>>>>>>>>>>> Get phDoc to lhDoc
102511>>>>>>>>>>> Move (VpeGetDevice(lhDoc,lpDevice,255)) to liGrb
102512>>>>>>>>>>> send vpe_CloseDoc
102513>>>>>>>>>>> Function_Return (CString(lsDevice))
102514>>>>>>>>>>> End_Function
102515>>>>>>>>>>> Function IsLandscape returns dword
102517>>>>>>>>>>> Integer rval#
102517>>>>>>>>>>> Get Vpe_GetPageOrientation to rval#
102518>>>>>>>>>>> Function_Return (rval# = VORIENTATION_LANDSCAPE)
102519>>>>>>>>>>> End_Function
102520>>>>>>>>>>> Procedure vpe_SelectFont string Font# integer FontSize#
102522>>>>>>>>>>> DWord lhDoc
102522>>>>>>>>>>> Get phDoc to lhDoc
102523>>>>>>>>>>> Move (VpeSetFont(lhDoc,Font#,FontSize#)) to Vpe$ReturnGrb#
102524>>>>>>>>>>> Set pCurFont to Font#
102525>>>>>>>>>>> Set pCurFontSize to FontSize#
102526>>>>>>>>>>> End_Procedure
102527>>>>>>>>>>> Procedure ExportCurMargins
102529>>>>>>>>>>> Integer left# right# top# bottom# Width# Length#
102529>>>>>>>>>>> DWord lhDoc
102529>>>>>>>>>>> Get phDoc to lhDoc
102530>>>>>>>>>>> Get pPageWidth to Width#
102531>>>>>>>>>>> Get pPageLength to Length#
102532>>>>>>>>>>> // If landscape: switch length and width:
102532>>>>>>>>>>> If (IsLandscape(Self)) Begin
102534>>>>>>>>>>> Move Width# to Left# // Overload!
102535>>>>>>>>>>> Move Length# to Width#
102536>>>>>>>>>>> Move Left# to Length# // End overload!
102537>>>>>>>>>>> End
102537>>>>>>>>>>>>
102537>>>>>>>>>>> get pCurLeftMargin to Left#
102538>>>>>>>>>>> Get pCurRightMargin to Right#
102539>>>>>>>>>>> Get pCurTopMargin to Top#
102540>>>>>>>>>>> Get pCurBottomMargin to Bottom#
102541>>>>>>>>>>> Move (VpeSet(lhDoc,VLEFTMARGIN, Left#)) to Vpe$ReturnGrb#
102542>>>>>>>>>>> Move (VpeSet(lhDoc,VRIGHTMARGIN, Width#-Right#)) to Vpe$ReturnGrb#
102543>>>>>>>>>>> Move (VpeSet(lhDoc,VTOPMARGIN, Top#)) to Vpe$ReturnGrb#
102544>>>>>>>>>>> Move (VpeSet(lhDoc,VBOTTOMMARGIN,Length#-Bottom#)) to Vpe$ReturnGrb#
102545>>>>>>>>>>> End_Procedure
102546>>>>>>>>>>> Procedure SetMargins integer left# integer right# integer top# integer bottom#
102548>>>>>>>>>>> Set pCurLeftMargin to Left#
102549>>>>>>>>>>> Set pCurRightMargin to Right#
102550>>>>>>>>>>> Set pCurTopMargin to Top#
102551>>>>>>>>>>> Set pCurBottomMargin to Bottom#
102552>>>>>>>>>>> Send ExportCurMargins
102553>>>>>>>>>>> End_Procedure
102554>>>>>>>>>>> Procedure vpe_Set Integer what# Integer val# // Same as SetCoord
102556>>>>>>>>>>> DWord lhDoc
102556>>>>>>>>>>> Get phDoc to lhDoc
102557>>>>>>>>>>> Move (VpeSet(lhDoc,what#,val#)) to Vpe$ReturnGrb#
102558>>>>>>>>>>> End_Procedure
102559>>>>>>>>>>> Procedure SetCoord Integer what# Integer val#
102561>>>>>>>>>>> DWord lhDoc
102561>>>>>>>>>>> Get phDoc to lhDoc
102562>>>>>>>>>>> Move (VpeSet(lhDoc,what#,val#)) to Vpe$ReturnGrb#
102563>>>>>>>>>>> End_Procedure
102564>>>>>>>>>>> Function GetCoord Integer what# Returns integer
102566>>>>>>>>>>> DWord lhDoc
102566>>>>>>>>>>> Get phDoc to lhDoc
102567>>>>>>>>>>> Function_Return (VpeGet(lhDoc,what#))
102568>>>>>>>>>>> End_Function
102569>>>>>>>>>>> Function vpe_Get Integer what# Returns integer // Same as GetCoord
102571>>>>>>>>>>> DWord lhDoc
102571>>>>>>>>>>> Get phDoc to lhDoc
102572>>>>>>>>>>> Function_Return (VpeGet(lhDoc,what#))
102573>>>>>>>>>>> End_Function
102574>>>>>>>>>>> Procedure vpe_OpenDoc handle parent# string title# dword flags#
102576>>>>>>>>>>> DWord lhDoc
102576>>>>>>>>>>> Integer target# main_client#
102576>>>>>>>>>>> String bypass#
102576>>>>>>>>>>> Get VPE_OemToChar title# to title#
102577>>>>>>>>>>>
102577>>>>>>>>>>> Move (VpeOpenDoc(parent#,title#,flags#)) to lhDoc
102578>>>>>>>>>>> Move (VpeLicense(lhDoc,VPE_SERIAL_CODE1,VPE_SERIAL_CODE2)) to Vpe$ReturnGrb#
102579>>>>>>>>>>> Set phDoc to lhDoc
102580>>>>>>>>>>> If (pLandscape(Self)) Begin
102582>>>>>>>>>>> Send Vpe_SetDevOrientation VORIENTATION_LANDSCAPE
102583>>>>>>>>>>> Send Vpe_SetPageOrientation VORIENTATION_LANDSCAPE
102584>>>>>>>>>>> End
102584>>>>>>>>>>>>
102584>>>>>>>>>>> End_Procedure
102585>>>>>>>>>>> Procedure OpenDoc string tmpTitle# string tmpSetupFile#
102587>>>>>>>>>>> DWord lhDoc
102587>>>>>>>>>>> String title# SetupFile#
102587>>>>>>>>>>> Integer length# width#
102587>>>>>>>>>>> Integer target# main_client#
102587>>>>>>>>>>> String bypass#
102587>>>>>>>>>>> if num_arguments gt 0 move tmpTitle# to title#
102590>>>>>>>>>>> Else Get pTitle to title#
102592>>>>>>>>>>> If num_arguments gt 1 Move tmpSetupFile# to SetupFile#
102595>>>>>>>>>>> Else Get sDefaultSetupFileName to SetupFile# // "c:\vpe3.set"
102597>>>>>>>>>>> If (SetupFile# = "") Get sDefaultSetupFileName to SetupFile# // "c:\vpe3.set"
102600>>>>>>>>>>> get VPE_OemToChar title# To title#
102601>>>>>>>>>>> get pPageWidth to Width#
102602>>>>>>>>>>> Get pPageLength to Length#
102603>>>>>>>>>>> if (width# = VPAPER_A4) begin
102605>>>>>>>>>>> Move 2100 to Width#
102606>>>>>>>>>>> Move 2970 to Length#
102607>>>>>>>>>>> End
102607>>>>>>>>>>>>
102607>>>>>>>>>>> If (width# = VPAPER_LETTER) Begin
102609>>>>>>>>>>> Move 2159 to Width#
102610>>>>>>>>>>> Move 2794 to Length#
102611>>>>>>>>>>> End
102611>>>>>>>>>>>>
102611>>>>>>>>>>> Set pPageWidth to Width#
102612>>>>>>>>>>> Set pPageLength to Length#
102613>>>>>>>>>>> // width and length are no longer passed as params to opendoc
102613>>>>>>>>>>> // we might have to set paper size diffently
102613>>>>>>>>>>> Move (VpeOpenDoc(0,title#,pOpenOptions(Self))) to lhDoc
102614>>>>>>>>>>> Move (VpeLicense(lhDoc,VPE_SERIAL_CODE1,VPE_SERIAL_CODE2)) to Vpe$ReturnGrb#
102615>>>>>>>>>>> Set phDoc to lhDoc
102616>>>>>>>>>>> If (pLandscape(Self)) Begin
102618>>>>>>>>>>> Send Vpe_SetDevOrientation VORIENTATION_LANDSCAPE
102619>>>>>>>>>>> Send Vpe_SetPageOrientation VORIENTATION_LANDSCAPE
102620>>>>>>>>>>> End
102620>>>>>>>>>>>>
102620>>>>>>>>>>> move (VpeSetupPrinter(lhDoc,SetupFile#,PRINTDLG_ONFAIL)) to Vpe$ReturnGrb#
102621>>>>>>>>>>> If (Vpe$ReturnGrb# = 1) Begin // User pressed cancel
102623>>>>>>>>>>> Send vpe_CloseDoc
102624>>>>>>>>>>> End
102624>>>>>>>>>>>>
102624>>>>>>>>>>> Else Begin
102625>>>>>>>>>>> Send SetMargins (pLeftMargin(Self)) (pRightMargin(Self)) (pTopMargin(Self)) (pBottomMargin(Self))
102626>>>>>>>>>>> Send vpe_SelectFont (pFont(Self)) (pFontSize(Self))
102627>>>>>>>>>>> Set pBold to False
102628>>>>>>>>>>> Set pUnderLine to False
102629>>>>>>>>>>> Set pItalics to False
102630>>>>>>>>>>> Set pNewPageOnNextLine to 0
102631>>>>>>>>>>> End
102631>>>>>>>>>>>>
102631>>>>>>>>>>> End_Procedure
102632>>>>>>>>>>> Procedure vpe_CloseDoc
102634>>>>>>>>>>> DWord lhDoc
102634>>>>>>>>>>> Get phDoc to lhDoc
102635>>>>>>>>>>> Move (VpeCloseDoc(lhDoc)) to Vpe$ReturnGrb#
102636>>>>>>>>>>> End_Procedure
102637>>>>>>>>>>> Procedure vpe_PreviewDoc
102639>>>>>>>>>>> DWord lhDoc
102639>>>>>>>>>>> String bypass#
102639>>>>>>>>>>> Get phDoc to lhDoc
102640>>>>>>>>>>> Move (VpeSetPaperView(lhDoc,1)) to Vpe$ReturnGrb# // Display paper size
102641>>>>>>>>>>> Move (VpePreviewDoc(lhDoc, VPE_NULL, VPE_SHOW_MAXIMIZED)) to Vpe$ReturnGrb#
102642>>>>>>>>>>> End_Procedure
102643>>>>>>>>>>> Procedure PreviewDoc
102645>>>>>>>>>>> DWord lhDoc
102645>>>>>>>>>>> Get phDoc to lhDoc
102646>>>>>>>>>>> //JK (2000.04.11): VpeGotoPage replaced with VpeGotoVisualPage
102646>>>>>>>>>>> //Move (VpeGotoPage(lhDoc,1)) to Vpe$ReturnGrb#
102646>>>>>>>>>>> Move (VpeGotoVisualPage(lhDoc,1)) to Vpe$ReturnGrb#
102647>>>>>>>>>>> Send vpe_PreviewDoc
102648>>>>>>>>>>> End_Procedure
102649>>>>>>>>>>> //JK (2000.04.11): Updates an open preview when the document has changed
102649>>>>>>>>>>> // Warning: if the user closes the preview, the document will also be closed,
102649>>>>>>>>>>> // and DispatchAllMessages will then return true.
102649>>>>>>>>>>> // At that point you immediately have to end all printing activites or
102649>>>>>>>>>>> // the program will crash!!!
102649>>>>>>>>>>> Function DispatchAllMessages Returns Integer
102651>>>>>>>>>>> DWord lhDoc
102651>>>>>>>>>>> Integer bClosed
102651>>>>>>>>>>> Get phDoc to lhDoc
102652>>>>>>>>>>> Move (VpeDispatchAllMessages(lhDoc)) to bClosed
102653>>>>>>>>>>> Function_Return bClosed
102654>>>>>>>>>>> End_Function
102655>>>>>>>>>>> Procedure vpe_PrintDoc
102657>>>>>>>>>>> DWord lhDoc
102657>>>>>>>>>>> Get phDoc to lhDoc
102658>>>>>>>>>>> Move (VpePrintDoc(lhDoc, VPE_FALSE)) to Vpe$ReturnGrb#
102659>>>>>>>>>>> End_Procedure
102660>>>>>>>>>>> Procedure PrintDoc
102662>>>>>>>>>>> DWord lhDoc
102662>>>>>>>>>>> Get phDoc to lhDoc
102663>>>>>>>>>>> Move (VpePrintDoc(lhDoc, VPE_FALSE)) to Vpe$ReturnGrb#
102664>>>>>>>>>>> End_Procedure
102665>>>>>>>>>>> Procedure vpe_SetupPrinter string file# integer mode#
102667>>>>>>>>>>> DWord lhDoc
102667>>>>>>>>>>> Get phDoc to lhDoc
102668>>>>>>>>>>> Move (VpeSetupPrinter(lhDoc,file#,mode#)) to Vpe$ReturnGrb#
102669>>>>>>>>>>> End_Procedure
102670>>>>>>>>>>> //JK: Writes current document to specified file
102670>>>>>>>>>>> Procedure vpe_WriteDoc String file#
102672>>>>>>>>>>> DWord lhDoc
102672>>>>>>>>>>> Get phDoc to lhDoc
102673>>>>>>>>>>> Move (VpeWriteDoc(lhDoc,file#)) to Vpe$ReturnGrb#
102674>>>>>>>>>>> End_Procedure
102675>>>>>>>>>>> //JK: Reads specified file into current document
102675>>>>>>>>>>> Procedure vpe_ReadDoc String file#
102677>>>>>>>>>>> DWord lhDoc
102677>>>>>>>>>>> Get phDoc to lhDoc
102678>>>>>>>>>>> Move (VpeReadDoc(lhDoc,file#)) to Vpe$ReturnGrb#
102679>>>>>>>>>>> End_Procedure
102680>>>>>>>>>>> Function iTextHeight.is integer width# string str# returns integer
102682>>>>>>>>>>> DWord lhDoc
102682>>>>>>>>>>> Integer rval#
102682>>>>>>>>>>> Get phDoc to lhDoc
102683>>>>>>>>>>> Get VPE_OemToChar str# to str#
102684>>>>>>>>>>> Move (VpeRenderWrite(lhDoc,100,100,(100+width#),VFREE,str#)) to Vpe$ReturnGrb#
102685>>>>>>>>>>> // Vpe$ReturnGrb# now contains info on whether autobreak occured
102685>>>>>>>>>>> Move (VpeGet(lhDoc,VRENDERHEIGHT)) to rval#
102686>>>>>>>>>>> Function_Return rval#
102687>>>>>>>>>>> End_Function
102688>>>>>>>>>>> Procedure Vpe_SetDevOrientation integer orient#
102690>>>>>>>>>>> DWord lhDoc
102690>>>>>>>>>>> Get phDoc to lhDoc
102691>>>>>>>>>>> Move (VpeSetDevOrientation(lhDoc,orient#)) to Vpe$ReturnGrb#
102692>>>>>>>>>>> End_Procedure
102693>>>>>>>>>>> Function Vpe_GetDevOrientation returns integer
102695>>>>>>>>>>> DWord lhDoc
102695>>>>>>>>>>> Get phDoc to lhDoc
102696>>>>>>>>>>> Function_Return (VpeGetDevOrientation(lhDoc))
102697>>>>>>>>>>> End_Function
102698>>>>>>>>>>> Procedure Vpe_SetPageOrientation integer orient#
102700>>>>>>>>>>> DWord lhDoc
102700>>>>>>>>>>> Get phDoc to lhDoc
102701>>>>>>>>>>> Move (VpeSetPageOrientation(lhDoc,orient#)) to Vpe$ReturnGrb#
102702>>>>>>>>>>> End_Procedure
102703>>>>>>>>>>> Function Vpe_GetPageOrientation returns integer
102705>>>>>>>>>>> DWord lhDoc
102705>>>>>>>>>>> Get phDoc to lhDoc
102706>>>>>>>>>>> Function_Return (VpeGetPageOrientation(lhDoc))
102707>>>>>>>>>>> End_Function
102708>>>>>>>>>>> Procedure SetupPrinter string tmpSetupFile#
102710>>>>>>>>>>> DWord lhDoc
102710>>>>>>>>>>> String SetupFile#
102710>>>>>>>>>>> If num_arguments gt 0 Move tmpSetupFile# to SetupFile#
102713>>>>>>>>>>> Else Get sDefaultSetupFileName to SetupFile#
102715>>>>>>>>>>> If SetupFile# eq "" Get sDefaultSetupFileName to SetupFile#
102718>>>>>>>>>>> send OpenDoc
102719>>>>>>>>>>> Get phDoc to lhDoc
102720>>>>>>>>>>> Move (VpeSetupPrinter(lhDoc,SetupFile#,PRINTDLG_ALWAYS)) to Vpe$ReturnGrb#
102721>>>>>>>>>>> Send vpe_CloseDoc
102722>>>>>>>>>>> End_Procedure
102723>>>>>>>>>>> // The procedures Write and WriteLn simulates the good old way of
102723>>>>>>>>>>> // outputting to the printer.
102723>>>>>>>>>>> Function AttributeString Returns String
102725>>>>>>>>>>> Function_Return ("["+If(pBold(Self),"B ","BO ")+If(pUnderLine(Self),"U ","UO ")+If(pItalics(Self),"I ","IO ")+"]")
102726>>>>>>>>>>> End_Function
102727>>>>>>>>>>> Function AttributeString.iii integer lbBold integer lbItalics integer lbUnderline returns string
102729>>>>>>>>>>> Function_Return ("["+If(lbBold,"B ","BO ")+If(lbUnderline,"U ","UO ")+If(lbItalics,"I","IO")+"]")
102730>>>>>>>>>>> End_Function
102731>>>>>>>>>>>
102731>>>>>>>>>>> // When something has been printed that is known to be one line, this
102731>>>>>>>>>>> // function will tell you how many more lines may printed on the current
102731>>>>>>>>>>> // page. In general the function will tell you how many more of the
102731>>>>>>>>>>> // previous objects may be printed on the current page.
102731>>>>>>>>>>> Function RemainingLines Returns integer
102733>>>>>>>>>>> Integer wy1 wy2 wy3
102733>>>>>>>>>>> DWord lhDoc
102733>>>>>>>>>>> Get phDoc to lhDoc
102734>>>>>>>>>>> Move (VpeGet(lhDoc,VTOP)) to wy1
102735>>>>>>>>>>> Move (VpeGet(lhDoc,VBOTTOM)) to wy2
102736>>>>>>>>>>> Move (VpeGet(lhDoc,VBOTTOMMARGIN)) to wy3
102737>>>>>>>>>>> If (wy1=wy2) Function_Return 999 // No lines have been written yet
102740>>>>>>>>>>> Function_Return (wy3-wy2/Number(wy2-wy1))
102741>>>>>>>>>>> End_Function
102742>>>>>>>>>>> Function LinesPerPage Returns integer
102744>>>>>>>>>>> Integer wy1 wy2 wy3 wy4
102744>>>>>>>>>>> DWord lhDoc
102744>>>>>>>>>>> Get phDoc to lhDoc
102745>>>>>>>>>>> Move (VpeGet(lhDoc,VTOP)) to wy1
102746>>>>>>>>>>> Move (VpeGet(lhDoc,VBOTTOM)) to wy2
102747>>>>>>>>>>> Move (VpeGet(lhDoc,VBOTTOMMARGIN)) to wy3
102748>>>>>>>>>>> Move (VpeGet(lhDoc,VTOPMARGIN)) to wy4
102749>>>>>>>>>>> If (wy1=wy2) Function_Return 999 // No lines have been written yet
102752>>>>>>>>>>> Function_Return (wy3-wy4/Number(wy2-wy1)-1)
102753>>>>>>>>>>> End_Function
102754>>>>>>>>>>> Function CheckPage Integer Lins# Returns Integer
102756>>>>>>>>>>> Function_Return (Lins#>RemainingLines(Self))
102757>>>>>>>>>>> End_Function
102758>>>>>>>>>>> Procedure vpe_PageBreak
102760>>>>>>>>>>> DWord lhDoc
102760>>>>>>>>>>> Get phDoc to lhDoc
102761>>>>>>>>>>> Move (VpePageBreak(lhDoc)) to Vpe$ReturnGrb#
102762>>>>>>>>>>> End_Procedure
102763>>>>>>>>>>> Procedure NewPage
102765>>>>>>>>>>> DWord lhDoc
102765>>>>>>>>>>> Get phDoc to lhDoc
102766>>>>>>>>>>> Move (VpePageBreak(lhDoc)) to Vpe$ReturnGrb#
102767>>>>>>>>>>> Send ExportCurMargins
102768>>>>>>>>>>> Set pNewPageOnNextLine to 0
102769>>>>>>>>>>> End_Procedure
102770>>>>>>>>>>> Procedure Write string str#
102772>>>>>>>>>>> DWord lhDoc
102772>>>>>>>>>>> Get phDoc to lhDoc
102773>>>>>>>>>>> Get VPE_OemToChar str# to str#
102774>>>>>>>>>>> If (pNewPageOnNextLine(Self)=2) Send NewPage
102777>>>>>>>>>>> If (CheckPage(Self,1)) Set pNewPageOnNextLine to 1
102780>>>>>>>>>>> If (VpeGet(lhDoc,VBOTTOM)=VpeGet(lhDoc,VTOP)) ; Move (VpePrint(lhDoc,pCurLeftMargin(Self),pCurTopMargin(Self),AttributeString(Self)+str#)) to Vpe$ReturnGrb#
102783>>>>>>>>>>> //JK: hmm... shouldn't it be VpeGet(VRIGHT) and VpeGet(VTOP) ?!?
102783>>>>>>>>>>> Else Move (VpePrint(lhDoc,VRIGHT,VTOP,AttributeString(Self)+str#)) to Vpe$ReturnGrb#
102785>>>>>>>>>>> End_Procedure
102786>>>>>>>>>>> Procedure WriteLn string str#
102788>>>>>>>>>>> DWord lhDoc
102788>>>>>>>>>>> Integer VTOP# VBOTTOM#
102788>>>>>>>>>>> Get phDoc to lhDoc
102789>>>>>>>>>>> Send Write str#
102790>>>>>>>>>>> Move (VpeGet(lhDoc,VTOP)) to VTOP#
102791>>>>>>>>>>> Move (VpeGet(lhDoc,VBOTTOM)) to VBOTTOM#
102792>>>>>>>>>>> Move (VpeSet(lhDoc,VTOP,VTOP#+VBOTTOM#-VTOP#)) to Vpe$ReturnGrb#
102793>>>>>>>>>>> // These two lines are not equivalent ???
102793>>>>>>>>>>> //Move (VpeSet(lhDoc,VTOP, VBOTTOM# )) To Vpe$ReturnGrb#
102793>>>>>>>>>>> Move (VpeSet(lhDoc,VBOTTOM,VBOTTOM#+VBOTTOM#-VTOP#)) to Vpe$ReturnGrb#
102794>>>>>>>>>>> Move (VpeSet(lhDoc,VRIGHT,pCurLeftMargin(Self))) to Vpe$ReturnGrb#
102795>>>>>>>>>>> If (pNewPageOnNextLine(Self)=1) Set pNewPageOnNextLine to 2
102798>>>>>>>>>>> End_Procedure
102799>>>>>>>>>>> Procedure vpe_Write integer x1# integer y1# integer x2# integer y2# string str#
102801>>>>>>>>>>> Integer lhDoc
102801>>>>>>>>>>> Move str# to str#
102802>>>>>>>>>>> If (str#<>"") Begin
102804>>>>>>>>>>> //showln x1# ":" y1# ":" x2# ":" y2# ":" str#
102804>>>>>>>>>>> Get phDoc to lhDoc
102805>>>>>>>>>>> Get VPE_OemToChar str# to str#
102806>>>>>>>>>>> Move (VpeWrite(lhDoc,x1#,y1#,x2#,y2#,str#)) to Vpe$ReturnGrb#
102807>>>>>>>>>>> End
102807>>>>>>>>>>>>
102807>>>>>>>>>>> End_Procedure
102808>>>>>>>>>>> Procedure vpe_WriteRTF integer x1# integer y1# integer x2# integer y2# string str#
102810>>>>>>>>>>> DWord lhDoc
102810>>>>>>>>>>> Get phDoc to lhDoc
102811>>>>>>>>>>> //Get VPE_OemToChar str# To str#
102811>>>>>>>>>>> Move (VpeWriteRTF(lhDoc,x1#,y1#,x2#,y2#,str#)) to Vpe$ReturnGrb#
102812>>>>>>>>>>> End_Procedure
102813>>>>>>>>>>> Procedure GenericWrite integer x1# integer y1# integer x2# integer y2# string str#
102815>>>>>>>>>>> Showln "GenericWrite should be vpe_Write"
102817>>>>>>>>>>> End_Procedure
102818>>>>>>>>>>> Procedure vpe_Line integer x1# integer y1# integer x2# integer y2#
102820>>>>>>>>>>> DWord lhDoc
102820>>>>>>>>>>> Get phDoc to lhDoc
102821>>>>>>>>>>> Move (VpeLine(lhDoc,x1#,y1#,x2#,y2#)) to Vpe$ReturnGrb#
102822>>>>>>>>>>> End_Procedure
102823>>>>>>>>>>> Procedure vpe_HorizontalLineKeepPos Integer tmpleft# Integer tmpright#
102825>>>>>>>>>>> Integer left# right#
102825>>>>>>>>>>> DWord lhDoc
102825>>>>>>>>>>> If num_arguments gt 0 Move tmpleft# to left#
102828>>>>>>>>>>> Else Move VLEFTMARGIN to left#
102830>>>>>>>>>>> If num_arguments gt 1 Move tmpright# to right#
102833>>>>>>>>>>> Else Move VRIGHTMARGIN to right#
102835>>>>>>>>>>> Get phDoc to lhDoc
102836>>>>>>>>>>> Move (VpeStorePos(lhDoc)) to Vpe$ReturnGrb#
102837>>>>>>>>>>> Send vpe_Line left# VBOTTOM right# VBOTTOM
102838>>>>>>>>>>> Move (VpeRestorePos(lhDoc)) to Vpe$ReturnGrb#
102839>>>>>>>>>>> End_Procedure
102840>>>>>>>>>>> Procedure WriteLine integer tmpleft# integer tmpright#
102842>>>>>>>>>>> Integer left# right#
102842>>>>>>>>>>> DWord lhDoc
102842>>>>>>>>>>> If num_arguments gt 0 Move tmpleft# to left#
102845>>>>>>>>>>> Else Move VLEFTMARGIN to left#
102847>>>>>>>>>>> If num_arguments gt 1 Move tmpright# to right#
102850>>>>>>>>>>> Else Move VRIGHTMARGIN to right#
102852>>>>>>>>>>> Get phDoc to lhDoc
102853>>>>>>>>>>> Move (VpeStorePos(lhDoc)) to Vpe$ReturnGrb#
102854>>>>>>>>>>> Send vpe_Line left# VTOP right# VTOP
102855>>>>>>>>>>> Move (VpeRestorePos(lhDoc)) to Vpe$ReturnGrb#
102856>>>>>>>>>>> End_Procedure
102857>>>>>>>>>>> Procedure vpe_Box integer x1# integer y1# integer x2# integer y2#
102859>>>>>>>>>>> DWord lhDoc
102859>>>>>>>>>>> If (x1# > x2#) Begin // Coordinates MUST be upper left, lower right.
102861>>>>>>>>>>> Move x1# to lhDoc // Otherwise errors in pre-viewer.
102862>>>>>>>>>>> Move x2# to x1#
102863>>>>>>>>>>> Move lhDoc to x2#
102864>>>>>>>>>>> End
102864>>>>>>>>>>>>
102864>>>>>>>>>>> If (y1# > y2#) Begin
102866>>>>>>>>>>> Move y1# to lhDoc
102867>>>>>>>>>>> Move y2# to y1#
102868>>>>>>>>>>> Move lhDoc to y2#
102869>>>>>>>>>>> End
102869>>>>>>>>>>>>
102869>>>>>>>>>>> Get phDoc to lhDoc
102870>>>>>>>>>>> Move (VpeBox(lhDoc,x1#,y1#,x2#,y2#)) to Vpe$ReturnGrb#
102871>>>>>>>>>>> End_Procedure
102872>>>>>>>>>>> Procedure vpe_Ellipse Integer x1# Integer y1# Integer x2# Integer y2#
102874>>>>>>>>>>> DWord lhDoc
102874>>>>>>>>>>> Get phDoc to lhDoc
102875>>>>>>>>>>> Move (VpeEllipse(lhDoc,x1#,y1#,x2#,y2#)) to Vpe$ReturnGrb#
102876>>>>>>>>>>> End_Procedure
102877>>>>>>>>>>> Procedure vpe_SetTransparentMode Integer onoff#
102879>>>>>>>>>>> DWord lhDoc
102879>>>>>>>>>>> Get phDoc to lhDoc
102880>>>>>>>>>>> Move (VpeSetTransparentMode(lhDoc,onoff#)) to Vpe$ReturnGrb#
102881>>>>>>>>>>> End_Procedure
102882>>>>>>>>>>> Procedure vpe_SetBkgColor Integer color#
102884>>>>>>>>>>> DWord lhDoc
102884>>>>>>>>>>> Get phDoc to lhDoc
102885>>>>>>>>>>> Move (VpeSetBkgColor(lhDoc,color#)) to Vpe$ReturnGrb#
102886>>>>>>>>>>> End_Procedure
102887>>>>>>>>>>> Procedure vpe_SetHatchStyle Integer hatch#
102889>>>>>>>>>>> DWord lhDoc
102889>>>>>>>>>>> Get phDoc to lhDoc
102890>>>>>>>>>>> Move (VpeSetHatchStyle(lhDoc,hatch#)) to Vpe$ReturnGrb#
102891>>>>>>>>>>> End_Procedure
102892>>>>>>>>>>> Procedure vpe_SetHatchColor Integer color#
102894>>>>>>>>>>> DWord lhDoc
102894>>>>>>>>>>> Get phDoc to lhDoc
102895>>>>>>>>>>> Move (VpeSetHatchColor(lhDoc,color#)) to Vpe$ReturnGrb#
102896>>>>>>>>>>> End_Procedure
102897>>>>>>>>>>> Procedure vpe_Print_Print integer x1# integer y1# string str#
102899>>>>>>>>>>> DWord lhDoc
102899>>>>>>>>>>> Get phDoc to lhDoc
102900>>>>>>>>>>> Get VPE_OemToChar str# to str#
102901>>>>>>>>>>> Move (VpePrint(lhDoc,x1#,y1#,str#)) to Vpe$ReturnGrb#
102902>>>>>>>>>>> End_Procedure
102903>>>>>>>>>>> Procedure vpe_PrintBox integer x1# integer y1# string str#
102905>>>>>>>>>>> DWord lhDoc
102905>>>>>>>>>>> Get phDoc to lhDoc
102906>>>>>>>>>>> Get VPE_OemToChar str# to str#
102907>>>>>>>>>>> Move (VpePrintBox(lhDoc,x1#,y1#,str#)) to Vpe$ReturnGrb#
102908>>>>>>>>>>> End_Procedure
102909>>>>>>>>>>> Procedure vpe_WriteBox Integer x1# Integer y1# Integer x2# Integer y2# String str#
102911>>>>>>>>>>> DWord lhDoc
102911>>>>>>>>>>> Get phDoc to lhDoc
102912>>>>>>>>>>> Get VPE_OemToChar str# to str#
102913>>>>>>>>>>> Move (VpeWriteBox(lhDoc,x1#,y1#,x2#,y2#,str#)) to Vpe$ReturnGrb#
102914>>>>>>>>>>> End_Procedure
102915>>>>>>>>>>> Procedure Vpe_Polygon integer arrayhandle# integer length#
102917>>>>>>>>>>> DWord lhDoc
102917>>>>>>>>>>> Get phDoc to lhDoc
102918>>>>>>>>>>> Move (VpePolygon(lhDoc,arrayhandle#,length#)) to Vpe$ReturnGrb#
102919>>>>>>>>>>> End_Procedure
102920>>>>>>>>>>> Procedure Vpe_Polyline Integer arrayhandle# Integer length#
102922>>>>>>>>>>> DWord lhDoc
102922>>>>>>>>>>> Get phDoc to lhDoc
102923>>>>>>>>>>> Move (VpePolyline(lhDoc,arrayhandle#,length#)) to Vpe$ReturnGrb#
102924>>>>>>>>>>> End_Procedure
102925>>>>>>>>>>> //External_Function32 VpePolyLine "VpePolyLine" Dword lhDoc Dword array# integer size# returns dword#
102925>>>>>>>>>>>//// long EXPO VpePolygon(long hDoc, POINT *pt, unsigned int size);
102925>>>>>>>>>>>//External_Function32 VpePolyLine "VpePolyLine" Dword lhDoc Dword array# integer size# returns dword#
102925>>>>>>>>>>> Procedure vpe_SetAlign integer attr#
102927>>>>>>>>>>> DWord lhDoc
102927>>>>>>>>>>> Get phDoc to lhDoc
102928>>>>>>>>>>> Move (VpeSetAlign(lhDoc,attr#)) to Vpe$ReturnGrb#
102929>>>>>>>>>>> End_Procedure
102930>>>>>>>>>>> Procedure vpe_SetPen Integer size# Integer style# Integer color#
102932>>>>>>>>>>> DWord lhDoc
102932>>>>>>>>>>> Get phDoc to lhDoc
102933>>>>>>>>>>> Move (VpeSetPen(lhDoc,size#,style#,color#)) to Vpe$ReturnGrb#
102934>>>>>>>>>>> End_Procedure
102935>>>>>>>>>>> Procedure vpe_Picture Integer x1# Integer y1# Integer x2# Integer y2# String bmpstr# Integer flags#
102937>>>>>>>>>>> DWord lhDoc
102937>>>>>>>>>>> String path#
102937>>>>>>>>>>> Get phDoc to lhDoc
102938>>>>>>>>>>> //JK - 2000.06.26:
102938>>>>>>>>>>> // Check if bitmap really exists
102938>>>>>>>>>>> // If it doesn't, don't try top print it.
102938>>>>>>>>>>> // If it does, convert to full path/filename.
102938>>>>>>>>>>> If (pos(sysconf(SYSCONF_DIR_SEPARATOR),bmpstr#) > 0) Begin
102940>>>>>>>>>>> // File has path already
102940>>>>>>>>>>> If (not(SEQ_FileExists(bmpstr#))) Procedure_Return
102943>>>>>>>>>>> End
102943>>>>>>>>>>>>
102943>>>>>>>>>>> Else Begin
102944>>>>>>>>>>> // File has no path, so we search along dfpath
102944>>>>>>>>>>> Move (SEQ_FindFileAlongDFPath(bmpstr#)) to path#
102945>>>>>>>>>>> If (path# = "") Procedure_Return
102948>>>>>>>>>>> Move (path# + sysconf(SYSCONF_DIR_SEPARATOR) + bmpstr#) to bmpstr#
102949>>>>>>>>>>> End
102949>>>>>>>>>>>>
102949>>>>>>>>>>> //JK - 2000.06.08:
102949>>>>>>>>>>> // Dirty hack to always save bitmaps in the generated document
102949>>>>>>>>>>> Move (flags# ior PIC_IN_FILE) to flags#
102950>>>>>>>>>>> Move (VpePicture(lhDoc,x1#,y1#,x2#,y2#,bmpstr#,flags#)) to Vpe$ReturnGrb#
102951>>>>>>>>>>> End_Procedure
102952>>>>>>>>>>> Procedure vpe_PictureKeepPos Integer x1# Integer y1# Integer x2# Integer y2# String bmpstr# Integer flags#
102954>>>>>>>>>>> DWord lhDoc
102954>>>>>>>>>>> Get phDoc to lhDoc
102955>>>>>>>>>>> Move (VpeStorePos(lhDoc)) to Vpe$ReturnGrb#
102956>>>>>>>>>>> Send vpe_Picture x1# y1# x2# y2# bmpstr# flags#
102957>>>>>>>>>>> Move (VpeRestorePos(lhDoc)) to Vpe$ReturnGrb#
102958>>>>>>>>>>> End_Procedure
102959>>>>>>>>>>> Procedure vpe_StorePos
102961>>>>>>>>>>> DWord lhDoc
102961>>>>>>>>>>> Get phDoc to lhDoc
102962>>>>>>>>>>> Move (VpeStorePos(lhDoc)) to Vpe$ReturnGrb#
102963>>>>>>>>>>> End_Procedure
102964>>>>>>>>>>> Procedure vpe_RestorePos
102966>>>>>>>>>>> DWord lhDoc
102966>>>>>>>>>>> Get phDoc to lhDoc
102967>>>>>>>>>>> Move (VpeRestorePos(lhDoc)) to Vpe$ReturnGrb#
102968>>>>>>>>>>> End_Procedure
102969>>>>>>>>>>> Procedure vpe_DefineHeader Integer x1# Integer y1# Integer x2# Integer y2# String text#
102971>>>>>>>>>>> DWord lhDoc
102971>>>>>>>>>>> Get phDoc to lhDoc
102972>>>>>>>>>>> Move (VpeDefineHeader(lhDoc,x1#,y1#,x2#,y2#,text#)) to Vpe$ReturnGrb#
102973>>>>>>>>>>> End_Procedure
102974>>>>>>>>>>> Procedure vpe_DefineFooter Integer x1# Integer y1# Integer x2# Integer y2# String text#
102976>>>>>>>>>>> DWord lhDoc
102976>>>>>>>>>>> Get phDoc to lhDoc
102977>>>>>>>>>>> Move (VpeDefineFooter(lhDoc,x1#,y1#,x2#,y2#,text#)) to Vpe$ReturnGrb#
102978>>>>>>>>>>> End_Procedure
102979>>>>>>>>>>> Procedure vpe_SetTextColor DWord color#
102981>>>>>>>>>>> DWord lhDoc
102981>>>>>>>>>>> Get phDoc to lhDoc
102982>>>>>>>>>>> Move (VpeSetTextColor(lhDoc,color#)) to Vpe$ReturnGrb#
102983>>>>>>>>>>> End_Procedure
102984>>>>>>>>>>> Procedure vpe_SetDefOutRectSP Integer left# Integer top# Integer right# Integer bottom#
102986>>>>>>>>>>> DWord lhDoc
102986>>>>>>>>>>> Get phDoc to lhDoc
102987>>>>>>>>>>> Move (VpeSetDefOutRectSP(lhDoc,left#,top#,right#,bottom#)) to Vpe$ReturnGrb#
102988>>>>>>>>>>> End_Procedure
102989>>>>>>>>>>> Function vpe_GetCurrentPage Returns Integer
102991>>>>>>>>>>> DWord lhDoc
102991>>>>>>>>>>> Get phDoc to lhDoc
102992>>>>>>>>>>> Function_Return (VpeGetCurrentPage(lhDoc))
102993>>>>>>>>>>> End_Function
102994>>>>>>>>>>> Function vpe_GetPageCount returns integer
102996>>>>>>>>>>> DWord lhDoc
102996>>>>>>>>>>> Get phDoc to lhDoc
102997>>>>>>>>>>> Function_Return (VpeGetPageCount(lhDoc))
102998>>>>>>>>>>> End_Function
102999>>>>>>>>>>> Procedure vpe_GotoPage integer page#
103001>>>>>>>>>>> DWord lhDoc
103001>>>>>>>>>>> Get phDoc to lhDoc
103002>>>>>>>>>>> Move (VpeGotoPage(lhDoc,page#)) to Vpe$ReturnGrb#
103003>>>>>>>>>>> End_Procedure
103004>>>>>>>>>>> Procedure vpe_Addbookmark Integer parent# String title#
103006>>>>>>>>>>> DWord lhDoc
103006>>>>>>>>>>> Get phDoc to lhDoc
103007>>>>>>>>>>>// Move (VpeAddBookmark(lhDoc,parent#,title#)) to Vpe$ReturnGrb#
103007>>>>>>>>>>> End_Procedure
103008>>>>>>>>>>> Function Vpe_DevEnumPaperBins Returns Integer
103010>>>>>>>>>>> DWord hDoc#
103010>>>>>>>>>>> Integer iVal
103010>>>>>>>>>>> Get phDoc to hDoc#
103011>>>>>>>>>>> Move (vpeDevEnumPaperBins(hDoc#)) to iVal
103012>>>>>>>>>>> Function_Return iVal
103013>>>>>>>>>>> End_Function
103014>>>>>>>>>>> Function Vpe_GetDevPaperBinName Integer iIndex Returns String
103016>>>>>>>>>>> DWord hDoc#
103016>>>>>>>>>>> Integer iVal p2BinName
103016>>>>>>>>>>> String sBinName
103016>>>>>>>>>>> ZeroString 65 to sBinName
103017>>>>>>>>>>> GetAddress of sBinName to p2BinName
103018>>>>>>>>>>> Get phDoc to hDoc#
103019>>>>>>>>>>> Move (vpeGetDevPaperBinName(hDoc#,iIndex,p2BinName,64)) to iVal
103020>>>>>>>>>>> Function_Return sBinName
103021>>>>>>>>>>> End_Function
103022>>>>>>>>>>>
103022>>>>>>>>>>> End_Class // cVPE
103023>>>>>>>>>>>
103023>>>>>>>>>>>Integer oVPE#
103023>>>>>>>>>>>
103023>>>>>>>>>>>Object oVPE is a cVPE
103025>>>>>>>>>>> Procedure display_previous_object
103028>>>>>>>>>>> Showln ("Left/Right/Top/Bottom:"+String(GetCoord(oVPE#,VLeft))*String(GetCoord(oVPE#,VRight))*String(GetCoord(oVPE#,VTop))*String(GetCoord(oVPE#,VBottom)))
103030>>>>>>>>>>> End_Procedure
103031>>>>>>>>>>> Procedure display_stuff
103034>>>>>>>>>>> Showln "****vpe_get*******************************************"
103036>>>>>>>>>>> Showln ("Text: Left/Right/Top/Bottom:"+String(GetCoord(oVPE#,VLeft))*String(GetCoord(oVPE#,VRight))*String(GetCoord(oVPE#,VTop))*String(GetCoord(oVPE#,VBottom)))
103038>>>>>>>>>>> Showln ("Marg: Left/Right/Top/Bottom:"+String(GetCoord(oVPE#,VLeftMargin))*String(GetCoord(oVPE#,VRightMargin))*String(GetCoord(oVPE#,VTopMargin))*String(GetCoord(oVPE#,VBottomMargin)))
103040>>>>>>>>>>> End_Procedure
103041>>>>>>>>>>> Move Self to oVPE#
103042>>>>>>>>>>>End_Object
103043>>>>>>>>>
103043>>>>>>>>>object oVpeReportHelper is a cArray
103045>>>>>>>>> property integer piCurrentY
103047>>>>>>>>> property integer priv.vpe.max_bottom 0
103049>>>>>>>>> property boolean priv.skip_page_top_area TRUE
103051>>>>>>>>> property integer priv.PageCount
103053>>>>>>>>>
103053>>>>>>>>> object oWrittenPagesArray is a cArray
103055>>>>>>>>> item_property_list // OBS! This array is 1-based
103055>>>>>>>>> item_property integer piPageNo.i
103055>>>>>>>>> item_property integer piPageColumn.i
103055>>>>>>>>> end_item_property_list
#REM 103092 DEFINE FUNCTION PIPAGECOLUMN.I INTEGER LIROW RETURNS INTEGER
#REM 103097 DEFINE PROCEDURE SET PIPAGECOLUMN.I INTEGER LIROW INTEGER VALUE
#REM 103102 DEFINE FUNCTION PIPAGENO.I INTEGER LIROW RETURNS INTEGER
#REM 103107 DEFINE PROCEDURE SET PIPAGENO.I INTEGER LIROW INTEGER VALUE
103113>>>>>>>>>
103113>>>>>>>>> procedure fill_out_page_numberings
103116>>>>>>>>> // This procedure fills out the array to reflect the current status of the docuemnt being written.
103116>>>>>>>>> integer iSheet
103116>>>>>>>>> integer iSheetOffset
103116>>>>>>>>> integer iTotalSheets // Number of sheets of paper currently printed
103116>>>>>>>>> integer iPageCount // Pages currently printed (one page may be more than one sheet)
103116>>>>>>>>> get row_count to iSheetOffset
103117>>>>>>>>> if (iSheetOffset=0) move 1 to iSheetOffset
103120>>>>>>>>> get vpe_GetPageCount of oVPE# to iTotalSheets
103121>>>>>>>>> get priv.PageCount to iPageCount
103122>>>>>>>>> for iSheet from iSheetOffset to iTotalSheets
103128>>>>>>>>>>
103128>>>>>>>>> set piPageNo.i iSheet to iPageCount
103129>>>>>>>>> set piPageColumn.i iSheet to (iSheet-iSheetOffset)
103130>>>>>>>>> loop
103131>>>>>>>>>>
103131>>>>>>>>> end_procedure
103132>>>>>>>>> end_object // oWrittenPagesArray
103133>>>>>>>>>
103133>>>>>>>>> procedure OnPageDone // oVpeReportHelper object
103136>>>>>>>>> set priv.PageCount to (priv.PageCount(self)+1)
103137>>>>>>>>> send fill_out_page_numberings of oWrittenPagesArray
103138>>>>>>>>> end_procedure
103139>>>>>>>>>
103139>>>>>>>>> procedure Callback_Sheets integer hMsg integer hObj
103142>>>>>>>>> integer hArr iMax iSheet iMaxPage
103142>>>>>>>>> move oWrittenPagesArray to hArr
103143>>>>>>>>>
103143>>>>>>>>> get priv.PageCount to iMaxPage
103144>>>>>>>>>
103144>>>>>>>>> get row_count of hArr to iMax
103145>>>>>>>>> decrement iMax
103146>>>>>>>>> for iSheet from 1 to iMax
103152>>>>>>>>>>
103152>>>>>>>>> //procedure HandleSheet integer iSheet integer iPage integer iPageColumn integer iMaxPage
103152>>>>>>>>> send hMsg of hObj iSheet (piPageNo.i(hArr,iSheet)) (piPageColumn.i(hArr,iSheet)) iMaxPage
103153>>>>>>>>> loop
103154>>>>>>>>>>
103154>>>>>>>>> end_procedure
103155>>>>>>>>>
103155>>>>>>>>> procedure OnNewReport
103158>>>>>>>>> set piCurrentY to 0
103159>>>>>>>>> set priv.vpe.max_bottom to 0
103160>>>>>>>>> set priv.PageCount to 0
103161>>>>>>>>> send delete_data of oWrittenPagesArray
103162>>>>>>>>> end_procedure
103163>>>>>>>>>
103163>>>>>>>>> procedure GoToSheetCurrentPlus integer iExtra
103166>>>>>>>>> integer iCurrentSheet iMaxSheet iSheet
103166>>>>>>>>>// showln "GoToSheetCurrentPlus " iExtra
103166>>>>>>>>> get row_count of oWrittenPagesArray to iCurrentSheet
103167>>>>>>>>> if (iCurrentSheet=0) move 1 to iCurrentSheet
103170>>>>>>>>> //increment iCurrentSheet // This is the number of the current root-page
103170>>>>>>>>>
103170>>>>>>>>> get vpe_GetPageCount of oVPE# to iMaxSheet // 3
103171>>>>>>>>> for iSheet from (iMaxSheet+1) to (iCurrentSheet+iExtra)
103177>>>>>>>>>>
103177>>>>>>>>> send vpe_PageBreak of oVPE#
103178>>>>>>>>>// showln "Create an extra page!"
103178>>>>>>>>> loop
103179>>>>>>>>>>
103179>>>>>>>>> send vpe_GotoPage to oVPE# (iCurrentSheet+iExtra)
103180>>>>>>>>> end_procedure
103181>>>>>>>>>
103181>>>>>>>>> function nLeftMargin returns number
103184>>>>>>>>> function_return (Vpe_Get(oVPE#,VLEFTMARGIN)/100.0)
103185>>>>>>>>> end_function
103186>>>>>>>>> function nRightMargin returns number
103189>>>>>>>>> function_return (Vpe_Get(oVPE#,VRIGHTMARGIN)/100.0)
103190>>>>>>>>> end_function
103191>>>>>>>>>
103191>>>>>>>>> procedure WriteLine
103194>>>>>>>>> send vpe_Line of oVPE# (Vpe_Get(oVPE#,VLEFTMARGIN)) (piCurrentY(self)) (Vpe_Get(oVPE#,VRIGHTMARGIN)) (piCurrentY(self))
103195>>>>>>>>> //set piCurrentY to (vpe_get(oVPE#,VBOTTOM))
103195>>>>>>>>> end_procedure
103196>>>>>>>>>
103196>>>>>>>>> procedure WritePos string lsValue number lnPos integer liFontAttr integer liDecs number lnWidth
103199>>>>>>>>> integer liFontAttrTmp liDecsTmp liX1 liX2 liY1 liY2
103199>>>>>>>>> number lnWidthTmp
103199>>>>>>>>> if (num_arguments<5) move 0 to lnWidthTmp
103202>>>>>>>>> else move (lnWidth*100) to lnWidthTmp
103204>>>>>>>>>
103204>>>>>>>>> if (num_arguments<4) move -1 to liDecsTmp
103207>>>>>>>>> else move liDecs to liDecsTmp
103209>>>>>>>>>
103209>>>>>>>>> if (liDecsTmp<>-1) get NumToStr lsValue liDecsTmp to lsValue
103212>>>>>>>>>
103212>>>>>>>>> if (num_arguments<3) move 0 to liFontAttrTmp
103215>>>>>>>>> else move liFontAttr to liFontAttrTmp
103217>>>>>>>>>
103217>>>>>>>>> if (liFontAttrTmp iand FONT_BOLD) move ("[B ]"+lsValue) to lsValue
103220>>>>>>>>> if (liFontAttrTmp iand FONT_ITALIC) move ("[I ]"+lsValue) to lsValue
103223>>>>>>>>>
103223>>>>>>>>> if (lnWidthTmp=0) begin
103225>>>>>>>>> if (liFontAttrTmp iand FONT_RIGHT) begin
103227>>>>>>>>> move (lnPos*100-vpe_get(oVPE#,VLEFTMARGIN)) to lnWidthTmp
103228>>>>>>>>> end
103228>>>>>>>>>>
103228>>>>>>>>> else begin
103229>>>>>>>>> move (vpe_get(oVPE#,VRIGHTMARGIN)-(lnPos*100)) to lnWidthTmp
103230>>>>>>>>> end
103230>>>>>>>>>>
103230>>>>>>>>> end
103230>>>>>>>>>>
103230>>>>>>>>>
103230>>>>>>>>> move (lnPos*100+vpe_get(oVPE#,VLEFTMARGIN)) to liX1
103231>>>>>>>>>
103231>>>>>>>>> // Figure out vertical position
103231>>>>>>>>> get piCurrentY to liY1
103232>>>>>>>>>
103232>>>>>>>>> //// If we are "under" the Default Output Rectangle, we take a new page
103232>>>>>>>>> //if ((liY1+100)>vpe_get(oVPE#,VBOTTOMMARGIN)) begin
103232>>>>>>>>> // send vpe_PageBreak of oVPE# // <<--------- PAGE BREAK
103232>>>>>>>>> // get vpe_get of oVPE# VTOPMARGIN) to liY1
103232>>>>>>>>> // set piCurrentY to liY1
103232>>>>>>>>> //end
103232>>>>>>>>>
103232>>>>>>>>> if (priv.skip_page_top_area(self)) begin
103234>>>>>>>>> // If we are "over" the Default Output Rectangle, we move down so we're in. If we are in XY-mode we do not make this adjustment (we could be writing the page top)
103234>>>>>>>>> if (liY1<vpe_get(oVPE#,VTOPMARGIN)) begin //
103236>>>>>>>>> get vpe_get of oVPE# VTOPMARGIN) to liY1
103237>>>>>>>>> set piCurrentY to liY1
103238>>>>>>>>> end
103238>>>>>>>>>>
103238>>>>>>>>> end
103238>>>>>>>>>>
103238>>>>>>>>>
103238>>>>>>>>> move VFREE to liY2
103239>>>>>>>>>
103239>>>>>>>>> move (trim(lsValue)) to lsValue))
103240>>>>>>>>> if (liFontAttrTmp iand FONT_RIGHT) begin
103242>>>>>>>>> send vpe_SetAlign of oVPE# ALIGN_RIGHT
103243>>>>>>>>> send vpe_Write of oVPE# (liX1-lnWidthTmp) liY1 liX1 liY2 lsValue
103244>>>>>>>>> send vpe_SetAlign of oVPE# ALIGN_LEFT
103245>>>>>>>>> end
103245>>>>>>>>>>
103245>>>>>>>>> else begin
103246>>>>>>>>> send vpe_Write of oVPE# liX1 liY1 (liX1+lnWidthTmp) liY2 lsValue
103247>>>>>>>>> end
103247>>>>>>>>>>
103247>>>>>>>>>
103247>>>>>>>>> if (liFontAttrTmp iand FONT_BOLD) begin
103249>>>>>>>>> send vpe_StorePos of oVPE#
103250>>>>>>>>> send vpe_Write of oVPE# VRIGHT liY1 VRIGHT liY2 "[BO ]"
103251>>>>>>>>> send vpe_RestorePos of oVPE#
103252>>>>>>>>> end
103252>>>>>>>>>>
103252>>>>>>>>> if (liFontAttrTmp iand FONT_ITALIC) begin
103254>>>>>>>>> send vpe_StorePos of oVPE#
103255>>>>>>>>> send vpe_Write of oVPE# VRIGHT liY1 VRIGHT liY2 "[IO ]"
103256>>>>>>>>> send vpe_RestorePos of oVPE#
103257>>>>>>>>> end
103257>>>>>>>>>>
103257>>>>>>>>>
103257>>>>>>>>> // x1=lnPos x2=piVpe_Current
103257>>>>>>>>> // y1
103257>>>>>>>>> // y2=VFREE
103257>>>>>>>>> if (vpe_get(oVPE#,VBOTTOM)>priv.vpe.max_bottom(self)) set priv.vpe.max_bottom to (vpe_get(oVPE#,VBOTTOM))
103260>>>>>>>>> end_procedure
103261>>>>>>>>>
103261>>>>>>>>> procedure WriteLnPos string lsValue number lnPos integer liFontAttr integer liDecs number lnWidth
103264>>>>>>>>> if (num_arguments=2) send WritePos lsValue lnPos
103267>>>>>>>>> if (num_arguments=3) send WritePos lsValue lnPos liFontAttr
103270>>>>>>>>> if (num_arguments=4) send WritePos lsValue lnPos liFontAttr liDecs
103273>>>>>>>>> if (num_arguments=5) send WritePos lsValue lnPos liFontAttr liDecs lnWidth
103276>>>>>>>>>
103276>>>>>>>>> if (priv.skip_page_top_area(self)) begin
103278>>>>>>>>> if (priv.vpe.max_bottom(self)<piCurrentY(self)) set piCurrentY to 0
103281>>>>>>>>> else set piCurrentY to (priv.vpe.max_bottom(self)) // Next available vertical position
103283>>>>>>>>> set priv.vpe.max_bottom to 0 //(piCurrentY(oVpeReportHelper))
103284>>>>>>>>> end
103284>>>>>>>>>>
103284>>>>>>>>> else begin
103285>>>>>>>>> set piCurrentY to (priv.vpe.max_bottom(self))
103286>>>>>>>>> set priv.vpe.max_bottom to 0 //(piCurrentY(oVpeReportHelper))
103287>>>>>>>>> end
103287>>>>>>>>>>
103287>>>>>>>>> end_procedure
103288>>>>>>>>>end_object // oVpeReportHelper
103289>>>>>>>>>
103289>>>>>>>>>
103289>>>>>>>>>class cWinPrint_ImageDefinition is a cArray
103290>>>>>>>>> procedure construct_object
103292>>>>>>>>> forward send construct_object
103294>>>>>>>>> property integer pbVpe_Mode public FALSE
103295>>>>>>>>> end_procedure
103296>>>>>>>>>
103296>>>>>>>>> item_property_list
103296>>>>>>>>> item_property integer pbDeactivate.i
103296>>>>>>>>> item_property string psColumnHeader.i
103296>>>>>>>>> item_property number pnPosition.i
103296>>>>>>>>> item_property integer piType.i
103296>>>>>>>>> item_property integer piDecimals.i
103296>>>>>>>>> item_property integer pbNewLine.i
103296>>>>>>>>> item_property integer pbTotals.i
103296>>>>>>>>> item_property string psValue.i
103296>>>>>>>>> item_property integer pbBold.i
103296>>>>>>>>>// item_property integer pbZeroSuppress.i
103296>>>>>>>>> item_property number pnSumTotal.i
103296>>>>>>>>> item_property number pnSumTotal2.i
103296>>>>>>>>> item_property number pnSumTotal3.i
103296>>>>>>>>> item_property number pnSumTotal4.i
103296>>>>>>>>> item_property number pnSumTotal5.i
103296>>>>>>>>> item_property integer pbForceRight.i
103296>>>>>>>>> item_property integer pbNewColumnPage.i
103296>>>>>>>>> end_item_property_list cWinPrint_ImageDefinition
#REM 103370 DEFINE FUNCTION PBNEWCOLUMNPAGE.I INTEGER LIROW RETURNS INTEGER
#REM 103374 DEFINE PROCEDURE SET PBNEWCOLUMNPAGE.I INTEGER LIROW INTEGER VALUE
#REM 103378 DEFINE FUNCTION PBFORCERIGHT.I INTEGER LIROW RETURNS INTEGER
#REM 103382 DEFINE PROCEDURE SET PBFORCERIGHT.I INTEGER LIROW INTEGER VALUE
#REM 103386 DEFINE FUNCTION PNSUMTOTAL5.I INTEGER LIROW RETURNS NUMBER
#REM 103390 DEFINE PROCEDURE SET PNSUMTOTAL5.I INTEGER LIROW NUMBER VALUE
#REM 103394 DEFINE FUNCTION PNSUMTOTAL4.I INTEGER LIROW RETURNS NUMBER
#REM 103398 DEFINE PROCEDURE SET PNSUMTOTAL4.I INTEGER LIROW NUMBER VALUE
#REM 103402 DEFINE FUNCTION PNSUMTOTAL3.I INTEGER LIROW RETURNS NUMBER
#REM 103406 DEFINE PROCEDURE SET PNSUMTOTAL3.I INTEGER LIROW NUMBER VALUE
#REM 103410 DEFINE FUNCTION PNSUMTOTAL2.I INTEGER LIROW RETURNS NUMBER
#REM 103414 DEFINE PROCEDURE SET PNSUMTOTAL2.I INTEGER LIROW NUMBER VALUE
#REM 103418 DEFINE FUNCTION PNSUMTOTAL.I INTEGER LIROW RETURNS NUMBER
#REM 103422 DEFINE PROCEDURE SET PNSUMTOTAL.I INTEGER LIROW NUMBER VALUE
#REM 103426 DEFINE FUNCTION PBBOLD.I INTEGER LIROW RETURNS INTEGER
#REM 103430 DEFINE PROCEDURE SET PBBOLD.I INTEGER LIROW INTEGER VALUE
#REM 103434 DEFINE FUNCTION PSVALUE.I INTEGER LIROW RETURNS STRING
#REM 103438 DEFINE PROCEDURE SET PSVALUE.I INTEGER LIROW STRING VALUE
#REM 103442 DEFINE FUNCTION PBTOTALS.I INTEGER LIROW RETURNS INTEGER
#REM 103446 DEFINE PROCEDURE SET PBTOTALS.I INTEGER LIROW INTEGER VALUE
#REM 103450 DEFINE FUNCTION PBNEWLINE.I INTEGER LIROW RETURNS INTEGER
#REM 103454 DEFINE PROCEDURE SET PBNEWLINE.I INTEGER LIROW INTEGER VALUE
#REM 103458 DEFINE FUNCTION PIDECIMALS.I INTEGER LIROW RETURNS INTEGER
#REM 103462 DEFINE PROCEDURE SET PIDECIMALS.I INTEGER LIROW INTEGER VALUE
#REM 103466 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 103470 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 103474 DEFINE FUNCTION PNPOSITION.I INTEGER LIROW RETURNS NUMBER
#REM 103478 DEFINE PROCEDURE SET PNPOSITION.I INTEGER LIROW NUMBER VALUE
#REM 103482 DEFINE FUNCTION PSCOLUMNHEADER.I INTEGER LIROW RETURNS STRING
#REM 103486 DEFINE PROCEDURE SET PSCOLUMNHEADER.I INTEGER LIROW STRING VALUE
#REM 103490 DEFINE FUNCTION PBDEACTIVATE.I INTEGER LIROW RETURNS INTEGER
#REM 103494 DEFINE PROCEDURE SET PBDEACTIVATE.I INTEGER LIROW INTEGER VALUE
103499>>>>>>>>>
103499>>>>>>>>> procedure WritePos string lsValue number lnPos integer liFontAttr integer liDecs number lnWidth
103501>>>>>>>>> integer liFontAttrTmp liDecsTmp liX1 liX2 liY1 liY2
103501>>>>>>>>> number lnWidthTmp
103501>>>>>>>>> if (pbVpe_Mode(self)) begin
103503>>>>>>>>> if (num_arguments=2) send WritePos of oVpeReportHelper lsValue lnPos
103506>>>>>>>>> if (num_arguments=3) send WritePos of oVpeReportHelper lsValue lnPos liFontAttr
103509>>>>>>>>> if (num_arguments=4) send WritePos of oVpeReportHelper lsValue lnPos liFontAttr liDecs
103512>>>>>>>>> if (num_arguments=5) send WritePos of oVpeReportHelper lsValue lnPos liFontAttr liDecs lnWidth
103515>>>>>>>>> end
103515>>>>>>>>>>
103515>>>>>>>>> else begin
103516>>>>>>>>> if (num_arguments=2) DFWritePos lsValue lnPos
103519>>>>>>>>> if (num_arguments=3) DFWritePos lsValue lnPos liFontAttr
103522>>>>>>>>> if (num_arguments=4) DFWritePos lsValue lnPos liFontAttr liDecs
103525>>>>>>>>> if (num_arguments=5) DFWritePos lsValue lnPos liFontAttr liDecs lnWidth
103528>>>>>>>>> end
103528>>>>>>>>>>
103528>>>>>>>>> end_procedure
103529>>>>>>>>>
103529>>>>>>>>> procedure WriteLnPos string lsValue number lnPos integer liFontAttr integer liDecs number lnWidth
103531>>>>>>>>> if (pbVpe_Mode(self)) begin
103533>>>>>>>>> if (num_arguments=2) send WriteLnPos of oVpeReportHelper lsValue lnPos
103536>>>>>>>>> if (num_arguments=3) send WriteLnPos of oVpeReportHelper lsValue lnPos liFontAttr
103539>>>>>>>>> if (num_arguments=4) send WriteLnPos of oVpeReportHelper lsValue lnPos liFontAttr liDecs
103542>>>>>>>>> if (num_arguments=5) send WriteLnPos of oVpeReportHelper lsValue lnPos liFontAttr liDecs lnWidth
103545>>>>>>>>> end
103545>>>>>>>>>>
103545>>>>>>>>> else begin
103546>>>>>>>>> if (num_arguments=2) DFWriteLnPos lsValue lnPos
103549>>>>>>>>> if (num_arguments=3) DFWriteLnPos lsValue lnPos liFontAttr
103552>>>>>>>>> if (num_arguments=4) DFWriteLnPos lsValue lnPos liFontAttr liDecs
103555>>>>>>>>> if (num_arguments=5) DFWriteLnPos lsValue lnPos liFontAttr liDecs lnWidth
103558>>>>>>>>> end
103558>>>>>>>>>>
103558>>>>>>>>>// showln ("efter: priv.vpe.max_bottom: "+string(priv.vpe.max_bottom(self))) " " ("piCurrentY: "+string(piCurrentY(oVpeReportHelper)))
103558>>>>>>>>> end_procedure
103559>>>>>>>>>
103559>>>>>>>>> procedure Reset_Totals integer liLevel
103561>>>>>>>>> integer liRow liMax
103561>>>>>>>>> get row_count to liMax
103562>>>>>>>>> decrement liMax
103563>>>>>>>>> for liRow from 0 to liMax
103569>>>>>>>>>>
103569>>>>>>>>> if NUM_ARGUMENTS eq 0 begin
103571>>>>>>>>> set pnSumTotal.i liRow to 0
103572>>>>>>>>> set pnSumTotal2.i liRow to 0
103573>>>>>>>>> set pnSumTotal3.i liRow to 0
103574>>>>>>>>> set pnSumTotal4.i liRow to 0
103575>>>>>>>>> set pnSumTotal5.i liRow to 0
103576>>>>>>>>> end
103576>>>>>>>>>>
103576>>>>>>>>> else begin
103577>>>>>>>>> if (liLevel=1) begin
103579>>>>>>>>> set pnSumTotal2.i liRow to (pnSumTotal2.i(self,liRow)+pnSumTotal.i(self,liRow))
103580>>>>>>>>> set pnSumTotal.i liRow to 0
103581>>>>>>>>> end
103581>>>>>>>>>>
103581>>>>>>>>> if (liLevel=2) begin
103583>>>>>>>>> set pnSumTotal3.i liRow to (pnSumTotal3.i(self,liRow)+pnSumTotal2.i(self,liRow))
103584>>>>>>>>> set pnSumTotal2.i liRow to 0
103585>>>>>>>>> end
103585>>>>>>>>>>
103585>>>>>>>>> if (liLevel=3) begin
103587>>>>>>>>> set pnSumTotal4.i liRow to (pnSumTotal4.i(self,liRow)+pnSumTotal3.i(self,liRow))
103588>>>>>>>>> set pnSumTotal3.i liRow to 0
103589>>>>>>>>> end
103589>>>>>>>>>>
103589>>>>>>>>> if (liLevel=4) begin
103591>>>>>>>>> set pnSumTotal5.i liRow to (pnSumTotal5.i(self,liRow)+pnSumTotal4.i(self,liRow))
103592>>>>>>>>> set pnSumTotal4.i liRow to 0
103593>>>>>>>>> end
103593>>>>>>>>>>
103593>>>>>>>>> if (liLevel=5) begin
103595>>>>>>>>> set pnSumTotal5.i liRow to 0
103596>>>>>>>>> end
103596>>>>>>>>>>
103596>>>>>>>>> end
103596>>>>>>>>>>
103596>>>>>>>>> loop
103597>>>>>>>>>>
103597>>>>>>>>> end_procedure
103598>>>>>>>>>
103598>>>>>>>>> procedure Output_Total integer liLevelTmp
103600>>>>>>>>> integer liRow liMax liType liDecimals lbNewLine lbTotals liLevel
103600>>>>>>>>> boolean lbForceRight
103600>>>>>>>>> number lnPosition
103600>>>>>>>>> string lsValue
103600>>>>>>>>> if NUM_ARGUMENTS eq 0 move 1 to liLevel
103603>>>>>>>>> else move liLevelTmp to liLevel
103605>>>>>>>>> get row_count to liMax
103606>>>>>>>>> decrement liMax
103607>>>>>>>>> for liRow from 0 to liMax
103613>>>>>>>>>>
103613>>>>>>>>> if (liLevel=1) get pnSumTotal.i liRow to lsValue
103616>>>>>>>>> if (liLevel=2) get pnSumTotal2.i liRow to lsValue
103619>>>>>>>>> if (liLevel=3) get pnSumTotal3.i liRow to lsValue
103622>>>>>>>>> if (liLevel=4) get pnSumTotal4.i liRow to lsValue
103625>>>>>>>>> if (liLevel=5) get pnSumTotal5.i liRow to lsValue
103628>>>>>>>>> get pnPosition.i liRow to lnPosition
103629>>>>>>>>> get piType.i liRow to liType
103630>>>>>>>>> get piDecimals.i liRow to liDecimals
103631>>>>>>>>> get pbNewLine.i liRow to lbNewLine
103632>>>>>>>>> get pbTotals.i liRow to lbTotals
103633>>>>>>>>> get pbForceRight.i liRow to lbForceRight
103634>>>>>>>>> move (lbNewLine or liRow=liMax) to lbNewLine // Last column will have a new line anyway
103635>>>>>>>>> if (pbDeactivate.i(self,liRow)) move "" to lsValue
103638>>>>>>>>> if lbTotals begin
103640>>>>>>>>> if (liType=DF_BCD or lbForceRight<>FALSE) begin
103642>>>>>>>>> if lbNewLine send WriteLnPos lsValue lnPosition FONT_RIGHT liDecimals
103645>>>>>>>>> else send WritePos lsValue lnPosition FONT_RIGHT liDecimals
103647>>>>>>>>> end
103647>>>>>>>>>>
103647>>>>>>>>> else begin
103648>>>>>>>>> if lbNewLine send WriteLnPos (psValue.i(self,liRow)) lnPosition
103651>>>>>>>>> else send WritePos (psValue.i(self,liRow)) lnPosition
103653>>>>>>>>> end
103653>>>>>>>>>>
103653>>>>>>>>> end
103653>>>>>>>>>>
103653>>>>>>>>> loop
103654>>>>>>>>>>
103654>>>>>>>>> send Reset_Totals liLevel
103655>>>>>>>>> end_procedure
103656>>>>>>>>>
103656>>>>>>>>> procedure DoReset
103658>>>>>>>>> send delete_data
103659>>>>>>>>> end_procedure
103660>>>>>>>>>
103660>>>>>>>>> procedure Add_Column string lsHeader number lnPos integer liType integer liDecs integer lbNewLine integer lbTotals integer lbNewColumnPage //integer lbZeroSuppress
103662>>>>>>>>> integer liRow
103662>>>>>>>>> get row_count to liRow
103663>>>>>>>>> set psColumnHeader.i liRow to lsHeader
103664>>>>>>>>> set pnPosition.i liRow to lnPos
103665>>>>>>>>> set piType.i liRow to liType
103666>>>>>>>>> set piDecimals.i liRow to liDecs
103667>>>>>>>>> set pbNewLine.i liRow to lbNewLine
103668>>>>>>>>> set pbTotals.i liRow to lbTotals
103669>>>>>>>>> if (NUM_ARGUMENTS>=7) set pbNewColumnPage.i liRow to lbNewColumnPage
103672>>>>>>>>> else set pbNewColumnPage.i liRow to FALSE
103674>>>>>>>>>// set pbZeroSuppress.i liRow to lbZeroSuppress
103674>>>>>>>>> end_procedure
103675>>>>>>>>>
103675>>>>>>>>> procedure set Bold_State integer lbValue
103677>>>>>>>>> set pbBold.i (row_count(self)-1) to lbValue
103678>>>>>>>>> end_procedure
103679>>>>>>>>>
103679>>>>>>>>> procedure set Force_RightAdjust integer lbValue
103681>>>>>>>>> set pbForceRight.i (row_count(self)-1) to lbValue
103682>>>>>>>>> end_procedure
103683>>>>>>>>>
103683>>>>>>>>> procedure Output_Header
103685>>>>>>>>> integer liRow liMax liType lbNewLine iCurSheet iColCount
103685>>>>>>>>> boolean lbForceRight
103685>>>>>>>>> number lnPosition
103685>>>>>>>>> string lsValue
103685>>>>>>>>>
103685>>>>>>>>> get vpe_GetCurrentPage of oVPE# to iCurSheet
103686>>>>>>>>> move 0 to iColCount
103687>>>>>>>>>
103687>>>>>>>>> get row_count to liMax
103688>>>>>>>>> decrement liMax
103689>>>>>>>>> for liRow from 0 to liMax
103695>>>>>>>>>>
103695>>>>>>>>> if (pbNewColumnPage.i(self,liRow)) begin
103697>>>>>>>>> increment iColCount
103698>>>>>>>>> send GoToSheetCurrentPlus of oVpeReportHelper iColCount
103699>>>>>>>>> end
103699>>>>>>>>>>
103699>>>>>>>>>
103699>>>>>>>>> get psColumnHeader.i liRow to lsValue
103700>>>>>>>>> get pnPosition.i liRow to lnPosition
103701>>>>>>>>> get piType.i liRow to liType
103702>>>>>>>>> get pbNewLine.i liRow to lbNewLine
103703>>>>>>>>> get pbForceRight.i liRow to lbForceRight
103704>>>>>>>>> move (lbNewLine or liRow=liMax) to lbNewLine // Last column will have a new line anyway
103705>>>>>>>>> if (pbDeactivate.i(self,liRow)) move "" to lsValue
103708>>>>>>>>> if (liType=DF_BCD or lbForceRight<>FALSE) begin
103710>>>>>>>>> if lbNewLine send WriteLnPos lsValue lnPosition (FONT_RIGHT+FONT_BOLD) -1
103713>>>>>>>>> else send WritePos lsValue lnPosition (FONT_RIGHT+FONT_BOLD) -1
103715>>>>>>>>> end
103715>>>>>>>>>>
103715>>>>>>>>> else begin
103716>>>>>>>>> if lbNewLine send WriteLnPos lsValue lnPosition FONT_BOLD
103719>>>>>>>>> else send WritePos lsValue lnPosition FONT_BOLD
103721>>>>>>>>> end
103721>>>>>>>>>>
103721>>>>>>>>> loop
103722>>>>>>>>>>
103722>>>>>>>>> if (vpe_GetCurrentPage(oVPE#)<>iCurSheet) send vpe_GotoPage to oVPE# iCurSheet
103725>>>>>>>>> end_procedure
103726>>>>>>>>>
103726>>>>>>>>> procedure Update_Totals
103728>>>>>>>>> integer liRow liMax liType lbTotals
103728>>>>>>>>> string lsValue
103728>>>>>>>>> get row_count to liMax
103729>>>>>>>>> decrement liMax
103730>>>>>>>>> for liRow from 0 to liMax
103736>>>>>>>>>>
103736>>>>>>>>> get piType.i liRow to liType
103737>>>>>>>>> get pbTotals.i liRow to lbTotals
103738>>>>>>>>>
103738>>>>>>>>> if (liType=DF_BCD and lbTotals<>0) begin
103740>>>>>>>>> get psValue.i liRow to lsValue
103741>>>>>>>>>
103741>>>>>>>>> if (StringIsNumber(lsValue,ascii(CurrentDecimalSeparator()))) ; set pnSumTotal.i liRow to (pnSumTotal.i(self,liRow)+number(lsValue))
103744>>>>>>>>> end
103744>>>>>>>>>>
103744>>>>>>>>> loop
103745>>>>>>>>>>
103745>>>>>>>>> end_procedure
103746>>>>>>>>>
103746>>>>>>>>> procedure Output_Image
103748>>>>>>>>> boolean lbForceRight
103748>>>>>>>>> integer liRow liMax liType liDecimals lbNewLine lbTotals lbBold liBold iCurSheet iColCount
103748>>>>>>>>> number lnPosition lnMaxWidth
103748>>>>>>>>> string lsValue
103748>>>>>>>>>
103748>>>>>>>>> get vpe_GetCurrentPage of oVPE# to iCurSheet
103749>>>>>>>>> move 0 to iColCount
103750>>>>>>>>>
103750>>>>>>>>> get row_count to liMax
103751>>>>>>>>> decrement liMax
103752>>>>>>>>> for liRow from 0 to liMax
103758>>>>>>>>>>
103758>>>>>>>>> if (pbNewColumnPage.i(self,liRow)) begin
103760>>>>>>>>> increment iColCount
103761>>>>>>>>> send GoToSheetCurrentPlus of oVpeReportHelper iColCount
103762>>>>>>>>> end
103762>>>>>>>>>>
103762>>>>>>>>>
103762>>>>>>>>> get psValue.i liRow to lsValue
103763>>>>>>>>> get pnPosition.i liRow to lnPosition
103764>>>>>>>>> get piType.i liRow to liType
103765>>>>>>>>> get piDecimals.i liRow to liDecimals
103766>>>>>>>>> get pbNewLine.i liRow to lbNewLine
103767>>>>>>>>> get pbBold.i liRow to lbBold
103768>>>>>>>>> get pbForceRight.i liRow to lbForceRight
103769>>>>>>>>>
103769>>>>>>>>> if lbBold move FONT_BOLD to liBold
103772>>>>>>>>> else move 0 to liBold
103774>>>>>>>>>
103774>>>>>>>>> if (liRow=liMax or lbNewLine<>0 or liType=DF_BCD or pbNewColumnPage.i(self,liRow+1)<>0) move 0 to lnMaxWidth //
103777>>>>>>>>> else move (pnPosition.i(self,liRow+1)-lnPosition-0.1) to lnMaxWidth
103779>>>>>>>>>
103779>>>>>>>>> move (lbNewLine or liRow=liMax) to lbNewLine // Last column will have a new line anyway
103780>>>>>>>>> if (pbDeactivate.i(self,liRow)) begin
103782>>>>>>>>> if lbNewLine send WriteLnPos "" lnPosition (FONT_RIGHT+liBold) -1 lnMaxWidth
103785>>>>>>>>> else send WritePos "" lnPosition (FONT_RIGHT+liBold) -1 lnMaxWidth
103787>>>>>>>>> end
103787>>>>>>>>>>
103787>>>>>>>>> else begin
103788>>>>>>>>> if (liType=DF_BCD or lbForceRight<>FALSE) begin
103790>>>>>>>>> if (not(StringIsNumber(lsValue,ascii(CurrentDecimalSeparator()))) or (liType<>DF_BCD)) begin
103792>>>>>>>>> if lbNewLine send WriteLnPos lsValue lnPosition (FONT_RIGHT+liBold) -1 lnMaxWidth
103795>>>>>>>>> else send WritePos lsValue lnPosition (FONT_RIGHT+liBold) -1 lnMaxWidth
103797>>>>>>>>> end
103797>>>>>>>>>>
103797>>>>>>>>> else begin
103798>>>>>>>>> if lbNewLine send WriteLnPos lsValue lnPosition (FONT_RIGHT+liBold) liDecimals lnMaxWidth
103801>>>>>>>>> else send WritePos lsValue lnPosition (FONT_RIGHT+liBold) liDecimals lnMaxWidth
103803>>>>>>>>> end
103803>>>>>>>>>>
103803>>>>>>>>> end
103803>>>>>>>>>>
103803>>>>>>>>> else begin
103804>>>>>>>>> if lbNewLine send WriteLnPos lsValue lnPosition liBold -1 lnMaxWidth
103807>>>>>>>>> else send WritePos lsValue lnPosition liBold -1 lnMaxWidth
103809>>>>>>>>> end
103809>>>>>>>>>>
103809>>>>>>>>> end
103809>>>>>>>>>>
103809>>>>>>>>> loop
103810>>>>>>>>>>
103810>>>>>>>>> send Update_Totals
103811>>>>>>>>>
103811>>>>>>>>> if (vpe_GetCurrentPage(oVPE#)<>iCurSheet) send vpe_GotoPage to oVPE# iCurSheet
103814>>>>>>>>> end_procedure
103815>>>>>>>>>
103815>>>>>>>>> procedure BlankForm_Image
103817>>>>>>>>> integer liRow liMax
103817>>>>>>>>> get row_count to liMax
103818>>>>>>>>> decrement liMax
103819>>>>>>>>> for liRow from 0 to liMax
103825>>>>>>>>>>
103825>>>>>>>>> set psValue.i liRow to ""
103826>>>>>>>>> loop
103827>>>>>>>>>>
103827>>>>>>>>> end_procedure
103828>>>>>>>>>
103828>>>>>>>>> procedure Print_Value integer liRow string lsValue
103830>>>>>>>>> set psValue.i liRow to lsValue
103831>>>>>>>>> end_procedure
103832>>>>>>>>>
103832>>>>>>>>> procedure Print_ColumnLabel integer liRow string lsValue
103834>>>>>>>>> set psColumnHeader.i liRow to lsValue
103835>>>>>>>>> end_procedure
103836>>>>>>>>>end_class // cWinPrint_ImageDefinition
103837>>>>>>>>>
103837>>>>>>>
103837>>>>>>>
103837>>>>>>>object oDbdReport is a aps.ReportView label "DB Description - Printed report"
103840>>>>>>> on_key kcancel send close_panel
103841>>>>>>> property integer phDbdSystem public 0
103843>>>>>>> property integer phDbdView public 0
103845>>>>>>>
103845>>>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
103846>>>>>>>
103846>>>>>>> object oTableSelect is a aps.Group label "Select tables"
103849>>>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
103850>>>>>>> set p_auto_column to 0
103851>>>>>>> object oGrid is a aps.Grid
103853>>>>>>> send GridPrepare_AddCheckBoxColumn
103854>>>>>>> send GridPrepare_AddColumn "#" AFT_ASCII4
103855>>>>>>> send GridPrepare_AddColumn "Table" AFT_ASCII30
103856>>>>>>> send GridPrepare_AddColumn "Name" AFT_ASCII12
103857>>>>>>> send GridPrepare_Apply self
103858>>>>>>> set select_mode to MULTI_SELECT
103859>>>>>>> set highlight_row_state to true
103860>>>>>>> on_key KNEXT_ITEM send switch
103861>>>>>>> on_key KPREVIOUS_ITEM send switch_back
103862>>>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
103863>>>>>>> set peResizeColumn to rcSelectedColumn
103864>>>>>>> set piResizeColumn to 2
103865>>>>>>> procedure HandleTable integer liId string lsName string lsLogic_name string lsPhysic_name integer liNot_found string lsOpenas_path string lsDescription
103868>>>>>>> integer liBase
103868>>>>>>> get item_count to liBase
103869>>>>>>> send Grid_AddCheckBoxItem self DFTRUE
103870>>>>>>> set aux_value item liBase to liId
103871>>>>>>> send add_item msg_none liId
103872>>>>>>> send add_item msg_none lsName
103873>>>>>>> send add_item msg_none lsLogic_name
103874>>>>>>> end_procedure
103875>>>>>>> procedure fill_list
103878>>>>>>> integer lhTableAccess
103878>>>>>>> move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess
103879>>>>>>> send delete_data
103880>>>>>>> set dynamic_update_state to false
103881>>>>>>> send Callback_All_Tables of lhTableAccess MSG_HandleTable self
103882>>>>>>> set dynamic_update_state to true
103883>>>>>>> send Grid_SetEntryState self DFFALSE
103884>>>>>>> end_procedure
103885>>>>>>> procedure select_toggling integer itm# integer i#
103888>>>>>>> integer ci# iColumns
103888>>>>>>> get Grid_Columns self to iColumns
103889>>>>>>> get current_item to ci#
103890>>>>>>> move ((ci#/iColumns)*iColumns) to ci# // Redirect to first column
103891>>>>>>> forward send select_toggling ci# i#
103893>>>>>>> end_procedure
103894>>>>>>> end_object
103895>>>>>>> procedure DoSelectAll
103898>>>>>>> send Grid_RowSelectAll (oGrid(self))
103899>>>>>>> end_procedure
103900>>>>>>> procedure DoSelectNone
103903>>>>>>> send Grid_RowDeselectAll (oGrid(self))
103904>>>>>>> end_procedure
103905>>>>>>> object oBtn1 is a aps.Multi_Button
103907>>>>>>> set peAnchors to (anRight+anBottom)
103908>>>>>>> on_item "Select all" send DoSelectAll
103909>>>>>>> end_object
103910>>>>>>> object oBtn1 is a aps.Multi_Button
103912>>>>>>> set peAnchors to (anRight+anBottom)
103913>>>>>>> on_item "Clear" send DoSelectNone
103914>>>>>>> end_object
103915>>>>>>> send aps_locate_multi_buttons
103916>>>>>>> end_object
103917>>>>>>> Object oOther is a aps.Group Label "Other:" snap SL_DOWN
103921>>>>>>> set peAnchors to (anLeft+anRight+anBottom)
103922>>>>>>> object oIncludeFieldAndIndex is a aps.CheckBox label "Include field and index descriptions"
103925>>>>>>> set checked_state to true
103926>>>>>>> end_object
103927>>>>>>> end_object
103928>>>>>>> Object oDestination is a aps.RadioGroup Label "Output Device:" snap SL_DOWN
103932>>>>>>> set peAnchors to (anLeft+anRight+anBottom)
103933>>>>>>> send tab_column_define 1 60 55 jmode_left
103934>>>>>>> Object oScreen is a aps.Radio label "Screen"
103937>>>>>>> Set Status_Help to "Preview the report to screen"
103938>>>>>>> End_Object
103939>>>>>>> Object oPrinter is a aps.Radio snap SL_RIGHT_SPACE label "Printer"
103943>>>>>>> Set Status_Help to "Send the report to the default printer"
103944>>>>>>> End_Object
103945>>>>>>> Procedure Notify_Select_State Integer iNewItem Integer iOldItem
103948>>>>>>> Forward Send Notify_Select_State iNewItem iOldItem
103950>>>>>>> If (iNewItem=0) Set Output_Device_Mode To PRINT_TO_WINDOW
103953>>>>>>> Else Set Output_Device_Mode To PRINT_TO_PRINTER
103955>>>>>>> End_Procedure
103956>>>>>>> Set Current_Radio to 0
103957>>>>>>> End_Object // oDestination
103958>>>>>>> send aps_size_identical_max (oTableSelect(self)) (oDestination(self)) SL_HORIZONTAL
103959>>>>>>> send aps_size_identical_max (oOther(self)) (oDestination(self)) SL_HORIZONTAL
103960>>>>>>> on_key ksave_record send Run_Report
103961>>>>>>> object oBtn1 is a aps.Multi_Button
103963>>>>>>> set peAnchors to (anRight+anBottom)
103964>>>>>>> on_item "Run report" send Run_Report
103965>>>>>>> end_object
103966>>>>>>> object oBtn2 is a aps.Multi_Button
103968>>>>>>> set peAnchors to (anRight+anBottom)
103969>>>>>>> procedure DoSetup
103972>>>>>>> integer hoReport
103972>>>>>>> Get Report_Object_ID To hoReport
103973>>>>>>> Send DFPrintSetup To hoReport
103974>>>>>>> end_procedure
103975>>>>>>> on_item "Setup" send DoSetup
103976>>>>>>> end_object
103977>>>>>>> object oBtn3 is a aps.Multi_Button
103979>>>>>>> set peAnchors to (anRight+anBottom)
103980>>>>>>> on_item "Close" send close_panel
103981>>>>>>> end_object
103982>>>>>>> send aps_locate_multi_buttons
103983>>>>>>>
103983>>>>>>> Object oReport is a cWinReport2
103985>>>>>>> Set No_Finding_State to TRUE
103986>>>>>>>
103986>>>>>>> property integer piId
103988>>>>>>> property string psName
103990>>>>>>> property string psLogic_name
103992>>>>>>> property string psPhysic_name
103994>>>>>>> property integer piNot_found
103996>>>>>>> property string psOpenas_path
103998>>>>>>> property string psDescription
104000>>>>>>>
104000>>>>>>> procedure PrintTable integer liId string lsName string lsLogic_name string lsPhysic_name integer liNot_found string lsOpenas_path string lsDescription
104003>>>>>>> integer liGrb
104003>>>>>>> set piId to liId
104004>>>>>>> set psName to lsName
104005>>>>>>> set psLogic_name to lsLogic_name
104006>>>>>>> set psPhysic_name to lsPhysic_name
104007>>>>>>> set piNot_found to liNot_found
104008>>>>>>> set psOpenas_path to lsOpenas_path
104009>>>>>>> set psDescription to lsDescription
104010>>>>>>> get handle_report_line to liGrb
104011>>>>>>> end_procedure
104012>>>>>>>
104012>>>>>>> procedure PrintSelectedTable integer liRow integer liBase
104015>>>>>>> integer liFile lhTableAccess
104015>>>>>>> move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess
104016>>>>>>> get aux_value of (oGrid(oTableSelect(self))) liBase to liFile
104017>>>>>>> send Callback_One_Table of lhTableAccess liFile msg_PrintTable self
104018>>>>>>> end_procedure
104019>>>>>>>
104019>>>>>>> Function Start_Report returns integer
104022>>>>>>> integer liOk
104022>>>>>>> string lsTitle
104022>>>>>>>
104022>>>>>>> move "DB Description" to lsTitle
104023>>>>>>>
104023>>>>>>> set Report_Title to lsTitle
104024>>>>>>>// set Report_SubTitle to lsTitle
104024>>>>>>>
104024>>>>>>> Set No_Finding_State to TRUE
104025>>>>>>> Forward Get Start_Report to liOk
104027>>>>>>> if (liOk=RPT_OK) begin
104029>>>>>>> send DFSetMargins to WinPrintID 2.5 1.5 1.5 1.5
104030>>>>>>> send Grid_RowCallBackSelected (oGrid(oTableSelect(self))) msg_PrintSelectedTable self
104031>>>>>>> end
104031>>>>>>>>
104031>>>>>>> Get End_Report liOk to liOk
104032>>>>>>> function_return liOk
104033>>>>>>> end_function
104034>>>>>>>
104034>>>>>>> object oBodyImage is a cWinPrint_ImageDefinition
104036>>>>>>> send Add_Column "#" 1.0 DF_BCD 0 DFFALSE DFFALSE
104037>>>>>>> set Bold_State to true
104038>>>>>>> send Add_Column "Logical name" 1.5 DF_ASCII 0 DFFALSE DFFALSE
104039>>>>>>> set Bold_State to true
104040>>>>>>> send Add_Column "Table" 4.5 DF_ASCII 0 DFFALSE DFFALSE
104041>>>>>>> set Bold_State to true
104042>>>>>>> end_object
104043>>>>>>>
104043>>>>>>> Procedure_Section Page_Top
104046>>>>>>> DFBeginHeader DFPageTop // Header of type DFPageTop
104047>>>>>>> DFHeaderPos HDR_LEFT // left justify the data in the header
104048>>>>>>> DFHeaderFrame HDR_MARGINS // Paint frame margin to margin
104049>>>>>>>
104049>>>>>>> DFFont "Arial" // Using Arial font size 20
104050>>>>>>> DFFontSize 20
104051>>>>>>> DFWritelnPos (Report_Title(self)) 0.5 FONT_BOLD
104052>>>>>>>
104052>>>>>>> DFFontSize 14
104053>>>>>>>// DFWritePos "Sub title" 0.5 FONT_BOLD
104053>>>>>>>
104053>>>>>>> DFFont "Times New Roman" // Use font Times New Roman
104054>>>>>>> DFFontSize 12 // font size 14
104055>>>>>>> DFWritePos "Page:" 13 (FONT_ITALIC+FONT_BOLD)
104056>>>>>>> DFWritePos "#pagecount#" 15 (FONT_ITALIC+FONT_BOLD)
104057>>>>>>> DFWriteln "" // print a blank line
104058>>>>>>> DFFontSize 10
104059>>>>>>> send Output_Header to oBodyImage
104060>>>>>>> DFEndHeader
104062>>>>>>> End_Procedure // Page_Top
104063>>>>>>>
104063>>>>>>> Procedure Print_Text string lsLabel string lsValue
104066>>>>>>> move (trim(lsValue)) to lsValue
104067>>>>>>> if (lsValue<>"") begin
104069>>>>>>> DFWritePos lsLabel 1.6 //0 -1 0
104070>>>>>>> DFWritePos lsValue 4.2 FONT_ITALIC -1 0
104071>>>>>>> DFWriteLn ""
104072>>>>>>> end
104072>>>>>>>>
104072>>>>>>> end_procedure
104073>>>>>>>
104073>>>>>>> Procedure_Section Body
104076>>>>>>> Send Update_Status (string(piId(self))+" "+psLogic_name(self))
104077>>>>>>> send BlankForm_Image to oBodyImage
104078>>>>>>> send Print_Value to oBodyImage 0 (piId(self))
104079>>>>>>> send Print_Value to oBodyImage 1 (psLogic_name(self))
104080>>>>>>> send Print_Value to oBodyImage 2 (psName(self))
104081>>>>>>> DFFontSize 10
104082>>>>>>> DFWriteln "" // print a blank line
104083>>>>>>> send Output_Image to oBodyImage
104084>>>>>>> send Print_Text "Table description:" (psDescription(self))
104085>>>>>>> forward send Body
104087>>>>>>> End_Procedure // Body
104088>>>>>>>
104088>>>>>>> Procedure_Section Page_Bottom
104091>>>>>>> DFFont "Times New Roman"
104092>>>>>>> DFFontSize 10
104093>>>>>>>
104093>>>>>>> DFBeginHeader DFPageBottom // Header of type DFPageBottom
104094>>>>>>> DFHeaderPos HDR_CENTER // Center the data in the header
104095>>>>>>> DFHeaderFrame HDR_MARGINS // Frame margin to margin
104096>>>>>>> DFWrite "Printed on: " (FONT_ITALIC)
104097>>>>>>>
104097>>>>>>> // Using the RptToday property in DFReport to set the date
104097>>>>>>> DFWriteln (string(dSysDate())+" "+sSysTime()) (FONT_ITALIC)
104098>>>>>>> DFEndHeader
104100>>>>>>> End_Procedure
104101>>>>>>>
104101>>>>>>> Object oFieldReport is a WinReport
104103>>>>>>> Set No_Finding_State to TRUE
104104>>>>>>>
104104>>>>>>> property integer piTbl_Id
104106>>>>>>> property integer piFld_Pos
104108>>>>>>> property string psFld_Name
104110>>>>>>> property integer piFld_Not_Found
104112>>>>>>> property string psFld_Description
104114>>>>>>> property string psSuggested_Label
104116>>>>>>> property string psFld_Definition
104118>>>>>>>
104118>>>>>>> object oBodyImage is a cWinPrint_ImageDefinition
104120>>>>>>> send Add_Column "#" 3.1 DF_BCD 0 DFFALSE DFFALSE
104121>>>>>>> set Bold_State to true
104122>>>>>>> send Add_Column "Field" 3.6 DF_ASCII 0 DFFALSE DFFALSE
104123>>>>>>> set Bold_State to true
104124>>>>>>> send Add_Column "Type" 9.0 DF_ASCII 0 DFFALSE DFFALSE
104125>>>>>>> set Bold_State to true
104126>>>>>>> end_object
104127>>>>>>>
104127>>>>>>> procedure PrintField integer liTbl_Id integer liFld_Pos string lsFld_Name integer liFld_Not_Found string lsFld_Description string lsSuggested_Label string lsFld_Definition
104130>>>>>>> integer liGrb
104130>>>>>>> set piTbl_Id to liTbl_Id
104131>>>>>>> set piFld_Pos to liFld_Pos
104132>>>>>>> set psFld_Name to lsFld_Name
104133>>>>>>> set piFld_Not_Found to liFld_Not_Found
104134>>>>>>> set psFld_Description to lsFld_Description
104135>>>>>>> set psSuggested_Label to lsSuggested_Label
104136>>>>>>> set psFld_Definition to lsFld_Definition
104137>>>>>>> get handle_report_line to liGrb
104138>>>>>>> end_procedure
104139>>>>>>>
104139>>>>>>> Function Start_Report returns integer
104142>>>>>>> integer liOk lbRun liFile lhTableAccess liIndex
104142>>>>>>> move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess
104143>>>>>>> get checked_state of (oIncludeFieldAndIndex(oOther(self))) to lbRun
104144>>>>>>> Forward Get Start_Report to liOk
104146>>>>>>> if (liOk=RPT_OK) begin
104148>>>>>>> if lbRun begin
104150>>>>>>> get piId to liFile
104151>>>>>>> DFFontSize 10
104152>>>>>>> //send Output_Header of oBodyImage
104152>>>>>>> move 2 to liIndex // 2=Ordered by position
104153>>>>>>> if (piId(self)=DBDLIB_DICTIONARY) move 1 to liIndex
104156>>>>>>> if (piId(self)=DBDLIB_CALENDAR ) move 1 to liIndex
104159>>>>>>> if (piId(self)=DBDLIB_ARTICLES ) move 1 to liIndex
104162>>>>>>>
104162>>>>>>> send Callback_TableFields of lhTableAccess liFile msg_PrintField self liIndex
104163>>>>>>> end
104163>>>>>>>>
104163>>>>>>> end
104163>>>>>>>>
104163>>>>>>> Get End_Report liOk to liOk
104164>>>>>>> function_return liOk
104165>>>>>>> end_function
104166>>>>>>>
104166>>>>>>> Procedure Print_Text string lsLabel string lsValue
104169>>>>>>> move (trim(lsValue)) to lsValue
104170>>>>>>> if (lsValue<>"") begin
104172>>>>>>> DFWritePos lsLabel 3.9 //0 -1 0
104173>>>>>>> DFWritePos lsValue 6.5 FONT_ITALIC -1 0
104174>>>>>>> DFWriteLn ""
104175>>>>>>> end
104175>>>>>>>>
104175>>>>>>> end_procedure
104176>>>>>>>
104176>>>>>>> procedure_section Body
104179>>>>>>> send BlankForm_Image to oBodyImage
104180>>>>>>> send Print_Value to oBodyImage 0 (piFld_Pos(self))
104181>>>>>>> send Print_Value to oBodyImage 1 (psFld_Name(self))
104182>>>>>>> send Print_Value to oBodyImage 2 (psFld_Definition(self))
104183>>>>>>> DFFontSize 10
104184>>>>>>>// DFWriteln "" // print a blank line
104184>>>>>>> send Output_Image to oBodyImage
104185>>>>>>> send Print_Text "Field description:" (psFld_Description(self))
104186>>>>>>> forward send Body
104188>>>>>>> end_procedure // Body
104189>>>>>>> end_object
104190>>>>>>> End_object
104191>>>>>>> procedure DestroyingDbdView integer lhView
104194>>>>>>> if (lhView=phDbdView(self)) send close_panel
104197>>>>>>> end_procedure
104198>>>>>>> procedure popup
104201>>>>>>> send fill_list of (oGrid(oTableSelect(self)))
104202>>>>>>> forward send popup
104204>>>>>>> end_procedure
104205>>>>>>>End_Object
104206>>>>>>>send aps_SetMinimumDialogSize (oDbdReport(self))
104207>>>>>>>
104207>>>>>>>procedure popup_dbdreport integer lhDbdSystem integer lhView
104210>>>>>>> set phDbdSystem of oDbdReport to lhDbdSystem
104211>>>>>>> set phDbdView of oDbdReport to lhView
104212>>>>>>> send popup of oDbdReport
104213>>>>>>>end_procedure
104214>>>>>
104214>>>>>Use Language // Set default languange if not set by compiler command line
104214>>>>>
104214>>>>>Use FdxSet.nui // cFdxSetOfTables, cFdxSetOfFields, cFdxSetOfIndices
Including file: fdxset.nui (C:\Apps\VDFQuery\AppSrc\fdxset.nui)
104214>>>>>>>// Use FdxSet.nui // cFdxSetOfTables, cFdxSetOfFields, cFdxSetOfIndices
104214>>>>>>>
104214>>>>>>>Use FDX.nui // cFDX class
104214>>>>>>>Use FDX_Attr.nui // FDX compatible attribute functions
104214>>>>>>>Use Strings.nui // String manipulation for VDF
104214>>>>>>>Use WildCard.nui // WildCardMatch function
104214>>>>>>>
104214>>>>>>>enumeration_list
104214>>>>>>> define FDXSET_NONE
104214>>>>>>> define FDXSET_EQ
104214>>>>>>> define FDXSET_NE
104214>>>>>>> define FDXSET_LT
104214>>>>>>> define FDXSET_LE
104214>>>>>>> define FDXSET_GE
104214>>>>>>> define FDXSET_GT
104214>>>>>>> define FDXSET_END // Must be the higher number defined
104214>>>>>>>end_enumeration_list
104214>>>>>>>
104214>>>>>>>function sFdxSet_CompText global integer comp# returns string
104216>>>>>>> if comp# eq FDXSET_NONE function_return ""
104219>>>>>>> if comp# eq FDXSET_LT function_return "LT"
104222>>>>>>> if comp# eq FDXSET_LE function_return "LE"
104225>>>>>>> if comp# eq FDXSET_EQ function_return "EQ"
104228>>>>>>> if comp# eq FDXSET_GE function_return "GE"
104231>>>>>>> if comp# eq FDXSET_GT function_return "GT"
104234>>>>>>> if comp# eq FDXSET_NE function_return "NE"
104237>>>>>>>end_function
104238>>>>>>>
104238>>>>>>>//> Call back all legal comparison modes when attribute is attr#
104238>>>>>>>procedure FdxSet_Comp_CallBack global integer attr# integer msg# integer obj#
104240>>>>>>> integer comp# type#
104240>>>>>>> if (API_AttrDiscreteValues(attr#)) begin // Is the attribute represented by a set of (symbolic) discrete values?
104242>>>>>>> send msg# to obj# FDXSET_EQ (sFdxSet_CompText(FDXSET_EQ))
104243>>>>>>> send msg# to obj# FDXSET_NE (sFdxSet_CompText(FDXSET_NE))
104244>>>>>>> end
104244>>>>>>>>
104244>>>>>>> else begin
104245>>>>>>> if (API_AttrType(attr#)=ATTRTYPE_IDXSEG) send msg# to obj# FDXSET_EQ (sFdxSet_CompText(FDXSET_EQ))
104248>>>>>>> else begin
104249>>>>>>> if (API_AttrValueType(attr#)) eq DF_BCD begin
104251>>>>>>> for comp# from 1 to (FDXSET_END-1)
104257>>>>>>>>
104257>>>>>>> send msg# to obj# comp# (sFdxSet_CompText(comp#))
104258>>>>>>> loop
104259>>>>>>>>
104259>>>>>>> end
104259>>>>>>>>
104259>>>>>>> else begin // DF_ASCII
104260>>>>>>> send msg# to obj# FDXSET_EQ (sFdxSet_CompText(FDXSET_EQ))
104261>>>>>>> send msg# to obj# FDXSET_NE (sFdxSet_CompText(FDXSET_NE))
104262>>>>>>> end
104262>>>>>>>>
104262>>>>>>> end
104262>>>>>>>>
104262>>>>>>> end
104262>>>>>>>>
104262>>>>>>>end_procedure
104263>>>>>>>
104263>>>>>>>class cFdxSet is a cArray
104264>>>>>>> procedure construct_object integer img#
104266>>>>>>> forward send construct_object img#
104268>>>>>>> property string psTitle public ""
104269>>>>>>> property integer piFDX_Server public 0
104270>>>>>>> object oAuxArray is a cArray no_image
104272>>>>>>> end_object
104273>>>>>>> property integer piTestAttribute public 0
104274>>>>>>> property integer piTestCompMode public FDXSET_NONE
104275>>>>>>> property string psTestValue public ""
104276>>>>>>> end_procedure
104277>>>>>>> procedure display_criterion
104279>>>>>>> send obs (API_Attr_Name(piTestAttribute(self))) (sFdxSet_CompText(piTestCompMode(self))) (psTestValue(self))
104280>>>>>>> end_procedure
104281>>>>>>> item_property_list
104281>>>>>>> item_property integer piFile.i
104281>>>>>>> item_property integer piItem.i
104281>>>>>>> end_item_property_list cFdxSet
#REM 104313 DEFINE FUNCTION PIITEM.I INTEGER LIROW RETURNS INTEGER
#REM 104317 DEFINE PROCEDURE SET PIITEM.I INTEGER LIROW INTEGER VALUE
#REM 104321 DEFINE FUNCTION PIFILE.I INTEGER LIROW RETURNS INTEGER
#REM 104325 DEFINE PROCEDURE SET PIFILE.I INTEGER LIROW INTEGER VALUE
104330>>>>>>> //***** PRIVATE ***************************************************
104330>>>>>>> procedure AddItem integer file# integer item#
104332>>>>>>> integer row#
104332>>>>>>> get row_count to row#
104333>>>>>>> set piFile.i row# to file#
104334>>>>>>> set piItem.i row# to item#
104335>>>>>>> end_procedure
104336>>>>>>> function iFindItem.ii integer file# integer item# returns integer
104338>>>>>>> integer max# row#
104338>>>>>>> get row_count to max#
104339>>>>>>> for row# from 0 to (max#-1)
104345>>>>>>>>
104345>>>>>>> if (piFile.i(self,row#)=file# and piItem.i(self,row#)=item#) function_return row#
104348>>>>>>> loop
104349>>>>>>>>
104349>>>>>>> function_return -1
104350>>>>>>> end_function
104351>>>>>>> function iAddItem integer file# integer item# returns integer
104353>>>>>>> if (iFindItem.ii(self,file#,item#)) eq -1 begin
104355>>>>>>> send AddItem file# item#
104356>>>>>>> function_return 1
104357>>>>>>> end
104357>>>>>>>>
104357>>>>>>> //function_return 0
104357>>>>>>> end_function
104358>>>>>>> procedure AddItemIfNotAlready integer file# integer item#
104360>>>>>>> integer grb#
104360>>>>>>> get iAddItem file# item# to grb#
104361>>>>>>> end_procedure
104362>>>>>>>
104362>>>>>>> procedure private.add_to_help_array integer file# integer item#
104364>>>>>>> integer itm# arr#
104364>>>>>>> move (oAuxArray(self)) to arr#
104365>>>>>>> set value of arr# item (item_count(arr#)) to (IntToStrR(file#,4)+IntToStrR(item#,4))
104366>>>>>>> end_procedure
104367>>>>>>> procedure private.CopyDownFromHelpArray
104369>>>>>>> integer arr# max# itm#
104369>>>>>>> string str#
104369>>>>>>> move (oAuxArray(self)) to arr#
104370>>>>>>> send sort_items to arr# ASCENDING
104371>>>>>>> send reset
104372>>>>>>> get item_count of arr# to max#
104373>>>>>>> for itm# from 0 to (max#-1)
104379>>>>>>>>
104379>>>>>>> get value of arr# item itm# to str#
104380>>>>>>> send AddItem (left(str#,4)) (right(str#,4))
104381>>>>>>> loop
104382>>>>>>>>
104382>>>>>>> send delete_data to arr#
104383>>>>>>> end_procedure // Introduction to algorithms, MIT Press 0-262-03141-8
104384>>>>>>>
104384>>>>>>> //***** PUBLIC ****************************************************
104384>>>>>>> function iValidate.iiss integer type# integer comp# ; string scurrentvalue# string stestvalue# returns integer
104386>>>>>>> number ncurrentvalue# ntestvalue#
104386>>>>>>> if type# eq DF_BCD begin
104388>>>>>>> move scurrentvalue# to ncurrentvalue#
104389>>>>>>> move stestvalue# to ntestvalue#
104390>>>>>>> if comp# eq FDXSET_LT function_return (ncurrentvalue#<ntestvalue#)
104393>>>>>>> if comp# eq FDXSET_LE function_return (ncurrentvalue#<=ntestvalue#)
104396>>>>>>> if comp# eq FDXSET_EQ function_return (ncurrentvalue#=ntestvalue#)
104399>>>>>>> if comp# eq FDXSET_GE function_return (ncurrentvalue#>=ntestvalue#)
104402>>>>>>> if comp# eq FDXSET_GT function_return (ncurrentvalue#>ntestvalue#)
104405>>>>>>> if comp# eq FDXSET_NE function_return (ncurrentvalue#<>ntestvalue#)
104408>>>>>>> end
104408>>>>>>>>
104408>>>>>>> else begin // Then it's DF_ASCII
104409>>>>>>> uppercase scurrentvalue#
104410>>>>>>>>
104410>>>>>>> uppercase stestvalue#
104411>>>>>>>>
104411>>>>>>> if comp# eq FDXSET_LT function_return (scurrentvalue#<stestvalue#)
104414>>>>>>> if comp# eq FDXSET_LE function_return (scurrentvalue#<=stestvalue#)
104417>>>>>>> if comp# eq FDXSET_EQ function_return (WildCardMatch(scurrentvalue#))
104420>>>>>>> if comp# eq FDXSET_GE function_return (scurrentvalue#>=stestvalue#)
104423>>>>>>> if comp# eq FDXSET_GT function_return (scurrentvalue#>stestvalue#)
104426>>>>>>> if comp# eq FDXSET_NE function_return (scurrentvalue#<>stestvalue#)
104429>>>>>>> end
104429>>>>>>>>
104429>>>>>>> function_return 1
104430>>>>>>> end_function
104431>>>>>>>
104431>>>>>>> procedure reset
104433>>>>>>> send delete_data
104434>>>>>>> end_procedure
104435>>>>>>>
104435>>>>>>> procedure sort_rows
104437>>>>>>> integer max# row#
104437>>>>>>> send delete_data to (oAuxArray(self))
104438>>>>>>> get row_count to max#
104439>>>>>>> for row# from 0 to (max#-1)
104445>>>>>>>>
104445>>>>>>> send private.add_to_help_array (piFile.i(self,row#)) (piItem.i(self,row#))
104446>>>>>>> loop
104447>>>>>>>>
104447>>>>>>> send private.CopyDownFromHelpArray
104448>>>>>>> end_procedure
104449>>>>>>>
104449>>>>>>> function iValidate_Item.ii integer file# integer item# returns integer
104451>>>>>>> end_function
104452>>>>>>>
104452>>>>>>> //> Function iNumberOfFiles returns the number of different tables
104452>>>>>>> //> represented by fields currently in the set.
104452>>>>>>> function iNumberOfFiles returns integer
104454>>>>>>> integer max# file# row#
104454>>>>>>> string str#
104454>>>>>>> move "" to str#
104455>>>>>>> get row_count to max#
104456>>>>>>> for row# from 0 to (max#-1)
104462>>>>>>>>
104462>>>>>>> get piFile.i row# to file#
104463>>>>>>> move (overstrike("1",str#,file#)) to str#
104464>>>>>>> loop
104465>>>>>>>>
104465>>>>>>> move (replaces(" ",str#,"")) to str#
104466>>>>>>> function_return (length(str#)) // Clever!
104467>>>>>>> end_function
104468>>>>>>>
104468>>>>>>> //***** SET OPERATIONS ********************************************
104468>>>>>>> procedure DoUnion.i integer oFdxSetOfItems
104470>>>>>>> integer row# max#
104470>>>>>>> get row_count of oFdxSetOfItems to max#
104471>>>>>>> for row# from 0 to (max#-1)
104477>>>>>>>>
104477>>>>>>> send AddItemIfNotAlready (piFile.i(oFdxSetOfItems,row#)) (piItem.i(oFdxSetOfItems,row#))
104478>>>>>>> loop
104479>>>>>>>>
104479>>>>>>> send sort_rows
104480>>>>>>> end_procedure
104481>>>>>>> procedure DoInterSection.i integer oFdxSetOfItems
104483>>>>>>> integer max# row# file# item#
104483>>>>>>> send delete_data to (oAuxArray(self))
104484>>>>>>> get row_count to max#
104485>>>>>>> for row# from 0 to (max#-1)
104491>>>>>>>>
104491>>>>>>> get piFile.i row# to file#
104492>>>>>>> get piItem.i row# to item#
104493>>>>>>> if (iFindItem.ii(oFdxSetOfItems,file#,item#)) ne -1 send private.add_to_help_array file# item#
104496>>>>>>> loop
104497>>>>>>>>
104497>>>>>>> send private.CopyDownFromHelpArray
104498>>>>>>> end_procedure
104499>>>>>>> procedure DoComplement.i integer oFdxSetOfItems // Remove all fields that are also in oFdxSetOfItems
104501>>>>>>> integer row# max# found_row#
104501>>>>>>> get row_count of oFdxSetOfItems to max#
104502>>>>>>> for row# from 0 to (max#-1)
104508>>>>>>>>
104508>>>>>>> get iFindItem.ii (piFile.i(oFdxSetOfItems,row#)) (piItem.i(oFdxSetOfItems,row#)) to found_row#
104509>>>>>>> if found_row# ne -1 send delete_row found_row#
104512>>>>>>> loop
104513>>>>>>>>
104513>>>>>>> end_procedure
104514>>>>>>> procedure DoRemoveFile.i integer liFile
104516>>>>>>> integer liMax liRow
104516>>>>>>> get row_count to liMax
104517>>>>>>> decrement liMax
104518>>>>>>> for liRow from 0 to liMax
104524>>>>>>>>
104524>>>>>>> if (piFile.i(self,liRow)=liFile) begin
104526>>>>>>> send delete_row liRow
104527>>>>>>> decrement liRow
104528>>>>>>> decrement liMax
104529>>>>>>> end
104529>>>>>>>>
104529>>>>>>> loop
104530>>>>>>>>
104530>>>>>>> end_procedure
104531>>>>>>>end_class // cFdxSet
104532>>>>>>>
104532>>>>>>>class cFdxSetOfTables is a cFdxSet
104533>>>>>>> function iValidate_Item.ii integer file# integer item# returns integer
104535>>>>>>> integer attr# oFDX# type# comp#
104535>>>>>>> string scurrentvalue# stestvalue#
104535>>>>>>> get piFDX_Server to oFDX#
104536>>>>>>> get piTestAttribute to attr#
104537>>>>>>> get piTestCompMode to comp#
104538>>>>>>> if (attr# and comp#) begin
104540>>>>>>> get psTestValue to stestvalue#
104541>>>>>>> get API_AttrValueType attr# to type#
104542>>>>>>> get FDX_AttrValue_FILE oFDX# attr# file# to scurrentvalue#
104543>>>>>>> function_return (iValidate.iiss(self,type#,comp#,scurrentvalue#,stestvalue#))
104544>>>>>>> end
104544>>>>>>>>
104544>>>>>>> function_return 0
104545>>>>>>> end_function
104546>>>>>>>
104546>>>>>>> procedure Traverse_All //> Go through all files in the world
104548>>>>>>> integer oFDX# file#
104548>>>>>>> //send display_criterion
104548>>>>>>> send delete_data
104549>>>>>>> if (piTestCompMode(self)=FDXSET_EQ and API_AttrValueType(piTestAttribute(self))=DF_ASCII) send WildCardMatchPrepare (uppercase(psTestValue(self)))
104552>>>>>>> get piFDX_Server to oFDX#
104553>>>>>>> move 0 to file#
104554>>>>>>> repeat
104554>>>>>>>>
104554>>>>>>> get iNextFileThatCanOpen of oFDX# file# to file#
104555>>>>>>> if (file# and iValidate_Item.ii(self,file#,0)) send AddItem file# 0
104558>>>>>>> until file# eq 0
104560>>>>>>> end_procedure
104561>>>>>>> procedure make_set_of_files integer obj#
104563>>>>>>> integer max# row# file#
104563>>>>>>> send reset to obj#
104564>>>>>>> get row_count to max#
104565>>>>>>> for row# from 0 to (max#-1)
104571>>>>>>>>
104571>>>>>>> send AddItemIfNotAlready to obj# (piFile.i(self,row#)) 0
104572>>>>>>> loop
104573>>>>>>>>
104573>>>>>>> end_procedure
104574>>>>>>>end_class // cFdxSetOfTables
104575>>>>>>>
104575>>>>>>>//> A set of fields is a set of (file,field). The cFdxSetOfFields class
104575>>>>>>>//> is able to contain such a set and it's able to search a FDX object
104575>>>>>>>//> for fields
104575>>>>>>>
104575>>>>>>>class cFdxSetOfFields is a cFdxSet
104576>>>>>>> function iValidate_Item.ii integer file# integer field# returns integer
104578>>>>>>> integer attr# oFDX# type# comp#
104578>>>>>>> string scurrentvalue# stestvalue#
104578>>>>>>> get piFDX_Server to oFDX#
104579>>>>>>> get piTestAttribute to attr#
104580>>>>>>> get piTestCompMode to comp#
104581>>>>>>> if (attr# and comp#) begin
104583>>>>>>> get psTestValue to stestvalue#
104584>>>>>>> get API_AttrValueType attr# to type#
104585>>>>>>> get FDX_AttrValue_FIELD oFDX# attr# file# field# to scurrentvalue#
104586>>>>>>> function_return (iValidate.iiss(self,type#,comp#,scurrentvalue#,stestvalue#))
104587>>>>>>> end
104587>>>>>>>>
104587>>>>>>> function_return 0
104588>>>>>>> end_function
104589>>>>>>>
104589>>>>>>> procedure Traverse_All //> Go through all fields in the world
104591>>>>>>> integer oFDX# file# item# max# type# attr#
104591>>>>>>> send reset
104592>>>>>>> //send display_criterion
104592>>>>>>> get piFDX_Server to oFDX#
104593>>>>>>> get piTestAttribute to attr#
104594>>>>>>> if (API_AttrValueType(attr#)=DF_ASCII and piTestCompMode(self)=FDXSET_EQ) send WildCardMatchPrepare (uppercase(psTestValue(self)))
104597>>>>>>> move 0 to file#
104598>>>>>>> repeat
104598>>>>>>>>
104598>>>>>>> get iNextFileThatCanOpen of oFDX# file# to file#
104599>>>>>>> if file# begin
104601>>>>>>> move (FDX_AttrValue_FILE(oFDX#,DF_FILE_NUMBER_FIELDS,file#)) to max#
104602>>>>>>> for item# from 1 to max#
104608>>>>>>>>
104608>>>>>>> if (iValidate_Item.ii(self,file#,item#)) send AddItem file# item#
104611>>>>>>> loop
104612>>>>>>>>
104612>>>>>>> end
104612>>>>>>>>
104612>>>>>>> until file# eq 0
104614>>>>>>> end_procedure
104615>>>>>>>
104615>>>>>>> function private.iFindFieldWithOffset.ii integer file# integer offset# returns integer
104617>>>>>>> integer oFDX# item# max_item#
104617>>>>>>> get piFDX_Server to oFDX#
104618>>>>>>> move (FDX_AttrValue_FILE(oFDX#,DF_FILE_NUMBER_FIELDS,file#)) to max_item#
104619>>>>>>> for item# from 1 to max_item#
104625>>>>>>>>
104625>>>>>>> if (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_OFFSET,file#,item#)) eq offset# function_return item#
104628>>>>>>> loop
104629>>>>>>>>
104629>>>>>>> //function_return 0
104629>>>>>>> end_function
104630>>>>>>>
104630>>>>>>> procedure private.Traverse_Relating_Help integer Parent_File# integer Parent_Field# string Child_Files#
104632>>>>>>> integer file# item# itm# max# oFDX# max_item# Rel_File# Rel_Field# Rootitem#
104632>>>>>>> integer Parent_Offset# Parent_OverlapOffset#
104632>>>>>>> integer Child_Offset# Child_OverlapOffset#
104632>>>>>>> get piFDX_Server to oFDX#
104633>>>>>>> move (HowManyIntegers(Child_Files#)) to max#
104634>>>>>>> move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_OFFSET,parent_file#,Parent_Field#)) to Parent_Offset#
104635>>>>>>> for itm# from 1 to max#
104641>>>>>>>>
104641>>>>>>> move (ExtractInteger(Child_Files#,itm#)) to file#
104642>>>>>>> move (FDX_AttrValue_FILE(oFDX#,DF_FILE_NUMBER_FIELDS,File#)) to max_item#
104643>>>>>>> for item# from 1 to max_item#
104649>>>>>>>>
104649>>>>>>> move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_RELATED_FILE,file#,item#)) to Rel_File#
104650>>>>>>> if Rel_File# eq Parent_File# begin
104652>>>>>>> move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_RELATED_FIELD,file#,item#)) to Rel_Field#
104653>>>>>>> if Rel_Field# eq Parent_Field# send private.Traverse_Related_Help file# item#
104656>>>>>>> else begin
104657>>>>>>> if (integer(FDX_AttrValue_FIELD(oFDX#,DF_FIELD_TYPE,file#,item#))) eq DF_OVERLAP begin
104659>>>>>>> // Does it overlap our RootField?
104659>>>>>>> if (integer(FDX_AttrValue_SPECIAL1(oFDX#,DF_FIELD_OVERLAP,Rel_File#,Rel_Field#,Parent_Field#))) begin
104661>>>>>>>
104661>>>>>>> // OK! We know that they overlap. Now we have to figure out
104661>>>>>>> // which field in the child file corresponds
104661>>>>>>> // to Parent_file.Parent_Field#:
104661>>>>>>> move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_OFFSET,Rel_File#,Rel_Field#)) to Parent_OverlapOffset#
104662>>>>>>>
104662>>>>>>> move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_OFFSET,file#,item#)) to Child_OverlapOffset#
104663>>>>>>> move (Child_OverlapOffset#+Parent_Offset#-Parent_OverlapOffset#) to Child_Offset#
104664>>>>>>>
104664>>>>>>> get private.iFindFieldWithOffset.ii file# Child_Offset# to Rootitem#
104665>>>>>>> if Rootitem# send private.Traverse_Related_Help file# Rootitem#
104668>>>>>>> else send obs "Overlap structure mismatch (2)"
104670>>>>>>> //send private.Traverse_Related_Help file# item#
104670>>>>>>> end
104670>>>>>>>>
104670>>>>>>> end
104670>>>>>>>>
104670>>>>>>> end
104670>>>>>>>>
104670>>>>>>> end
104670>>>>>>>>
104670>>>>>>> loop
104671>>>>>>>>
104671>>>>>>> loop
104672>>>>>>>>
104672>>>>>>> end_procedure
104673>>>>>>>
104673>>>>>>> procedure private.Traverse_Related_Help integer File# integer Rootitem#
104675>>>>>>> integer oFDX# item# max_item# rel_file# rel_item# self#
104675>>>>>>> integer RootField_Offset# field_offset# rel_file_offset#
104675>>>>>>> integer liAliasFile liMaxAliasFile liPos
104675>>>>>>> string ChildFiles# lsAliasFiles
104675>>>>>>> get piFDX_Server to oFDX#
104676>>>>>>> // Just in case we need it:
104676>>>>>>> move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_OFFSET,file#,Rootitem#)) to RootField_Offset#
104677>>>>>>> if (iFindItem.ii(self,file#,Rootitem#)) eq -1 begin
104679>>>>>>> send AddItem file# Rootitem#
104680>>>>>>> move self to self#
104681>>>>>>> move (FDX_AttrValue_FILE(oFDX#,DF_FILE_NUMBER_FIELDS,File#)) to max_item#
104682>>>>>>> for item# from 1 to max_item#
104688>>>>>>>>
104688>>>>>>> // Does it relate?
104688>>>>>>> move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_RELATED_FILE,file#,item#)) to rel_file#
104689>>>>>>> if rel_file# begin // OK! We relate
104691>>>>>>> move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_RELATED_FIELD,file#,item#)) to rel_item#
104692>>>>>>> if item# eq Rootitem# begin // Is it the field, we are specifically querying?
104694>>>>>>> send private.Traverse_Related_Help rel_file# rel_item#
104695>>>>>>> end
104695>>>>>>>>
104695>>>>>>> else begin
104696>>>>>>> // Is it an overlap? Otherwise we are not interested.
104696>>>>>>> if (integer(FDX_AttrValue_FIELD(oFDX#,DF_FIELD_TYPE,file#,item#))) eq DF_OVERLAP begin
104698>>>>>>> // Does it overlap our RootField?
104698>>>>>>> if (integer(FDX_AttrValue_SPECIAL1(oFDX#,DF_FIELD_OVERLAP,file#,Rootitem#,item#))) begin
104700>>>>>>> // OK! We know that they overlap. Now we have to figure out
104700>>>>>>> // which field in the related file corresponds to our RootField:
104700>>>>>>> move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_OFFSET,file#,item#)) to field_offset#
104701>>>>>>> move (FDX_AttrValue_FIELD(oFDX#,DF_FIELD_OFFSET,rel_file#,rel_item#)) to rel_file_offset#
104702>>>>>>> // This is the offset of our root field be in the related file:
104702>>>>>>> move (rel_file_offset#-field_offset#+RootField_Offset#) to rel_file_offset#
104703>>>>>>> get private.iFindFieldWithOffset.ii rel_file# rel_file_offset# to rel_item# // overload
104704>>>>>>> if rel_item# send private.Traverse_Related_Help rel_file# rel_item#
104707>>>>>>> else send obs "Overlap structure mismatch (1)"
104709>>>>>>> end
104709>>>>>>>>
104709>>>>>>> end
104709>>>>>>>>
104709>>>>>>> end
104709>>>>>>>>
104709>>>>>>> end
104709>>>>>>>>
104709>>>>>>> loop
104710>>>>>>>>
104710>>>>>>> // Does anybody relate to it?
104710>>>>>>> get sChildFiles.i of oFDX# file# to ChildFiles#
104711>>>>>>> send private.Traverse_Relating_Help File# Rootitem# ChildFiles#
104712>>>>>>> // Are there any alias files that we have to go through?
104712>>>>>>> get sAliasFiles.i of oFDX# File# to lsAliasFiles
104713>>>>>>> get HowManyIntegers lsAliasFiles to liMaxAliasFile
104714>>>>>>> for liPos from 1 to liMaxAliasFile
104720>>>>>>>>
104720>>>>>>> get ExtractInteger lsAliasFiles liPos to liAliasFile
104721>>>>>>> send private.Traverse_Related_Help liAliasFile Rootitem#
104722>>>>>>> loop
104723>>>>>>>>
104723>>>>>>> end
104723>>>>>>>>
104723>>>>>>> end_procedure
104724>>>>>>>
104724>>>>>>> procedure Traverse_ConnectedFields integer file# integer field#
104726>>>>>>> send reset
104727>>>>>>> send private.Traverse_Related_Help file# field#
104728>>>>>>> end_procedure
104729>>>>>>>
104729>>>>>>> procedure make_set_of_files integer obj#
104731>>>>>>> integer max# row# file#
104731>>>>>>> send reset to obj#
104732>>>>>>> get row_count to max#
104733>>>>>>> for row# from 0 to (max#-1)
104739>>>>>>>>
104739>>>>>>> send AddItemIfNotAlready to obj# (piFile.i(self,row#)) 0
104740>>>>>>> loop
104741>>>>>>>>
104741>>>>>>> end_procedure
104742>>>>>>>end_class // cFdxSetOfFields
104743>>>>>>>
104743>>>>>>>class cFdxSetOfIndices is a cFdxSet
104744>>>>>>> function iValidate_Item.ii integer file# integer index# returns integer
104746>>>>>>> integer attr# oFDX# type# comp# attrtype# seg# max_seg#
104746>>>>>>> string scurrentvalue# stestvalue#
104746>>>>>>> get piFDX_Server to oFDX#
104747>>>>>>> get piTestAttribute to attr#
104748>>>>>>> get piTestCompMode to comp#
104749>>>>>>> if (attr# and comp#) begin
104751>>>>>>> get API_AttrType attr# to attrtype#
104752>>>>>>> get psTestValue to stestvalue#
104753>>>>>>> get API_AttrValueType attr# to type#
104754>>>>>>> if attrtype# eq ATTRTYPE_INDEX begin
104756>>>>>>> get FDX_AttrValue_INDEX oFDX# attr# file# index# to scurrentvalue#
104757>>>>>>> function_return (iValidate.iiss(self,type#,comp#,scurrentvalue#,stestvalue#))
104758>>>>>>> end
104758>>>>>>>>
104758>>>>>>> if attrtype# eq ATTRTYPE_IDXSEG begin
104760>>>>>>> // If we get to this point we can be sure that the comperator is EQ
104760>>>>>>> get FDX_AttrValue_INDEX oFDX# DF_INDEX_NUMBER_SEGMENTS file# index# to max_seg#
104761>>>>>>> for seg# from 1 to max_seg#
104767>>>>>>>>
104767>>>>>>> get FDX_AttrValue_IDXSEG oFDX# attr# file# index# seg# to scurrentvalue#
104768>>>>>>> if (iValidate.iiss(self,type#,comp#,scurrentvalue#,stestvalue#)) function_return 1
104771>>>>>>> loop
104772>>>>>>>>
104772>>>>>>> end
104772>>>>>>>>
104772>>>>>>> end
104772>>>>>>>>
104772>>>>>>> function_return 0
104773>>>>>>> end_function
104774>>>>>>>
104774>>>>>>> procedure Traverse_All //> Go through all indices in the world
104776>>>>>>> integer oFDX# file# Index# max# type# segments# attr#
104776>>>>>>> send reset
104777>>>>>>> //send display_criterion
104777>>>>>>> get piFDX_Server to oFDX#
104778>>>>>>> get piTestAttribute to attr#
104779>>>>>>> if (API_AttrValueType(attr#)=DF_ASCII and piTestCompMode(self)=FDXSET_EQ) send WildCardMatchPrepare (uppercase(psTestValue(self)))
104782>>>>>>> move 0 to file#
104783>>>>>>> repeat
104783>>>>>>>>
104783>>>>>>> get iNextFileThatCanOpen of oFDX# file# to file#
104784>>>>>>> if file# begin
104786>>>>>>> for Index# from 1 to 16
104792>>>>>>>>
104792>>>>>>> get FDX_AttrValue_INDEX oFDX# DF_INDEX_NUMBER_SEGMENTS file# index# to segments#
104793>>>>>>> if segments# if (iValidate_Item.ii(self,file#,Index#)) send AddItem file# Index#
104798>>>>>>> loop
104799>>>>>>>>
104799>>>>>>> end
104799>>>>>>>>
104799>>>>>>> until file# eq 0
104801>>>>>>> end_procedure
104802>>>>>>>
104802>>>>>>> procedure make_set_of_files integer obj#
104804>>>>>>> integer max# row# file#
104804>>>>>>> send reset to obj#
104805>>>>>>> get row_count to max#
104806>>>>>>> for row# from 0 to (max#-1)
104812>>>>>>>>
104812>>>>>>> send AddItemIfNotAlready to obj# (piFile.i(self,row#)) 0
104813>>>>>>> loop
104814>>>>>>>>
104814>>>>>>> end_procedure
104815>>>>>>>
104815>>>>>>> procedure make_set_of_fields integer obj#
104817>>>>>>> integer max# row# file# index# seg# segments# oFDX# field#
104817>>>>>>> send reset to obj#
104818>>>>>>> get piFDX_Server to oFDX#
104819>>>>>>> get row_count to max#
104820>>>>>>> for row# from 0 to (max#-1)
104826>>>>>>>>
104826>>>>>>> get piFile.i row# to file#
104827>>>>>>> get piItem.i row# to index#
104828>>>>>>> get FDX_AttrValue_INDEX oFDX# DF_INDEX_NUMBER_SEGMENTS file# index# to segments#
104829>>>>>>> for seg# from 1 to segments#
104835>>>>>>>>
104835>>>>>>> move (FDX_AttrValue_IDXSEG(oFDX#,DF_INDEX_SEGMENT_FIELD,file#,index#,seg#)) to field#
104836>>>>>>> if field# send AddItemIfNotAlready to obj# file# field#
104839>>>>>>> loop
104840>>>>>>>>
104840>>>>>>> loop
104841>>>>>>>>
104841>>>>>>> end_procedure
104842>>>>>>>
104842>>>>>>>end_class // cFdxSetOfIndices
104843>>>>>Use FdxSet.pkg // cFdxSetOfFieldsList class
Including file: fdxset.pkg (C:\Apps\VDFQuery\AppSrc\fdxset.pkg)
104843>>>>>>>// Use FdxSet.pkg // cFdxSetOfFieldsList class
104843>>>>>>>Use Strings.nui // String manipulation for VDF
104843>>>>>>>Use GridUtil.utl // Grid and List utilities
104843>>>>>>>Use FdxField.nui // FDX Field things
104843>>>>>>>Use FdxIndex.utl // Index analysing functions
104843>>>>>>>
104843>>>>>>>class cFdxSetOfTablesList is a aps.Grid
104844>>>>>>> procedure construct_object integer img#
104846>>>>>>> forward send construct_object img#
104848>>>>>>> property integer piFDX_Server public 0
104849>>>>>>> property integer piSOT_Server public 0 // SOF = SetOfTables
104850>>>>>>> set line_width to 4 0
104851>>>>>>> send GridPrepare_AddColumn "#" AFT_ASCII4
104852>>>>>>> send GridPrepare_AddColumn "Display name" AFT_ASCII40
104853>>>>>>> send GridPrepare_AddColumn "DF name" AFT_ASCII10
104854>>>>>>> send GridPrepare_AddColumn "Root name" AFT_ASCII32
104855>>>>>>> send GridPrepare_Apply self
104856>>>>>>> set select_mode to NO_SELECT
104857>>>>>>> on_key KNEXT_ITEM send switch
104858>>>>>>> on_key KPREVIOUS_ITEM send switch_back
104859>>>>>>> on_key KENTER send next
104860>>>>>>> on_key KDELETE_RECORD send delete_table
104861>>>>>>> property integer piAllowDelete public dfFalse
104862>>>>>>> on_key KEY_CTRL+KEY_R send sort_data
104863>>>>>>> on_key KEY_CTRL+KEY_W send DoWriteToFile
104864>>>>>>> end_procedure
104865>>>>>>>
104865>>>>>>> procedure DoWriteToFile
104867>>>>>>> send Grid_DoWriteToFile self
104868>>>>>>> end_procedure
104869>>>>>>>
104869>>>>>>> function iSpecialSortValueOnColumn.i integer column# returns integer
104871>>>>>>> if column# eq 0 function_Return 1
104874>>>>>>> end_function
104875>>>>>>>
104875>>>>>>> function sSortValue.ii integer column# integer itm# returns string
104877>>>>>>> if column# eq 0 function_return (IntToStrR(value(self,itm#),4))
104880>>>>>>> end_function
104881>>>>>>>
104881>>>>>>> procedure sort_data.i integer column#
104883>>>>>>> send Grid_SortByColumn self column#
104884>>>>>>> end_procedure
104885>>>>>>>
104885>>>>>>> procedure sort_data
104887>>>>>>> integer cc#
104887>>>>>>> get Grid_CurrentColumn self to cc#
104888>>>>>>> send sort_data.i cc#
104889>>>>>>> end_procedure
104890>>>>>>> procedure header_mouse_click integer itm#
104892>>>>>>> send sort_data.i itm#
104893>>>>>>> forward send header_mouse_click itm#
104895>>>>>>> end_procedure
104896>>>>>>> function iNumberOfFiles returns integer
104898>>>>>>> function_return (iNumberOfFiles(piSOT_Server(self)))
104899>>>>>>> end_function
104900>>>>>>> procedure delete_table
104902>>>>>>> integer base# file# field# row# oSOF#
104902>>>>>>> if (piAllowDelete(self) and item_count(self)) begin
104904>>>>>>> get Grid_BaseItem self to base#
104905>>>>>>> get aux_value item base# to file#
104906>>>>>>> get value item (base#+1) to field#
104907>>>>>>> get piSOT_Server to oSOF#
104908>>>>>>> get iFindItem.ii of oSOF# file# field# to row#
104909>>>>>>> if row# ne -1 send delete_row to oSOF# row#
104912>>>>>>> get Grid_CurrentRow self to row#
104913>>>>>>> send Grid_DeleteRow self row#
104914>>>>>>> send update_display_counter (iNumberOfFiles(self))
104915>>>>>>> end
104915>>>>>>>>
104915>>>>>>> end_procedure
104916>>>>>>> procedure fill_list.i integer oSOT#
104918>>>>>>> integer file# itm# max# oFDX#
104918>>>>>>> set dynamic_update_state to DFFALSE
104919>>>>>>> send delete_data
104920>>>>>>> set piSOT_Server to oSOT#
104921>>>>>>> get piFDX_Server of oSOT# to oFDX#
104922>>>>>>> set piFDX_Server to oFDX#
104923>>>>>>> get row_count of oSOT# to max#
104924>>>>>>> for itm# from 0 to (max#-1)
104930>>>>>>>>
104930>>>>>>> get piFile.i of oSOT# item itm# to file#
104931>>>>>>> send add_item msg_none (string(file#))
104932>>>>>>> send add_item msg_none (FDX_AttrValue_FILELIST(oFDX#,DF_FILE_DISPLAY_NAME,file#))
104933>>>>>>> send add_item msg_none (FDX_AttrValue_FILELIST(oFDX#,DF_FILE_LOGICAL_NAME,file#))
104934>>>>>>> send add_item msg_none (FDX_AttrValue_FILELIST(oFDX#,DF_FILE_ROOT_NAME,file#))
104935>>>>>>> loop
104936>>>>>>>>
104936>>>>>>> send Grid_SetEntryState self DFFALSE
104937>>>>>>> send update_display_counter (iNumberOfFiles(self))
104938>>>>>>> set dynamic_update_state to DFTRUE
104939>>>>>>> end_procedure
104940>>>>>>> procedure fill_list.ii integer oSOT# integer oFDX#
104942>>>>>>> set piFDX_Server of oSOT# to oFDX#
104943>>>>>>> send fill_list.i oSOT#
104944>>>>>>> end_procedure
104945>>>>>>> procedure update_display_counter integer files#
104947>>>>>>> end_procedure
104948>>>>>>>end_class // cFdxSetOfTablesList
104949>>>>>>>
104949>>>>>>>
104949>>>>>>>Use APS // Auto Positioning and Sizing classes for VDF
104949>>>>>>>class cFdxSetOfFieldsList is a aps.Grid
104950>>>>>>> procedure construct_object integer img#
104952>>>>>>> forward send construct_object img#
104954>>>>>>> property integer piFDX_Server public 0
104955>>>>>>> property integer piSOF_Server public 0 // SOF = SetOfFields
104956>>>>>>> property integer piAllowDelete public dfFalse
104957>>>>>>> set line_width to 8 0
104958>>>>>>>
104958>>>>>>> send GridPrepare_AddColumn "Table" AFT_ASCII10
104959>>>>>>> send GridPrepare_AddColumn "#" AFT_ASCII2
104960>>>>>>> send GridPrepare_AddColumn "Name" AFT_ASCII15
104961>>>>>>> send GridPrepare_AddColumn "Type" AFT_ASCII4
104962>>>>>>> send GridPrepare_AddColumn "Len" AFT_ASCII5
104963>>>>>>> send GridPrepare_AddColumn "Offset" AFT_ASCII5
104964>>>>>>> send GridPrepare_AddColumn "Idx" AFT_ASCII3
104965>>>>>>> send GridPrepare_AddColumn "Relation" AFT_ASCII30
104966>>>>>>> send GridPrepare_Apply self
104967>>>>>>> set select_mode to NO_SELECT
104968>>>>>>> on_key knext_item send switch
104969>>>>>>> on_key kprevious_item send switch_back
104970>>>>>>> on_key kenter send next
104971>>>>>>> on_key kdelete_record send delete_field
104972>>>>>>> on_key key_ctrl+key_r send sort_data
104973>>>>>>> on_key key_ctrl+key_w send DoWriteToFile
104974>>>>>>> end_procedure
104975>>>>>>>
104975>>>>>>> procedure DoWriteToFile
104977>>>>>>> send Grid_DoWriteToFile self
104978>>>>>>> end_procedure
104979>>>>>>>
104979>>>>>>> function iSpecialSortValueOnColumn.i integer liColumn returns integer
104981>>>>>>> if liColumn eq 1 function_Return 1
104984>>>>>>> if liColumn eq 4 function_Return 1
104987>>>>>>> if liColumn eq 5 function_Return 1
104990>>>>>>> if liColumn eq 6 function_Return 1
104993>>>>>>> end_function
104994>>>>>>>
104994>>>>>>> function sSortValue.ii integer liColumn integer liItem returns string
104996>>>>>>> string lsValue lsSep
104996>>>>>>> if liColumn eq 1 function_return (IntToStrR(value(self,liItem),4))
104999>>>>>>> if liColumn eq 4 begin
105001>>>>>>> get value item liItem to lsValue
105002>>>>>>> get CurrentDecimalSeparator to lsSep
105003>>>>>>> replace "." in lsValue with lsSep
105005>>>>>>> replace "," in lsValue with lsSep
105007>>>>>>> function_return (NumToStrR(lsValue,2,8))
105008>>>>>>> end
105008>>>>>>>>
105008>>>>>>> if liColumn eq 5 function_return (IntToStrR(value(self,liItem),5))
105011>>>>>>> if liColumn eq 6 function_return (IntToStrR(value(self,liItem),2))
105014>>>>>>> end_function
105015>>>>>>>
105015>>>>>>> procedure sort_data.i integer liColumn
105017>>>>>>> send Grid_SortByColumn self liColumn
105018>>>>>>> end_procedure
105019>>>>>>>
105019>>>>>>> procedure sort_data
105021>>>>>>> integer liColumn
105021>>>>>>> get Grid_CurrentColumn self to liColumn
105022>>>>>>> send sort_data.i liColumn
105023>>>>>>> end_procedure
105024>>>>>>>
105024>>>>>>> procedure header_mouse_click integer liItem
105026>>>>>>> send sort_data.i liItem
105027>>>>>>> forward send header_mouse_click liItem
105029>>>>>>> end_procedure
105030>>>>>>>
105030>>>>>>> function sRelFieldName.ii integer liFile integer liField returns string
105032>>>>>>> integer lhFDX
105032>>>>>>> get piFDX_Server to lhFDX
105033>>>>>>> function_return (FDX_FieldName(lhFDX,liFile,liField,1))
105034>>>>>>> end_function
105035>>>>>>> function iNumberOfFiles returns integer
105037>>>>>>> function_return (iNumberOfFiles(piSOF_Server(self)))
105038>>>>>>> end_function
105039>>>>>>> function iNumberOfFields returns integer
105041>>>>>>> function_return (row_count(piSOF_Server(self)))
105042>>>>>>> end_function
105043>>>>>>> procedure delete_field
105045>>>>>>> integer liBase liFile liField liRow lhSOF
105045>>>>>>> if (piAllowDelete(self) and item_count(self)) begin
105047>>>>>>> get Grid_BaseItem self to liBase
105048>>>>>>> get aux_value item liBase to liFile
105049>>>>>>> get value item (liBase+1) to liField
105050>>>>>>> get piSOF_Server to lhSOF
105051>>>>>>> get iFindItem.ii of lhSOF liFile liField to liRow
105052>>>>>>> if liRow ne -1 send delete_row to lhSOF liRow
105055>>>>>>> get Grid_CurrentRow self to liRow
105056>>>>>>> send Grid_DeleteRow self liRow
105057>>>>>>> send update_display_counter (iNumberOfFiles(self)) (iNumberOfFields(self))
105058>>>>>>> end
105058>>>>>>>>
105058>>>>>>> end_procedure
105059>>>>>>> procedure fill_list.i integer lhSOF
105061>>>>>>> integer lhFDX liRow liMax liFile liField liType liLen liDec liIdx
105061>>>>>>> set dynamic_update_state to DFFALSE
105062>>>>>>> send delete_data
105063>>>>>>> set piSOF_Server to lhSOF
105064>>>>>>> get piFDX_Server of lhSOF to lhFDX
105065>>>>>>> set piFDX_Server to lhFDX
105066>>>>>>> get row_count of lhSOF to liMax
105067>>>>>>> for liRow from 0 to (liMax-1)
105073>>>>>>>>
105073>>>>>>> get piFile.i of lhSOF liRow to liFile
105074>>>>>>> get piItem.i of lhSOF liRow to liField
105075>>>>>>> send add_item msg_none (FDX_AttrValue_FILELIST(lhFDX,DF_FILE_LOGICAL_NAME,liFile))
105076>>>>>>> set aux_value item (item_count(self)-1) to liFile
105077>>>>>>> send add_item msg_none (string(liField))
105078>>>>>>> send add_item msg_none (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_NAME,liFile,liField))
105079>>>>>>>
105079>>>>>>> move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_TYPE,liFile,liField)) to liType
105080>>>>>>> send add_item msg_none (API_ShortFieldTypeName(liType))
105081>>>>>>> move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_LENGTH,liFile,liField)) to liLen
105082>>>>>>> if liType eq DF_BCD begin
105084>>>>>>> move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_PRECISION,liFile,liField)) to liDec
105085>>>>>>> send add_item msg_none (string(liLen-liDec)+"."+string(liDec))
105086>>>>>>> end
105086>>>>>>>>
105086>>>>>>> else send add_item msg_none (string(liLen))
105088>>>>>>> send add_item msg_none (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_OFFSET,liFile,liField))
105089>>>>>>> move (FDX_AttrValue_FIELD(lhFDX,DF_FIELD_INDEX,liFile,liField)) to liIdx
105090>>>>>>> if liIdx send add_item msg_none (string(liIdx))
105093>>>>>>> else send add_item msg_none ""
105095>>>>>>> send add_item msg_none (sRelFieldName.ii(self,FDX_AttrValue_FIELD(lhFDX,DF_FIELD_RELATED_FILE,liFile,liField),FDX_AttrValue_FIELD(lhFDX,DF_FIELD_RELATED_FIELD,liFile,liField)))
105096>>>>>>> loop
105097>>>>>>>>
105097>>>>>>> send Grid_SetEntryState self false
105098>>>>>>> send update_display_counter (iNumberOfFiles(self)) (iNumberOfFields(self))
105099>>>>>>> set dynamic_update_state to DFTRUE
105100>>>>>>> end_procedure
105101>>>>>>> procedure update_display_counter integer liFiles integer liFields
105103>>>>>>> end_procedure
105104>>>>>>> function row_file.i integer liRow returns integer
105106>>>>>>> integer liBase
105106>>>>>>> if (item_count(self)) begin
105108>>>>>>> get Grid_RowBaseItem self liRow to liBase
105109>>>>>>> function_return (aux_value(self,liBase))
105110>>>>>>> end
105110>>>>>>>>
105110>>>>>>> // function_return 0
105110>>>>>>> end_function
105111>>>>>>> function row_field.i integer liRow returns integer
105113>>>>>>> integer liBase
105113>>>>>>> if (item_count(self)) begin
105115>>>>>>> get Grid_RowBaseItem self liRow to liBase
105116>>>>>>> function_return (value(self,liBase+1))
105117>>>>>>> end
105117>>>>>>>>
105117>>>>>>> // function_return 0
105117>>>>>>> end_function
105118>>>>>>> function row_field_name.i integer liRow returns string
105120>>>>>>> integer liBase
105120>>>>>>> if (item_count(self)) begin
105122>>>>>>> get Grid_RowBaseItem self liRow to liBase
105123>>>>>>> function_return (value(self,liBase+2))
105124>>>>>>> end
105124>>>>>>>>
105124>>>>>>> function_return ""
105125>>>>>>> end_function
105126>>>>>>>end_class // cFdxSetOfFieldsList
105127>>>>>>>
105127>>>>>>>Use APS // Auto Positioning and Sizing classes for VDF
105127>>>>>>>class cFdxSetOfIndicesList is a aps.Grid
105128>>>>>>> procedure construct_object integer img#
105130>>>>>>> forward send construct_object img#
105132>>>>>>> property integer piFDX_Server public 0
105133>>>>>>> property integer piSOF_Server public 0 // SOF = SetOfIndices
105134>>>>>>> set line_width to 3 0
105135>>>>>>> send GridPrepare_AddColumn "Table" AFT_ASCII10
105136>>>>>>> send GridPrepare_AddColumn "Idx" AFT_ASCII3
105137>>>>>>> send GridPrepare_AddColumn "Fields" AFT_ASCII50
105138>>>>>>> send GridPrepare_Apply self
105139>>>>>>> set select_mode to NO_SELECT
105140>>>>>>> on_key knext_item send switch
105141>>>>>>> on_key kprevious_item send switch_back
105142>>>>>>> on_key kenter send next
105143>>>>>>> on_key kdelete_record send delete_index
105144>>>>>>> on_key key_ctrl+key_w send DoWriteToFile
105145>>>>>>> property integer piAllowDelete public dfFalse
105146>>>>>>> end_procedure
105147>>>>>>>
105147>>>>>>> procedure DoWriteToFile
105149>>>>>>> send Grid_DoWriteToFile self
105150>>>>>>> end_procedure
105151>>>>>>>
105151>>>>>>> function iNumberOfFiles returns integer
105153>>>>>>> function_return (iNumberOfFiles(piSOF_Server(self)))
105154>>>>>>> end_function
105155>>>>>>> function iNumberOfIndices returns integer
105157>>>>>>> function_return (row_count(piSOF_Server(self)))
105158>>>>>>> end_function
105159>>>>>>> procedure delete_index
105161>>>>>>> integer base# file# index# row# oSOF#
105161>>>>>>> if (piAllowDelete(self) and item_count(self)) begin
105163>>>>>>> get Grid_BaseItem self to base#
105164>>>>>>> get aux_value item base# to file#
105165>>>>>>> get value item (base#+1) to index#
105166>>>>>>> get piSOF_Server to oSOF#
105167>>>>>>> get iFindItem.ii of oSOF# file# index# to row#
105168>>>>>>> if row# ne -1 send delete_row to oSOF# row#
105171>>>>>>> get Grid_CurrentRow self to row#
105172>>>>>>> send Grid_DeleteRow self row#
105173>>>>>>> send update_display_counter (iNumberOfFiles(self)) (iNumberOfIndices(self))
105174>>>>>>> end
105174>>>>>>>>
105174>>>>>>> end_procedure
105175>>>>>>> procedure fill_list.i integer oSOF#
105177>>>>>>> integer oFDX# row# max# file# index# type# len# dec# idx# itm# itm_max#
105177>>>>>>> string IdxAsStr# lf#
105177>>>>>>> set dynamic_update_state to DFFALSE
105178>>>>>>> send delete_data
105179>>>>>>> move (character(10)) to lf#
105180>>>>>>> set piSOF_Server to oSOF#
105181>>>>>>> get piFDX_Server of oSOF# to oFDX#
105182>>>>>>> set piFDX_Server to oFDX#
105183>>>>>>> get row_count of oSOF# to max#
105184>>>>>>> for row# from 0 to (max#-1)
105190>>>>>>>>
105190>>>>>>> get piFile.i of oSOF# row# to file#
105191>>>>>>> get piItem.i of oSOF# row# to index#
105192>>>>>>> send add_item msg_none (FDX_AttrValue_FILELIST(oFDX#,DF_FILE_LOGICAL_NAME,file#))
105193>>>>>>> set aux_value item (item_count(self)-1) to file#
105194>>>>>>> send add_item msg_none (string(index#))
105195>>>>>>> move (FDX_IndexAsFieldNames(oFDX#,file#,index#,50)) to IdxAsStr#
105196>>>>>>> move (HowManyWords(IdxAsStr#,lf#)) to itm_max#
105197>>>>>>> for itm# from 1 to itm_max#
105203>>>>>>>>
105203>>>>>>> if itm# eq 1 send add_item msg_none (ExtractWord(IdxAsStr#,lf#,itm#))
105206>>>>>>> else begin
105207>>>>>>> send add_item msg_none ""
105208>>>>>>> set aux_value item (item_count(self)-1) to file#
105209>>>>>>> send add_item msg_none ""
105210>>>>>>> send add_item msg_none (ExtractWord(IdxAsStr#,lf#,itm#))
105211>>>>>>> end
105211>>>>>>>>
105211>>>>>>> loop
105212>>>>>>>>
105212>>>>>>> loop
105213>>>>>>>>
105213>>>>>>> send Grid_SetEntryState self false
105214>>>>>>> send update_display_counter (iNumberOfFiles(self)) (iNumberOfIndices(self))
105215>>>>>>> set dynamic_update_state to DFTRUE
105216>>>>>>> end_procedure
105217>>>>>>> procedure update_display_counter integer files# integer Indices#
105219>>>>>>> end_procedure
105220>>>>>>>end_class // cFdxSetOfIndicesList
105221>>>>>>>
105221>>>>>Use API_Attr.pkg // UI objects for use with API_Attr.utl
Including file: api_attr.pkg (C:\Apps\VDFQuery\AppSrc\api_attr.pkg)
105221>>>>>>>// Use API_Attr // UI objects for use with API_Attr.utl
105221>>>>>>>Use API_Attr.utl // Functions for querying API attributes
105221>>>>>>>
105221>>>>>>>//register_procedure FdxSet_Comp_CallBack global integer attr# integer msg# integer obj#
105221>>>>>>>
105221>>>>>>>class Api_Attr.ComboFormAux is a aps.ComboFormAux
105222>>>>>>> procedure contruct_object
105224>>>>>>> forward send contruct_object
105226>>>>>>> on_key kenter send next
105227>>>>>>> set allow_blank_state to false
105228>>>>>>> end_procedure
105229>>>>>>> procedure fill_list_attrtype_help integer attr#
105231>>>>>>> send combo_add_item (API_Attr_DisplayName(attr#)) attr#
105232>>>>>>> end_procedure
105233>>>>>>> procedure fill_list_attrtype integer type#
105235>>>>>>> send API_AttrType_Callback type# msg_fill_list_attrtype_help self
105236>>>>>>> set entry_state item 0 to false
105237>>>>>>> end_procedure
105238>>>>>>> procedure fill_list_attrtypes
105240>>>>>>> integer max# attrtype#
105240>>>>>>> move (API_AttrType_Count()) to max#
105241>>>>>>> for attrtype# from 0 to (max#-1)
105247>>>>>>>>
105247>>>>>>> send combo_add_item (API_AttrType_Name(attrtype#)) attrtype#
105248>>>>>>> loop
105249>>>>>>>>
105249>>>>>>> set entry_state item 0 to false
105250>>>>>>> end_procedure
105251>>>>>>> procedure prepare_attr_values_help integer value# string codename# string displayname#
105253>>>>>>> send combo_add_item displayname# value#
105254>>>>>>> end_procedure
105255>>>>>>> procedure prepare_attr_values integer attr#
105257>>>>>>> send Combo_Delete_Data
105258>>>>>>> if (API_AttrDiscreteValues(attr#)) begin
105260>>>>>>> send API_AttrValue_Callback attr# msg_prepare_attr_values_help self
105261>>>>>>> set entry_state item 0 to false
105262>>>>>>> end
105262>>>>>>>>
105262>>>>>>> else begin
105263>>>>>>> set entry_state item 0 to true
105264>>>>>>> set value item 0 to ""
105265>>>>>>> end
105265>>>>>>>>
105265>>>>>>> end_procedure
105266>>>>>>> procedure comparison_modes_help integer comp# string str#
105268>>>>>>> send combo_add_item str# comp#
105269>>>>>>> end_procedure
105270>>>>>>> procedure prepare_comparison_modes integer attr#
105272>>>>>>> send Combo_Delete_Data
105273>>>>>>> send FdxSet_Comp_CallBack attr# msg_comparison_modes_help self
105274>>>>>>> set entry_state item 0 to false
105275>>>>>>> end_procedure
105276>>>>>>>end_class // Api_Attr.ComboFormAux
105277>>>>>>>
105277>>>>>>>
105277>>>>>Use GridUtil.utl // Grid and List utilities (not for dbGrid's or Table's)
105277>>>>>Use RGB.utl // Some color functions
105277>>>>>
105277>>>>>object oDbdFilelistReassigner is a cArray
105279>>>>> item_property_list
105279>>>>> item_property integer piCurrentEntry.i // (In dbd tables)
105279>>>>> item_property string psLogicName.i
105279>>>>> item_property integer piNewEntry.i // in global FDX
105279>>>>> item_property integer piEntryAlreadyExists.i
105279>>>>> end_item_property_list
#REM 105322 DEFINE FUNCTION PIENTRYALREADYEXISTS.I INTEGER LIROW RETURNS INTEGER
#REM 105327 DEFINE PROCEDURE SET PIENTRYALREADYEXISTS.I INTEGER LIROW INTEGER VALUE
#REM 105332 DEFINE FUNCTION PINEWENTRY.I INTEGER LIROW RETURNS INTEGER
#REM 105337 DEFINE PROCEDURE SET PINEWENTRY.I INTEGER LIROW INTEGER VALUE
#REM 105342 DEFINE FUNCTION PSLOGICNAME.I INTEGER LIROW RETURNS STRING
#REM 105347 DEFINE PROCEDURE SET PSLOGICNAME.I INTEGER LIROW STRING VALUE
#REM 105352 DEFINE FUNCTION PICURRENTENTRY.I INTEGER LIROW RETURNS INTEGER
#REM 105357 DEFINE PROCEDURE SET PICURRENTENTRY.I INTEGER LIROW INTEGER VALUE
105363>>>>> procedure ReadAllFileNumbers integer lhTableAccess
105366>>>>> integer lbFound liTableFile liFile liRow liNewFile liMax
105366>>>>> string lsLogicName
105366>>>>> send delete_data
105367>>>>> get piFile.i of lhTableAccess DBDTABLE_TABLE to liTableFile
105368>>>>> clear liTableFile
105369>>>>> repeat
105369>>>>>>
105369>>>>> vfind liTableFile 0 GT
105371>>>>> move (found) to lbFound
105372>>>>> if lbFound begin
105374>>>>> get_field_value liTableFile 1 to liFile
105377>>>>> get_field_value liTableFile 3 to lsLogicName
105380>>>>>
105380>>>>> get iFindLogicalName.si of ghFDX lsLogicName 0 to liNewFile
105381>>>>> if (liNewFile<>0 and liNewFile<>liFile) begin
105383>>>>> get row_count to liRow
105384>>>>> set piCurrentEntry.i liRow to liFile
105385>>>>> set psLogicName.i liRow to lsLogicName
105386>>>>> set piNewEntry.i liRow to liNewFile
105387>>>>> end
105387>>>>>>
105387>>>>> end
105387>>>>>>
105387>>>>> until (not(lbFound))
105389>>>>> send sort_rows 0
105390>>>>> get row_count to liMax
105391>>>>> decrement liMax
105392>>>>> for liRow from 0 to liMax
105398>>>>>>
105398>>>>> get piNewEntry.i liRow to liNewFile
105399>>>>> clear liTableFile
105400>>>>> set_field_value liTableFile 1 to liNewFile
105403>>>>> vfind liTableFile 1 EQ
105405>>>>> set piEntryAlreadyExists.i liRow to (found)
105406>>>>> loop
105407>>>>>>
105407>>>>> end_procedure
105408>>>>> object oTmpArray is a cArray
105410>>>>> procedure add_recnum integer liRecnum
105413>>>>> integer liItem
105413>>>>> get item_count to liItem
105414>>>>> set value liItem to liRecnum
105415>>>>> end_procedure
105416>>>>> procedure update_field_table integer liFile integer liNewEntry
105419>>>>> integer liItem liMax
105419>>>>> get item_count to liMax
105420>>>>> decrement liMax
105421>>>>> for liItem from 0 to liMax
105427>>>>>>
105427>>>>> clear liFile
105428>>>>> set_field_value liFile 0 to (value(self,liItem))
105431>>>>> vfind liFile 0 EQ
105433>>>>> set_field_value liFile 1 to liNewEntry
105436>>>>> saverecord liFile
105437>>>>> loop
105438>>>>>>
105438>>>>> end_procedure
105439>>>>> procedure update_index_table integer liFile integer liNewEntry
105442>>>>> // Ir really is code identical to the procedure just above us
105442>>>>> // So why not:
105442>>>>> send update_field_table liFile liNewEntry
105443>>>>> end_procedure
105444>>>>> end_object
105445>>>>> procedure Run.i integer lhTableAccess
105448>>>>> integer liRow liMax liCurrentEntry liNewEntry lbContinue lhTmpArray
105448>>>>> integer liTableFile liFieldFile liIndexFile lbFound liTestValue liRecnum
105448>>>>> send ReadAllFileNumbers lhTableAccess
105449>>>>> if (row_count(self)) begin
105451>>>>> get DBD_ReassignConfirm to lbContinue
105452>>>>> if lbContinue begin
105454>>>>> move oTmpArray to lhTmpArray
105455>>>>> get piFile.i of lhTableAccess DBDTABLE_TABLE to liTableFile
105456>>>>> get piFile.i of lhTableAccess DBDTABLE_FIELD to liFieldFile
105457>>>>> get piFile.i of lhTableAccess DBDTABLE_INDEX to liIndexFile
105458>>>>> get row_count to liMax
105459>>>>> decrement liMax
105460>>>>>
105460>>>>> send cursor_wait to (cursor_control(self))
105461>>>>> lock // -----------------------------------------------------
105462>>>>>>
105462>>>>> for liRow from 0 to liMax
105468>>>>>>
105468>>>>> get piCurrentEntry.i liRow to liCurrentEntry
105469>>>>> get piNewEntry.i liRow to liNewEntry
105470>>>>> ifnot (piEntryAlreadyExists.i(self,liRow)) begin
105472>>>>>
105472>>>>> clear liTableFile
105473>>>>> set_field_value liTableFile 1 to liCurrentEntry
105476>>>>> vfind liTableFile 1 EQ
105478>>>>> set_field_value liTableFile 1 to liNewEntry
105481>>>>> saverecord liTableFile
105482>>>>>
105482>>>>> send delete_data of lhTmpArray // Find all fields
105483>>>>> clear liFieldFile
105484>>>>> set_field_value liFieldFile 1 to liCurrentEntry
105487>>>>> repeat
105487>>>>>>
105487>>>>> vfind liFieldFile 1 GT
105489>>>>> move (found) to lbFound
105490>>>>> if lbFound begin
105492>>>>> get_field_value liFieldFile 1 to liTestValue
105495>>>>> move (liTestValue=liCurrentEntry) to lbFound
105496>>>>> if lbFound begin
105498>>>>> get_field_value liFieldFile 0 to liRecnum
105501>>>>> send add_recnum of lhTmpArray liRecnum
105502>>>>> end
105502>>>>>>
105502>>>>> end
105502>>>>>>
105502>>>>> until (not(lbFound))
105504>>>>> send update_field_table of lhTmpArray liFieldFile liNewEntry
105505>>>>>
105505>>>>> send delete_data of lhTmpArray // Find all indices
105506>>>>> clear liIndexFile
105507>>>>> set_field_value liIndexFile 1 to liCurrentEntry
105510>>>>> repeat
105510>>>>>>
105510>>>>> vfind liIndexFile 1 GT
105512>>>>> move (found) to lbFound
105513>>>>> if lbFound begin
105515>>>>> get_field_value liIndexFile 1 to liTestValue
105518>>>>> move (liTestValue=liCurrentEntry) to lbFound
105519>>>>> if lbFound begin
105521>>>>> get_field_value liIndexFile 0 to liRecnum
105524>>>>> send add_recnum of lhTmpArray liRecnum
105525>>>>> end
105525>>>>>>
105525>>>>> end
105525>>>>>>
105525>>>>> until (not(lbFound))
105527>>>>> send update_index_table of lhTmpArray liIndexFile liNewEntry
105528>>>>> end
105528>>>>>>
105528>>>>> loop
105529>>>>>>
105529>>>>> unlock // ---------------------------------------------------
105530>>>>>>
105530>>>>> send cursor_ready to (cursor_control(self))
105531>>>>> send obs "Done"
105532>>>>> end
105532>>>>>>
105532>>>>> end
105532>>>>>>
105532>>>>> else send obs "Table numbers are already in accordance with filelist.cfg" "(If you have fastload enabled you may have to 'refresh')"
105534>>>>> end_procedure
105535>>>>>end_object // oDbdFilelistReassigner
105536>>>>>
105536>>>>>object oDbdFilelistReassignerConfirm is a aps.ModalPanel label "Reassign table numbers according to filelist.cfg"
105539>>>>> set locate_mode to CENTER_ON_SCREEN
105540>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
105541>>>>> on_key ksave_record send close_panel_ok
105542>>>>> on_key kcancel send close_panel
105543>>>>> property integer pbResult
105545>>>>>
105545>>>>> object oGrid is a aps.Grid
105547>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
105548>>>>> send GridPrepare_AddColumn "Logical name" AFT_ASCII12
105549>>>>> send GridPrepare_AddColumn "Current entry" AFT_NUMERIC4.0
105550>>>>> send GridPrepare_AddColumn "New entry" AFT_NUMERIC4.0
105551>>>>> send GridPrepare_AddCheckBoxColumn "New entry already occupied"
105552>>>>> send GridPrepare_Apply self
105553>>>>> set select_mode to NO_SELECT
105554>>>>> on_key KNEXT_ITEM send switch
105555>>>>> on_key KPREVIOUS_ITEM send switch_back
105556>>>>> set size to 200 0
105557>>>>> procedure fill_list
105560>>>>> integer lhArr liRow liMax
105560>>>>> send delete_data
105561>>>>> move oDbdFilelistReassigner to lhArr
105562>>>>> set dynamic_update_state to FALSE
105563>>>>> get row_count of lhArr to liMax
105564>>>>> decrement liMax
105565>>>>> for liRow from 0 to liMax
105571>>>>>>
105571>>>>> send add_item MSG_NONE (psLogicName.i(lhArr,liRow))
105572>>>>> send add_item MSG_NONE (piCurrentEntry.i(lhArr,liRow))
105573>>>>> send add_item MSG_NONE (piNewEntry.i(lhArr,liRow))
105574>>>>> send Grid_AddCheckBoxItem self (piEntryAlreadyExists.i(lhArr,liRow))
105575>>>>> loop
105576>>>>>>
105576>>>>> set dynamic_update_state to TRUE
105577>>>>> send Grid_SetEntryState self FALSE
105578>>>>> end_procedure
105579>>>>> end_object
105580>>>>>
105580>>>>> object oBtn1 is a aps.Multi_Button
105582>>>>> on_item "OK" send close_panel_ok
105583>>>>> set peAnchors to (anBottom+anRight)
105584>>>>> end_object
105585>>>>> object oBtn2 is a aps.Multi_Button
105587>>>>> on_item "Close" send close_panel
105588>>>>> set peAnchors to (anBottom+anRight)
105589>>>>> end_object
105590>>>>> send aps_locate_multi_buttons
105591>>>>>
105591>>>>> procedure close_panel_ok
105594>>>>> set pbResult to DFTRUE
105595>>>>> send close_panel
105596>>>>> end_procedure
105597>>>>> function iPopup returns integer
105600>>>>> set pbResult to DFFALSE
105601>>>>> send fill_list of oGrid
105602>>>>> send popup
105603>>>>> function_return (pbResult(self))
105604>>>>> end_procedure
105605>>>>>end_object // oDbdFilelistReassignerConfirm
105606>>>>>send aps_SetMinimumDialogSize (oDbdFilelistReassignerConfirm(self)) // Set minimum size
105607>>>>>
105607>>>>>function DBD_ReassignConfirm global returns integer
105609>>>>> integer lbRval
105609>>>>> get iPopup of oDbdFilelistReassignerConfirm to lbRval
105610>>>>> function_return lbRval
105611>>>>>end_function
105612>>>>>
105612>>>>>
/DBD.HELP.MAIN
Image 5, DBD.HELP.MAIN
<h1>Document your database</h1>
<p>You may document your database table by table and field by field using this
function. The text you enter, may be used to describe your database to other
developers or the contents may be published for use with VDFQuery (later).</p>
<p>The data you enter is stored in a set of tables that may be queried using the
built in report (the Report button) or whatever reporting tool you have handy.</p>
/Dbd.Help.CreateTables
Image 6, DBD.HELP.CREATETABLES
<h1>Document your database</h1>
<h2>Description tables not found</h2>
<p>In order for this function to work a set of tables must be created to store
the table and field descriptions.</p>
<p>This is a automated process that will look for 4 available entries in your
<i>filelist.cfg</i> (above entry 600) and fill them in with a set of empty
tables automatically created for this purpose.</p>
<p><b>NOTE</b> that the first thing you want to do after having created the
tables is to click the "Read DB definitions" button in the main view</p>
/*
105612>>>>>
105612>>>>>
105612>>>>>object oDbdSetOfFieldsResultModal is a aps.ModalPanel
105614>>>>> set locate_mode to CENTER_ON_SCREEN
105615>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
105616>>>>> on_key kcancel send close_panel
105617>>>>> on_key ksave_record send none
105618>>>>> on_key KEY_ALT+KEY_U send DoUnion
105619>>>>> on_key KEY_ALT+KEY_I send DoIntersection
105620>>>>> on_key KEY_ALT+KEY_C send DoComplement
105621>>>>> property integer phResultSet public 0
105623>>>>> property integer phTargetSet public 0
105625>>>>> register_object oTxt
105625>>>>> object oLst is a cFdxSetOfFieldsList
105627>>>>> set size to 100 0
105628>>>>> set peResizeColumn to rcAll
105629>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
105630>>>>> procedure update_display_counter integer liFiles integer liFields
105633>>>>> string lsValue
105633>>>>> if liFields move (string(liFields)+" fields from "+string(liFiles)+" tables") to lsValue
105636>>>>> else move "" to lsValue
105638>>>>> set value of (oTxt(self)) item 0 to lsValue
105639>>>>> end_procedure
105640>>>>> end_object
105641>>>>> object oTxt is a aps.TextBox snap SL_DOWN
105644>>>>> set peAnchors to (anRight+anBottom+anLeft)
105645>>>>> set auto_size_state to false
105646>>>>> set size to 10 300
105647>>>>> set value to "(empty)"
105648>>>>> end_object
105649>>>>> set auto_size_state of (oTxt(self)) to true
105650>>>>> object oBtn1 is a aps.Multi_Button
105652>>>>> set peAnchors to (anRight+anBottom)
105653>>>>> on_item "&Union" send DoUnion
105654>>>>> end_object
105655>>>>> object oBtn2 is a aps.Multi_Button
105657>>>>> set peAnchors to (anRight+anBottom)
105658>>>>> on_item "&Intersection" send DoIntersection
105659>>>>> end_object
105660>>>>> object oBtn3 is a aps.Multi_Button
105662>>>>> set peAnchors to (anRight+anBottom)
105663>>>>> on_item "&Complement" send DoComplement
105664>>>>> end_object
105665>>>>> object oBtn4 is a aps.Multi_Button
105667>>>>> set peAnchors to (anRight+anBottom)
105668>>>>> on_item t.btn.cancel send close_panel
105669>>>>> end_object
105670>>>>> send aps_locate_multi_buttons
105671>>>>> procedure DoIntersection
105674>>>>> send DoIntersection.i to (phTargetSet(self)) (phResultSet(self))
105675>>>>> send close_panel
105676>>>>> end_procedure
105677>>>>> procedure DoUnion
105680>>>>> send DoUnion.i to (phTargetSet(self)) (phResultSet(self))
105681>>>>> send close_panel
105682>>>>> end_procedure
105683>>>>> procedure DoComplement
105686>>>>> send DoComplement.i to (phTargetSet(self)) (phResultSet(self))
105687>>>>> send close_panel
105688>>>>> end_procedure
105689>>>>> procedure update_display integer lhResultSet
105692>>>>> set label to (psTitle(lhResultSet))
105693>>>>> set phResultSet to lhResultSet
105694>>>>> send fill_list.i to (oLst(self)) lhResultSet
105695>>>>> end_procedure
105696>>>>> procedure popup.ii integer lhResultSet integer lhTargetset
105699>>>>> set phTargetSet to lhTargetset
105700>>>>> send update_display lhResultSet
105701>>>>> send popup
105702>>>>> end_procedure
105703>>>>>end_object // oDbdSetOfFieldsResultModal
105704>>>>>send aps_SetMinimumDialogSize (oDbdSetOfFieldsResultModal(self))
105705>>>>>
105705>>>>>object oDbdFieldSearcher is a aps.View label "Field search"
105708>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
105709>>>>> set Window_Style to WS_MAXIMIZEBOX 1
105710>>>>> on_key kcancel send close_panel
105711>>>>> property integer phDbdView
105713>>>>>
105713>>>>> procedure GoBackToDbd
105716>>>>> send GotoEditObject to (phDbdView(self))
105717>>>>> end_procedure
105718>>>>> on_key KEY_ALT+KEY_S send GoBackToDbd
105719>>>>>
105719>>>>> // If the DBD view that started this view is closed we should close this view as well
105719>>>>> procedure DestroyingDbdView integer lhView
105722>>>>> if (lhView=phDbdView(self)) send close_panel
105725>>>>> end_procedure
105726>>>>> object oSetOfFields is a cFdxSetOfFields
105728>>>>> set piFDX_Server to ghFDX
105729>>>>> end_object
105730>>>>> object oSetOfFieldsResult is a cFdxSetOfFields
105732>>>>> set piFDX_Server to ghFDX
105733>>>>> set psTitle to "Field search result"
105734>>>>> end_object
105735>>>>> object oLst is a cFdxSetOfFieldsList
105737>>>>> set piAllowDelete to dfTrue
105738>>>>> set size to 100 0
105739>>>>> set piFDX_Server to ghFDX
105740>>>>> set piSOF_Server to (oSetOfFields(self))
105741>>>>> set peResizeColumn to rcAll
105742>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
105743>>>>> procedure update_display_counter integer liFiles integer liFields
105746>>>>> string lsValue
105746>>>>> if liFields move (string(liFields)+" fields from "+string(liFiles)+" tables") to lsValue
105749>>>>> else move "(empty)" to lsValue
105751>>>>> set value of (oTxt(self)) item 0 to lsValue
105752>>>>> end_procedure
105753>>>>>
105753>>>>> procedure row_change integer liRowFrom integer liRowTo
105756>>>>> send DisplayDbd liRowTo
105757>>>>> end_procedure
105758>>>>> procedure item_change integer liItm1 integer liItm2 returns integer
105761>>>>> integer liRval liColumns
105761>>>>> get Grid_Columns self to liColumns
105762>>>>> forward get msg_item_change liItm1 liItm2 to liRval
105764>>>>> if (liItm1/liColumns) ne (liItm2/liColumns) send row_change (liItm1/liColumns) (liItm2/liColumns)
105767>>>>> procedure_return liRval
105768>>>>> end_procedure
105769>>>>>
105769>>>>> end_object
105770>>>>> procedure DoWriteToFile
105773>>>>> send DoWriteToFile of oLst
105774>>>>> end_procedure
105775>>>>> on_key KEY_CTRL+KEY_W send DoWriteToFile
105776>>>>> object oTxt is a aps.TextBox snap SL_DOWN
105779>>>>> set peAnchors to (anRight+anBottom+anLeft)
105780>>>>> set auto_size_state to false
105781>>>>> set size to 10 300
105782>>>>> set value to "(empty)"
105783>>>>> end_object
105784>>>>> object oTrackMainView is a aps.CheckBox label "Track fields in main panel" snap SL_RIGHT_SPACE
105788>>>>> set peAnchors to (anRight+anBottom)
105789>>>>> set checked_state to true
105790>>>>> end_object
105791>>>>> procedure DisplayDbd integer liRow
105794>>>>> integer liFile lbSelect
105794>>>>> string lsFieldName
105794>>>>> get checked_state of oTrackMainView to lbSelect
105795>>>>> if lbSelect begin
105797>>>>> get row_file.i of oLst liRow to liFile
105798>>>>> get row_field_name.i of oLst liRow to lsFieldName
105799>>>>> send GotoField of (phDbdView(self)) liFile lsFieldName
105800>>>>> end
105800>>>>>>
105800>>>>> end_procedure
105801>>>>>
105801>>>>> send aps_goto_max_row
105802>>>>>
105802>>>>> object oHint1 is a aps.TextBox label " Click column headers to sort the grid. "
105805>>>>> set color to (RGB_Brighten(clYellow,75))
105806>>>>> set peAnchors to (anBottom+anLeft)
105807>>>>> set justification_mode to (JMODE_CENTER+JMODE_VCENTER)
105808>>>>> end_object
105809>>>>> object oHint2 is a aps.TextBox label " Press Ctrl+W to write grid contents to ASCII file " snap SL_RIGHT
105813>>>>> set color to (RGB_Brighten(clYellow,75))
105814>>>>> set peAnchors to (anRight+anBottom+anLeft)
105815>>>>> set justification_mode to (JMODE_CENTER+JMODE_VCENTER)
105816>>>>> end_object
105817>>>>> object oHint3 is a aps.TextBox label " When selecting by name, wildcards are allowed " snap SL_RIGHT
105821>>>>> set color to (RGB_Brighten(clYellow,75))
105822>>>>> set peAnchors to (anRight+anBottom)
105823>>>>> set justification_mode to (JMODE_CENTER+JMODE_VCENTER)
105824>>>>> end_object
105825>>>>> send aps_goto_max_row
105826>>>>> object oAddFieldsGroup is a aps.Group label "Add fields (selected by attribute value):"
105829>>>>> set peAnchors to (anRight+anBottom+anLeft)
105830>>>>> set p_auto_column to 0
105831>>>>> object oAttribute is a Api_Attr.ComboFormAux label "Attribute:"
105834>>>>> set form_margin item 0 to 20
105835>>>>> set p_extra_internal_width to -50
105836>>>>> procedure OnChange
105839>>>>> send DoUpdate (Combo_Current_Aux_Value(self))
105840>>>>> end_procedure
105841>>>>> procedure fill_list_attrtype integer liAttrTyoe
105844>>>>> forward send fill_list_attrtype liAttrTyoe // which is ATTRTYPE_FIELD
105846>>>>> set value item 0 to "Name"
105847>>>>> end_procedure
105848>>>>> end_object
105849>>>>> object oComperator is a Api_Attr.ComboFormAux label "Comp:" snap SL_RIGHT_SPACE
105853>>>>> set form_margin item 0 to 2
105854>>>>> end_object
105855>>>>> object oDiscreteValue is a Api_Attr.ComboFormAux label "Discrete value:" snap SL_RIGHT_SPACE
105859>>>>> set p_extra_internal_width to -23
105860>>>>> set form_margin item 0 to 10
105861>>>>> end_object
105862>>>>> object oUserValue is a aps.Form label "User value:" snap SL_RIGHT_SPACE
105866>>>>> set form_margin item 0 to 20
105867>>>>> set p_extra_internal_width to -40
105868>>>>> set peAnchors to (anRight+anLeft)
105869>>>>> on_key kenter send DoAddFields
105870>>>>> end_object
105871>>>>> procedure DoUpdate integer liAttr
105874>>>>> send prepare_comparison_modes to (oComperator(self)) liAttr
105875>>>>> send prepare_attr_values to (oDiscreteValue(self)) liAttr
105876>>>>> if (API_AttrDiscreteValues(liAttr)) begin
105878>>>>> set enabled_state of (oDiscreteValue(self)) to true
105879>>>>> set enabled_state of (oUserValue(self)) to false
105880>>>>> set value of (oUserValue(self)) item 0 to ""
105881>>>>> end
105881>>>>>>
105881>>>>> else begin
105882>>>>> set enabled_state of (oDiscreteValue(self)) to false
105883>>>>> set enabled_state of (oUserValue(self)) to true
105884>>>>> end
105884>>>>>>
105884>>>>> end_procedure
105885>>>>> function iAttribute returns integer
105888>>>>> function_return (Combo_Current_Aux_Value(oAttribute(self)))
105889>>>>> end_function
105890>>>>> function iComperator returns integer
105893>>>>> function_return (Combo_Current_Aux_Value(oComperator(self)))
105894>>>>> end_function
105895>>>>> function sValue returns string
105898>>>>> if (API_AttrDiscreteValues(iAttribute(self))) function_return (Combo_Current_Aux_Value(oDiscreteValue(self)))
105901>>>>> function_return (value(oUserValue(self),0))
105902>>>>> end_function
105903>>>>> procedure DoAddFields
105906>>>>> integer lhSet lbNotEmpty
105906>>>>> get row_count of oSetOfFields to lbNotEmpty
105907>>>>> if lbNotEmpty move (oSetOfFieldsResult(self)) to lhSet
105910>>>>> else move (oSetOfFields(self)) to lhSet
105912>>>>>
105912>>>>> set piTestAttribute of lhSet to (iAttribute(self))
105913>>>>> set piTestCompMode of lhSet to (iComperator(self))
105914>>>>> set psTestValue of lhSet to (sValue(self))
105915>>>>>
105915>>>>> // This line saves us for a lot of errors if an alphanumeric value is entered into an integer comparation:
105915>>>>> if (piTestAttribute(lhSet)<>DF_FIELD_NAME) set psTestValue of lhSet to (ExtractInteger(psTestValue(lhSet),1))
105918>>>>>
105918>>>>> send Traverse_All of lhSet
105919>>>>> send DoRemoveFile.i of lhSet 49 // Remove MENU
105920>>>>> send DoRemoveFile.i of lhSet 50 // Remove FLEXERRS
105921>>>>>
105921>>>>> if lbNotEmpty begin // The set was empty so we just dump it right away
105923>>>>> send popup.ii of oDbdSetOfFieldsResultModal lhSet (oSetOfFields(self))
105924>>>>> send fill_list.i of oLst (oSetOfFields(self))
105925>>>>> end
105925>>>>>>
105925>>>>> else begin
105926>>>>> send fill_list.i of oLst lhSet
105927>>>>> end
105927>>>>>>
105927>>>>> end_procedure
105928>>>>> object oAddBtn is a aps.Button snap SL_RIGHT_SPACE
105931>>>>> set size to 14 30
105932>>>>> set peAnchors to (anRight)
105933>>>>> on_item "Add" send DoAddFields
105934>>>>> end_object
105935>>>>> send Combo_Delete_Data to (oAttribute(self))
105936>>>>> send Combo_Delete_Data to (oComperator(self))
105937>>>>> send Combo_Delete_Data to (oDiscreteValue(self))
105938>>>>> send fill_list_attrtype to (oAttribute(self)) ATTRTYPE_FIELD
105939>>>>> send DoUpdate (Combo_Current_Aux_Value(oAttribute(self)))
105940>>>>> end_object // oAddFieldsGroup
105941>>>>> procedure DoSelectByRelation
105944>>>>> integer liFile liField liRow lhLst lhSet
105944>>>>> move (oLst(self)) to lhSet
105945>>>>> if (item_count(lhSet)) begin
105947>>>>> get Grid_CurrentRow lhSet to liRow
105948>>>>> get row_file.i of lhSet liRow to liFile
105949>>>>> get row_field.i of lhSet liRow to liField
105950>>>>> move (oSetOfFieldsResult(self)) to lhSet
105951>>>>>
105951>>>>> send Traverse_ConnectedFields of lhSet liFile liField
105952>>>>>
105952>>>>> send DoRemoveFile.i of lhSet 49 // Remove MENU
105953>>>>> send DoRemoveFile.i of lhSet 50 // Remove FLEXERRS
105954>>>>> send popup.ii of oDbdSetOfFieldsResultModal lhSet (oSetOfFields(self))
105955>>>>> send fill_list.i of oLst (oSetOfFields(self))
105956>>>>> end
105956>>>>>>
105956>>>>> else send obs "You must point to a field" "before executing this function"
105958>>>>> end_procedure
105959>>>>> object oBtn1 is a aps.Multi_Button
105961>>>>> set size to 14 50
105962>>>>> set peAnchors to (anRight+anBottom)
105963>>>>> on_item t.btn.reset send DoReset
105964>>>>> end_object
105965>>>>> object oBtn2 is a aps.Multi_Button
105967>>>>> set size to 14 83
105968>>>>> set peAnchors to (anRight+anBottom)
105969>>>>> on_item "Select by relations" send DoSelectByRelation
105970>>>>> end_object
105971>>>>> object oBtn3 is a aps.Multi_Button
105973>>>>> set size to 14 50
105974>>>>> set peAnchors to (anRight+anBottom)
105975>>>>> on_item t.btn.close send close_panel
105976>>>>> end_object
105977>>>>> send aps_locate_multi_buttons
105978>>>>> procedure DoReset
105981>>>>> send reset to (oSetOfFields(self))
105982>>>>> send update_display
105983>>>>> end_procedure
105984>>>>> procedure DoPrint
105987>>>>> end_procedure
105988>>>>> procedure update_display
105991>>>>> send fill_list.i to (oLst(self)) (oSetOfFields(self))
105992>>>>> end_procedure
105993>>>>> procedure OnChangeFdx
105996>>>>> send reset to (oSetOfFields(self))
105997>>>>> send update_display
105998>>>>> end_procedure
105999>>>>>end_object // oDbdFieldSearcher
106000>>>>>send aps_SetMinimumDialogSize (oDbdFieldSearcher(self))
106001>>>>>
106001>>>>>procedure Activate_DbdFieldSearcher integer lhDbdView
106004>>>>> set phDbdView of oDbdFieldSearcher to lhDbdView
106005>>>>> send popup of oDbdFieldSearcher
106006>>>>>end_procedure
106007>>>>>
106007>>>>>
106007>>>>>
106007>>>>>DEFINE_OBJECT_GROUP OG_Dbd_View
106008>>>>> object oDBD_System is a cDBD_System
106010>>>>> object oDBD_TableAccess is a cDBD_TableAccess
106012>>>>> set pbOpenTablesOnDefine to false
106013>>>>> set psRootNamePrefix to (og_param(0))
106014>>>>> function bConvertFilelistTo4095 returns integer
106017>>>>> function_return (MB_Verify4("Your filelist.cfg is an old one","with less than 256 entries.","","Should it be converted to a 4095 entry filelist?",1))
106018>>>>> end_function
106019>>>>> end_object
106020>>>>> object oDBD_Updater is a cDBD_Updater
106022>>>>> object oUpdateSentinel is a cBatchCompanion
106024>>>>> end_object
106025>>>>> procedure OnUpdateBegin
106028>>>>> send batch_on of oUpdateSentinel "Reading (new) tables and fields"
106029>>>>> end_procedure
106030>>>>> procedure OnHandleTable string lsMsg
106033>>>>> send batch_update of oUpdateSentinel lsMsg
106034>>>>> end_procedure
106035>>>>> procedure OnHandleField string lsMsg
106038>>>>> send batch_update2 of oUpdateSentinel lsMsg
106039>>>>> end_procedure
106040>>>>> procedure OnHandleIndex string lsMsg
106043>>>>> send batch_update2 of oUpdateSentinel lsMsg
106044>>>>> end_procedure
106045>>>>> procedure OnUpdateEnd
106048>>>>> send batch_off of oUpdateSentinel
106049>>>>> end_procedure
106050>>>>> end_object
106051>>>>> move self to OG_Current_Object# // global integer
106052>>>>> end_object // oDBD_System
106053>>>>>
106053>>>>> // WindowIndex is a globally defined integer that I use
106053>>>>>
106053>>>>> get DoOpenTables of (oDBD_TableAccess(OG_Current_Object#)) to WindowIndex
106054>>>>> ifnot WindowIndex begin
106056>>>>> //send Popup_DbdControlPanel OG_Current_Object#
106056>>>>> send Popup_DbdCreateTablesPanel OG_Current_Object#
106057>>>>> get DoOpenTables of (oDBD_TableAccess(OG_Current_Object#)) to WindowIndex
106058>>>>> end
106058>>>>>>
106058>>>>>
106058>>>>> ifnot WindowIndex begin // Tables were not opened: therefore we abort the whole thing
106060>>>>> send Request_Destroy_Object of OG_Current_Object#
106061>>>>> move 0 to OG_Current_Object#
106062>>>>> end
106062>>>>>>
106062>>>>> else begin
106063>>>>> object oDBD_View is a aps.dbView
106065>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
106066>>>>> set Window_Style to WS_MAXIMIZEBOX 1
106067>>>>> on_key kcancel send close_panel
106068>>>>> on_key key_ctrl+key_n send Request_CloneView
106069>>>>>
106069>>>>> procedure Request_CloneView
106072>>>>> integer liLocation lhVw lhParent
106072>>>>> get location to liLocation
106073>>>>>
106073>>>>> get parent of self to lhParent
106074>>>>>
106074>>>>> CREATE_OBJECT_GROUP OG_Dbd_View PARENT lhParent "db"
106084>>>>> if (OG_Current_Object#<>0) begin
106086>>>>> move OG_Current_Object# to lhVw
106087>>>>> set location of lhVw to (hi(liLocation)+13) (low(liLocation)+13)
106088>>>>> send popup to lhVw
106089>>>>> end
106089>>>>>>
106089>>>>> else send obs "Tables could not be opened"
106091>>>>> end_procedure
106092>>>>>
106092>>>>> function ViewPanelObjectId returns integer
106095>>>>> function_return self
106096>>>>> end_function
106097>>>>>
106097>>>>> property integer phDbdSystem public OG_Current_Object#
106099>>>>> property integer piTable_FileNumber public 0
106101>>>>> property integer piField_FileNumber public 0
106103>>>>> property integer piIndex_FileNumber public 0
106105>>>>>
106105>>>>> function iTable_FileNumber returns integer
106108>>>>> integer lhTableAccess liTableFile
106108>>>>> move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess
106109>>>>> get piFile.i of lhTableAccess DBDTABLE_TABLE to liTableFile
106110>>>>> function_return liTableFile
106111>>>>> end_function
106112>>>>> function iField_FileNumber returns integer
106115>>>>> integer lhTableAccess liFieldFile
106115>>>>> move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess
106116>>>>> get piFile.i of lhTableAccess DBDTABLE_FIELD to liFieldFile
106117>>>>> function_return liFieldFile
106118>>>>> end_function
106119>>>>>
106119>>>>> object oTable_DD is a DataDictionary
106121>>>>> //set main_file to dbTable.file_number
106121>>>>> procedure OnCreate
106124>>>>> integer lhTableAccess
106124>>>>> move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess
106125>>>>> set main_file to (piFile.i(lhTableAccess,DBDTABLE_TABLE))
106126>>>>> set piTable_FileNumber to (main_file(self))
106127>>>>> send DDUTIL_DoQuickSetup self
106128>>>>> set cascade_delete_state to false // Don't delete tables if fields exists
106129>>>>> end_procedure
106130>>>>> send OnCreate
106131>>>>> procedure new_current_record integer liOldRec integer liNewRec
106134>>>>> forward send new_current_record liOldRec liNewRec
106136>>>>> send update_ui_properties
106137>>>>> end_procedure
106138>>>>> end_object
106139>>>>>
106139>>>>> // The bConstrainHelp function is placed here (instead of inside the
106139>>>>> // oField_DD object, where it belongs) because of an error in the
106139>>>>> // constrain mechanism (that is not able to interprete the "self"
106139>>>>> // symbol correctly)
106139>>>>> property integer pbCommentedOnly public false
106141>>>>> function bConstrainHelp returns integer
106144>>>>> integer liFile
106144>>>>> string lsValue
106144>>>>> if (pbCommentedOnly(self)) begin
106146>>>>> get piFile.i of (phTableAccessObject(integer(phDbdSystem(self)))) DBDTABLE_FIELD to liFile
106147>>>>> get_field_value liFile 5 to lsValue
106150>>>>> function_return (lsValue<>"")
106151>>>>> end
106151>>>>>>
106151>>>>> else function_return 1
106153>>>>> end_function
106154>>>>> object oField_DD is a DataDictionary
106156>>>>> procedure OnCreate
106159>>>>> integer lhTableAccess
106159>>>>> move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess
106160>>>>> set main_file to (piFile.i(lhTableAccess,DBDTABLE_FIELD))
106161>>>>> set constrain_file to (piFile.i(lhTableAccess,DBDTABLE_TABLE))
106162>>>>> set piField_FileNumber to (main_file(self))
106163>>>>> set key_field_state 2 to true
106164>>>>> send DDUTIL_DoQuickSetup self
106165>>>>> end_procedure
106166>>>>> send OnCreate
106167>>>>> set DDO_Server to oTable_DD
106168>>>>> set ordering to 2
106169>>>>>
106169>>>>> procedure OnConstrain
106172>>>>> integer liFile
106172>>>>> get piFile.i of (phTableAccessObject(integer(phDbdSystem(self)))) DBDTABLE_TABLE to liFile
106173>>>>> set constrain_file to liFile
106174>>>>> get piFile.i of (phTableAccessObject(integer(phDbdSystem(self)))) DBDTABLE_FIELD to liFile
106175>>>>> vconstrain liFile as (bConstrainHelp(self))
106176>>>>> end_procedure
106177>>>>>
106177>>>>> Procedure Field_Defaults
106180>>>>> integer liPos
106180>>>>> //integer lhTableAccess
106180>>>>> //move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess
106180>>>>> get iNextAvailableFieldPosCurrentTable of (phTableAccessObject(integer(phDbdSystem(self)))) to liPos
106181>>>>> set field_changed_value 2 to liPos
106182>>>>> End_Procedure
106183>>>>>
106183>>>>> procedure save_main_file
106186>>>>> integer liTableFile liFieldFile liTableId
106186>>>>> date ldDate
106186>>>>> string lsName lsBetterName
106186>>>>> get iTable_FileNumber to liTableFile
106187>>>>> get iField_FileNumber to liFieldFile
106188>>>>>
106188>>>>> get_field_value liTableFile 1 to liTableId
106191>>>>> get_field_value liFieldFile 3 to lsName
106194>>>>> get_field_value liFieldFile 6 to lsBetterName
106197>>>>>
106197>>>>> if (liTableId=DBDLIB_DICTIONARY or liTableId=DBDLIB_ARTICLES) begin
106199>>>>> set_field_value liFieldFile 3 to lsBetterName
106202>>>>> end
106202>>>>>>
106202>>>>> if (liTableId=DBDLIB_CALENDAR ) begin
106204>>>>> if (DateIsValid(lsBetterName)) begin
106206>>>>> move (date(lsBetterName)) to ldDate
106207>>>>> move (DateToString(ldDate,DF_DATE_MILITARY,1,"")) to lsName
106208>>>>> set_field_value liFieldFile 3 to lsName
106211>>>>> end
106211>>>>>>
106211>>>>> else error 205 "Enter a valid date"
106213>>>>> end
106213>>>>>>
106213>>>>>
106213>>>>> forward send save_main_file
106215>>>>> end_procedure
106216>>>>> end_object
106217>>>>> object oIndex_DD is a DataDictionary
106219>>>>> procedure OnCreate
106222>>>>> integer lhTableAccess
106222>>>>> move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess
106223>>>>> set main_file to (piFile.i(lhTableAccess,DBDTABLE_INDEX))
106224>>>>> set constrain_file to (piFile.i(lhTableAccess,DBDTABLE_TABLE))
106225>>>>> set piIndex_FileNumber to (main_file(self))
106226>>>>> send DDUTIL_DoQuickSetup self
106227>>>>> end_procedure
106228>>>>> send OnCreate
106229>>>>> set DDO_Server to oTable_DD
106230>>>>> set ordering to 1
106231>>>>> end_object
106232>>>>>
106232>>>>> set server to oTable_DD
106233>>>>> set main_dd to oTable_DD
106234>>>>>
106234>>>>> set auto_clear_deo_state to false
106235>>>>>
106235>>>>> set Verify_Save_Msg to GET_Verify_Save_AutoName
106236>>>>> set Verify_Delete_Msg to GET_Verify_Delete_AutoName
106237>>>>>
106237>>>>> procedure DoSetPanelLabel
106240>>>>> string lsValue lsTableFn
106240>>>>> move "Document your database (#, #)" to lsValue
106241>>>>> move (replace("#",lsValue,psRootNamePrefix(phTableAccessObject(phDbdSystem(self))))) to lsValue
106242>>>>> get DBMS_TablePath (piTable_FileNumber(self)) to lsTableFn
106243>>>>> move (replace("#",lsValue,lsTableFn)) to lsValue
106244>>>>> set label to lsValue
106245>>>>> end_procedure
106246>>>>> send DoSetPanelLabel
106247>>>>>
106247>>>>> set p_auto_column to 1
106248>>>>> object dbTable_Tbl_Id is a aps.dbForm label "Table no:"
106251>>>>> send bind_data (piTable_FileNumber(self)) 1 // entry_item dbTable.Tbl_Id
106252>>>>> set prompt_object 0 to (DefaultPromptList(self))
106253>>>>> end_object
106254>>>>> object dbTable_Tbl_Name is a aps.dbForm label NONE snap SL_RIGHT_SPACE
106258>>>>> send bind_data (piTable_FileNumber(self)) 2 // entry_item dbTable.Tbl_Name
106259>>>>> set p_extra_internal_width to -26
106260>>>>> set entry_state item 0 to FALSE
106261>>>>> set enabled_state to FALSE
106262>>>>> end_object
106263>>>>> object dbTable_Tbl_Logic_Name is a aps.dbForm label "Logical name:"
106266>>>>> send bind_data (piTable_FileNumber(self)) 3 // entry_item dbTable.Tbl_Logic_Name
106267>>>>> set entry_state item 0 to FALSE
106268>>>>> set enabled_state to FALSE
106269>>>>> end_object
106270>>>>> object dbTable_Tbl_Physic_Name is a aps.dbForm snap SL_RIGHT_SPACE label "Physical name:"
106274>>>>> set p_extra_internal_width to -300
106275>>>>> send bind_data (piTable_FileNumber(self)) 4 // entry_item dbTable.Tbl_Physic_Name
106276>>>>> set entry_state item 0 to FALSE
106277>>>>> set enabled_state to FALSE
106278>>>>> end_object
106279>>>>> object dbTable_Tbl_Not_Found is a aps.dbCheckBox label "Table definition not found"
106282>>>>> send bind_data (piTable_FileNumber(self)) 5 // entry_item dbTable.Tbl_Not_Found
106283>>>>> set enabled_state to FALSE
106284>>>>> end_object
106285>>>>> object dbTable_Tbl_Not_Found is a aps.dbCheckBox label "Table obsolete" snap SL_RIGHT_SPACE
106289>>>>> send bind_data (piTable_FileNumber(self)) 8 // entry_item dbTable.Tbl_Obsolete
106290>>>>> end_object
106291>>>>> object dbTable_Tbl_OpenAs_Path is a aps.dbForm label "Data path:"
106294>>>>> set p_extra_internal_width to -1050
106295>>>>> send bind_data (piTable_FileNumber(self)) 6 // entry_item dbTable.Tbl_OpenAs_Path
106296>>>>> set enabled_state to FALSE
106297>>>>> end_object
106298>>>>> set p_auto_column to 0
106299>>>>> send aps_goto_max_row
106300>>>>> send aps_make_row_space 2
106301>>>>> object oSliderLabel is a aps.TextBox label "Font size:"
106304>>>>> end_object
106305>>>>>
106305>>>>> object oSlider is a TrackBar
106307>>>>> set Size To 13 100
106308>>>>> set Location To 50 10
106309>>>>> set Minimum_Position To 12
106310>>>>> set Maximum_Position To 36
106311>>>>> set Skip_State to true
106312>>>>>
106312>>>>> procedure OnSliding
106315>>>>> integer liFontSize
106315>>>>> get Current_Position to liFontSize
106316>>>>> send DoAllFontSize liFontSize
106317>>>>> end_procedure
106318>>>>>
106318>>>>> procedure OnFinishedSliding
106321>>>>> integer liFontSize
106321>>>>> get Current_Position to liFontSize
106322>>>>> send DoAllFontSize liFontSize
106323>>>>> end_procedure
106324>>>>> property integer p_extra_external_width public 30
106326>>>>> end_object
106327>>>>> send aps_auto_locate_control (oSlider(self)) SL_RIGHT
106328>>>>> send aps_align_by_moving (oSlider(self)) (dbTable_Tbl_OpenAs_Path(self)) SL_ALIGN_LEFT
106329>>>>> object oDisplayDefBtn is a aps.Button snap SL_RIGHT
106332>>>>> procedure DisplayDef
106335>>>>> integer liTableID liTableFile
106335>>>>> get iTable_FileNumber to liTableFile
106336>>>>> get_field_value liTableFile 1 to liTableId
106339>>>>> send FDX_ModalDisplayFileAttributes 0 liTableId
106340>>>>> end_procedure
106341>>>>> on_item "Show definition" send DisplayDef
106342>>>>> set size to 14 60
106343>>>>> set skip_state to TRUE
106344>>>>> end_object
106345>>>>> object oReadBtn is a aps.Button snap SL_RIGHT
106348>>>>> procedure ReadDB
106351>>>>> integer lhDbdSystem
106351>>>>> if (MB_Verify4("Read (new) table- and field definitions into the description tables?","","","",0)) begin
106353>>>>> // This one needs to refresh fastload.fdx (if enabled) before
106353>>>>> // proceeding.
106353>>>>> send FV_FastLoadRefresh // Refresh FastLoad file if active
106354>>>>> get phDbdSystem to lhDbdSystem
106355>>>>> send DbdControl_ReadDatabaseDefinitions lhDbdSystem
106356>>>>> send update_fields_list
106357>>>>> send obs "Done"
106358>>>>> end
106358>>>>>>
106358>>>>> end_procedure
106359>>>>> on_item "Read definitions" send ReadDB
106360>>>>> set size to 14 60
106361>>>>> set skip_state to TRUE
106362>>>>> end_object
106363>>>>>
106363>>>>> object dbTable_Tbl_Description is a aps.dbEdit label "Table description: (Use Alt+Up/Dn to move to previous/next table)" snap SL_RIGHT_SPACE relative_to (dbTable_Tbl_Name(self)) NEW_COLUMN
106374>>>>> set label_justification_mode to JMODE_TOP
106375>>>>> set size to 65 253
106376>>>>> send bind_data (piTable_FileNumber(self)) 7 // entry_item dbTable.Tbl_Description
106377>>>>> set peAnchors to (anTop+anLeft+anRight)
106378>>>>> on_key KEY_ALT+KEY_UP_ARROW send MoveTableUp
106379>>>>> on_key KEY_ALT+KEY_DOWN_ARROW send MoveTableDown
106380>>>>> procedure MoveTableUp
106383>>>>> send request_save
106384>>>>> send find of oTable_DD LT 1
106385>>>>> end_procedure
106386>>>>> procedure MoveTableDown
106389>>>>> send request_save
106390>>>>> send find of oTable_DD GT 1
106391>>>>> end_procedure
106392>>>>> end_object
106393>>>>> send aps_goto_max_row
106394>>>>> send aps_make_row_space 5
106395>>>>> set p_auto_column to 0
106396>>>>>
106396>>>>> object oTabs is a aps.dbTabDialog
106398>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
106399>>>>> object oTab1 is a aps.dbTabpage label "Fields"
106402>>>>> set p_auto_column to 0
106403>>>>> object oLst is a aps.dbGrid // Fields
106405>>>>> set server to oField_DD
106406>>>>> set ordering to 2
106407>>>>>// set highlight_row_state to DFTRUE
106407>>>>>// set highlight_row_color to (rgb(0,255,255))
106407>>>>>// set current_item_color to (rgb(0,255,255))
106407>>>>>
106407>>>>> set highlight_row_state to DFTRUE
106408>>>>> set CurrentCellColor to clHighlight
106409>>>>> set CurrentCellTextColor to clHighlightText
106410>>>>> set CurrentRowColor to clHighlight
106411>>>>> set CurrentRowTextColor to clHighlightText
106412>>>>>
106412>>>>> set peAnchors to (anTop+anLeft+anBottom)
106413>>>>> get piField_FileNumber to filenumber
106414>>>>> set size to 83 0
106415>>>>> begin_row
106418>>>>> move 2 to fieldindex
106419>>>>> entry_item indirect_file.recnum {noput} // dbField.Fld_Pos {noput}
106420>>>>> move 3 to fieldindex
106421>>>>> entry_item indirect_file.recnum {noenter} // dbField.Fld_Name {noenter}
106422>>>>> entry_item "" // ""
106423>>>>>// move 4 to fieldindex
106423>>>>>// entry_item indirect_file.recnum {noenter} // dbField.Fld_Not_Found {noenter}
106423>>>>> move 8 to fieldindex
106424>>>>> entry_item indirect_file.recnum // dbField.Obsolete {noenter}
106425>>>>> move 6 to fieldindex
106426>>>>> entry_item indirect_file.recnum // dbField.Suggested_Label {noenter}
106427>>>>> end_row
106432>>>>> set header_label 0 to "Pos"
106433>>>>> set header_label 1 to "Name"
106434>>>>>// set column_checkbox_state 3 to true
106434>>>>>// set header_label 3 to "Err"
106434>>>>> set column_checkbox_state 3 to true
106435>>>>> set header_label 3 to "Obsolete"
106436>>>>> set header_label 4 to "Better name"
106437>>>>> set aps_fixed_column_width 2 to 16
106438>>>>> procedure color_the_row
106441>>>>> integer liBase liMax liItem
106441>>>>> get base_item to liBase
106442>>>>> get Grid_Columns self to liMax
106443>>>>> decrement liMax
106444>>>>> for liItem from liBase to (liBase+liMax)
106450>>>>>>
106450>>>>> set item_color item liItem to (RGB_Brighten(clRed,75))
106451>>>>> loop
106452>>>>>>
106452>>>>> end_procedure
106453>>>>> procedure entry_display integer liInt1 integer liInt2
106456>>>>> integer liBase liFile lbFieldNotFound
106456>>>>> string lsBmp lsValue
106456>>>>> get piField_FileNumber to liFile
106457>>>>> get base_item to liBase
106458>>>>> forward send entry_display liInt1 liInt2
106460>>>>> get_field_value liFile 5 to lsValue
106463>>>>> if (lsValue<>"") move "openbook.bmp" to lsBmp // dbField.Fld_Description
106466>>>>> else move "" to lsBmp
106468>>>>> set form_bitmap (liBase+2) to lsBmp
106469>>>>> get_field_value liFile 4 to lbFieldNotFound
106472>>>>> if lbFieldNotFound send color_the_row
106475>>>>> end_procedure
106476>>>>> end_object
106477>>>>> send aps_goto_max_row
106478>>>>> object oOrdering is a aps.ComboForm label "&Order fields by:" abstract AFT_ASCII8
106482>>>>> set peAnchors to (anLeft+anBottom)
106483>>>>> set p_extra_internal_width to -8
106484>>>>> set skip_state to true
106485>>>>> set combo_sort_state to false
106486>>>>> set entry_state item 0 to false
106487>>>>> send Combo_Add_Item "Position"
106488>>>>> send Combo_Add_Item "Name"
106489>>>>> set value item 0 to "Position"
106490>>>>> procedure OnChange
106493>>>>> integer liOrder
106493>>>>> string lsValue
106493>>>>> get value item 0 to lsValue
106494>>>>> if (lsValue="Position") move 2 to liOrder
106497>>>>> else move 1 to liOrder
106499>>>>> send FieldListOrdering liOrder
106500>>>>> end_procedure
106501>>>>> end_object
106502>>>>>
106502>>>>> procedure ToggleFieldOrder
106505>>>>> integer liOrdering
106505>>>>> get ordering of oLst to liOrdering
106506>>>>> if (liOrdering=2) set value of oOrdering item 0 to "Name"
106509>>>>> else set value of oOrdering item 0 to "Position"
106511>>>>> end_procedure
106512>>>>> on_key KEY_ALT+KEY_O send ToggleFieldOrder
106513>>>>>
106513>>>>> procedure DoFieldSearch
106516>>>>> integer lhView
106516>>>>> get ViewPanelObjectId to lhView
106517>>>>> send Activate_DbdFieldSearcher lhView
106518>>>>> end_procedure
106519>>>>>
106519>>>>> object oFieldSearchBtn is a aps.Button snap SL_RIGHT_SPACE
106522>>>>> set peAnchors to (anLeft+anBottom)
106523>>>>> set size to 14 55
106524>>>>> set skip_state to TRUE
106525>>>>> on_item "Field &search" send DoFieldSearch
106526>>>>> end_object
106527>>>>> on_key KEY_ALT+KEY_S send DoFieldSearch
106528>>>>>
106528>>>>> object oConstrainCB is a aps.CheckBox label "Show only &commented fields" snap SL_RIGHT_SPACE
106532>>>>> set peAnchors to (anLeft+anBottom)
106533>>>>> set skip_state to true
106534>>>>> procedure OnChange
106537>>>>> integer liOrder
106537>>>>> string lsValue
106537>>>>> get value of oOrdering item 0 to lsValue
106538>>>>> if (lsValue="Position") move 2 to liOrder
106541>>>>> else move 1 to liOrder
106543>>>>> set pbCommentedOnly to (checked_state(self))
106544>>>>> send FieldListOrdering liOrder
106545>>>>> end_procedure
106546>>>>> end_object
106547>>>>> procedure DoConstrainRem
106550>>>>> integer lhConstrainCB
106550>>>>> move oConstrainCB to lhConstrainCB
106551>>>>> set select_state of lhConstrainCB to (not(select_state(lhConstrainCB)))
106552>>>>> end_procedure
106553>>>>> on_key KEY_ALT+KEY_C send DoConstrainRem
106554>>>>>
106554>>>>> object dbField_Fld_Description is a aps.dbEdit label "Description of field: (Use Ctrl+Up/Dn to move to previous/next field)" snap SL_RIGHT relative_to (oLst(self))
106563>>>>> set label_justification_mode to JMODE_TOP
106564>>>>> set server to oField_DD
106565>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
106566>>>>> set size to 72 250
106567>>>>> send bind_data (piField_FileNumber(self)) 5 // entry_item dbField.Fld_Description
106568>>>>>
106568>>>>> property integer piFontSize public 12
106570>>>>>
106570>>>>> procedure upfont
106573>>>>> integer liFontSize
106573>>>>> get piFontSize to liFontSize
106574>>>>> increment liFontSize
106575>>>>> set Fontsize To liFontSize 0
106576>>>>> set piFontSize to liFontSize
106577>>>>> end_procedure
106578>>>>> procedure downfont
106581>>>>> integer liFontSize
106581>>>>> get piFontSize to liFontSize
106582>>>>> decrement liFontSize
106583>>>>> set Fontsize To liFontSize 0
106584>>>>> set piFontSize to liFontSize
106585>>>>> end_procedure
106586>>>>> on_key KEY_ALT+KEY_UP_ARROW send upfont
106587>>>>> on_key KEY_ALT+KEY_DOWN_ARROW send downfont
106588>>>>>
106588>>>>> procedure MoveFieldUp
106591>>>>> send process_key of oLst KUPARROW
106592>>>>> end_procedure
106593>>>>> procedure MoveFieldDown
106596>>>>> send process_key of oLst KDOWNARROW
106597>>>>> end_procedure
106598>>>>> procedure MoveTableUp
106601>>>>> send request_save
106602>>>>> send find of oTable_DD LT 1
106603>>>>> end_procedure
106604>>>>> procedure MoveTableDown
106607>>>>> send request_save
106608>>>>> send find of oTable_DD GT 1
106609>>>>> end_procedure
106610>>>>>
106610>>>>> on_key KEY_CTRL+KEY_UP_ARROW send MoveFieldUp
106611>>>>> on_key KEY_CTRL+KEY_DOWN_ARROW send MoveFieldDown
106612>>>>> on_key KEY_ALT+KEY_UP_ARROW send MoveTableUp
106613>>>>> on_key KEY_ALT+KEY_DOWN_ARROW send MoveTableDown
106614>>>>> procedure request_clear
106617>>>>> send request_clear of oLst
106618>>>>> end_procedure
106619>>>>> procedure request_save
106622>>>>> send request_save of oLst
106623>>>>> end_procedure
106624>>>>> procedure request_delete
106627>>>>> send request_delete of oLst
106628>>>>> end_procedure
106629>>>>> end_object
106630>>>>> send aps_relocate (dbField_Fld_Description(self)) 0 7 DFTRUE
106631>>>>> object dbField_Fld_Definition is a aps.dbForm label NONE snap SL_DOWN
106635>>>>> send bind_data (piField_FileNumber(self)) 7 // entry_item dbField.Fld_Definition
106636>>>>> set server to oField_DD
106637>>>>> set enabled_state to FALSE
106638>>>>> set peAnchors to (anLeft+anRight+anBottom)
106639>>>>> end_object
106640>>>>> procedure aps_beautify
106643>>>>> send APS_ALIGN_INSIDE_CONTAINER_BY_SIZING (dbField_Fld_Description(self)) SL_ALIGN_RIGHT
106644>>>>> send APS_ALIGN_INSIDE_CONTAINER_BY_SIZING (dbField_Fld_Definition(self)) SL_ALIGN_RIGHT
106645>>>>> end_procedure
106646>>>>> procedure FieldListOrdering integer liOrder
106649>>>>> integer liRec
106649>>>>> get current_record of oField_DD to liRec
106650>>>>> set ordering of oLst to liOrder
106651>>>>> set ordering of oField_DD to liOrder
106652>>>>> send rebuild_constraints of oField_DD
106653>>>>> send beginning_of_data to oLst
106654>>>>> //send find_by_recnum of oField_DD (main_file(oField_DD(self))) liRec
106654>>>>> end_procedure
106655>>>>> end_object // oTab1
106656>>>>> object oTab2 is a aps.dbTabpage label "Indices"
106659>>>>> set p_auto_column to 0
106660>>>>> object oLst is a aps.dbGrid // Indices
106662>>>>> set server to oIndex_DD
106663>>>>> set ordering to 1
106664>>>>> //set highlight_row_state to DFTRUE
106664>>>>> //set highlight_row_color to (rgb(0,255,255))
106664>>>>> //set current_item_color to (rgb(0,255,255))
106664>>>>>
106664>>>>> set highlight_row_state to DFTRUE
106665>>>>> set CurrentCellColor to clHighlight
106666>>>>> set CurrentCellTextColor to clHighlightText
106667>>>>> set CurrentRowColor to clHighlight
106668>>>>> set CurrentRowTextColor to clHighlightText
106669>>>>>
106669>>>>> set peAnchors to (anTop+anLeft+anBottom)
106670>>>>> // set Verify_Save_Msg to GET_Verify_Save_AutoName
106670>>>>> // set Verify_Delete_Msg to GET_Verify_Delete_AutoName
106670>>>>> get piIndex_FileNumber to filenumber
106671>>>>> begin_row
106674>>>>> move 2 to fieldindex
106675>>>>> entry_item indirect_file.recnum {noput} //entry_item dbIndex.Idx_Pos {noput}
106676>>>>> move 3 to fieldindex
106677>>>>> entry_item indirect_file.recnum {noenter} //entry_item dbIndex.Idx_Name {noenter}
106678>>>>> entry_item "" //entry_item ""
106679>>>>> move 5 to fieldindex
106680>>>>> entry_item indirect_file.recnum {noenter} //entry_item dbIndex.Idx_Not_Found {noenter}
106681>>>>> end_row
106686>>>>> set header_label 0 to "Pos"
106687>>>>> set header_label 1 to "Ordering fields"
106688>>>>> set aps_fixed_column_width 2 to 16
106689>>>>> set column_checkbox_state 3 to true
106690>>>>> set header_label 3 to "Not found"
106691>>>>> procedure entry_display integer liInt1 integer liInt2
106694>>>>> integer liBase liFile
106694>>>>> string lsBmp lsValue
106694>>>>> get piIndex_FileNumber to liFile
106695>>>>> get base_item to liBase
106696>>>>> forward send entry_display liInt1 liInt2
106698>>>>> get_field_value liFile 4 to lsValue
106701>>>>> if (lsValue<>"") move "openbook.bmp" to lsBmp // dbIndex.Idx_Description
106704>>>>> else move "" to lsBmp
106706>>>>> set form_bitmap (liBase+2) to lsBmp
106707>>>>> end_procedure
106708>>>>> end_object
106709>>>>> object dbIndex_Idx_Description is a aps.dbEdit label "Description of index:" snap SL_RIGHT_SPACE
106713>>>>> set label_justification_mode to JMODE_TOP
106714>>>>> set server to oIndex_DD
106715>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
106716>>>>> set size to 89 250
106717>>>>> send bind_data (piIndex_FileNumber(self)) 4 // entry_item dbIndex.Idx_Description
106718>>>>> procedure MoveIndexUp
106721>>>>> send process_key of oLst KUPARROW
106722>>>>> end_procedure
106723>>>>> procedure MoveIndexDown
106726>>>>> send process_key of oLst KDOWNARROW
106727>>>>> end_procedure
106728>>>>> procedure MoveTableUp
106731>>>>> send request_save
106732>>>>> send find of oTable_DD LT 1
106733>>>>> end_procedure
106734>>>>> procedure MoveTableDown
106737>>>>> send request_save
106738>>>>> send find of oTable_DD GT 1
106739>>>>> end_procedure
106740>>>>>
106740>>>>> on_key KEY_CTRL+KEY_UP_ARROW send MoveIndexUp
106741>>>>> on_key KEY_CTRL+KEY_DOWN_ARROW send MoveIndexDown
106742>>>>> on_key KEY_ALT+KEY_UP_ARROW send MoveTableUp
106743>>>>> on_key KEY_ALT+KEY_DOWN_ARROW send MoveTableDown
106744>>>>> procedure request_clear
106747>>>>> send request_clear of oLst
106748>>>>> end_procedure
106749>>>>> procedure request_save
106752>>>>> send request_save of oLst
106753>>>>> end_procedure
106754>>>>> procedure request_delete
106757>>>>> send request_delete of oLst
106758>>>>> end_procedure
106759>>>>> end_object
106760>>>>> procedure aps_beautify
106763>>>>> send APS_ALIGN_INSIDE_CONTAINER_BY_SIZING (dbIndex_Idx_Description(self)) SL_ALIGN_RIGHT
106764>>>>> end_procedure
106765>>>>> end_object // oTab2
106766>>>>> procedure ToggleFieldOrder
106769>>>>> if (current_tab(self)=0) send ToggleFieldOrder of oTab1
106772>>>>> end_procedure
106773>>>>> procedure DoFieldSearch
106776>>>>> if (current_tab(self)=0) send DoFieldSearch of oTab1
106779>>>>> end_procedure
106780>>>>> procedure DoConstrainRem
106783>>>>> if (current_tab(self)=0) send DoConstrainRem of oTab1
106786>>>>> end_procedure
106787>>>>> end_object // oTabs
106788>>>>>
106788>>>>> on_key KEY_ALT+KEY_O send ToggleFieldOrder of oTabs
106789>>>>> on_key KEY_ALT+KEY_S send DoFieldSearch of oTabs
106790>>>>> on_key KEY_ALT+KEY_C send DoConstrainRem of oTabs
106791>>>>>
106791>>>>> procedure update_fields_list
106794>>>>> integer liRecnum lhTableAccess liTableFile
106794>>>>> move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess
106795>>>>> get piFile.i of lhTableAccess DBDTABLE_TABLE to liTableFile
106796>>>>> get current_record of oTable_DD to liRecnum
106797>>>>> send find_by_recnum of oTable_DD liTableFile liRecnum
106798>>>>> end_procedure
106799>>>>>
106799>>>>> procedure DoAllFontSize integer liFontSize
106802>>>>> set Fontsize of (dbTable_Tbl_Description(self)) to liFontSize 0
106803>>>>> set Fontsize of (dbField_Fld_Description(oTab1(oTabs(self)))) to liFontSize 0
106804>>>>> set Fontsize of (dbIndex_Idx_Description(oTab2(oTabs(self)))) to liFontSize 0
106805>>>>> end_procedure
106806>>>>>
106806>>>>> procedure PopupControl
106809>>>>> integer lhDbdSystem
106809>>>>> get phDbdSystem to lhDbdSystem
106810>>>>> send Popup_DbdControlPanel lhDbdSystem
106811>>>>> if (DbdControl_NewTablesSelected()) begin
106813>>>>>
106813>>>>> CREATE_OBJECT_GROUP OG_Dbd_View PARENT ghClientArea_FastView (psRootNamePrefix(phTableAccessObject(lhDbdSystem)))
106823>>>>> if (OG_Current_Object#<>0) send popup to OG_Current_Object#
106826>>>>> else send obs "Tables could not be opened"
106828>>>>> send close_panel
106829>>>>> end
106829>>>>>>
106829>>>>> else begin
106830>>>>> send request_clear_all
106831>>>>> send DoSetPanelLabel
106832>>>>> end
106832>>>>>>
106832>>>>> end_procedure
106833>>>>>
106833>>>>> procedure PrintReport
106836>>>>> integer lhView
106836>>>>> get ViewPanelObjectId to lhView
106837>>>>> send popup_dbdreport (phDbdSystem(self)) lhView
106838>>>>> end_procedure
106839>>>>>
106839>>>>> procedure DoRelocateFilelistEntries
106842>>>>> integer lhTableAccess liTableFile liFieldFile liIndexFile
106842>>>>> string lsValue
106842>>>>>
106842>>>>> // Just save all changes so we don't have to worry about that
106842>>>>> send request_save of oTable_DD
106843>>>>> send request_save of oField_DD
106844>>>>> send request_save of oIndex_DD
106845>>>>>
106845>>>>> get piFile.i of lhTableAccess DBDTABLE_TABLE to liTableFile
106846>>>>> get piFile.i of lhTableAccess DBDTABLE_FIELD to liFieldFile
106847>>>>> get piFile.i of lhTableAccess DBDTABLE_INDEX to liIndexFile
106848>>>>>
106848>>>>> move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess
106849>>>>>
106849>>>>>
106849>>>>>
106849>>>>>
106849>>>>>
106849>>>>> end_procedure
106850>>>>> procedure GotoField integer liFile string lsFieldName
106853>>>>> integer lhTableAccess liTableFile liFieldFile liRecnum lbCommentedFieldsOnly
106853>>>>> string lsValue
106853>>>>>
106853>>>>> // Just save all changes so we don't have to worry about that
106853>>>>> send request_save of oTable_DD
106854>>>>> send request_save of oField_DD
106855>>>>> send request_save of oIndex_DD
106856>>>>>
106856>>>>> move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess
106857>>>>>
106857>>>>> if (pbCommentedOnly(self)) begin
106859>>>>> // At this point we have to make sure that the list of fields
106859>>>>> // isn't constrained to only commented fields if the field
106859>>>>> // we are about to display doesn't have any comments
106859>>>>> get piFile.i of lhTableAccess DBDTABLE_FIELD to liFieldFile
106860>>>>> clear liFieldFile
106861>>>>> set_field_value liFieldFile 1 to liFile
106864>>>>> set_field_value liFieldFile 3 to lsFieldName
106867>>>>> vfind liFieldFile 1 EQ
106869>>>>> if (found) begin
106871>>>>> get_field_value liFieldFile 5 to lsValue
106874>>>>> if (lsValue="") set checked_state of (oConstrainCB(oTab1(oTabs(self)))) to false
106877>>>>> end
106877>>>>>>
106877>>>>> end
106877>>>>>>
106877>>>>>
106877>>>>> get piFile.i of lhTableAccess DBDTABLE_TABLE to liTableFile
106878>>>>> clear liTableFile
106879>>>>> set_field_value liTableFile 1 to liFile
106882>>>>> vfind liTableFile 1 EQ
106884>>>>> if (found) begin
106886>>>>> get_field_value liTableFile 0 to liRecnum
106889>>>>> send find_by_recnum of oTable_DD liTableFile liRecnum
106890>>>>>
106890>>>>> get piFile.i of lhTableAccess DBDTABLE_FIELD to liFieldFile
106891>>>>> clear liFieldFile
106892>>>>> set_field_value liFieldFile 1 to liFile
106895>>>>> set_field_value liFieldFile 3 to lsFieldName
106898>>>>> vfind liFieldFile 1 EQ
106900>>>>> if (found) begin
106902>>>>> get_field_value liFieldFile 0 to liRecnum
106905>>>>> send find_by_recnum of oField_DD liFieldFile liRecnum
106906>>>>> end
106906>>>>>>
106906>>>>> else if (liFile<>50) send obs "Field could not found." "You should click the 'Read DB definitions' button" "to create the missing files and fields"
106910>>>>>
106910>>>>> end
106910>>>>>>
106910>>>>> else if (liFile<>50) send obs "Table could not found." "You should click the 'Read DB definitions' button" "to create the missing files and fields"
106914>>>>> end_procedure
106915>>>>>
106915>>>>> procedure GotoEditObject
106918>>>>> send activate of dbField_Fld_Description
106919>>>>> end_procedure
106920>>>>>
106920>>>>> procedure update_ui_properties
106923>>>>> integer liTableFile liTableId liRow lhLst
106923>>>>> string lsColumnHeader
106923>>>>>
106923>>>>> get iTable_FileNumber to liTableFile
106924>>>>> move (oLst(oTab1(oTabs(self)))) to lhLst
106925>>>>>
106925>>>>> get_field_value liTableFile 1 to liTableId
106928>>>>> get iFindPredefinedTableRow of oDBD_PredefinedLibraries liTableId to liRow
106929>>>>> if (liRow=-1) begin // Normal table
106931>>>>> move "Better name" to lsColumnHeader
106932>>>>> set no_create_state of lhLst to true
106933>>>>> end
106933>>>>>>
106933>>>>> else begin
106934>>>>> get psColumnHeader.i of oDBD_PredefinedLibraries liRow to lsColumnHeader
106935>>>>> set no_create_state of lhLst to false
106936>>>>> end
106936>>>>>>
106936>>>>> set header_label of lhLst 4 to lsColumnHeader
106937>>>>> end_procedure
106938>>>>>
106938>>>>> object oPrintBtn is a aps.Multi_Button
106940>>>>> set peAnchors to (anRight+anBottom)
106941>>>>> on_item "Report" send PrintReport
106942>>>>> end_object
106943>>>>>
106943>>>>> object oReassignBtn is a aps.Multi_Button
106945>>>>> set peAnchors to (anRight+anBottom)
106946>>>>> procedure ReassignFilelist
106949>>>>> integer lhTableAccess
106949>>>>> move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess
106950>>>>> send Run.i of oDbdFilelistReassigner lhTableAccess
106951>>>>> end_procedure
106952>>>>> on_item "Reassign" send ReassignFilelist
106953>>>>> end_object
106954>>>>> object oControlBtn is a aps.Multi_Button
106956>>>>> set peAnchors to (anRight+anBottom)
106957>>>>> on_item "Advanced" send PopupControl
106958>>>>> end_object
106959>>>>> object oCloseBtn is a aps.Multi_Button
106961>>>>> set peAnchors to (anRight+anBottom)
106962>>>>> on_item t.btn.close send close_panel
106963>>>>> end_object
106964>>>>> send aps_locate_multi_buttons
106965>>>>>
106965>>>>> procedure aps_beautify
106968>>>>> send aps_align_inside_container_by_moving (dbTable_Tbl_Description(self)) SL_ALIGN_RIGHT
106969>>>>> send aps_align_inside_container_by_sizing (oTabs(self)) SL_ALIGN_RIGHT
106970>>>>> send aps_beautify to (oTab1(oTabs(self)))
106971>>>>> send aps_beautify to (oTab2(oTabs(self)))
106972>>>>> end_procedure
106973>>>>>
106973>>>>> procedure Close_Panel // Release when closed!
106976>>>>> integer lhView
106976>>>>> get ViewPanelObjectId to lhView
106977>>>>> send DestroyingDbdView of oDbdFieldSearcher lhView
106978>>>>> send DestroyingDbdView of oDbdReport lhView
106979>>>>> Forward Send Close_Panel
106981>>>>> send Request_Destroy_Object of (phDbdSystem(self))
106982>>>>> send Request_Destroy_Object
106983>>>>> end_procedure
106984>>>>>
106984>>>>> procedure Close_Query_View // Meant to be broadcasted by somebody that needs to close all queries
106987>>>>> set delegation_mode to DELEGATE_TO_PARENT
106988>>>>> send deferred_message MSG_close_panel
106989>>>>> end_procedure
106990>>>>>
106990>>>>> move self to OG_Current_Object# // global integer
106991>>>>> end_object
106992>>>>> send aps_SetMinimumDialogSize OG_Current_Object#
106993>>>>> end
106993>>>>>>
106993>>>>>END_DEFINE_OBJECT_GROUP
106994>>>>>
106994>>>>>procedure Popup_DBD_View
106997>>>>> CREATE_OBJECT_GROUP OG_Dbd_View "db"
107001>>>>> if (OG_Current_Object#<>0) send popup to OG_Current_Object#
107004>>>>> else send obs "Tables could not be opened"
107006>>>>>end_procedure
107007>>> Use PkgDoc.vw
Including file: PkgDoc.vw (C:\Apps\VDFQuery\AppSrc\PkgDoc.vw)
107007>>>>>// Dims, der kan lave hul i b‘lter
107007>>>>>//
107007>>>>>//
107007>>>>>//
107007>>>>>// Am7 Dm7 G7 Cmaj/C7
107007>>>>>// Fmaj7 Bm7b5 G7 Am/A7
107007>>>>>// Dm7 G7 Cmaj Gm7/A7
107007>>>>>// Dm7 G7 Cmaj Dm7b5/E7
107007>>>>>
107007>>>>>// Am7 Dm7 G7 Cmaj/C7
107007>>>>>// Fmaj7 Bm7b5 G7 Am/A7
107007>>>>>// Dm7 G7 Em7 A7
107007>>>>>// Dm7 G7 Cmaj Dm7b5/E7
107007>>>>>
107007>>>>>use aps.pkg
107007>>>>>use pkgdoc.nui
Including file: pkgdoc.nui (C:\Apps\VDFQuery\AppSrc\pkgdoc.nui)
107007>>>>>>>//> Package name: PkgDoc.nui
107007>>>>>>>//> Created: 12-06-2004
107007>>>>>>>//>
107007>>>>>>>//>
107007>>>>>>>//> Basic array structures
107007>>>>>>>//>
107007>>>>>>>//> Array
107007>>>>>>>//> Array2D
107007>>>>>>>//> Array3D
107007>>>>>>>//> Stack
107007>>>>>>>//> Tree
107007>>>>>>>//> Item_Property
107007>>>>>>>//>
107007>>>>>>>//> Global function libraries
107007>>>>>>>//>
107007>>>>>>>//> Strings.nui
107007>>>>>>>//> Dates.nui
107007>>>>>>>//> Dates.utl
107007>>>>>>>//> Files.nui
107007>>>>>>>//> Files.utl
107007>>>>>>>//> Rgb.nui
107007>>>>>>>//>
107007>>>>>>>//>
107007>>>>>>>//> XML Builder
107007>>>>>>>//>
107007>>>>>>>//>
107007>>>>>>>
107007>>>>>>>Use dfallent
107007>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
107007>>>>>>>Use Files.nui // Utilities for handling file related stuff (No User Interface)
107007>>>>>>>Use Strings.nui // String manipulation for VDF (No User Interface)
107007>>>>>>>Use ExtendedItemProp.nui // cExtendedItemPropertyArray class
Including file: ExtendedItemProp.nui (C:\Apps\VDFQuery\AppSrc\ExtendedItemProp.nui)
107007>>>>>>>>>// Use ExtendedItemProp.nui // cExtendedItemPropertyArray class
107007>>>>>>>>>
107007>>>>>>>>>Use ItemProp.nui // ITEM_PROPERTY command for use within arrays
107007>>>>>>>>>Use XmlBuilder.nui // cXmlBuilder class
Including file: xmlbuilder.nui (C:\Apps\VDFQuery\AppSrc\xmlbuilder.nui)
107007>>>>>>>>>>>// Use XmlBuilder.nui // cXmlBuilder class
107007>>>>>>>>>>>// Part of VDFQuery by Sture ApS
107007>>>>>>>>>>>
107007>>>>>>>>>>>//> pkgdoc.begin
107007>>>>>>>>>>>//> The XmlBuilder.nui packages defines three classes for facilitating the building of XML documents:
107007>>>>>>>>>>>//>
107007>>>>>>>>>>>//> 1. The cXmlBuilder class for the actual building
107007>>>>>>>>>>>//> 2. The cXmlSequence class that is capable of defining a sequence of XML for adding to a document multiple times
107007>>>>>>>>>>>//> 3. The cXmlParamArray class that defines a set of parameters for use with an object of the cXmlSequence class.
107007>>>>>>>>>>>//>
107007>>>>>>>>>>>//> The cXmlBuilder class may be used for adding elements to an XML DOM tree in a way that relieves
107007>>>>>>>>>>>//> you of having to deal with a myriad of handle type variables in your code. This is not to mention
107007>>>>>>>>>>>//> the house keeping of destroying all the element objects again.
107007>>>>>>>>>>>//>
107007>>>>>>>>>>>//> As an alternative it may be used to write directly to a sequential file without building
107007>>>>>>>>>>>//> a DOM object in memory. It is a question of which method you use for initiating the
107007>>>>>>>>>>>//> XML builing (either use begin_xml_add_to_dom or begin_xml_write_seq)
107007>>>>>>>>>>>//>
107007>>>>>>>>>>>//> <tip legend="Writing XHTML code">
107007>>>>>>>>>>>//> If used in the sequential file output mode, all output is written by the write method. I use this
107007>>>>>>>>>>>//> when I write XTHML directly from within a WebApp application because I can augment just one
107007>>>>>>>>>>>//> method and have it write to the WebApp output stream..
107007>>>>>>>>>>>//> </tip>
107007>>>>>>>>>>>//>
107007>>>>>>>>>>>//> This piece of code:
107007>>>>>>>>>>>//> <pkgdoc:code>
107007>>>>>>>>>>>//> use Files.nui // Utilities for handling file related stuff (No User Interface)
107007>>>>>>>>>>>//> object oTestBuilder is a cXmlBuilder
107007>>>>>>>>>>>//> procedure DoTest
107007>>>>>>>>>>>//> integer liChannel
107007>>>>>>>>>>>//> get SEQ_DirectOutput "test.xml" to liChannel
107007>>>>>>>>>>>//> if (liChannel>=0) begin
107007>>>>>>>>>>>//> // Manually write this line:
107007>>>>>>>>>>>//> write channel liChannel '<?xml version="1.0" encoding="iso-8859-1"?>'
107007>>>>>>>>>>>//> send begin_xml_write_seq liChannel //
107007>>>>>>>>>>>//> send add_open_element "response"
107007>>>>>>>>>>>//> send add_attribute "xmlns:service" "http://www.sture.dk/2004/service/"
107007>>>>>>>>>>>//> send add_open_element "function"
107007>>>>>>>>>>>//> send add_attribute "name" "login"
107007>>>>>>>>>>>//> send add_open_element "result"
107007>>>>>>>>>>>//> send add_open_element "fieldset"
107007>>>>>>>>>>>//> send add_closed_element "legend" "Login"
107007>>>>>>>>>>>//> send add_closed_element "span" "UserName"
107007>>>>>>>>>>>//> send add_open_element "span"
107007>>>>>>>>>>>//> send add_closed_element "input" ""
107007>>>>>>>>>>>//> send add_attribute "type" "text"
107007>>>>>>>>>>>//> send close_element // "span"
107007>>>>>>>>>>>//> send add_closed_element "span" "Password"
107007>>>>>>>>>>>//> send add_open_element "span"
107007>>>>>>>>>>>//> send add_closed_element "input" ""
107007>>>>>>>>>>>//> send add_attribute "type" "password"
107007>>>>>>>>>>>//> send close_element // span
107007>>>>>>>>>>>//> send close_element // fieldset
107007>>>>>>>>>>>//> send close_element // result
107007>>>>>>>>>>>//> send close_element // function
107007>>>>>>>>>>>//> send close_element // response
107007>>>>>>>>>>>//> send end_xml
107007>>>>>>>>>>>//> send SEQ_CloseOutput liChannel
107007>>>>>>>>>>>//> end
107007>>>>>>>>>>>//> end_procedure
107007>>>>>>>>>>>//> send DoTest
107007>>>>>>>>>>>//> end_object
107007>>>>>>>>>>>//> </pkgdoc:code>
107007>>>>>>>>>>>//>
107007>>>>>>>>>>>//> will write this to a file called test.xml:
107007>>>>>>>>>>>//>
107007>>>>>>>>>>>//> <pkgdoc:code>
107007>>>>>>>>>>>//> <?xml version="1.0" encoding="iso-8859-1"?>
107007>>>>>>>>>>>//> <response xmlns:service="http://www.sture.dk/2004/service/">
107007>>>>>>>>>>>//> <function name="login">
107007>>>>>>>>>>>//> <result>
107007>>>>>>>>>>>//> <fieldset>
107007>>>>>>>>>>>//> <legend>Login</legend>
107007>>>>>>>>>>>//> <span>Username</span>
107007>>>>>>>>>>>//> <span><input type="text" /></span>
107007>>>>>>>>>>>//> <span>Password</span>
107007>>>>>>>>>>>//> <span><input type="password" /></span>
107007>>>>>>>>>>>//> </fieldset>>
107007>>>>>>>>>>>//> </result>
107007>>>>>>>>>>>//> </function>
107007>>>>>>>>>>>//> </response>
107007>>>>>>>>>>>//> </pkgdoc:code>
107007>>>>>>>>>>>//>
107007>>>>>>>>>>>//> (line feeds and indentation has been added for readability)
107007>>>>>>>>>>>//>
107007>>>>>>>>>>>//> <pkgdoc:note>
107007>>>>>>>>>>>//> This class is not able to handle mixed-content elements except by the use of the
107007>>>>>>>>>>>//> pbProtectValueData property.
107007>>>>>>>>>>>//> </pkgdoc:note>
107007>>>>>>>>>>>//>
107007>>>>>>>>>>>//> pkgdoc.end
107007>>>>>>>>>>>//>
107007>>>>>>>>>>>//> And here it comes:
107007>>>>>>>>>>>
107007>>>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
107007>>>>>>>>>>>Use Dates.nui // Date routines (No User Interface)
107007>>>>>>>>>>>Use FleXML.pkg
107007>>>>>>>>>>>Use ExtendedItemProp.nui // cExtendedItemPropertyArray class
107007>>>>>>>>>>>
107007>>>>>>>>>>>class cXmlBuilder is a cStack
107008>>>>>>>>>>> procedure construct_object
107010>>>>>>>>>>> forward send construct_object
107012>>>>>>>>>>> property integer priv.pbWriteModeSeq public false
107013>>>>>>>>>>> property integer priv.piChannel public false
107014>>>>>>>>>>> property handle priv.phCurrentNode public 0
107015>>>>>>>>>>> property string priv.psWriteBuffer public ""
107016>>>>>>>>>>> property integer priv.pbOpen public false
107017>>>>>>>>>>> property integer priv.pbCData public false
107018>>>>>>>>>>> property integer priv.ClosedElement public false
107019>>>>>>>>>>> property integer priv.pbWebAppStream public false
107020>>>>>>>>>>> //> This property has been introduced because the textarea element in (X)HTML is not allowed to be closed
107020>>>>>>>>>>> //> in this way "<textarea />" when it's empty. Totally not understandable! But it must be written as
107020>>>>>>>>>>> //> "<textarea></textarea>".
107020>>>>>>>>>>> property integer pbTextAreaException public false
107021>>>>>>>>>>> //> This property has been introduced because the script element in (X)HTML is not allowed to be closed
107021>>>>>>>>>>> //> in this way "<script />" when it's empty. Must be written as "<script></script>". IE 6 problem
107021>>>>>>>>>>> property integer pbScriptException public false
107022>>>>>>>>>>> //> The pbProtectValueData property controls whether <, > and & characters written to the XML as data
107022>>>>>>>>>>> //> is HTML encoded ("<", ">" and "&") or not. Its default value is to do this encoding (true).
107022>>>>>>>>>>> //> The reason for (temporarily) setting it to false when generating XHTML code is making it able to handle
107022>>>>>>>>>>> //> when the data itself represents XHTML code. In this case it is not OK to encode these characters.
107022>>>>>>>>>>> property integer pbProtectValueData public true
107023>>>>>>>>>>> object oArray is a cArray
107025>>>>>>>>>>> // This array is used when building XML in a string
107025>>>>>>>>>>> end_object
107026>>>>>>>>>>> end_procedure
107027>>>>>>>>>>>
107027>>>>>>>>>>> //> If object is initiated using the begin_xml_write_seq method all output will be sent to this procedure.
107027>>>>>>>>>>> procedure write string lsValue
107029>>>>>>>>>>> integer liChannel lhArr
107029>>>>>>>>>>> get priv.piChannel to liChannel
107030>>>>>>>>>>> if (liChannel>=0) write channel (priv.piChannel(self)) lsValue
107034>>>>>>>>>>> else begin
107035>>>>>>>>>>> if (priv.pbWebAppStream(self)) begin
107037>>>>>>>>>>> end
107037>>>>>>>>>>>>
107037>>>>>>>>>>> else begin
107038>>>>>>>>>>> move (oArray(self)) to lhArr
107039>>>>>>>>>>> set value of lhArr item (item_count(lhArr)) to lsValue
107040>>>>>>>>>>> end
107040>>>>>>>>>>>>
107040>>>>>>>>>>> end
107040>>>>>>>>>>>>
107040>>>>>>>>>>> end_procedure
107041>>>>>>>>>>>
107041>>>>>>>>>>> procedure flush_buffer // Private
107043>>>>>>>>>>> handle hoNode
107043>>>>>>>>>>> integer lbCDATA lbException
107043>>>>>>>>>>> string lsBuffer lsValue lsElement
107043>>>>>>>>>>> if (priv.pbWriteModeSeq(self)) begin
107045>>>>>>>>>>> get priv.psWriteBuffer to lsBuffer
107046>>>>>>>>>>> if (lsBuffer<>"") begin // If there's anything in the buffer
107048>>>>>>>>>>> if (priv.pbOpen(self)) send write (lsBuffer+">") // If we're writing an opening tag
107051>>>>>>>>>>> else begin // We're dealing with writing a data element (including a closing tag)
107052>>>>>>>>>>> get iPop to lbCDATA
107053>>>>>>>>>>> get sPop to lsElement
107054>>>>>>>>>>> get sPop to lsValue
107055>>>>>>>>>>> if (lsValue="" and ((lowercase(lsElement)<>"textarea" or pbTextAreaException(self)=0) and (lowercase(lsElement)<>"script" or pbScriptException(self)=0) )) send write (lsBuffer+" />") // If no value, we're writing the shorthand open-close tag.
107058>>>>>>>>>>> else begin
107059>>>>>>>>>>> if lbCDATA begin
107061>>>>>>>>>>> send write (lsBuffer+"><![CDATA["+lsValue+"]]></"+lsElement+">")
107062>>>>>>>>>>> end
107062>>>>>>>>>>>>
107062>>>>>>>>>>> else begin
107063>>>>>>>>>>> if (pbProtectValueData(self)) begin
107065>>>>>>>>>>> move (replaces("&",lsValue,"&")) to lsValue
107066>>>>>>>>>>> move (replaces("<",lsValue,"<")) to lsValue
107067>>>>>>>>>>> move (replaces(">",lsValue,">")) to lsValue
107068>>>>>>>>>>> end
107068>>>>>>>>>>>>
107068>>>>>>>>>>> send write (lsBuffer+">"+lsValue+"</"+lsElement+">")
107069>>>>>>>>>>> end
107069>>>>>>>>>>>>
107069>>>>>>>>>>> end
107069>>>>>>>>>>>>
107069>>>>>>>>>>> end
107069>>>>>>>>>>>>
107069>>>>>>>>>>> set priv.psWriteBuffer to ""
107070>>>>>>>>>>> set priv.pbCData to false
107071>>>>>>>>>>> end
107071>>>>>>>>>>>>
107071>>>>>>>>>>> end
107071>>>>>>>>>>>>
107071>>>>>>>>>>> else begin
107072>>>>>>>>>>> if (priv.ClosedElement(self)) begin
107074>>>>>>>>>>> send destroy of (priv.phCurrentNode(self))
107075>>>>>>>>>>> set priv.phCurrentNode to (iPop(self))
107076>>>>>>>>>>> set priv.ClosedElement to false
107077>>>>>>>>>>> end
107077>>>>>>>>>>>>
107077>>>>>>>>>>> end
107077>>>>>>>>>>>>
107077>>>>>>>>>>> end_procedure
107078>>>>>>>>>>>
107078>>>>>>>>>>> procedure stream string lsValue
107080>>>>>>>>>>> if (priv.pbWriteModeSeq(self)) begin
107082>>>>>>>>>>> send flush_buffer
107083>>>>>>>>>>> send write lsValue
107084>>>>>>>>>>> end
107084>>>>>>>>>>>>
107084>>>>>>>>>>> end_procedure
107085>>>>>>>>>>>
107085>>>>>>>>>>> //> Adds an element that contains other elements
107085>>>>>>>>>>> procedure add_open_element string lsElement
107087>>>>>>>>>>> handle hoParentNode lhChildNode
107087>>>>>>>>>>> if (priv.pbWriteModeSeq(self)) begin
107089>>>>>>>>>>> send flush_buffer
107090>>>>>>>>>>> set priv.psWriteBuffer to ("<"+lsElement)
107091>>>>>>>>>>> send push.s lsElement
107092>>>>>>>>>>> set priv.pbOpen to true
107093>>>>>>>>>>> end
107093>>>>>>>>>>>>
107093>>>>>>>>>>> else begin
107094>>>>>>>>>>> send flush_buffer
107095>>>>>>>>>>> get priv.phCurrentNode to hoParentNode
107096>>>>>>>>>>>// get AddElementNS of hoParentNode "" lsElement "" to lhChildNode
107096>>>>>>>>>>> get AddElement of hoParentNode lsElement "" to lhChildNode
107097>>>>>>>>>>> send push.i hoParentNode
107098>>>>>>>>>>> set priv.phCurrentNode to lhChildNode
107099>>>>>>>>>>> end
107099>>>>>>>>>>>>
107099>>>>>>>>>>> end_procedure
107100>>>>>>>>>>>
107100>>>>>>>>>>> //> Adds a data element (an element with no children)
107100>>>>>>>>>>> procedure add_closed_element string lsElement string lsValue
107102>>>>>>>>>>> handle hoParentNode lhChildNode
107102>>>>>>>>>>> if (priv.pbWriteModeSeq(self)) begin
107104>>>>>>>>>>> send flush_buffer
107105>>>>>>>>>>> set priv.psWriteBuffer to ("<"+lsElement)
107106>>>>>>>>>>> send push.s lsValue
107107>>>>>>>>>>> send push.s lsElement
107108>>>>>>>>>>> send push.i 0 // not cdata
107109>>>>>>>>>>> set priv.pbOpen to false
107110>>>>>>>>>>> end
107110>>>>>>>>>>>>
107110>>>>>>>>>>> else begin
107111>>>>>>>>>>> send flush_buffer
107112>>>>>>>>>>> get priv.phCurrentNode to hoParentNode
107113>>>>>>>>>>>// get AddElementNS of hoParentNode "" lsElement "" to lhChildNode
107113>>>>>>>>>>> get AddElement of hoParentNode lsElement lsValue to lhChildNode
107114>>>>>>>>>>> send push.i hoParentNode
107115>>>>>>>>>>> set priv.phCurrentNode to lhChildNode
107116>>>>>>>>>>> set priv.ClosedElement to true
107117>>>>>>>>>>> end
107117>>>>>>>>>>>>
107117>>>>>>>>>>> end_procedure
107118>>>>>>>>>>>
107118>>>>>>>>>>> //> Same as add_closed_element but marks up the data in lsValue as CDATA.
107118>>>>>>>>>>> procedure add_closed_element_cdata string lsElement string lsValue
107120>>>>>>>>>>> handle hoParentNode lhChildNode
107120>>>>>>>>>>> if (priv.pbWriteModeSeq(self)) begin
107122>>>>>>>>>>> send flush_buffer
107123>>>>>>>>>>> set priv.psWriteBuffer to ("<"+lsElement)
107124>>>>>>>>>>> send push.s lsValue
107125>>>>>>>>>>> send push.s lsElement
107126>>>>>>>>>>> send push.i 1 // cdata
107127>>>>>>>>>>> set priv.pbOpen to false
107128>>>>>>>>>>> end
107128>>>>>>>>>>>>
107128>>>>>>>>>>> else begin
107129>>>>>>>>>>> send flush_buffer
107130>>>>>>>>>>> get priv.phCurrentNode to hoParentNode
107131>>>>>>>>>>> get AddElement of hoParentNode lsElement "" to lhChildNode
107132>>>>>>>>>>> send AddCDataSection of lhChildNode lsValue
107133>>>>>>>>>>> send push.i hoParentNode
107134>>>>>>>>>>> set priv.phCurrentNode to lhChildNode
107135>>>>>>>>>>> set priv.ClosedElement to true
107136>>>>>>>>>>> end
107136>>>>>>>>>>>>
107136>>>>>>>>>>> end_procedure
107137>>>>>>>>>>>
107137>>>>>>>>>>> //> Close an element previously added by the add_open_element method
107137>>>>>>>>>>> procedure close_element // Public
107139>>>>>>>>>>> string lsElement
107139>>>>>>>>>>> if (priv.pbWriteModeSeq(self)) begin
107141>>>>>>>>>>> send flush_buffer
107142>>>>>>>>>>> get sPop to lsElement
107143>>>>>>>>>>> send write ("</"+lsElement+">")
107144>>>>>>>>>>> end
107144>>>>>>>>>>>>
107144>>>>>>>>>>> else begin
107145>>>>>>>>>>> send flush_buffer
107146>>>>>>>>>>> send destroy of (priv.phCurrentNode(self))
107147>>>>>>>>>>> set priv.phCurrentNode to (iPop(self))
107148>>>>>>>>>>> end
107148>>>>>>>>>>>>
107148>>>>>>>>>>> end_procedure
107149>>>>>>>>>>>
107149>>>>>>>>>>> //> Add an attribute to the element that was most recently added (whether it's an open or a closed element)
107149>>>>>>>>>>> procedure add_attribute string lsAttr string lsValue
107151>>>>>>>>>>> string lsBuffer
107151>>>>>>>>>>> if (priv.pbWriteModeSeq(self)) begin
107153>>>>>>>>>>> get priv.psWriteBuffer to lsBuffer
107154>>>>>>>>>>> set priv.psWriteBuffer to (lsBuffer+' '+lsAttr+'="'+lsValue+'"')
107155>>>>>>>>>>> end
107155>>>>>>>>>>>>
107155>>>>>>>>>>> else begin
107156>>>>>>>>>>>// send AddAttributeNS of (priv.phCurrentNode(self)) "" lsAttr lsValue
107156>>>>>>>>>>> send AddAttribute of (priv.phCurrentNode(self)) lsAttr lsValue
107157>>>>>>>>>>> end
107157>>>>>>>>>>>>
107157>>>>>>>>>>> end_procedure
107158>>>>>>>>>>>
107158>>>>>>>>>>> //> Send this to initiate the process of writing XML to the sequential channel
107158>>>>>>>>>>> procedure begin_xml_write_seq integer liChannel
107160>>>>>>>>>>> send delete_data // clear the stack
107161>>>>>>>>>>> set priv.pbOpen to false
107162>>>>>>>>>>> set priv.pbWriteModeSeq to true
107163>>>>>>>>>>> set priv.piChannel to liChannel
107164>>>>>>>>>>> set priv.phCurrentNode to -1
107165>>>>>>>>>>> set priv.psWriteBuffer to ""
107166>>>>>>>>>>> set pbProtectValueData to true
107167>>>>>>>>>>> end_procedure
107168>>>>>>>>>>>
107168>>>>>>>>>>> //>
107168>>>>>>>>>>> procedure begin_xml_write_seq_custom
107170>>>>>>>>>>> send delete_data // clear the stack
107171>>>>>>>>>>> set priv.pbOpen to false
107172>>>>>>>>>>> set priv.pbWriteModeSeq to true
107173>>>>>>>>>>> set priv.piChannel to -1
107174>>>>>>>>>>> set priv.phCurrentNode to -1
107175>>>>>>>>>>> set priv.psWriteBuffer to ""
107176>>>>>>>>>>> set pbProtectValueData to true
107177>>>>>>>>>>> set priv.pbWebAppStream to false
107178>>>>>>>>>>> end_procedure
107179>>>>>>>>>>>
107179>>>>>>>>>>> // Only use this from within an webapp
107179>>>>>>>>>>> procedure begin_xml_write_webapp_stream
107181>>>>>>>>>>> send begin_xml_write_seq_custom
107182>>>>>>>>>>> set priv.pbWebAppStream to true
107183>>>>>>>>>>> error 323 "Must be a WebApp (XmlBuilder.pkg)"
107184>>>>>>>>>>>>
107184>>>>>>>>>>> end_procedure
107185>>>>>>>>>>>
107185>>>>>>>>>>> //> Send this to initiate the process of adding to XML DOM node
107185>>>>>>>>>>> procedure begin_xml_add_to_dom integer hoNode
107187>>>>>>>>>>> send delete_data // clear the stack
107188>>>>>>>>>>> set priv.pbOpen to false
107189>>>>>>>>>>> set priv.pbWriteModeSeq to false
107190>>>>>>>>>>> set priv.piChannel to -1
107191>>>>>>>>>>> set priv.phCurrentNode to hoNode
107192>>>>>>>>>>> set priv.psWriteBuffer to ""
107193>>>>>>>>>>> set priv.ClosedElement to false
107194>>>>>>>>>>> set pbProtectValueData to true
107195>>>>>>>>>>> end_procedure
107196>>>>>>>>>>>
107196>>>>>>>>>>> //> If you want the XML to be returned as a string you should use this
107196>>>>>>>>>>> //> method to initate the process.
107196>>>>>>>>>>> procedure begin_xml_build_string_value
107198>>>>>>>>>>> send delete_data of (oArray(self))
107199>>>>>>>>>>> send begin_xml_write_seq_custom
107200>>>>>>>>>>> end_procedure
107201>>>>>>>>>>>
107201>>>>>>>>>>> //> Send this to conclude the process of building the XML sequence.
107201>>>>>>>>>>> procedure end_xml
107203>>>>>>>>>>> send flush_buffer
107204>>>>>>>>>>> end_procedure
107205>>>>>>>>>>>
107205>>>>>>>>>>> //> If theXML building was initiated by the begin_xml_build_string_value
107205>>>>>>>>>>> //> message you can use this function to retrieve the value. Calling this
107205>>>>>>>>>>> //> function resets the content of the internal array.
107205>>>>>>>>>>> function sXmlValue returns string
107207>>>>>>>>>>> integer lhArr liMax liItm
107207>>>>>>>>>>> string lsValue
107207>>>>>>>>>>> move "" to lsValue
107208>>>>>>>>>>> move (oArray(self)) to lhArr
107209>>>>>>>>>>> get item_count of lhArr to liMax
107210>>>>>>>>>>> decrement liMax
107211>>>>>>>>>>> for liItm from 0 to liMax
107217>>>>>>>>>>>>
107217>>>>>>>>>>> move (lsValue+value(lhArr,liItm)) to lsValue
107218>>>>>>>>>>> loop
107219>>>>>>>>>>>>
107219>>>>>>>>>>> send delete_data of lhArr // You can only get its value once!
107220>>>>>>>>>>> function_return lsValue
107221>>>>>>>>>>> end_function
107222>>>>>>>>>>>
107222>>>>>>>>>>> //> Same as add_closed_element but formats the number with "." as decimal separator
107222>>>>>>>>>>> procedure add_closed_element_number string lsElement number lnValue // Public
107224>>>>>>>>>>> string lsValue
107224>>>>>>>>>>> move lnValue to lsValue
107225>>>>>>>>>>> move (replace(",",lsValue,".")) to lsValue
107226>>>>>>>>>>> send add_closed_element lsValue
107227>>>>>>>>>>> end_procedure
107228>>>>>>>>>>>
107228>>>>>>>>>>> //> Same as add_closed_element but formats the date according to ISO 8601 (YYYY-MM-DD)
107228>>>>>>>>>>> procedure add_closed_element_date string lsElement date ldValue
107230>>>>>>>>>>> string lsValue
107230>>>>>>>>>>> get DateToString ldValue DF_DATE_MILITARY true "-" to lsValue // International Standard ISO 8601
107231>>>>>>>>>>> send add_closed_element lsValue
107232>>>>>>>>>>> end_procedure
107233>>>>>>>>>>>end_class // cXmlBuilder
107234>>>>>>>>>>>
107234>>>>>>>>>
107234>>>>>>>>>desktop_section
107239>>>>>>>>>object oItemPropertyArrayXmlBuilder is a cXmlBuilder
107241>>>>>>>>> property integer phRoot
107243>>>>>>>>> property integer phxml
107245>>>>>>>>> procedure RememberRootAndXmlHandle integer lhXml integer lhRoot
107248>>>>>>>>> set phXml to lhXml
107249>>>>>>>>> set phRoot to lhRoot
107250>>>>>>>>> end_procedure
107251>>>>>>>>> procedure DestroyXmlHandles
107254>>>>>>>>> integer lhXml lhRoot
107254>>>>>>>>> get phXml to lhXml
107255>>>>>>>>> get phRoot to lhRoot
107256>>>>>>>>> send Destroy of lhRoot
107257>>>>>>>>> send Destroy of lhXml
107258>>>>>>>>> end_procedure
107259>>>>>>>>> procedure SaveAndDestroy
107262>>>>>>>>> integer lhXml lhRoot lbTest
107262>>>>>>>>> get phXml to lhXml
107263>>>>>>>>> get phRoot to lhRoot
107264>>>>>>>>> send Destroy of lhRoot
107265>>>>>>>>> get SaveXmlDocument of lhXml to lbTest
107266>>>>>>>>> send Destroy of lhXml
107267>>>>>>>>> end_procedure
107268>>>>>>>>>end_object
107269>>>>>>>>>end_desktop_section
107274>>>>>>>>>
107274>>>>>>>>> class cItemPropertyArrayColInfo is a cArray
107275>>>>>>>>> item_property_list
107275>>>>>>>>> // XML properties:
107275>>>>>>>>> item_property string psXmlTag.i
107275>>>>>>>>> item_property integer pbXmlSubNode.i
107275>>>>>>>>> item_property integer piXmlArrayClass.i // Which class do we instantiate to soak up subnodes?
107275>>>>>>>>> // Grid related properties:
107275>>>>>>>>> item_property string psHeader.i
107275>>>>>>>>> item_property integer pbDisplay.i
107275>>>>>>>>> item_property integer piLength.i
107275>>>>>>>>> item_property integer piDecimals.i
107275>>>>>>>>> end_item_property_list cItemPropertyArrayColInfo
#REM 107322 DEFINE FUNCTION PIDECIMALS.I INTEGER LIROW RETURNS INTEGER
#REM 107326 DEFINE PROCEDURE SET PIDECIMALS.I INTEGER LIROW INTEGER VALUE
#REM 107330 DEFINE FUNCTION PILENGTH.I INTEGER LIROW RETURNS INTEGER
#REM 107334 DEFINE PROCEDURE SET PILENGTH.I INTEGER LIROW INTEGER VALUE
#REM 107338 DEFINE FUNCTION PBDISPLAY.I INTEGER LIROW RETURNS INTEGER
#REM 107342 DEFINE PROCEDURE SET PBDISPLAY.I INTEGER LIROW INTEGER VALUE
#REM 107346 DEFINE FUNCTION PSHEADER.I INTEGER LIROW RETURNS STRING
#REM 107350 DEFINE PROCEDURE SET PSHEADER.I INTEGER LIROW STRING VALUE
#REM 107354 DEFINE FUNCTION PIXMLARRAYCLASS.I INTEGER LIROW RETURNS INTEGER
#REM 107358 DEFINE PROCEDURE SET PIXMLARRAYCLASS.I INTEGER LIROW INTEGER VALUE
#REM 107362 DEFINE FUNCTION PBXMLSUBNODE.I INTEGER LIROW RETURNS INTEGER
#REM 107366 DEFINE PROCEDURE SET PBXMLSUBNODE.I INTEGER LIROW INTEGER VALUE
#REM 107370 DEFINE FUNCTION PSXMLTAG.I INTEGER LIROW RETURNS STRING
#REM 107374 DEFINE PROCEDURE SET PSXMLTAG.I INTEGER LIROW STRING VALUE
107379>>>>>>>>> end_class // cItemPropertyArrayColInfo
107380>>>>>>>>>
107380>>>>>>>>>class cExtendedItemPropertyArray is a cArray
107381>>>>>>>>> procedure construct_object
107383>>>>>>>>> forward send construct_object
107385>>>>>>>>> property string psRowXmlTag public "record"
107386>>>>>>>>> object oColInfo is a cItemPropertyArrayColInfo
107388>>>>>>>>> end_object
107389>>>>>>>>> end_procedure
107390>>>>>>>>> procedure set column_xml_tag integer liColumn string lsValue
107392>>>>>>>>> set psXmlTag.i of (oColInfo(self)) liColumn to lsValue
107393>>>>>>>>> end_procedure
107394>>>>>>>>> procedure set column_xml_subnode_array integer liColumn integer lbState
107396>>>>>>>>> set pbXmlSubNode.i of (oColInfo(self)) liColumn to lbState
107397>>>>>>>>> end_procedure
107398>>>>>>>>> procedure set column_subnode_array_class integer liColumn integer liClass
107400>>>>>>>>> set piXmlArrayClass.i of (oColInfo(self)) liColumn to liClass
107401>>>>>>>>> end_procedure
107402>>>>>>>>> procedure set column_header integer liColumn string lsValue
107404>>>>>>>>> set psHeader.i of (oColInfo(self)) liColumn to lsValue
107405>>>>>>>>> end_procedure
107406>>>>>>>>> procedure set column_display integer liColumn integer lbState
107408>>>>>>>>> set pbDisplay.i of (oColInfo(self)) liColumn to lbState
107409>>>>>>>>> end_procedure
107410>>>>>>>>> procedure set column_length integer liColumn integer liLen
107412>>>>>>>>> set piLength.i of (oColInfo(self)) liColumn to liLen
107413>>>>>>>>> end_procedure
107414>>>>>>>>> procedure set column_decimals integer liColumn integer liDecs
107416>>>>>>>>> set piDecimals.i of (oColInfo(self)) liColumn to liDecs
107417>>>>>>>>> end_procedure
107418>>>>>>>>>
107418>>>>>>>>> procedure WriteXml
107420>>>>>>>>> integer lhBuilder liMax liRow liCol lhColInfo liColMax
107420>>>>>>>>> integer lbXmlSubNode lhSubNodeArr liType
107420>>>>>>>>> string lsValue lsXmlTag lsRowXmlTag
107420>>>>>>>>> move oItemPropertyArrayXmlBuilder to lhBuilder
107421>>>>>>>>> move (oColInfo(self)) to lhColInfo
107422>>>>>>>>> get psRowXmlTag to lsRowXmlTag
107423>>>>>>>>> get row_count to liMax
107424>>>>>>>>> decrement liMax
107425>>>>>>>>> get column_count to liColMax
107426>>>>>>>>> decrement liColMax
107427>>>>>>>>> for liRow from 0 to liMax
107433>>>>>>>>>>
107433>>>>>>>>>
107433>>>>>>>>> send add_open_element of lhBuilder lsRowXmlTag
107434>>>>>>>>>
107434>>>>>>>>> for liCol from 0 to liColMax
107440>>>>>>>>>>
107440>>>>>>>>> get psXmlTag.i of lhColInfo liCol to lsXmlTag
107441>>>>>>>>> if (lsXmlTag<>"") begin
107443>>>>>>>>> get value item (liRow*(liColMax+1)+liCol) to lsValue
107444>>>>>>>>>
107444>>>>>>>>> get pbXmlSubNode.i of lhColInfo liCol to lbXmlSubNode
107445>>>>>>>>> if lbXmlSubNode begin
107447>>>>>>>>> if (integer(lsValue)) begin
107449>>>>>>>>> move lsValue to lhSubNodeArr
107450>>>>>>>>> send add_open_element of lhBuilder lsXmlTag
107451>>>>>>>>> send WriteXml of lhSubNodeArr
107452>>>>>>>>> send close_element of lhBuilder
107453>>>>>>>>> end
107453>>>>>>>>>>
107453>>>>>>>>> end
107453>>>>>>>>>>
107453>>>>>>>>> else begin
107454>>>>>>>>> get item_property_type liCol to liType
107455>>>>>>>>> if (liType=ITMP_INTEGER) send add_closed_element of lhBuilder lsXmlTag lsValue
107458>>>>>>>>> if (liType=ITMP_STRING) send add_closed_element of lhBuilder lsXmlTag lsValue
107461>>>>>>>>> if (liType=ITMP_REAL) send add_closed_element of lhBuilder lsXmlTag lsValue
107464>>>>>>>>> if (liType=ITMP_NUMBER) send add_closed_element_number of lhBuilder lsXmlTag lsValue
107467>>>>>>>>> if (liType=ITMP_DATE) send add_closed_element_date of lhBuilder lsXmlTag lsValue
107470>>>>>>>>> end
107470>>>>>>>>>>
107470>>>>>>>>> end
107470>>>>>>>>>>
107470>>>>>>>>> loop
107471>>>>>>>>>>
107471>>>>>>>>>
107471>>>>>>>>> send close_element of lhBuilder // lsRowXmlTag
107472>>>>>>>>> loop
107473>>>>>>>>>>
107473>>>>>>>>> end_procedure
107474>>>>>>>>>
107474>>>>>>>>> procedure ReadXml integer hoNode
107476>>>>>>>>> integer liLen liItm hoCollectionNode liCol liColMax lhColInfo liRow lbXmlSubNode liClass lhNewArray hoList
107476>>>>>>>>> integer hoChildNode
107476>>>>>>>>> string lsValue lsXmlTag lsRowXmlTag
107476>>>>>>>>> get psRowXmlTag to lsRowXmlTag
107477>>>>>>>>> move (oColInfo(self)) to lhColInfo
107478>>>>>>>>> get column_count to liColMax
107479>>>>>>>>> decrement liColMax
107480>>>>>>>>>
107480>>>>>>>>> get FindNodeList of hoNode lsRowXmlTag To hoList
107481>>>>>>>>>
107481>>>>>>>>> get NodeListLength of hoList to liLen
107482>>>>>>>>> decrement liLen
107483>>>>>>>>> for liItm from 0 to liLen
107489>>>>>>>>>>
107489>>>>>>>>> get CollectionNode of hoList liItm to hoCollectionNode
107490>>>>>>>>> get row_count to liRow
107491>>>>>>>>> for liCol from 0 to liColMax
107497>>>>>>>>>>
107497>>>>>>>>> get psXmlTag.i of lhColInfo liCol to lsXmlTag
107498>>>>>>>>> if (lsXmlTag<>"") begin
107500>>>>>>>>> get pbXmlSubNode.i of lhColInfo liCol to lbXmlSubNode // Is this a sub-array thing?
107501>>>>>>>>> if lbXmlSubNode begin
107503>>>>>>>>> get FindNode of hoCollectionNode lsXmlTag to hoChildNode
107504>>>>>>>>> if hoChildNode begin
107506>>>>>>>>> get piXmlArrayClass.i of lhColInfo liCol to liClass
107507>>>>>>>>> get create liClass to lhNewArray
107508>>>>>>>>> set value item (liRow*(liColMax+1)+liCol) to lhNewArray
107509>>>>>>>>> send ReadXml of lhNewArray hoChildNode
107510>>>>>>>>> send destroy of hoChildNode
107511>>>>>>>>> end
107511>>>>>>>>>>
107511>>>>>>>>> end
107511>>>>>>>>>>
107511>>>>>>>>> else begin
107512>>>>>>>>> get ChildNodeValue of hoCollectionNode lsXmlTag to lsValue // What's it's value?
107513>>>>>>>>> set value item (liRow*(liColMax+1)+liCol) to lsValue
107514>>>>>>>>> end
107514>>>>>>>>>>
107514>>>>>>>>> end
107514>>>>>>>>>>
107514>>>>>>>>> loop
107515>>>>>>>>>>
107515>>>>>>>>> send destroy of hoCollectionNode
107516>>>>>>>>> loop
107517>>>>>>>>>>
107517>>>>>>>>> send destroy of hoList
107518>>>>>>>>> end_procedure
107519>>>>>>>>>end_class // cItemPropertyArray
107520>>>>>>>>>
107520>>>>>>>>>
107520>>>>>>>Use XmlBuilder.nui // cXmlBuilder class (XML building made easy)
107520>>>>>>>//Use TextProcessor.nui // cTextProcessor class
107520>>>>>>>
107520>>>>>>>enumeration_list
107520>>>>>>> define PKGDOC_ITEMTYPE_UNDEFINED
107520>>>>>>> define PKGDOC_ITEMTYPE_COMMAND
107520>>>>>>> define PKGDOC_ITEMTYPE_OBJECT
107520>>>>>>> define PKGDOC_ITEMTYPE_CLASS
107520>>>>>>> define PKGDOC_ITEMTYPE_METHOD
107520>>>>>>> define PKGDOC_ITEMTYPE_PROPERTY
107520>>>>>>> define PKGDOC_ITEMTYPE_FILE
107520>>>>>>>end_enumeration_list
107520>>>>>>>
107520>>>>>>>
107520>>>>>>>object cPkgReader is a cArray
107522>>>>>>>
107522>>>>>>> property string psPackageName
107524>>>>>>>
107524>>>>>>> property integer pbXmlDomMode public false
107526>>>>>>>
107526>>>>>>> item_property_list
107526>>>>>>> item_property integer piGroupType.i // 0 desktop level, 1=object, 2=class
107526>>>>>>> item_property string psGroupName.i // Object or class name or blank if desktop
107526>>>>>>> item_property integer piType.i // File, class, object, method
107526>>>>>>> item_property string psSourceLine.i // Source line that flushed the documentation buffer
107526>>>>>>> item_property string psDocText.i // Doc text
107526>>>>>>> end_item_property_list
#REM 107572 DEFINE FUNCTION PSDOCTEXT.I INTEGER LIROW RETURNS STRING
#REM 107577 DEFINE PROCEDURE SET PSDOCTEXT.I INTEGER LIROW STRING VALUE
#REM 107582 DEFINE FUNCTION PSSOURCELINE.I INTEGER LIROW RETURNS STRING
#REM 107587 DEFINE PROCEDURE SET PSSOURCELINE.I INTEGER LIROW STRING VALUE
#REM 107592 DEFINE FUNCTION PITYPE.I INTEGER LIROW RETURNS INTEGER
#REM 107597 DEFINE PROCEDURE SET PITYPE.I INTEGER LIROW INTEGER VALUE
#REM 107602 DEFINE FUNCTION PSGROUPNAME.I INTEGER LIROW RETURNS STRING
#REM 107607 DEFINE PROCEDURE SET PSGROUPNAME.I INTEGER LIROW STRING VALUE
#REM 107612 DEFINE FUNCTION PIGROUPTYPE.I INTEGER LIROW RETURNS INTEGER
#REM 107617 DEFINE PROCEDURE SET PIGROUPTYPE.I INTEGER LIROW INTEGER VALUE
107623>>>>>>>
107623>>>>>>> object oXmlBuilder is a cXmlBuilder
107625>>>>>>> end_object
107626>>>>>>>
107626>>>>>>> property integer piXmlChannel
107628>>>>>>> property handle phXmlDoc
107630>>>>>>>
107630>>>>>>> procedure DoOpenXml string lsXmlFile
107633>>>>>>> integer liChannel
107633>>>>>>> handle hoXML
107633>>>>>>> if (pbXmlDomMode(self)) begin
107635>>>>>>> Get Create U_cXmlDomDocument to hoXML
107636>>>>>>> Send AddChildProcessingInstruction to hoXML "xml" "version='1.0' encoding='iso-8859-1'"
107637>>>>>>> set psDocumentName of hoXML to lsXmlFile
107638>>>>>>> send begin_xml_add_to_dom of oXmlBuilder hoXML
107639>>>>>>> set phXmlDoc to hoXML
107640>>>>>>> end
107640>>>>>>>>
107640>>>>>>> else begin
107641>>>>>>> get SEQ_DirectOutput lsXmlFile to liChannel
107642>>>>>>> write channel liChannel '<?xml version="1.0" encoding="iso-8859-1"?>' // Manually write this
107644>>>>>>> send begin_xml_write_seq of oXmlBuilder liChannel
107645>>>>>>> set piXmlChannel to liChannel
107646>>>>>>> end
107646>>>>>>>>
107646>>>>>>> send add_open_element of oXmlBuilder "sourcefilelist"
107647>>>>>>> end_procedure
107648>>>>>>>
107648>>>>>>> procedure DoCloseXml
107651>>>>>>> integer liChannel lbError
107651>>>>>>> handle hoXML
107651>>>>>>> send close_element of oXmlBuilder // "sourcefilelist"
107652>>>>>>> if (pbXmlDomMode(self)) begin
107654>>>>>>> get phXmlDoc to hoXML
107655>>>>>>> Get SaveXmlDocument of hoXML to lbError
107656>>>>>>> if lbError error 721 ("Error saving XML to file: "+string(lbError))
107659>>>>>>> Send Destroy of hoXML
107660>>>>>>> end
107660>>>>>>>>
107660>>>>>>> else begin
107661>>>>>>> get piXmlChannel to liChannel
107662>>>>>>> send end_xml of oXmlBuilder
107663>>>>>>> send SEQ_CloseOutput liChannel
107664>>>>>>> end
107664>>>>>>>>
107664>>>>>>> end_procedure
107665>>>>>>>
107665>>>>>>> function WriteXml_GroupElement integer liGroupType returns string
107668>>>>>>> if (liGroupType=0) function_return "desktop"
107671>>>>>>> if (liGroupType=1) function_return "object"
107674>>>>>>> if (liGroupType=2) function_return "class"
107677>>>>>>> end_function
107678>>>>>>> function WriteXml_TypeElement integer liType returns string
107681>>>>>>> if (liType=PKGDOC_ITEMTYPE_UNDEFINED) function_return "undefined"
107684>>>>>>> if (liType=PKGDOC_ITEMTYPE_COMMAND ) function_return "command"
107687>>>>>>> if (liType=PKGDOC_ITEMTYPE_OBJECT ) function_return "object"
107690>>>>>>> if (liType=PKGDOC_ITEMTYPE_CLASS ) function_return "class"
107693>>>>>>> if (liType=PKGDOC_ITEMTYPE_METHOD ) function_return "method"
107696>>>>>>> if (liType=PKGDOC_ITEMTYPE_PROPERTY ) function_return "property"
107699>>>>>>> if (liType=PKGDOC_ITEMTYPE_FILE ) function_return "pkg"
107702>>>>>>> end_function
107703>>>>>>>
107703>>>>>>> procedure DoWriteXml
107706>>>>>>> integer liMax liRow liType liGroupType lbFirst
107706>>>>>>> string lsSourceFile lsCurrentGroup lsGroup lsLine lsText
107706>>>>>>> string lsGroupElement lsTypeElement
107706>>>>>>> move "--" to lsCurrentGroup
107707>>>>>>> get psPackageName to lsSourceFile
107708>>>>>>> get row_count to liMax
107709>>>>>>> if liMax begin
107711>>>>>>> send add_open_element of oXmlBuilder "sourcefile"
107712>>>>>>> send add_attribute of oXmlBuilder "name" lsSourceFile
107713>>>>>>> move true to lbFirst
107714>>>>>>>
107714>>>>>>> decrement liMax
107715>>>>>>> for liRow from 0 to liMax
107721>>>>>>>>
107721>>>>>>> get psGroupName.i liRow to lsGroup
107722>>>>>>> get piGroupType.i liRow to liGroupType
107723>>>>>>> get piType.i liRow to liType
107724>>>>>>> get psSourceLine.i liRow to lsLine
107725>>>>>>> get psDocText.i liRow to lsText
107726>>>>>>>
107726>>>>>>> if (liRow=0 and liType=PKGDOC_ITEMTYPE_FILE) begin
107728>>>>>>> send add_closed_element_cdata of oXmlBuilder "doc" lsText
107729>>>>>>> end
107729>>>>>>>>
107729>>>>>>> else begin
107730>>>>>>>
107730>>>>>>> if (lsGroup<>lsCurrentGroup) begin
107732>>>>>>> ifnot lbFirst send close_element of oXmlBuilder // "?"
107735>>>>>>> get WriteXml_GroupElement liGroupType to lsGroupElement
107736>>>>>>> send add_open_element of oXmlBuilder lsGroupElement
107737>>>>>>> if (liGroupType<>0) send add_attribute of oXmlBuilder "name" lsGroup
107740>>>>>>> move lsGroup to lsCurrentGroup
107741>>>>>>> move false to lbFirst
107742>>>>>>> end
107742>>>>>>>>
107742>>>>>>> send add_open_element of oXmlBuilder "declaration"
107743>>>>>>> get WriteXml_TypeElement liType to lsTypeElement
107744>>>>>>> send add_attribute of oXmlBuilder "type" lsTypeElement
107745>>>>>>>
107745>>>>>>> send add_closed_element of oXmlBuilder "line" lsLine
107746>>>>>>>
107746>>>>>>> send add_closed_element_cdata of oXmlBuilder "doc" lsText
107747>>>>>>> send close_element of oXmlBuilder // "declaration"
107748>>>>>>> end
107748>>>>>>>>
107748>>>>>>>
107748>>>>>>> loop
107749>>>>>>>>
107749>>>>>>> ifnot lbFirst send close_element of oXmlBuilder // "?"
107752>>>>>>> send close_element of oXmlBuilder // "sourcefile"
107753>>>>>>> send delete_data
107754>>>>>>> end
107754>>>>>>>>
107754>>>>>>> end_procedure
107755>>>>>>>
107755>>>>>>> object oCommentsBuilder is a cArray
107757>>>>>>> procedure add_line string lsLine
107760>>>>>>> if (left(lsLine,1)=" ") move (replace(" ",lsLine,"")) to lsLine
107763>>>>>>> set value item (item_count(self)) to lsLine
107764>>>>>>> end_procedure
107765>>>>>>>
107765>>>>>>> function sValue.ssi string lsOn string lsOff integer lbInitial returns string
107768>>>>>>> integer liMax liItm lbOn
107768>>>>>>> string lsRval lsValue
107768>>>>>>> move lbInitial to lbOn
107769>>>>>>> move "" to lsRval
107770>>>>>>> get item_count to liMax
107771>>>>>>> decrement liMax
107772>>>>>>> for liItm from 0 to liMax
107778>>>>>>>>
107778>>>>>>> get value item liItm to lsValue
107779>>>>>>> if (lowercase(trim(replaces(" ",lsValue,"")))=lsOn) begin
107781>>>>>>> move 1 to lbOn
107782>>>>>>> move "" to lsValue // We will not include the "On" trigger
107783>>>>>>> end
107783>>>>>>>>
107783>>>>>>> if (lowercase(trim(replaces(" ",lsValue,"")))=lsOff) move 0 to lbOn
107786>>>>>>> if lbOn begin
107788>>>>>>> if (lsRval="") move lsValue to lsRval
107791>>>>>>> else move (lsRval+character(10)+lsValue) to lsRval
107793>>>>>>> end
107793>>>>>>>>
107793>>>>>>> loop
107794>>>>>>>>
107794>>>>>>> function_return lsRval
107795>>>>>>> end_function
107796>>>>>>>
107796>>>>>>> function sHeaderValue returns string
107799>>>>>>> string lsValue
107799>>>>>>> get sValue.ssi "pkgdoc.begin" "pkgdoc.end" false to lsValue
107800>>>>>>> function_return lsValue
107801>>>>>>> end_function
107802>>>>>>>
107802>>>>>>> function sValue returns string
107805>>>>>>> string lsValue
107805>>>>>>> get sValue.ssi "pkgdoc.end" "pkgdoc.begin" true to lsValue
107806>>>>>>> send delete_data
107807>>>>>>> function_return lsValue
107808>>>>>>> end_function
107809>>>>>>> end_object // oCommentsBuilder
107810>>>>>>>
107810>>>>>>> function sRemoveComment string lsLine returns string
107813>>>>>>> integer liPos
107813>>>>>>> string lsComment lsCommand
107813>>>>>>> move (pos("/"+"/",lsLine)) to liPos
107814>>>>>>> if liPos begin
107816>>>>>>> move (left(lsLine,liPos-1)) to lsCommand
107817>>>>>>> move (replace(lsCommand,lsLine,"")) to lsComment
107818>>>>>>> if (left(lsComment,3)="//>") begin
107820>>>>>>> get StringRightBut lsComment 3 to lsComment
107821>>>>>>> send add_line of oCommentsBuilder lsComment
107822>>>>>>> end
107822>>>>>>>>
107822>>>>>>> end
107822>>>>>>>>
107822>>>>>>> else move lsLine to lsCommand
107824>>>>>>> function_return (rtrim(lsCommand))
107825>>>>>>> end_function
107826>>>>>>>
107826>>>>>>> function sReadSourceLine.ii integer liChannel integer lbInImage returns string
107829>>>>>>> integer lbSeqEof
107829>>>>>>> string lsValue lsComment lsReturnValue
107829>>>>>>> move "" to lsReturnValue
107830>>>>>>> move 0 to lbSeqEof
107831>>>>>>> while (lbSeqEof=0 and lsReturnValue="")
107835>>>>>>> repeat
107835>>>>>>>>
107835>>>>>>> readln channel liChannel lsValue
107837>>>>>>> move (seqeof) to lbSeqEof
107838>>>>>>> until (lbSeqEof<>0 or lsValue<>"")
107840>>>>>>> ifnot lbInImage begin
107842>>>>>>> get sRemoveComment lsValue to lsValue
107843>>>>>>> end
107843>>>>>>>>
107843>>>>>>> move lsValue to lsReturnValue
107844>>>>>>> ifnot lbSeqEof begin
107846>>>>>>> ifnot lbInImage begin
107848>>>>>>> while (not(lbSeqEof) and right(lsReturnValue,1)=";")
107852>>>>>>> get StringLeftBut lsReturnValue 1 to lsReturnValue
107853>>>>>>> readln channel liChannel lsValue
107855>>>>>>> move (seqeof) to lbSeqEof
107856>>>>>>> ifnot lbSeqEof begin
107858>>>>>>> get sRemoveComment lsValue to lsValue
107859>>>>>>> move (lsReturnValue*lsValue) to lsReturnValue
107860>>>>>>> end
107860>>>>>>>>
107860>>>>>>> end
107861>>>>>>>>
107861>>>>>>> end
107861>>>>>>>>
107861>>>>>>> end
107861>>>>>>>>
107861>>>>>>> end
107862>>>>>>>>
107862>>>>>>> function_return (rtrim(lsReturnValue))
107863>>>>>>> end_function
107864>>>>>>>
107864>>>>>>> procedure DoReset
107867>>>>>>> send delete_data
107868>>>>>>> end_procedure
107869>>>>>>>
107869>>>>>>> function sReadUntil_Value integer liChannel string lsValue returns integer
107872>>>>>>> string lsLine
107872>>>>>>> move (uppercase(lsValue)) to lsValue
107873>>>>>>> repeat
107873>>>>>>>>
107873>>>>>>> get sReadSourceLine.ii liChannel false to lsLine
107874>>>>>>> if (lsLine="") function_return 0
107877>>>>>>> if (uppercase(trim(lsLine))=lsValue) function_return 1
107880>>>>>>> loop
107881>>>>>>>>
107881>>>>>>> end_function
107882>>>>>>>
107882>>>>>>> function sReadUntil_ImageEnd integer liChannel string lsValue returns integer
107885>>>>>>> string lsLine
107885>>>>>>> repeat
107885>>>>>>>>
107885>>>>>>> get sReadSourceLine.ii liChannel true to lsLine
107886>>>>>>> if (lsLine="") function_return 0
107889>>>>>>> if (lsLine=lsValue) function_return 1
107892>>>>>>> loop
107893>>>>>>>>
107893>>>>>>> end_function
107894>>>>>>>
107894>>>>>>> procedure add_to_doc integer liType integer liGroupType string lsGroup string lsLine
107897>>>>>>> integer liRow
107897>>>>>>> string lsComment
107897>>>>>>> get sHeaderValue of oCommentsBuilder to lsComment
107898>>>>>>> if (lsComment<>"") begin
107900>>>>>>> get row_count to liRow
107901>>>>>>> set piType.i liRow to PKGDOC_ITEMTYPE_FILE
107902>>>>>>> set piGroupType.i liRow to 0
107903>>>>>>> set psGroupName.i liRow to 0
107904>>>>>>> set psSourceLine.i liRow to ""
107905>>>>>>> set psDocText.i liRow to lsComment
107906>>>>>>> end
107906>>>>>>>>
107906>>>>>>>
107906>>>>>>> get sValue of oCommentsBuilder to lsComment
107907>>>>>>> if (lsComment<>"") begin
107909>>>>>>> get row_count to liRow
107910>>>>>>> set piType.i liRow to liType
107911>>>>>>> set piGroupType.i liRow to liGroupType
107912>>>>>>> set psGroupName.i liRow to lsGroup
107913>>>>>>> set psSourceLine.i liRow to lsLine
107914>>>>>>> set psDocText.i liRow to lsComment
107915>>>>>>> end
107915>>>>>>>>
107915>>>>>>> end_procedure
107916>>>>>>>
107916>>>>>>> procedure DoAddPkg string lsFile
107919>>>>>>> integer liChannel lbOk lbInClass liObjectLevel liGroupType
107919>>>>>>> integer lbIdentified
107919>>>>>>> string lsCommand lsArg1 lsLine
107919>>>>>>> string lsCurrentGroup // Class name or object name
107919>>>>>>> set psPackageName to (SEQ_RemovePathFromFileName(lsFile))
107920>>>>>>> send delete_data of oCommentsBuilder
107921>>>>>>>
107921>>>>>>> get SEQ_DirectInput lsFile to liChannel
107922>>>>>>> if (liChannel>=0) begin
107924>>>>>>> move false to lbInClass
107925>>>>>>> move 0 to liObjectLevel
107926>>>>>>> move 0 to liGroupType // 0=defined at desktop level, 1=defined in object, 2 defined in class
107927>>>>>>> repeat
107927>>>>>>>>
107927>>>>>>> get sReadSourceLine.ii liChannel false to lsLine
107928>>>>>>> if (lsLine<>"") begin
107930>>>>>>>
107930>>>>>>> if (left(lsLine,1)="/") get sReadUntil_ImageEnd liChannel ("/"+"*") to lbOk
107933>>>>>>> else begin
107934>>>>>>> move 0 to lbIdentified
107935>>>>>>> get ExtractWord lsLine " " 1 to lsCommand
107936>>>>>>> get ExtractWord lsLine " " 2 to lsArg1
107937>>>>>>> move (uppercase(lsCommand)) to lsCommand
107938>>>>>>> if (lsCommand="#COMMAND") begin
107940>>>>>>> send add_to_doc PKGDOC_ITEMTYPE_COMMAND liGroupType lsCurrentGroup lsLine
107941>>>>>>> get sReadUntil_Value liChannel "#ENDCOMMAND" to lbOk
107942>>>>>>> move 1 to lbIdentified
107943>>>>>>> end
107943>>>>>>>>
107943>>>>>>> ifnot lbInClass begin
107945>>>>>>> if (lsCommand="OBJECT") begin
107947>>>>>>> increment liObjectLevel
107948>>>>>>> if (liObjectLevel=1) begin
107950>>>>>>> get ExtractWord lsLine " " 2 to lsCurrentGroup
107951>>>>>>> move 1 to liGroupType // 0=defined at desktop level, 1=defined in object, 2 defined in class
107952>>>>>>> send add_to_doc PKGDOC_ITEMTYPE_OBJECT liGroupType lsCurrentGroup lsLine
107953>>>>>>> end
107953>>>>>>>>
107953>>>>>>> move 1 to lbIdentified
107954>>>>>>> end
107954>>>>>>>>
107954>>>>>>> if (lsCommand="END_OBJECT") begin
107956>>>>>>> decrement liObjectLevel
107957>>>>>>> ifnot liObjectLevel move 0 to liGroupType // 0=defined at desktop level, 1=defined in object, 2 defined in class
107960>>>>>>> move 1 to lbIdentified
107961>>>>>>> move "" to lsCurrentGroup
107962>>>>>>> end
107962>>>>>>>>
107962>>>>>>> end
107962>>>>>>>>
107962>>>>>>> if (lsCommand="CLASS") begin
107964>>>>>>> move true to lbInClass
107965>>>>>>> get ExtractWord lsLine " " 2 to lsCurrentGroup
107966>>>>>>> move 2 to liGroupType // 0=defined at desktop level, 1=defined in object, 2 defined in class
107967>>>>>>> send add_to_doc PKGDOC_ITEMTYPE_CLASS liGroupType lsCurrentGroup lsLine
107968>>>>>>> move 1 to lbIdentified
107969>>>>>>> end
107969>>>>>>>>
107969>>>>>>> if (lsCommand="END_CLASS") begin
107971>>>>>>> move false to lbInClass
107972>>>>>>> move 0 to liGroupType // 0=defined at desktop level, 1=defined in object, 2 defined in class
107973>>>>>>> move 1 to lbIdentified
107974>>>>>>> move "" to lsCurrentGroup
107975>>>>>>> end
107975>>>>>>>>
107975>>>>>>> if (lsCommand="FUNCTION") begin
107977>>>>>>> get sReadUntil_Value liChannel "END_FUNCTION" to lbOK
107978>>>>>>> send add_to_doc PKGDOC_ITEMTYPE_METHOD liGroupType lsCurrentGroup lsLine
107979>>>>>>> move 1 to lbIdentified
107980>>>>>>> end
107980>>>>>>>>
107980>>>>>>> if (lsCommand="PROCEDURE" and lsArg1="CONSTRUCT_OBJECT") begin
107982>>>>>>> move 1 to lbIdentified
107983>>>>>>> end
107983>>>>>>>>
107983>>>>>>> else begin
107984>>>>>>> if (lsCommand="PROCEDURE" or lsCommand="PROCEDURE_SECTION") begin
107986>>>>>>> get sReadUntil_Value liChannel "END_PROCEDURE" to lbOK
107987>>>>>>> send add_to_doc PKGDOC_ITEMTYPE_METHOD liGroupType lsCurrentGroup lsLine
107988>>>>>>> move 1 to lbIdentified
107989>>>>>>> end
107989>>>>>>>>
107989>>>>>>> end
107989>>>>>>>>
107989>>>>>>>
107989>>>>>>> if (lsCommand="PROPERTY") begin
107991>>>>>>> send add_to_doc PKGDOC_ITEMTYPE_PROPERTY liGroupType lsCurrentGroup lsLine
107992>>>>>>> move 1 to lbIdentified
107993>>>>>>> end
107993>>>>>>>>
107993>>>>>>>
107993>>>>>>> ifnot lbIdentified begin
107995>>>>>>> // Just in case of misplaced comments
107995>>>>>>> send add_to_doc PKGDOC_ITEMTYPE_UNDEFINED liGroupType lsCurrentGroup lsLine
107996>>>>>>> end
107996>>>>>>>>
107996>>>>>>> end
107996>>>>>>>>
107996>>>>>>> end
107996>>>>>>>>
107996>>>>>>> until (lsLine="")
107998>>>>>>> send SEQ_CloseInput liChannel
107999>>>>>>> send DoWriteXml
108000>>>>>>> end
108000>>>>>>>>
108000>>>>>>> end_procedure
108001>>>>>>>
108001>>>>>>>//send DoOpenXml "xmltest.xml"
108001>>>>>>>//send DoAddPkg "c:\dfs\xmlbuilder.nui"
108001>>>>>>>//send DoAddPkg "c:\dfs\strings.nui"
108001>>>>>>>//send DoAddPkg "c:\dfs\dates.nui"
108001>>>>>>>//send DoAddPkg "c:\dfs\files.nui"
108001>>>>>>>//send DoCloseXml
108001>>>>>>>end_object
108002>>>>>use setdir.pkg // cSetOfDirectories class
Including file: setdir.pkg (C:\Apps\VDFQuery\AppSrc\setdir.pkg)
108002>>>>>>>// Use SetDir.pkg // cSetOfDirectories class
108002>>>>>>>Use SetDir.nui // cSetOfDirectories class
Including file: setdir.nui (C:\Apps\VDFQuery\AppSrc\setdir.nui)
108002>>>>>>>>>// Use SetDir.nui // cSetOfDirectories class
108002>>>>>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
108002>>>>>>>>>Use Files.nui // Utilities for handling file related stuff (No User Interface)
108002>>>>>>>>>Use WildCard.nui // WildCardMatch function
108002>>>>>>>>>Use Strings.nui // String manipulation for VDF (No User Interface)
108002>>>>>>>>>Use ItemProp.nui // ITEM_PROPERTY command for use within arrays
108002>>>>>>>>>
108002>>>>>>>>>// cSetOfDirectories, public interface:
108002>>>>>>>>>// ------------------------------------
108002>>>>>>>>>//
108002>>>>>>>>>// Reset the array
108002>>>>>>>>>// procedure DoReset
108002>>>>>>>>>//
108002>>>>>>>>>// Add a directory
108002>>>>>>>>>// procedure DoAddDirectory string lsDir
108002>>>>>>>>>//
108002>>>>>>>>>// Add a number of directories
108002>>>>>>>>>// procedure DoAddSearchPath string lsPath
108002>>>>>>>>>//
108002>>>>>>>>>// Add a directory and all its subdirectories
108002>>>>>>>>>// procedure DoAddSubDirectories string lsDir
108002>>>>>>>>>//
108002>>>>>>>>>// Remove a directory from the list
108002>>>>>>>>>// procedure DoRemoveDirectory string lsDir
108002>>>>>>>>>//
108002>>>>>>>>>// Search for a file (mask) in all directories and call back. Parameter
108002>>>>>>>>>// lsFileMask determines whether the same file name is called back more
108002>>>>>>>>>// than once (if present in more than one directory)
108002>>>>>>>>>// procedure DoFindFileCallback string lsFileMask integer lbFirstOnly ;
108002>>>>>>>>>// integer liMsg integer liObj
108002>>>>>>>>>//
108002>>>>>>>>>// Search for all files included by a mask in a set of masks. Such a set
108002>>>>>>>>>// must be defined using the cSetOfMasks class defined in WildCard.nui
108002>>>>>>>>>//
108002>>>>>>>>>// procedure DoFindFileBySetOfMasksCallback integer lhSetOfMasks ;
108002>>>>>>>>>// integer lbFirstOnly integer liMsg integer liObj
108002>>>>>>>>>//
108002>>>>>>>>>// Search for all source files included by compiler in a *.PR? file
108002>>>>>>>>>// ("WebApp.prn" for example)
108002>>>>>>>>>//
108002>>>>>>>>>// procedure DoFindFilesCompilerListingCallback string lsPrnFile ;
108002>>>>>>>>>// integer lbFirstOnly integer liMsg integer liObj
108002>>>>>>>>>//
108002>>>>>>>>>class cSetOfDirectories is a cArray
108003>>>>>>>>> procedure construct_object integer liImage
108005>>>>>>>>> forward send construct_object liImage
108007>>>>>>>>> property integer piCbMessage public 0
108008>>>>>>>>> property integer piCbObject public 0
108009>>>>>>>>> property integer pbCbFirstOnly public DFFALSE
108010>>>>>>>>> object oDirStackTmp is a cStack NO_IMAGE
108012>>>>>>>>> end_object
108013>>>>>>>>> object oDirTmp is a cArray NO_IMAGE
108015>>>>>>>>> end_object
108016>>>>>>>>> object oFileNameSet is a cSet NO_IMAGE
108018>>>>>>>>> end_object
108019>>>>>>>>> object oWildCardMatcherArray is a cWildCardMatcherArray NO_IMAGE
108021>>>>>>>>> end_object
108022>>>>>>>>> property integer pi.prv.SuspendSentinelUpdate public DFFALSE
108023>>>>>>>>> end_procedure
108024>>>>>>>>>
108024>>>>>>>>> procedure OnWait_On string lsCaption
108026>>>>>>>>> end_procedure
108027>>>>>>>>> procedure OnWait_SetText1 string lsValue
108029>>>>>>>>> end_procedure
108030>>>>>>>>> procedure OnWait_SetText2 string lsValue
108032>>>>>>>>> end_procedure
108033>>>>>>>>> procedure OnWait_Off
108035>>>>>>>>> end_procedure
108036>>>>>>>>>
108036>>>>>>>>> procedure DoReset
108038>>>>>>>>> send delete_data
108039>>>>>>>>> end_procedure
108040>>>>>>>>>
108040>>>>>>>>> function iFindDir.s string lsDir returns integer
108042>>>>>>>>> integer liMax liItem
108042>>>>>>>>> move (lowercase(trim(lsDir))) to lsDir
108043>>>>>>>>> get item_count to liMax
108044>>>>>>>>> decrement liMax
108045>>>>>>>>> for liItem from 0 to liMax
108051>>>>>>>>>>
108051>>>>>>>>> if (lowercase(value(self,liItem))=lsDir) function_return liItem
108054>>>>>>>>> loop
108055>>>>>>>>>>
108055>>>>>>>>> function_return -1
108056>>>>>>>>> end_function
108057>>>>>>>>>
108057>>>>>>>>> procedure DoRemoveDirectory string lsDir
108059>>>>>>>>> integer liItem
108059>>>>>>>>> get iFindDir.s lsDir to liItem
108060>>>>>>>>> if (liItem<>-1) send delete_item liItem
108063>>>>>>>>> end_procedure
108064>>>>>>>>>
108064>>>>>>>>> procedure DoAddDirectory string lsDir
108066>>>>>>>>> integer liItem
108066>>>>>>>>> move (trim(lsDir)) to lsDir
108067>>>>>>>>> get SEQ_TranslatePathToAbsolute lsDir to lsDir
108068>>>>>>>>> get iFindDir.s lsDir to liItem
108069>>>>>>>>> if (liItem=-1) set value item (item_count(self)) to lsDir
108072>>>>>>>>> end_procedure
108073>>>>>>>>>
108073>>>>>>>>> procedure DoAddSearchPath string lsPath
108075>>>>>>>>> send SEQ_CallBack_DirsInPath lsPath msg_DoAddDirectory self
108076>>>>>>>>> end_procedure
108077>>>>>>>>>
108077>>>>>>>>> procedure AddSubDirectories_Help3 string lsDir
108079>>>>>>>>> integer lhDirTmp
108079>>>>>>>>> move (oDirTmp(self)) to lhDirTmp
108080>>>>>>>>> set value of lhDirTmp item (item_count(lhDirTmp)) to lsDir
108081>>>>>>>>> send OnWait_SetText2 lsDir
108082>>>>>>>>> end_procedure
108083>>>>>>>>> procedure AddSubDirectories_Help2 string lsDir string lsPath
108085>>>>>>>>> if (lsDir<>"[.]" and lsDir<>"[..]") begin
108087>>>>>>>>> replace "[" in lsDir with ""
108089>>>>>>>>> replace "]" in lsDir with ""
108091>>>>>>>>> move (SEQ_ComposeAbsoluteFileName(lsPath,lsDir)) to lsPath
108092>>>>>>>>> send push.s to (oDirStackTmp(self)) lsPath
108093>>>>>>>>> send AddSubDirectories_Help3 (SEQ_TranslatePathToAbsolute(lsPath))
108094>>>>>>>>> end
108094>>>>>>>>>>
108094>>>>>>>>> end_procedure
108095>>>>>>>>> procedure AddSubDirectories_Help1 string lsDir
108097>>>>>>>>> integer lhDirStack liItmStart liItmStop liItem
108097>>>>>>>>> move (oDirStackTmp(self)) to lhDirStack
108098>>>>>>>>> get item_count of lhDirStack to liItmStart
108099>>>>>>>>> send SEQ_Load_ItemsInDir lsDir
108100>>>>>>>>> send SEQ_CallBack_ItemsInDir SEQCB_DIRS_ONLY msg_AddSubDirectories_Help2 self
108101>>>>>>>>> get item_count of lhDirStack to liItmStop
108102>>>>>>>>> for liItem from liItmStart to (liItmStop-1)
108108>>>>>>>>>>
108108>>>>>>>>> send AddSubDirectories_Help1 (sPop(lhDirStack))
108109>>>>>>>>> loop
108110>>>>>>>>>>
108110>>>>>>>>> end_procedure
108111>>>>>>>>>
108111>>>>>>>>> procedure DoAddSubDirectories string lsDir
108113>>>>>>>>> integer lhDirTmp liMax liItem
108113>>>>>>>>> send OnWait_On "Adding sub-folders"
108114>>>>>>>>> move (oDirTmp(self)) to lhDirTmp
108115>>>>>>>>> send delete_data to lhDirTmp
108116>>>>>>>>> send OnWait_SetText1 "Searching"
108117>>>>>>>>> send AddSubDirectories_Help3 lsDir
108118>>>>>>>>> send AddSubDirectories_Help1 lsDir
108119>>>>>>>>> send OnWait_SetText1 "Sorting..."
108120>>>>>>>>> send sort_items to lhDirTmp
108121>>>>>>>>> get item_count of lhDirTmp to liMax
108122>>>>>>>>> decrement liMax
108123>>>>>>>>> send OnWait_SetText1 "Writing search result"
108124>>>>>>>>> send OnWait_SetText2 ""
108125>>>>>>>>> for liItem from 0 to liMax
108131>>>>>>>>>>
108131>>>>>>>>> send DoAddDirectory (value(lhDirTmp,liItem))
108132>>>>>>>>> loop
108133>>>>>>>>>>
108133>>>>>>>>> send delete_data to lhDirTmp
108134>>>>>>>>> send OnWait_Off
108135>>>>>>>>> end_procedure
108136>>>>>>>>>
108136>>>>>>>>> procedure DoFindFileCallback_Help string lsFileName string lsDir
108138>>>>>>>>> integer liCbMessage liCbObject
108138>>>>>>>>> if (iMatch.s(oWildCardMatcherArray(self),lowercase(lsFileName))) begin
108140>>>>>>>>> if (pbCbFirstOnly(self)) begin
108142>>>>>>>>> if (element_find(oFileNameSet(self),lowercase(lsFileName))=-1) begin
108144>>>>>>>>> send element_add to (oFileNameSet(self)) (lowercase(lsFileName))
108145>>>>>>>>> get piCbMessage to liCbMessage
108146>>>>>>>>> get piCbObject to liCbObject
108147>>>>>>>>> send liCbMessage to liCbObject lsFileName lsDir
108148>>>>>>>>> send OnWait_SetText2 ("Found "+lsFileName)
108149>>>>>>>>> end
108149>>>>>>>>>>
108149>>>>>>>>> end
108149>>>>>>>>>>
108149>>>>>>>>> else begin
108150>>>>>>>>> get piCbMessage to liCbMessage
108151>>>>>>>>> get piCbObject to liCbObject
108152>>>>>>>>> send liCbMessage to liCbObject lsFileName lsDir
108153>>>>>>>>> send OnWait_SetText2 ("Found "+lsFileName)
108154>>>>>>>>> end
108154>>>>>>>>>>
108154>>>>>>>>> end
108154>>>>>>>>>>
108154>>>>>>>>> end_procedure
108155>>>>>>>>>
108155>>>>>>>>> procedure DoFindFileCallback string lsFileMask integer lbFirstOnly integer liMsg integer liObj
108157>>>>>>>>> integer liMax liItem lhoWildCardMatcherArray liSentinalUpdate
108157>>>>>>>>> string lsDir lsFileName
108157>>>>>>>>>
108157>>>>>>>>> move (not(pi.prv.SuspendSentinelUpdate(self))) to liSentinalUpdate
108158>>>>>>>>>
108158>>>>>>>>> move (oWildCardMatcherArray(self)) to lhoWildCardMatcherArray
108159>>>>>>>>> send DoReset to lhoWildCardMatcherArray
108160>>>>>>>>> send BreakDownMask to lhoWildCardMatcherArray (lowercase(lsFileMask))
108161>>>>>>>>> get item_count to liMax
108162>>>>>>>>> decrement liMax
108163>>>>>>>>>
108163>>>>>>>>> if (iAnyWildCards(lhoWildCardMatcherArray)) begin // Wildcard search, slow way
108165>>>>>>>>> set piCbMessage to liMsg
108166>>>>>>>>> set piCbObject to liObj
108167>>>>>>>>> set pbCbFirstOnly to lbFirstOnly
108168>>>>>>>>> send delete_data to (oFileNameSet(self))
108169>>>>>>>>> if liSentinalUpdate send OnWait_On "Find file"
108172>>>>>>>>> for liItem from 0 to liMax
108178>>>>>>>>>>
108178>>>>>>>>> if liSentinalUpdate send OnWait_SetText1 lsDir
108181>>>>>>>>> get value item liItem to lsDir
108182>>>>>>>>> send SEQ_Load_ItemsInDir lsDir
108183>>>>>>>>> send SEQ_CallBack_ItemsInDir SEQCB_FILES_ONLY msg_DoFindFileCallback_Help self
108184>>>>>>>>> loop
108185>>>>>>>>>>
108185>>>>>>>>> send delete_data to (oFileNameSet(self))
108186>>>>>>>>> if liSentinalUpdate send OnWait_Off
108189>>>>>>>>> end
108189>>>>>>>>>>
108189>>>>>>>>> else begin // No wildcards, fast way
108190>>>>>>>>> if liSentinalUpdate send OnWait_On "Find file"
108193>>>>>>>>> for liItem from 0 to liMax
108199>>>>>>>>>>
108199>>>>>>>>> get value item liItem to lsDir
108200>>>>>>>>> if liSentinalUpdate send OnWait_SetText1 lsDir
108203>>>>>>>>> //get SEQ_ComposeAbsoluteFileName lsDir lsFileMask to lsFileName
108203>>>>>>>>> get Files_AppendPath lsDir lsFileMask to lsFileName
108204>>>>>>>>> if (SEQ_FileExists(lsFileName)=SEQIT_FILE) begin
108206>>>>>>>>> if liSentinalUpdate send OnWait_SetText2 lsFileMask
108209>>>>>>>>> send liMsg to liObj lsFileMask lsDir
108210>>>>>>>>> if lbFirstOnly begin
108212>>>>>>>>> if liSentinalUpdate send OnWait_Off
108215>>>>>>>>> procedure_return
108216>>>>>>>>> end
108216>>>>>>>>>>
108216>>>>>>>>> end
108216>>>>>>>>>>
108216>>>>>>>>> loop
108217>>>>>>>>>>
108217>>>>>>>>> if liSentinalUpdate send OnWait_Off
108220>>>>>>>>> end
108220>>>>>>>>>>
108220>>>>>>>>> send DoReset to lhoWildCardMatcherArray
108221>>>>>>>>> end_procedure
108222>>>>>>>>>
108222>>>>>>>>> procedure DoFindFileBySetOfMasksCallback integer lhSetOfMasks integer lbFirstOnly integer liMsg integer liObj
108224>>>>>>>>> integer lhoWildCardMatcherArray liMax liItem
108224>>>>>>>>> string lsDir
108224>>>>>>>>> move (oWildCardMatcherArray(self)) to lhoWildCardMatcherArray
108225>>>>>>>>> send DoReset to lhoWildCardMatcherArray
108226>>>>>>>>> set piCbMessage to liMsg
108227>>>>>>>>> set piCbObject to liObj
108228>>>>>>>>> set pbCbFirstOnly to lbFirstOnly
108229>>>>>>>>> send delete_data to (oFileNameSet(self))
108230>>>>>>>>> send BreakDownSetOfMasks to lhoWildCardMatcherArray lhSetOfMasks
108231>>>>>>>>>
108231>>>>>>>>> get item_count to liMax
108232>>>>>>>>> decrement liMax
108233>>>>>>>>> send OnWait_On ("Special find: "+psName(lhSetOfMasks))
108234>>>>>>>>> for liItem from 0 to liMax
108240>>>>>>>>>>
108240>>>>>>>>> get value item liItem to lsDir
108241>>>>>>>>> send OnWait_SetText1 lsDir
108242>>>>>>>>> send SEQ_Load_ItemsInDir lsDir
108243>>>>>>>>> send SEQ_CallBack_ItemsInDir SEQCB_FILES_ONLY msg_DoFindFileCallback_Help self
108244>>>>>>>>> loop
108245>>>>>>>>>>
108245>>>>>>>>> send OnWait_Off
108246>>>>>>>>> send DoReset to lhoWildCardMatcherArray
108247>>>>>>>>> send delete_data to (oFileNameSet(self))
108248>>>>>>>>> end_procedure
108249>>>>>>>>>
108249>>>>>>>>> procedure DoFindFilesCompilerListingCallback string lsPrnFile integer lbFirstOnly integer liMsg integer liObj
108251>>>>>>>>> integer liChannel liSeqEof liPos
108251>>>>>>>>> string lsLine
108251>>>>>>>>> get SEQ_DirectInput lsPrnFile to liChannel
108252>>>>>>>>> if liChannel ge 0 begin
108254>>>>>>>>> send OnWait_On ("Scanning "+lsPrnFile)
108255>>>>>>>>> set pi.prv.SuspendSentinelUpdate to DFTRUE
108256>>>>>>>>> repeat
108256>>>>>>>>>>
108256>>>>>>>>> readln channel liChannel lsLine
108258>>>>>>>>> move (SeqEof) to liSeqEof
108259>>>>>>>>> ifnot liSeqEof begin
108261>>>>>>>>> if (StringBeginsWith(lsLine,"INCLUDING FILE: ")) begin
108263>>>>>>>>> replace "INCLUDING FILE: " in lsLine with ""
108265>>>>>>>>> move (pos("(",lsLine)) to liPos
108266>>>>>>>>> if liPos begin
108268>>>>>>>>> move (left(lsLine,liPos-1)) to lsLine
108269>>>>>>>>> move (trim(lsLine)) to lsLine
108270>>>>>>>>> end
108270>>>>>>>>>>
108270>>>>>>>>> ifnot ".PKI" in lsLine begin
108272>>>>>>>>> ifnot ".PKD" in lsLine begin
108274>>>>>>>>> send OnWait_SetText1 ("Locating "+lsLine)
108275>>>>>>>>> send DoFindFileCallback lsLine lbFirstOnly liMsg liObj
108276>>>>>>>>> end
108276>>>>>>>>>>
108276>>>>>>>>> end
108276>>>>>>>>>>
108276>>>>>>>>> end
108276>>>>>>>>>>
108276>>>>>>>>> end
108276>>>>>>>>>>
108276>>>>>>>>> until liSeqEof
108278>>>>>>>>> send OnWait_Off
108279>>>>>>>>> set pi.prv.SuspendSentinelUpdate to DFFALSE
108280>>>>>>>>> send SEQ_CloseInput liChannel
108281>>>>>>>>> end
108281>>>>>>>>>>
108281>>>>>>>>> end_procedure
108282>>>>>>>>>end_class // cSetOfDirectories
108283>>>>>>>>>
108283>>>>>>>>>enumeration_list
108283>>>>>>>>> define SOF_ORDERING_NAME
108283>>>>>>>>> define SOF_ORDERING_TYPE
108283>>>>>>>>> define SOF_ORDERING_PATH
108283>>>>>>>>> define SOF_ORDERING_SIZE
108283>>>>>>>>> define SOF_ORDERING_TIME
108283>>>>>>>>>end_enumeration_list
108283>>>>>>>>>
108283>>>>>>>>>class cSetOfFilesNew is a cArray
108284>>>>>>>>> procedure construct_object integer liImage
108286>>>>>>>>> forward send construct_object liImage
108288>>>>>>>>> property integer piSOD_Object public 0
108289>>>>>>>>> end_procedure
108290>>>>>>>>> item_property_list
108290>>>>>>>>> item_property string psFileName.i // File name
108290>>>>>>>>> item_property string psFileType.i // File extention
108290>>>>>>>>> item_property string psFilePath.i // Path to file
108290>>>>>>>>> item_property integer piFileSize.i // File size
108290>>>>>>>>> item_property number pnFileTime.i // Time stamp
108290>>>>>>>>> end_item_property_list cSetOfFilesNew
#REM 108331 DEFINE FUNCTION PNFILETIME.I INTEGER LIROW RETURNS NUMBER
#REM 108335 DEFINE PROCEDURE SET PNFILETIME.I INTEGER LIROW NUMBER VALUE
#REM 108339 DEFINE FUNCTION PIFILESIZE.I INTEGER LIROW RETURNS INTEGER
#REM 108343 DEFINE PROCEDURE SET PIFILESIZE.I INTEGER LIROW INTEGER VALUE
#REM 108347 DEFINE FUNCTION PSFILEPATH.I INTEGER LIROW RETURNS STRING
#REM 108351 DEFINE PROCEDURE SET PSFILEPATH.I INTEGER LIROW STRING VALUE
#REM 108355 DEFINE FUNCTION PSFILETYPE.I INTEGER LIROW RETURNS STRING
#REM 108359 DEFINE PROCEDURE SET PSFILETYPE.I INTEGER LIROW STRING VALUE
#REM 108363 DEFINE FUNCTION PSFILENAME.I INTEGER LIROW RETURNS STRING
#REM 108367 DEFINE PROCEDURE SET PSFILENAME.I INTEGER LIROW STRING VALUE
108372>>>>>>>>> procedure DoReset
108374>>>>>>>>> send delete_data
108375>>>>>>>>> end_procedure
108376>>>>>>>>>//function item_property_type integer liColumn returns integer
108376>>>>>>>>>// if liColumn eq 0 function_return ITMP_STRING
108376>>>>>>>>>// if liColumn eq 1 function_return ITMP_STRING
108376>>>>>>>>>// if liColumn eq 2 function_return ITMP_STRING
108376>>>>>>>>>// if liColumn eq 3 function_return ITMP_INTEGER
108376>>>>>>>>>// if liColumn eq 4 function_return ITMP_NUMBER
108376>>>>>>>>>//end_function
108376>>>>>>>>> function iTotalSize returns integer
108378>>>>>>>>> integer liRval liMax liRow
108378>>>>>>>>> move 0 to liRval
108379>>>>>>>>> get row_count to liMax
108380>>>>>>>>> decrement liMax
108381>>>>>>>>> for liRow from 0 to liMax
108387>>>>>>>>>>
108387>>>>>>>>> move (liRval+piFileSize.i(self,liRow)) to liRval
108388>>>>>>>>> loop
108389>>>>>>>>>>
108389>>>>>>>>> function_return liRval
108390>>>>>>>>> end_function
108391>>>>>>>>> function sFileName.i integer liRow returns string
108393>>>>>>>>> string sName sExt
108393>>>>>>>>> get psFileName.i liRow to sName
108394>>>>>>>>> get psFileType.i liRow to sExt
108395>>>>>>>>> if sExt eq "" function_return sName
108398>>>>>>>>> function_return (sName+"."+sExt)
108399>>>>>>>>> end_function
108400>>>>>>>>> function iFindFile.ss string lsFileName string lsDir returns integer
108402>>>>>>>>> integer liMax liRow
108402>>>>>>>>> get row_count to liMax
108403>>>>>>>>> decrement liMax
108404>>>>>>>>> move (lowercase(lsFileName)) to lsFileName
108405>>>>>>>>> move (lowercase(lsDir)) to lsDir
108406>>>>>>>>> for liRow from 0 to liMax
108412>>>>>>>>>>
108412>>>>>>>>> if (lowercase(sFileName.i(self,liRow))=lsFileName and lowercase(psFilePath.i(self,liRow))=lsDir) function_return liRow
108415>>>>>>>>> loop
108416>>>>>>>>>>
108416>>>>>>>>> function_return -1
108417>>>>>>>>> end_function
108418>>>>>>>>> function sFileNameIncPath.i integer iItm returns string
108420>>>>>>>>> string sFile sDir
108420>>>>>>>>> get sFileName.i iItm to sFile
108421>>>>>>>>> get psFilePath.i iItm to sDir
108422>>>>>>>>> function_return (SEQ_ComposeAbsoluteFileName(sDir,sFile))
108423>>>>>>>>> end_function
108424>>>>>>>>> procedure DoAddFile string lsFileName string lsDir
108426>>>>>>>>> integer liRow
108426>>>>>>>>> string lsFileRootName
108426>>>>>>>>>// showln lsDir "/" lsFileName
108426>>>>>>>>>// procedure_return
108426>>>>>>>>> if (iFindFile.ss(self,lsFileName,lsDir)=-1) begin
108428>>>>>>>>> get row_count to liRow
108429>>>>>>>>> if "." in lsFileName move (StripFromLastOccurance(lsFileName,".")) to lsFileRootName
108432>>>>>>>>> else move lsFileName to lsFileRootName
108434>>>>>>>>> set psFileName.i liRow to lsFileRootName
108435>>>>>>>>> set psFilePath.i liRow to lsDir
108436>>>>>>>>> set psFileType.i liRow to (replace(".",replace(lsFileRootName,lsFileName,""),""))
108437>>>>>>>>> move (SEQ_ComposeAbsoluteFileName(lsDir,lsFileName)) to lsFileName
108438>>>>>>>>> set piFileSize.i liRow to (SEQ_FileSize(lsFileName))
108439>>>>>>>>> set pnFileTime.i liRow to (SEQ_FileModTime(lsFileName))
108440>>>>>>>>> end
108440>>>>>>>>>>
108440>>>>>>>>> end_procedure
108441>>>>>>>>> procedure DoSort integer liOrdering
108443>>>>>>>>> send ITMP_Sort_DoReset
108444>>>>>>>>> if liOrdering eq SOF_ORDERING_NAME begin
108446>>>>>>>>> send ITMP_Sort_DoAddSegment 0 DFTRUE
108447>>>>>>>>> send ITMP_Sort_DoAddSegment 1 DFTRUE
108448>>>>>>>>> end
108448>>>>>>>>>>
108448>>>>>>>>> if liOrdering eq SOF_ORDERING_TYPE begin
108450>>>>>>>>> send ITMP_Sort_DoAddSegment 1 DFTRUE
108451>>>>>>>>> send ITMP_Sort_DoAddSegment 0 DFTRUE
108452>>>>>>>>> end
108452>>>>>>>>>>
108452>>>>>>>>> if liOrdering eq SOF_ORDERING_PATH send ITMP_Sort_DoAddSegment 2 DFTRUE
108455>>>>>>>>> if liOrdering eq SOF_ORDERING_SIZE send ITMP_Sort_DoAddSegment 3 DFFALSE
108458>>>>>>>>> if liOrdering eq SOF_ORDERING_TIME send ITMP_Sort_DoAddSegment 4 DFFALSE
108461>>>>>>>>> send ITMP_Sort_DoSortData self
108462>>>>>>>>> end_procedure
108463>>>>>>>>> procedure DoFindFilesCompilerListing string lsPrnFile integer lbFirstOnly
108465>>>>>>>>> send DoFindFilesCompilerListingCallback to (piSOD_Object(self)) lsPrnFile lbFirstOnly msg_DoAddFile self
108466>>>>>>>>> end_procedure
108467>>>>>>>>> procedure DoFindFileBySetOfMasks integer lhSetOfMasks integer lbFirstOnly
108469>>>>>>>>> send DoFindFileBySetOfMasksCallback to (piSOD_Object(self)) lhSetOfMasks lbFirstOnly msg_DoAddFile self
108470>>>>>>>>> end_procedure
108471>>>>>>>>> procedure DoFindFile string lsFileMask integer lbFirstOnly
108473>>>>>>>>> send DoFindFileCallback to (piSOD_Object(self)) lsFileMask lbFirstOnly msg_DoAddFile self
108474>>>>>>>>> end_procedure
108475>>>>>>>>>
108475>>>>>>>>> procedure DoCallback integer liMsg integer lhObj
108477>>>>>>>>> integer liRow liMax
108477>>>>>>>>> get row_count to liMax
108478>>>>>>>>> decrement liMax
108479>>>>>>>>> for liRow from 0 to liMax
108485>>>>>>>>>>
108485>>>>>>>>> send liMsg to lhObj (sFileName.i(self,liRow)) (psFilePath.i(self,liRow))
108486>>>>>>>>> loop
108487>>>>>>>>>>
108487>>>>>>>>> end_procedure
108488>>>>>>>>>end_class // cSetOfFilesNew
108489>>>>>>>Use GridUtil.utl // Grid and List utilities
108489>>>>>>>Use Files.utl // Utilities for handling file related stuff
108489>>>>>>>
108489>>>>>>>use APS // Auto Positioning and Sizing classes for VDF
108489>>>>>>>class cSetOfDirectoriesList is a aps.Grid
108490>>>>>>> procedure construct_object integer img#
108492>>>>>>> forward send construct_object img#
108494>>>>>>> property integer piSetOfDirectoriesObject public 0
108495>>>>>>> send GridPrepare_AddColumn "Folders" AFT_ASCII70
108496>>>>>>> send GridPrepare_Apply self
108497>>>>>>> set gridline_mode to GRID_VISIBLE_NONE
108498>>>>>>> set Header_Visible_State to DFFALSE
108499>>>>>>> set highlight_row_state to DFTRUE
108500>>>>>>> on_key KNEXT_ITEM send switch
108501>>>>>>> on_key KPREVIOUS_ITEM send switch_back
108502>>>>>>> on_key KEY_CTRL+KEY_W send DoWriteToFile
108503>>>>>>> on_key KEY_CTRL+KEY_UP_ARROW send MoveItemUp
108504>>>>>>> on_key KEY_CTRL+KEY_DOWN_ARROW send MoveItemDown
108505>>>>>>> end_procedure
108506>>>>>>>
108506>>>>>>> procedure MoveItemUp
108508>>>>>>>// send Grid_SwapCurrentRowUp self
108508>>>>>>> end_procedure
108509>>>>>>> procedure MoveItemDown
108511>>>>>>>// send Grid_SwapCurrentRowDown self
108511>>>>>>> end_procedure
108512>>>>>>>
108512>>>>>>> procedure DoWriteToFile
108514>>>>>>> send Grid_DoWriteToFile self
108515>>>>>>> end_procedure
108516>>>>>>> procedure fill_list string lsDir
108518>>>>>>> integer liItem liMax lhObj liCurrentItem
108518>>>>>>> string lsTemp lsValue
108518>>>>>>> if NUM_ARGUMENTS move lsDir to lsTemp
108521>>>>>>> else move "" to lsTemp
108523>>>>>>> move (lowercase(lsTemp)) to lsTemp
108524>>>>>>> send delete_data
108525>>>>>>> move -1 to liCurrentItem
108526>>>>>>> set dynamic_update_state to DFFALSE
108527>>>>>>> get piSetOfDirectoriesObject to lhObj
108528>>>>>>> get item_count of lhObj to liMax
108529>>>>>>> decrement liMax
108530>>>>>>> for liItem from 0 to liMax
108536>>>>>>>>
108536>>>>>>> get value of lhObj item liItem to lsValue
108537>>>>>>> send add_item msg_none lsValue
108538>>>>>>> if (lowercase(lsValue)=lsTemp) move liItem to liCurrentItem
108541>>>>>>> loop
108542>>>>>>>>
108542>>>>>>> send Grid_SetEntryState self DFFALSE
108543>>>>>>> if (liCurrentItem<>-1) set current_item to liCurrentItem
108546>>>>>>> set dynamic_update_state to DFTRUE
108547>>>>>>> send OnListChanged (item_count(self))
108548>>>>>>> end_procedure
108549>>>>>>> procedure OnListChanged integer liItems
108551>>>>>>> end_procedure
108552>>>>>>> procedure DoReset
108554>>>>>>> send DoReset to (piSetOfDirectoriesObject(self))
108555>>>>>>> send fill_list
108556>>>>>>> end_procedure
108557>>>>>>> procedure DoAddDirectory
108559>>>>>>> string lsDir
108559>>>>>>> get SEQ_SelectDirectory "Select folder" to lsDir
108560>>>>>>> if (lsDir<>"") begin
108562>>>>>>> send DoAddDirectory to (piSetOfDirectoriesObject(self)) lsDir
108563>>>>>>> send fill_list lsDir
108564>>>>>>> end
108564>>>>>>>>
108564>>>>>>> end_procedure
108565>>>>>>> procedure DoAddSubDirectories
108567>>>>>>> string lsDir
108567>>>>>>> get SEQ_SelectDirectory "Select root folder" to lsDir
108568>>>>>>> if (lsDir<>"") begin
108570>>>>>>> send DoAddSubDirectories to (piSetOfDirectoriesObject(self)) lsDir
108571>>>>>>> send fill_list lsDir
108572>>>>>>> end
108572>>>>>>>>
108572>>>>>>> end_procedure
108573>>>>>>> procedure DoRemoveDirectory
108575>>>>>>> integer liItemCount liCurrentItem liNextItem
108575>>>>>>> string lsDir lsNextDir
108575>>>>>>> get item_count to liItemCount
108576>>>>>>> if liItemCount begin
108578>>>>>>> get current_item to liCurrentItem
108579>>>>>>>
108579>>>>>>> move -1 to liNextItem
108580>>>>>>> if (liCurrentItem<(liItemCount-1)) move (liCurrentItem+1) to liNextItem
108583>>>>>>> else if (liCurrentItem>0) move (liCurrentItem-1) to liNextItem
108587>>>>>>>
108587>>>>>>> get value item liCurrentItem to lsDir
108588>>>>>>> send DoRemoveDirectory to (piSetOfDirectoriesObject(self)) lsDir
108589>>>>>>> if (liNextItem<>-1) begin
108591>>>>>>> get value item liNextItem to lsNextDir
108592>>>>>>> send fill_list lsNextDir
108593>>>>>>> end
108593>>>>>>>>
108593>>>>>>> else send fill_list
108595>>>>>>> end
108595>>>>>>>>
108595>>>>>>> end_procedure
108596>>>>>>> procedure DoAddSearchPath string lsPath
108598>>>>>>> send DoAddSearchPath to (piSetOfDirectoriesObject(self)) lsPath
108599>>>>>>> send fill_list
108600>>>>>>> end_procedure
108601>>>>>>> procedure DoFindFileCallback string lsFileMask integer lbFirstOnly integer liMsg integer liObj
108603>>>>>>> send DoFindFileCallback to (piSetOfDirectoriesObject(self)) lsFileMask lbFirstOnly liMsg liObj
108604>>>>>>> end_procedure
108605>>>>>>> procedure DoFindFileBySetOfMasksCallback integer lhSetOfMasks integer lbFirstOnly integer liMsg integer liObj
108607>>>>>>> send DoFindFileBySetOfMasksCallback to (piSetOfDirectoriesObject(self)) lhSetOfMasks lbFirstOnly liMsg liObj
108608>>>>>>> end_procedure
108609>>>>>>> procedure DoFindFilesCompilerListingCallback string lsPrnFile integer lbFirstOnly integer liMsg integer liObj
108611>>>>>>> send DoFindFilesCompilerListingCallback to (piSetOfDirectoriesObject(self)) lsPrnFile lbFirstOnly liMsg liObj
108612>>>>>>> end_procedure
108613>>>>>>>end_class // cSetOfDirectoriesList
108614>>>>>>>
108614>>>>>>>class cSetOfFilesListNew is a aps.Grid
108615>>>>>>> procedure construct_object integer img#
108617>>>>>>> forward send construct_object img#
108619>>>>>>> property integer piSOF_Object public 0
108620>>>>>>> property string psConstrainPath public ""
108621>>>>>>> property string prv.psDir public ""
108622>>>>>>> set select_mode to NO_SELECT
108623>>>>>>> send GridPrepare_AddColumn "Filename" AFT_ASCII12
108624>>>>>>> send GridPrepare_AddColumn "Type" AFT_ASCII4
108625>>>>>>> send GridPrepare_AddColumn "Size" AFT_ASCII6
108626>>>>>>> send GridPrepare_AddColumn "Modified" AFT_ASCII20
108627>>>>>>> send GridPrepare_AddColumn "Folder" AFT_ASCII60
108628>>>>>>> send GridPrepare_Apply self
108629>>>>>>> set gridline_mode to GRID_VISIBLE_NONE
108630>>>>>>> set highlight_row_state to true
108631>>>>>>> on_key KNEXT_ITEM send switch
108632>>>>>>> on_key KPREVIOUS_ITEM send switch_back
108633>>>>>>> on_key KEY_CTRL+KEY_R send user_sort
108634>>>>>>> on_key KEY_CTRL+KEY_W send DoWriteToFile
108635>>>>>>> on_key KEY_CTRL+KEY_C send DoCopyFiles
108636>>>>>>> end_procedure
108637>>>>>>> procedure DoWriteToFile
108639>>>>>>> send Grid_DoWriteToFile self
108640>>>>>>> end_procedure
108641>>>>>>> procedure DoCopyFiles
108643>>>>>>> string lsTargetDir
108643>>>>>>> get SEQ_SelectDirectory "Select target directory" to lsTargetDir
108644>>>>>>> if (lsTargetDir<>"") begin
108646>>>>>>> if (SEQ_FileExists(lsTargetDir)=SEQIT_DIRECTORY) send DoCopyFiles to (piSOF_Object(self)) lsTargetDir
108649>>>>>>> else send obs "Illegal target directory"
108651>>>>>>> end
108651>>>>>>>>
108651>>>>>>> end_procedure
108652>>>>>>> procedure fill_list
108654>>>>>>> integer lhObj liRow liMax liFileCount liBase
108654>>>>>>> number lnTotalBytes liFileSize
108654>>>>>>> string lsConstrainPath lsPath
108654>>>>>>> get psConstrainPath to lsConstrainPath
108655>>>>>>> get piSOF_Object to lhObj
108656>>>>>>> if lhObj begin
108658>>>>>>> move 0 to lnTotalBytes
108659>>>>>>> move 0 to liFileCount
108660>>>>>>> get row_count of lhObj to liMax
108661>>>>>>> decrement liMax
108662>>>>>>> send delete_data
108663>>>>>>> set dynamic_update_state to DFFALSE
108664>>>>>>> for liRow from 0 to liMax
108670>>>>>>>>
108670>>>>>>> move (psFilePath.i(lhObj,liRow)) to lsPath
108671>>>>>>> if (lsConstrainPath="" or lsConstrainPath=lsPath) begin
108673>>>>>>> get item_count to liBase
108674>>>>>>> send add_item msg_none (psFileName.i(lhObj,liRow))
108675>>>>>>> set aux_value item liBase to liRow
108676>>>>>>> send add_item msg_none (psFileType.i(lhObj,liRow))
108677>>>>>>> move (piFileSize.i(lhObj,liRow)) to liFileSize
108678>>>>>>> send add_item msg_none (SEQ_FileSizeToString(liFileSize))
108679>>>>>>> send add_item msg_none (TS_ConvertToString(pnFileTime.i(lhObj,liRow)))
108680>>>>>>> send add_item msg_none lsPath
108681>>>>>>> move (lnTotalBytes+liFileSize) to lnTotalBytes
108682>>>>>>> increment liFileCount
108683>>>>>>> end
108683>>>>>>>>
108683>>>>>>> loop
108684>>>>>>>>
108684>>>>>>> send Grid_SetEntryState self DFFALSE
108685>>>>>>> set dynamic_update_state to DFTRUE
108686>>>>>>> send OnListFilled liFileCount lnTotalBytes
108687>>>>>>> end
108687>>>>>>>>
108687>>>>>>> end_procedure
108688>>>>>>> procedure OnListFilled integer liFileCount number lnBytes
108690>>>>>>> end_procedure
108691>>>>>>> procedure sort_by_column integer liColumn
108693>>>>>>> if liColumn eq 0 send DoSort to (piSOF_Object(self)) SOF_ORDERING_NAME
108696>>>>>>> if liColumn eq 1 send DoSort to (piSOF_Object(self)) SOF_ORDERING_TYPE
108699>>>>>>> if liColumn eq 2 send DoSort to (piSOF_Object(self)) SOF_ORDERING_SIZE
108702>>>>>>> if liColumn eq 3 send DoSort to (piSOF_Object(self)) SOF_ORDERING_TIME
108705>>>>>>> if liColumn eq 4 send DoSort to (piSOF_Object(self)) SOF_ORDERING_PATH
108708>>>>>>> send fill_list
108709>>>>>>> end_procedure
108710>>>>>>> procedure header_mouse_click integer liItem
108712>>>>>>> send sort_by_column liItem
108713>>>>>>> forward send header_mouse_click liItem
108715>>>>>>> end_procedure
108716>>>>>>> procedure user_sort
108718>>>>>>> integer liItem
108718>>>>>>> get current_item to liItem
108719>>>>>>> send sort_by_column (liItem-((liItem/5)*5))
108720>>>>>>> end_procedure
108721>>>>>>> procedure DoReset
108723>>>>>>> send DoReset to (piSOF_Object(self))
108724>>>>>>> send fill_list
108725>>>>>>> end_procedure
108726>>>>>>> procedure DoCopyFilesToDirectory_help string lsFile string lsPath
108728>>>>>>> integer liRval
108728>>>>>>> string lsTargetDir
108728>>>>>>> get prv.psDir to lsTargetDir
108729>>>>>>> get SEQ_CopyFile (SEQ_ComposeAbsoluteFileName(lsPath,lsFile)) (SEQ_ComposeAbsoluteFileName(lsTargetDir,lsFile)) to liRval
108730>>>>>>> ifnot liRval send obs "Error! File could not be copied." (SEQ_ComposeAbsoluteFileName(lsPath,lsFile)) "to" (SEQ_ComposeAbsoluteFileName(lsTargetDir,lsFile))
108733>>>>>>> end_procedure
108734>>>>>>> procedure DoCopyFilesToDirectory
108736>>>>>>> string lsDir
108736>>>>>>> if (item_count(self)) begin
108738>>>>>>> get SEQ_SelectDirectory "Copy files to folder" to lsDir
108739>>>>>>> if (lsDir<>"") begin
108741>>>>>>> set prv.psDir to lsDir
108742>>>>>>> send DoCallback to (piSOF_Object(self)) msg_DoCopyFilesToDirectory_help self
108743>>>>>>> end
108743>>>>>>>>
108743>>>>>>> end
108743>>>>>>>>
108743>>>>>>> else send obs "No files to copy"
108745>>>>>>> end_procedure
108746>>>>>>>end_class // cSetOfFilesListNew
108747>>>>>>>
108747>>>>>use Masks_DF.nui // DataFlex related file masks
Including file: masks_df.nui (C:\Apps\VDFQuery\AppSrc\masks_df.nui)
108747>>>>>>>// Use Masks_DF.nui // DataFlex related file masks
108747>>>>>>>Use WildCard.nui // WildCardMatch function
108747>>>>>>>
108747>>>>>>>class cSetOfMasks_DFSource is a cSetOfMasks
108748>>>>>>> procedure construct_object integer liImage
108750>>>>>>> forward send construct_object liImage
108752>>>>>>> set psName to "DataFlex source codes"
108753>>>>>>> send DoAddMask "*.pkg" "Package file"
108754>>>>>>> send DoAddMask "*.utl" "Package (Sture)"
108755>>>>>>> send DoAddMask "*.dd" "DataDictionary source"
108756>>>>>>> send DoAddMask "*.dg" "Dialog source"
108757>>>>>>> send DoAddMask "*.gui" "Package, graphical UI"
108758>>>>>>> send DoAddMask "*.inc" "Include file"
108759>>>>>>> send DoAddMask "*.nui" "Package, no UI (Sture)"
108760>>>>>>> send DoAddMask "*.sl" "Prompt list source"
108761>>>>>>> send DoAddMask "webapp.src" "WebApp application source"
108762>>>>>>> send DoAddMask "*.src" "Application source"
108763>>>>>>> send DoAddMask "*.vw" "View source"
108764>>>>>>> send DoAddMask "*.wo" "Web business object source"
108765>>>>>>> send DoAddMask "*.bpo" "Business process objects"
108766>>>>>>> send DoAddMask "*.rpt" "Report source"
108767>>>>>>> send DoAddMask "*.mn" "Menus"
108768>>>>>>> send DoAddMask "*.rv" "Report views"
108769>>>>>>> end_procedure
108770>>>>>>>end_class // cSetOfMasks_DFSource
108771>>>>>>>
108771>>>>>>>class cSetOfMasks_DFRuntime is a cSetOfMasks
108772>>>>>>> procedure construct_object integer liImage
108774>>>>>>> forward send construct_object liImage
108776>>>>>>> set psName to "DataFlex runtime files"
108777>>>>>>> send DoAddMask "*.flx" "Charactermode App"
108778>>>>>>> send DoAddMask "*.vdf" "VDF 4 App"
108779>>>>>>> send DoAddMask "*.vd5" "VDF 5 App"
108780>>>>>>> send DoAddMask "*.vd6" "VDF 6 App"
108781>>>>>>> send DoAddMask "*.vd7" "VDF 7 App"
108782>>>>>>> send DoAddMask "filelist.cfg" "List of tables"
108783>>>>>>> send DoAddMask "termlist.cfg" "DF License file"
108784>>>>>>> send DoAddMask "*.dfr" "DF License file"
108785>>>>>>> send DoAddMask "*.qry" "VDFQuery definition"
108786>>>>>>> send DoAddMask "*.fdx" "DFMatrix, Tables definition file"
108787>>>>>>> end_procedure
108788>>>>>>>end_class // cSetOfMasks_DFRuntime
108789>>>>>>>
108789>>>>>>>class cSetOfMasks_DFData is a cSetOfMasks
108790>>>>>>> procedure construct_object integer liImage
108792>>>>>>> forward send construct_object liImage
108794>>>>>>> set psName to "DataFlex Data files"
108795>>>>>>> send DoAddMask "*.dat" "Table data"
108796>>>>>>> send DoAddMask "*.k*" "Index file"
108797>>>>>>> send DoAddMask "*.tag" "Field names"
108798>>>>>>> send DoAddMask "*.vld" "Variable length data"
108799>>>>>>> send DoAddMask "*.hdr" "Header backup file"
108800>>>>>>> send DoAddMask "*.fd" "Table definition file"
108801>>>>>>> end_procedure
108802>>>>>>>end_class // cSetOfMasks_DFRuntime
108803>>>>>>>
108803>>>>>>>class cSetOfMasks_IIS is a cSetOfMasks
108804>>>>>>> procedure construct_object integer liImage
108806>>>>>>> forward send construct_object liImage
108808>>>>>>> set psName to "IIS Files"
108809>>>>>>> send DoAddMask "*.asp" "ASP files"
108810>>>>>>> send DoAddMask "*.htm" "HTML files"
108811>>>>>>> send DoAddMask "*.inc" "Include files"
108812>>>>>>> send DoAddMask "*.wsc" "Windows scripting files"
108813>>>>>>> end_procedure
108814>>>>>>>end_class // cSetOfMasks_DFRuntime
108815>>>>>>>
108815>>>>>>>class cSetOfMasks_CommandFiles is a cSetOfMasks
108816>>>>>>> procedure construct_object integer liImage
108818>>>>>>> forward send construct_object liImage
108820>>>>>>> set psName to "Commands"
108821>>>>>>> send DoAddMask "*.exe" "Executable"
108822>>>>>>> send DoAddMask "*.com" "Executable"
108823>>>>>>> send DoAddMask "*.bat" "Batch file"
108824>>>>>>> end_procedure
108825>>>>>>>end_class // cSetOfMasks_DFRuntime
108826>>>>>>>
108826>>>>>>>desktop_section
108831>>>>>>> object oSetOfMasks_DFSource is a cSetOfMasks_DFSource NO_IMAGE
108833>>>>>>> end_object
108834>>>>>>> object oSetOfMasks_DFRuntime is a cSetOfMasks_DFRuntime NO_IMAGE
108836>>>>>>> end_object
108837>>>>>>> object oSetOfMasks_DFData is a cSetOfMasks_DFData NO_IMAGE
108839>>>>>>> end_object
108840>>>>>>> object oSetOfMasks_DFAll is a cSetOfMasks NO_IMAGE
108842>>>>>>> set psName to "All DF files"
108843>>>>>>> send DoImport (oSetOfMasks_DFSource(self))
108844>>>>>>> send DoImport (oSetOfMasks_DFRuntime(self))
108845>>>>>>> send DoImport (oSetOfMasks_DFData(self))
108846>>>>>>> end_object
108847>>>>>>> object oSetOfMasks_CommandFiles is a cSetOfMasks_CommandFiles NO_IMAGE
108849>>>>>>> end_object
108850>>>>>>> object oSetOfMasks_IIS is a cSetOfMasks_IIS NO_IMAGE
108852>>>>>>> end_object
108853>>>>>>>end_desktop_section
108858>>>>>
108858>>>>>object oPkgDocSetOfDirectories is a cSetOfDirectories NO_IMAGE
108860>>>>> object oWait is a StatusPanel
108862>>>>> set allow_cancel_state to DFFALSE
108863>>>>> end_object
108864>>>>> procedure OnWait_On string lsCaption
108867>>>>> set caption_text of (oWait(self)) to lsCaption
108868>>>>> set title_text of (oWait(self)) to ""
108869>>>>> set message_text of (oWait(self)) to ""
108870>>>>> set action_text of (oWait(self)) to ""
108871>>>>> send Start_StatusPanel to (oWait(self))
108872>>>>> end_procedure
108873>>>>> procedure OnWait_SetText1 string lsValue
108876>>>>> set Message_Text of (oWait(self)) to lsValue
108877>>>>> end_procedure
108878>>>>> procedure OnWait_SetText2 string lsValue
108881>>>>> set Action_Text of (oWait(self)) to lsValue
108882>>>>> end_procedure
108883>>>>> procedure OnWait_Off
108886>>>>> send Stop_StatusPanel to (oWait(self))
108887>>>>> end_procedure
108888>>>>>end_object
108889>>>>>
108889>>>>>object oPkgDocSetOfFiles is a cSetOfFilesNew NO_IMAGE
108891>>>>> set piSOD_Object to (oPkgDocSetOfDirectories(self))
108892>>>>>end_object
108893>>>>>
108893>>>>>activate_view Popup_PkgDoc_View for oPkgDoc_View
108898>>>>>object oPkgDoc_View is a aps.View label "Document your source code"
108901>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
108902>>>>> object oDirLstHeader is a aps.Textbox label "Folders in search path:"
108905>>>>> end_object
108906>>>>> object oDirLst is a cSetOfDirectoriesList snap SL_DOWN
108909>>>>> set size to 70 0
108910>>>>> set peAnchors to (anLeft+anRight+anTop)
108911>>>>> set peResizeColumn to rcSelectedColumn // Resize mode (rcAll or rcSelectedColumn)
108912>>>>> set piResizeColumn to 0 // This is the column to resize
108913>>>>> set piSetOfDirectoriesObject to (oPkgDocSetOfDirectories(self))
108914>>>>> register_object oDirLstTotal
108914>>>>> set Horz_Scroll_Bar_Visible_State to false
108915>>>>>
108915>>>>> procedure OnListChanged integer liItems
108918>>>>> set value of (oDirLstTotal(self)) to (" "+string(liItems)+" folders")
108919>>>>> end_procedure
108920>>>>> end_object
108921>>>>> object oDirLstTotal is a aps.Textbox label " 0 folders "
108924>>>>> set peAnchors to (anRight+anTop)
108925>>>>> end_object
108926>>>>>
108926>>>>> procedure DoAddOne
108929>>>>> send DoAddDirectory to (oDirLst(self))
108930>>>>> end_procedure
108931>>>>> procedure DoAddSub
108934>>>>> send DoAddSubDirectories to (oDirLst(self))
108935>>>>> end_procedure
108936>>>>> procedure DoMakePath
108939>>>>> integer lhoWorkSpace
108939>>>>> string lsPath
108939>>>>> get_profile_string "DfComp" "MakePath" to lsPath
108942>>>>> send DoAddSearchPath to (oDirLst(self)) lsPath
108943>>>>> end_procedure
108944>>>>> procedure DoDFPath
108947>>>>> integer lhoWorkSpace
108947>>>>> string lsPath
108947>>>>> move (API_AttrValue_GLOBAL(DF_OPEN_PATH)) to lsPath
108948>>>>> send DoAddSearchPath to (oDirLst(self)) lsPath
108949>>>>> end_procedure
108950>>>>> send DoDFPath // Default value
108951>>>>> procedure DoPath
108954>>>>> send DoAddSearchPath to (oDirLst(self)) (API_OtherAttr_Value(OA_PATH))
108955>>>>> end_procedure
108956>>>>> procedure DoReset
108959>>>>> send DoReset to (oDirLst(self))
108960>>>>> end_procedure
108961>>>>> object oDirBtn1 is a aps.Button snap SL_RIGHT relative_to (oDirLst(self))
108969>>>>> set peAnchors to (anRight+anTop)
108970>>>>> set size to 14 70
108971>>>>> procedure PopupFM
108974>>>>> send FLOATMENU_PrepareAddItem msg_DoAddOne "One folder"
108975>>>>> send FLOATMENU_PrepareAddItem msg_DoAddSub "Sub-folders"
108976>>>>> send FLOATMENU_PrepareAddItem msg_DoMakePath "MakePath"
108977>>>>> send FLOATMENU_PrepareAddItem msg_DoDFPath "DFPath"
108978>>>>> send FLOATMENU_PrepareAddItem msg_DoPath "EXE search path"
108979>>>>> send FLOATMENU_PrepareAddItem msg_none ""
108980>>>>> send FLOATMENU_PrepareAddItem msg_DoReset "Reset list"
108981>>>>> send popup to (FLOATMENU_Apply(self))
108982>>>>> end_procedure
108983>>>>> on_item "Add folders" send PopupFM
108984>>>>> end_object
108985>>>>> object oDirBtn2 is a aps.Button snap SL_DOWN
108988>>>>> set peAnchors to (anRight+anTop)
108989>>>>> set size to 14 70
108990>>>>> on_item "Remove from list" send DoRemoveDirectory to (oDirLst(self))
108991>>>>> end_object
108992>>>>> object oDirBtn3 is a aps.Button snap SL_DOWN
108995>>>>> set peAnchors to (anRight+anTop)
108996>>>>> set size to 14 70
108997>>>>> on_item "Reset list" send DoReset
108998>>>>> end_object
108999>>>>>
108999>>>>> send aps_goto_max_row
109000>>>>> object oFrm is a aps.Form abstract AFT_ASCII80 label "Search file:"
109004>>>>> set p_extra_internal_width to -340
109005>>>>> on_key kenter send goto_search_button
109006>>>>> set peAnchors to (anLeft+anRight+anTop)
109007>>>>> end_object
109008>>>>> object oFindBtn1 is a aps.Button snap SL_RIGHT
109011>>>>> set size to 14 30
109012>>>>> on_item "Find" send DoFindFile
109013>>>>> set peAnchors to (anRight+anTop)
109014>>>>> end_object
109015>>>>> object oFindBtn2 is a aps.Button snap SL_RIGHT_SPACE
109018>>>>> set peAnchors to (anRight+anTop)
109019>>>>> set size to 14 70
109020>>>>> register_procedure DoFindDFSource
109020>>>>> register_procedure DoFindDFData
109020>>>>> register_procedure DoFindDFRuntime
109020>>>>> register_procedure DoFindDFAll
109020>>>>> procedure PopupFM
109023>>>>> send FLOATMENU_PrepareAddItem msg_DoFindDFSource "DF source code"
109024>>>>> send FLOATMENU_PrepareAddItem msg_DoFindDFData "DF data files"
109025>>>>> send FLOATMENU_PrepareAddItem msg_DoFindDFRuntime "DF runtime files"
109026>>>>> send FLOATMENU_PrepareAddItem msg_DoFindDFAll "All DF files"
109027>>>>> send popup to (FLOATMENU_Apply(self))
109028>>>>> end_procedure
109029>>>>> on_item "Find all source" send PopupFM
109030>>>>> end_object
109031>>>>> procedure goto_search_button
109034>>>>> send activate to (oFindBtn1(self))
109035>>>>> end_procedure
109036>>>>> object oFindBtn3 is a aps.Button snap SL_RIGHT
109039>>>>> set peAnchors to (anRight+anTop)
109040>>>>> set size to 14 70
109041>>>>> on_item "Scan PR? file" send DoFindPrnFile
109042>>>>> end_object
109043>>>>> object oFirstOccuranceOnly is a aps.CheckBox label "1st occur. only" snap SL_RIGHT_SPACE
109047>>>>> set peAnchors to (anRight+anTop)
109048>>>>> set checked_state to true
109049>>>>> set enabled_state to false
109050>>>>> end_object
109051>>>>> procedure DoFindFile
109054>>>>> integer lbFirstOnly
109054>>>>> string lsFileMask
109054>>>>> get value of (oFrm(self)) item 0 to lsFileMask
109055>>>>> if (lsFileMask<>"") begin
109057>>>>> get select_state of (oFirstOccuranceOnly(self)) to lbFirstOnly
109058>>>>> send DoFindFile to (oPkgDocSetOfFiles(self)) lsFileMask lbFirstOnly
109059>>>>> send Update_ResultList
109060>>>>> end
109060>>>>>>
109060>>>>> else begin
109061>>>>> send obs "You must enter a file name before finding."
109062>>>>> send activate to (oFrm(self))
109063>>>>> end
109063>>>>>>
109063>>>>> end_procedure
109064>>>>> procedure DoFindDFSource
109067>>>>> integer lbFirstOnly
109067>>>>> get select_state of (oFirstOccuranceOnly(self)) to lbFirstOnly
109068>>>>> send DoFindFileBySetOfMasks to (oPkgDocSetOfFiles(self)) (oSetOfMasks_DFSource(self)) lbFirstOnly
109069>>>>> send Update_ResultList
109070>>>>> end_procedure
109071>>>>> procedure DoFindDFData
109074>>>>> integer lbFirstOnly
109074>>>>> get select_state of (oFirstOccuranceOnly(self)) to lbFirstOnly
109075>>>>> send DoFindFileBySetOfMasks to (oPkgDocSetOfFiles(self)) (oSetOfMasks_DFData(self)) lbFirstOnly
109076>>>>> send Update_ResultList
109077>>>>> end_procedure
109078>>>>> procedure DoFindDFRuntime
109081>>>>> integer lbFirstOnly
109081>>>>> get select_state of (oFirstOccuranceOnly(self)) to lbFirstOnly
109082>>>>> send DoFindFileBySetOfMasks to (oPkgDocSetOfFiles(self)) (oSetOfMasks_DFRuntime(self)) lbFirstOnly
109083>>>>> send Update_ResultList
109084>>>>> end_procedure
109085>>>>> procedure DoFindDFAll
109088>>>>> integer lbFirstOnly
109088>>>>> get select_state of (oFirstOccuranceOnly(self)) to lbFirstOnly
109089>>>>> send DoFindFileBySetOfMasks to (oPkgDocSetOfFiles(self)) (oSetOfMasks_DFAll(self)) lbFirstOnly
109090>>>>> send Update_ResultList
109091>>>>> end_procedure
109092>>>>> procedure DoFindPrnFile
109095>>>>> integer lbFirstOnly
109095>>>>> string lsPrnFile
109095>>>>> get SEQ_SelectFile "Select compiler listing file" "Compiler listing (*.prn)|*.PRN|Precompile listing (*.prp)|*.PRP" to lsPrnFile
109096>>>>> if lsPrnFile ne "" begin
109098>>>>> get select_state of (oFirstOccuranceOnly(self)) to lbFirstOnly
109099>>>>> send DoFindFilesCompilerListing to (oPkgDocSetOfFiles(self)) lsPrnFile lbFirstOnly
109100>>>>> send Update_ResultList
109101>>>>> end
109101>>>>>>
109101>>>>> end_procedure
109102>>>>> procedure aps_beautify
109105>>>>>// send aps_align_by_moving (oFrm(self)) (oDirLst(self)) SL_ALIGN_RIGHT
109105>>>>> send aps_align_by_moving (oDirLstTotal(self)) (oDirLst(self)) SL_ALIGN_BOTTOM
109106>>>>> end_procedure
109107>>>>>
109107>>>>> send aps_goto_max_row
109108>>>>> send aps_make_row_space 5
109109>>>>> object oDirLstHeader is a aps.Textbox label "Source files to be documented:"
109112>>>>> end_object
109113>>>>>
109113>>>>> send aps_goto_max_row
109114>>>>> object oResultList is a cSetOfFilesListNew
109116>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
109117>>>>> set peResizeColumn to rcSelectedColumn // Resize mode (rcAll or rcSelectedColumn)
109118>>>>> set piResizeColumn to 4 // This is the column to resize
109119>>>>> set size to 100 0
109120>>>>> set piSOF_Object to (oPkgDocSetOfFiles(self))
109121>>>>> set aps_fixed_column_width item 4 to 200
109122>>>>> procedure OnListFilled integer liFileCount number lnBytes
109125>>>>> send total_display (SEQ_FileSizeToString(lnBytes)+" in "+string(liFileCount)+" files")
109126>>>>> end_procedure
109127>>>>> procedure DoReset
109130>>>>> forward send DoReset
109132>>>>>// send Activate_SetDirTestVw
109132>>>>> end_procedure
109133>>>>> end_object
109134>>>>> send aps_goto_max_row
109135>>>>>
109135>>>>> object oSelectTxt is a aps.TextBox
109137>>>>> end_object
109138>>>>> set auto_size_state of (oSelectTxt(self)) to DFTRUE
109139>>>>> procedure total_display string lsValue
109142>>>>> set value of (oSelectTxt(self)) to lsValue
109143>>>>> end_procedure
109144>>>>> object oBtn1 is a aps.Multi_Button
109146>>>>> set peAnchors to (anRight+anBottom)
109147>>>>> on_item "Reset list" send DoReset to (oResultList(self))
109148>>>>> end_object
109149>>>>> object oBtn2 is a aps.Multi_Button
109151>>>>> set peAnchors to (anRight+anBottom)
109152>>>>> on_item "Copy files" send DoCopyFilesToDirectory to (oResultList(self))
109153>>>>> end_object
109154>>>>> object oBtn3 is a aps.Multi_Button
109156>>>>> set peAnchors to (anRight+anBottom)
109157>>>>> on_item t.btn.close send close_panel
109158>>>>> end_object
109159>>>>> send aps_locate_multi_buttons
109160>>>>>
109160>>>>> procedure Update_ResultList
109163>>>>> end_procedure
109164>>>>>end_object // oPkgDoc_View
109165>>>>>
109165>>>>>send aps_SetMinimumDialogSize (oPkgDoc_View(self)) // Set minimum size
109166>>> Use fv_tools.vw
Including file: fv_tools.vw (C:\Apps\VDFQuery\AppSrc\fv_tools.vw)
109166>>>>>Use ToolUtilities.pkg // aps.YellowBox class
109166>>>>>Use Files.utl // Utilities for handling file related stuff
109166>>>>>
109166>>>>>//class aps.YellowText is a aps.Edit
109166>>>>>// procedure construct_object
109166>>>>>// forward send construct_object
109166>>>>>// set object_shadow_state to true
109166>>>>>// set border_style to BORDER_NONE
109166>>>>>// set color to (RGB_Brighten(clYellow,75))
109166>>>>>// set scroll_bar_visible_state to false
109166>>>>>// property integer private.piImage public 0
109166>>>>>// end_procedure
109166>>>>>// procedure set piImage integer liImg
109166>>>>>// string lsText
109166>>>>>// set private.piImage to liImg
109166>>>>>// if liImg get sTextFromDfImage liImg to lsText
109166>>>>>// else move "" to lsText
109166>>>>>// send Text_SetEditObjectValue self lsText
109166>>>>>// end_procedure
109166>>>>>//end_class // aps.YellowText
109166>>>>>
/FVTOOL01.DESCRIPTION.01
Image 7, FVTOOL01.DESCRIPTION.01
Save definitions of the currently opened tables to a file. Such a file is called a FDX file (for File Definition, eXtended).
Such a file may be opened in the DFMatrix program for further processing (and that's about the only thing it can be used for).
/*
109166>>>>>activate_view activate_fvtool_01 for oFV_Tool_01_View
109171>>>>>object oFV_Tool_01_View is a aps.View label "Save snap shot of table definitions (FDX file)"
109174>>>>>// set Border_Style to BORDER_THICK // Make panel resizeable
109174>>>>> on_key kCancel send close_panel
109175>>>>> object oDescription is a aps.YellowBox
109177>>>>> set peAnchors to (anRight+anLeft+anTop)
109178>>>>> set size to 60 200
109179>>>>> set piTextSourceImage to FvTool01.Description.01.N
109180>>>>> end_object
109181>>>>>
109181>>>>>
109181>>>>> procedure DoSave
109184>>>>> string lsFile lsPath
109184>>>>> get FastView_HomeDirectory to lsPath
109185>>>>> get SEQ_SelectOutFileStartDir "Save FDX file" "FDX files|*.fdx" lsPath to lsFile
109186>>>>> if (lsFile<>"") begin
109188>>>>> send FV_FastLoadRefresh
109189>>>>> send cursor_wait to (cursor_control(self))
109190>>>>> send FDXGL_WriteFile lsFile
109191>>>>> send cursor_ready to (cursor_control(self))
109192>>>>> send obs "FDX file has been saved!" ("("+lsFile+")")
109193>>>>> send close_panel
109194>>>>> end
109194>>>>>>
109194>>>>> end_procedure
109195>>>>>
109195>>>>> object oBtn1 is a aps.Multi_Button
109197>>>>> on_item "Save" send DoSave
109198>>>>> set peAnchors to (anRight+anBottom)
109199>>>>> end_object
109200>>>>> object oBtn2 is a aps.Multi_Button
109202>>>>> on_item "Cancel" send close_panel
109203>>>>> set peAnchors to (anRight+anBottom)
109204>>>>> end_object
109205>>>>> send aps_locate_multi_buttons
109206>>>>>end_object
109207>>>>>send aps_SetMinimumDialogSize (oFV_Tool_01_View(self))
109208>>>>>
109208>>>>>
109208>>>>>
109208>>> use menuedit.pkg
Including file: menuedit.pkg (C:\Apps\VDFQuery\AppSrc\menuedit.pkg)
109208>>>>>
109208>>>>>use aps
109208>>>>>use treenode_treeview_class.pkg // cTreeNodeView class
109208>>>>>
109208>>>>>
109208>>>>>
109208>>>>>use treenode.nui // Defines the cTreeNode class.
109208>>>>>Use DfMenu.pkg
109208>>>>>
109208>>>>>enumeration_list // Popup Menu Data item
109208>>>>> define PMD_LABEL // Menu item text
109208>>>>> define PMD_SHADOW_STATE // Should the item be shadowed
109208>>>>> define PMD_MESSAGE // Message to be sent
109208>>>>> define PMD_OBJECT // Object to receive the message
109208>>>>> define PMD_PARAMETER // Parameters to be passed to object (could be the filename)
109208>>>>> define PMD_IS_SUBMENU // Private
109208>>>>>end_enumeration_list
109208>>>>>
109208>>>>>
109208>>>>>class cPopupMenuClass is a PopupMenu
109209>>>>> procedure construct_object
109211>>>>> forward send construct_object
109213>>>>> property integer phMenuTreeNode
109214>>>>> end_procedure
109215>>>>>end_class //
109216>>>>>
109216>>>>>class cPopupMenuDataObject is a cTreeNodeDataObject
109217>>>>> function TreeViewLabel returns string
109219>>>>> string lsLabel
109219>>>>> get value item PMD_LABEL to lsLabel
109220>>>>> function_return lsLabel
109221>>>>> end_function
109222>>>>>end_class // cPopupMenuDataObject
109223>>>>>
109223>>>>>class cPopupMenuTreeNode is a cTreeNode
109224>>>>> procedure construct_object
109226>>>>> forward send construct_object
109228>>>>>
109228>>>>> set phNodeClass to U_cPopupMenuTreeNode
109229>>>>> set phDataClass to U_cPopupMenuDataObject
109230>>>>>
109230>>>>> property integer phPopupMenuClass public U_cPopupMenuClass
109231>>>>>
109231>>>>>// property integer phMenuObject public 0
109231>>>>>// // The phMenuObject is set to the object ID of the PopupMenu it
109231>>>>>// // instantiates. The purpose of this is two-fold:
109231>>>>>// //
109231>>>>>// // 1. This way we can keep track of them and destroy them every time
109231>>>>>// // we need to create the menu a-new.
109231>>>>>// //
109231>>>>>// // 2. All the data carried by th ecPopupMenuDataObject object cannot
109231>>>>>// // be represented in a PopupMenu object. Therefore we should be
109231>>>>>// // able to identify which
109231>>>>>// // The object ID of the instantiated menu can also be used
109231>>>>>// //
109231>>>>> end_procedure
109232>>>>> procedure Add_Menu_Item string lsLabel integer lhMsg integer lhObj integer lbShadow string lsParam returns integer
109234>>>>> integer lhItem
109234>>>>> get hAddChildNode of self to lhItem
109235>>>>> set DataObject_Array_Value of lhItem PMD_LABEL to lsLabel
109236>>>>> set DataObject_Array_Value of lhItem PMD_SHADOW_STATE to lbShadow
109237>>>>> set DataObject_Array_Value of lhItem PMD_MESSAGE to lhMsg
109238>>>>> set DataObject_Array_Value of lhItem PMD_OBJECT to lhObj
109239>>>>> set DataObject_Array_Value of lhItem PMD_PARAMETER to lsParam
109240>>>>> set DataObject_Array_Value of lhItem PMD_IS_SUBMENU to 0
109241>>>>> end_procedure
109242>>>>> function Add_SubMenu_Item string lsLabel string lbShadow returns integer
109244>>>>> integer lhRval
109244>>>>> get hAddChildNode of self to lhRval
109245>>>>> set DataObject_Array_Value of lhRval PMD_LABEL to lsLabel
109246>>>>> set DataObject_Array_Value of lhRval PMD_SHADOW_STATE to lbShadow
109247>>>>> set DataObject_Array_Value of lhRval PMD_MESSAGE to 0
109248>>>>> set DataObject_Array_Value of lhRval PMD_OBJECT to 0
109249>>>>> set DataObject_Array_Value of lhRval PMD_PARAMETER to ""
109250>>>>> set DataObject_Array_Value of lhRval PMD_IS_SUBMENU to 1
109251>>>>> function_return lhRval
109252>>>>> end_function
109253>>>>>
109253>>>>>//function Instantiate_SubMenu returns integer
109253>>>>>// integer lhSubMenu liMax liChild lhChild lhSelf
109253>>>>>// move self to lhSelf
109253>>>>>// object cPopupMenuClass is a cPopupMenuClass
109253>>>>>// move self to lhSubMenu
109253>>>>>// set phMenuTreeNode to lhSelf
109253>>>>>// end_object
109253>>>>>// get ChildCount to liMax
109253>>>>>// decrement liMax
109253>>>>>// for liChild from 0 to liMax
109253>>>>>// get ChildNodeObject liChild to lhChild
109253>>>>>// send Instantiate_Menu_Item of lhChild lhSubMenu
109253>>>>>// loop
109253>>>>>// function_return lhSubMenu
109253>>>>>//end_function
109253>>>>>//
109253>>>>>//procedure Instantiate_Menu_Item integer lhMenu
109253>>>>>// integer lhMsg lhObj lbIsSubMenu lhSubMenu lbShadow
109253>>>>>// string lsLabel lsParam
109253>>>>>// get DataObject_Array_Value PMD_LABEL to lsLabel
109253>>>>>// get DataObject_Array_Value PMD_MESSAGE to lhMsg
109253>>>>>// get DataObject_Array_Value PMD_OBJECT to lhObj
109253>>>>>// get DataObject_Array_Value PMD_SHADOW_STATE to lbShadow
109253>>>>>// get DataObject_Array_Value PMD_PARAMETER to lsParam
109253>>>>>// get DataObject_Array_Value PMD_IS_SUBMENU to lbIsSubMenu
109253>>>>>// if lbIsSubMenu begin
109253>>>>>// get Instantiate_SubMenu to lhSubMenu
109253>>>>>// send Add_Popup_Menu of lhMenu lhSubMenu lsLabel
109253>>>>>// end
109253>>>>>// else begin
109253>>>>>// send Add_Item of lhMenu MSG_NONE lsLabel
109253>>>>>// end
109253>>>>>// set shadow_state item (item_count(self)-1) to lbShadow
109253>>>>>//end_procedure
109253>>>>>
109253>>>>> // lhParentMenu <>0 Add items to that menu
109253>>>>> // lhParentMenu = 0 Create a menu and return handle
109253>>>>> function Instantiate integer lhParentMenu returns integer
109255>>>>> integer liMax liChild lhChild lhSubMenu lhClass
109255>>>>> integer lhMsg lhObj lbShadow lbIsSubMenu
109255>>>>> string lsLabel lsParam
109255>>>>>
109255>>>>> // First: If a Parent menu wasn't specified we'll create one ourselves:
109255>>>>> if (lhParentMenu=0) begin
109257>>>>> get phPopupMenuClass to lhClass
109258>>>>> name lhClass U_cPopupMenuClassName
109258>>>>> object oPopupMenu is a cPopupMenuClassName NO_IMAGE
109260>>>>> move self to lhParentMenu
109261>>>>> end_object
109262>>>>> end
109262>>>>>>
109262>>>>>
109262>>>>>
109262>>>>> get ChildCount to liMax
109263>>>>> decrement liMax
109264>>>>> for liChild from 0 to liMax
109270>>>>>>
109270>>>>> get ChildNodeObject liChild to lhChild
109271>>>>>
109271>>>>> get DataObject_Array_Value of lhChild PMD_LABEL to lsLabel
109272>>>>> get DataObject_Array_Value of lhChild PMD_MESSAGE to lhMsg
109273>>>>> get DataObject_Array_Value of lhChild PMD_OBJECT to lhObj
109274>>>>> get DataObject_Array_Value of lhChild PMD_SHADOW_STATE to lbShadow
109275>>>>> get DataObject_Array_Value of lhChild PMD_PARAMETER to lsParam
109276>>>>> get DataObject_Array_Value of lhChild PMD_IS_SUBMENU to lbIsSubMenu
109277>>>>>
109277>>>>> if lbIsSubMenu begin
109279>>>>> // We need to create the sub menu before adding it to the current menu
109279>>>>> get Instantiate of lhChild 0 to lhSubMenu
109280>>>>> showln "I'm attaching menu " lsLabel
109283>>>>> send Add_Popup_Menu of lhParentMenu lhSubMenu lsLabel
109284>>>>> end
109284>>>>>>
109284>>>>> else begin
109285>>>>> send Add_Item of lhParentMenu MSG_NONE lsLabel
109286>>>>> showln "I'm creating item " lsLabel
109289>>>>>
109289>>>>> end
109289>>>>>>
109289>>>>> if (lsLabel<>"") set shadow_state of lhParentMenu item (item_count(lhParentMenu)-1) to lbShadow
109292>>>>> loop
109293>>>>>>
109293>>>>>
109293>>>>> function_return lhParentMenu
109294>>>>> end_function
109295>>>>>end_class // cPopupMenuTreeNode
109296>>>>>
109296>>>>>object oPopupMenuStructure is a cPopupMenuTreeNode
109298>>>>> procedure DoPopulate
109301>>>>> integer lhSubMenu lhSubSubMenu
109301>>>>>
109301>>>>> set DataObject_Array_Value PMD_LABEL to "Submenu"
109302>>>>> set DataObject_Array_Value PMD_IS_SUBMENU to 1
109303>>>>>
109303>>>>>
109303>>>>> send Add_Menu_Item "Menu Item 1" 0 0 0 "deterden1.fvw"
109304>>>>> send Add_Menu_Item "Menu Item 2" 0 0 1 "deterden2.fvw"
109305>>>>> send Add_Menu_Item "Menu Item 3" 0 0 0 "deterden3.fvw"
109306>>>>> send Add_Menu_Item "" 0 0 0 ""
109307>>>>> send Add_Menu_Item "Menu Item 4" 0 0 0 "deterden4.fvw"
109308>>>>>
109308>>>>> get Add_SubMenu_Item "Undermenu 1" 0 to lhSubMenu
109309>>>>> send Add_Menu_Item of lhSubMenu "Menu Item 5" 0 0 0 "deterden2.fvw"
109310>>>>> send Add_Menu_Item of lhSubMenu "Menu Item 6" 0 0 0 "deterden3.fvw"
109311>>>>> get Add_SubMenu_Item "Undermenu 2" 0 to lhSubMenu
109312>>>>> send Add_Menu_Item of lhSubMenu "Menu Item 7" 0 0 0 "deterden1.fvw"
109313>>>>> send Add_Menu_Item of lhSubMenu "Menu Item 8" 0 0 0 "deterden3.fvw"
109314>>>>> get Add_SubMenu_Item "Undermenu 3" 0 to lhSubMenu
109315>>>>> send Add_Menu_Item of lhSubMenu "Menu Item 9" 0 0 0 "deterden1.fvw"
109316>>>>> send Add_Menu_Item of lhSubMenu "Menu Item 10" 0 0 0 "deterden2.fvw"
109317>>>>> get Add_SubMenu_Item of lhSubMenu "UnderUndermenu 1" 0 to lhSubSubMenu
109318>>>>> send Add_Menu_Item of lhSubSubMenu "Menu Item 11" 0 0 0 "deterden1.fvw"
109319>>>>> send Add_Menu_Item of lhSubSubMenu "Menu Item 12" 0 0 0 "deterden2.fvw"
109320>>>>>
109320>>>>> send Add_Menu_Item of lhSubMenu "Menu Item 13" 0 0 0 "deterden3.fvw"
109321>>>>> send Add_Menu_Item of lhSubMenu "Menu Item 14" 0 0 0 "deterden3.fvw"
109322>>>>>
109322>>>>> end_procedure
109323>>>>> send DoPopulate
109324>>>>>end_object // oPopupMenuStructure
109325>>>>>
109325>>>>>use aps
109325>>>>>use treenode_treeview_class.pkg // cTreeNodeView class
109325>>>>>
109325>>>>>object oPopupMenuEditor is a aps.View label "Menu editor"
109328>>>>> set locate_mode to CENTER_ON_SCREEN
109329>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
109330>>>>> on_key kcancel send close_panel
109331>>>>>
109331>>>>> object oLst is a aps.TreeNodeViewEdit
109333>>>>> set size to 200 200
109334>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
109335>>>>> set phTreeNode to (oPopupMenuStructure(self))
109336>>>>> end_object
109337>>>>>
109337>>>>> procedure add_items_to_menu
109340>>>>> integer lhMenu lhMenuImage lhBla
109340>>>>> move (FunctionPullDown(main_menu(self))) to lhMenu
109341>>>>> //move (main_menu(self)) to lhMenu
109341>>>>> move (oPopupMenuStructure(self)) to lhMenuImage
109342>>>>>
109342>>>>> get Instantiate of lhMenuImage lhMenu to lhBla
109343>>>>>
109343>>>>>// get Instantiate_SubMenu of lhMenuImage lhMenu to lhBla
109343>>>>>// send Add_Popup_Menu of lhMenu lhBla "Thorbasse"
109343>>>>> end_procedure
109344>>>>>
109344>>>>> object oAdd is a aps.Multi_Button
109346>>>>> on_item "Tilf›j" send add_items_to_menu
109347>>>>> set peAnchors to (anBottom+anRight)
109348>>>>>
109348>>>>> end_object
109349>>>>>
109349>>>>> object oBtn1 is a aps.Multi_Button
109351>>>>> on_item "OK" send close_panel
109352>>>>> set peAnchors to (anBottom+anRight)
109353>>>>> end_object
109354>>>>> send aps_locate_multi_buttons
109355>>>>>
109355>>>>>end_object // oPopupMenuEditor
109356>>>>>
109356>>>>>procedure Activate_MenuEditor
109359>>>>> send popup of oPopupMenuEditor
109360>>>>>end_procedure
109361>>> on_key KEY_CTRL+KEY_4 send FastView_RefreshMenuData // Activate_MenuEditor
109362>>>
109362>>> Use fvsystempounder //
Including file: fvsystempounder.pkg (C:\Apps\VDFQuery\AppSrc\fvsystempounder.pkg)
109362>>>>>// Use fvsystempounder //
109362>>>>>
109362>>>>>Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
109362>>>>>Use DBMS.nui // Basic DBMS functions (No User Interface)
109362>>>>>Use TblDynAc.nui // Table, dynamic access (cDynamicTableAccess class)
109362>>>>>Use Wait.utl // Something to put on screen while batching.
109362>>>>>Use Dates.nui // Dates
109362>>>>>Use OpenStat.nui // cTablesOpenStatus class (formely cFileAllFiles) (No User Interface)
109362>>>>>Use ToolUtilities.pkg // aps.YellowBox class
109362>>>>>
109362>>>>>// The FastView Table Pounder is used to see if a table placed on a given
109362>>>>>// drive can handle massive updating from a number of clients at the same
109362>>>>>// time. The goal is to determine that this can be done without errors,
109362>>>>>// thereby demonstrating the locking and cashing is correctly setup.
109362>>>>>//
109362>>>>>// The test cycle consists of creating 50 records in a test table, then finding
109362>>>>>// 50 records and marking them for deletion and then deleting them. The time
109362>>>>>// it takes to complete one iteration is displayed in a list (i.e. the time
109362>>>>>// it takes to perform 150 updates to the test table).
109362>>>>>//
109362>>>>>
109362>>>>>class cFVSystemPounder_TableAccess is a cDynamicTableAccess
109363>>>>> procedure construct_object
109365>>>>> forward send construct_object
109367>>>>>
109367>>>>> set pbAllowTemporaryFilelistEntries to TRUE
109368>>>>>
109368>>>>> set psRootNamePrefix to ""
109369>>>>>
109369>>>>> set TableBaseData 0 to "fvsyspnd" "FastView - System Pounder" 0
109370>>>>> end_procedure
109371>>>>>
109371>>>>> function DoOpenTables returns integer
109373>>>>> integer liRval liFile liLen
109373>>>>> forward get DoOpenTables to liRval
109375>>>>> function_return liRval
109376>>>>> end_function
109377>>>>> procedure DeclareOpenError string lsError
109379>>>>> move (replace("#",lsError,psRootNamePrefix(self))) to lsError
109380>>>>> send error 718 lsError
109381>>>>> end_procedure
109382>>>>>end_class // cFVSystemPounder_TableAccess
109383>>>>>
109383>>>>>object oSysPound_TableDefinitions is a cArray
109385>>>>>
109385>>>>> object oTable_SysPound is a cTableCreator
109387>>>>> procedure OnDefine
109390>>>>> set piMaxRecords to 1000000 // 1 million
109391>>>>> send DoAddField "CREATE_TIME" DF_BCD 14
109392>>>>> send DoAddField "CREATE_BY" DF_BCD 14
109393>>>>> send DoAddField "DELETE_BY" DF_BCD 14
109394>>>>> send DoAddOnlineIndex 1 "create_time"
109395>>>>> send DoAddOnlineIndex 2 "delete_by recnum"
109396>>>>> end_procedure
109397>>>>> end_object
109398>>>>>
109398>>>>> procedure DoCreateTables integer lhTableAccess
109401>>>>> integer liFile lhAppDbTable lbSuccess
109401>>>>> string lsRoot lsLogical lsDisplay
109401>>>>>
109401>>>>> get piFile.i of lhTableAccess 0 to liFile
109402>>>>> get psRootname.i of lhTableAccess 0 to lsRoot
109403>>>>> get psLogicalName.i of lhTableAccess 0 to lsLogical
109404>>>>> get psUserName.i of lhTableAccess 0 to lsDisplay
109405>>>>> set FileListValues of oTable_SysPound to liFile lsRoot lsLogical lsDisplay
109406>>>>> send DoDefine of oTable_SysPound
109407>>>>> send CreateTable of oTable_SysPound
109408>>>>> end_procedure
109409>>>>>end_object // oSysPound_TableDefinitions
109410>>>>>
109410>>>>>object oSystemPounder_TableAccess is a cFVSystemPounder_TableAccess
109412>>>>> set pbOpenTablesOnDefine to false
109413>>>>>end_object // oSystemPounder_TableAccess
109414>>>>>
109414>>>>>procedure SysPound_CreateTables global
109416>>>>> integer lhTableAccess
109416>>>>> move (oSystemPounder_TableAccess(self)) to lhTableAccess
109417>>>>> send DoCreateTables of oSysPound_TableDefinitions lhTableAccess
109418>>>>>end_procedure
109419>>>>>
109419>>>>>function SysPound_DropTables global returns integer
109421>>>>> integer lbOK lhTableAccess
109421>>>>> move (oSystemPounder_TableAccess(self)) to lhTableAccess
109422>>>>> get DoEraseAllTables of lhTableAccess to lbOK
109423>>>>> function_return lbOK
109424>>>>>end_function
109425>>>>>
109425>>>>>function SysPound_OpenTables global returns integer
109427>>>>> function_return (DoOpenTables(oSystemPounder_TableAccess(self)))
109428>>>>>end_function
109429>>>>>
109429>>>>>object oSysPound_Panel is a aps.ModalPanel label "System pounder (network tester)"
109432>>>>> set Window_Style to WS_MAXIMIZEBOX 1 // Enable maximize button (View's only)
109433>>>>> set Border_Style to BORDER_THICK // Make panel resizeable
109434>>>>> set locate_mode to CENTER_ON_SCREEN
109435>>>>> on_key kCancel send close_panel
109436>>>>> object oYellow is a aps.YellowBox
109438>>>>> set peAnchors to (anTop+anLeft+anRight)
109439>>>>> set size to 38 300
109440>>>>> set value item 0 to "Start this program from multiple clients to test that table updates are performed without errors."
109441>>>>> set value item 1 to ""
109442>>>>> set value item 2 to "Each iteration creates 50 records, then edits 50 records and finally deletes the records it edited. This is done in a table created for that purpose."
109443>>>>> end_object
109444>>>>> send aps_goto_max_row
109445>>>>> object oEdit is a aps.Edit
109447>>>>> set size to 200 300
109448>>>>> set peAnchors to (anTop+anLeft+anRight+anBottom)
109449>>>>> end_object
109450>>>>>
109450>>>>> procedure WriteLn integer liIter string lsLine
109453>>>>> set value of oEdit item (liIter-1) to lsLine
109454>>>>> end_procedure
109455>>>>>
109455>>>>> object oWait is a cBatchCompanion
109457>>>>> end_object
109458>>>>>
109458>>>>> function nSysTime returns number
109461>>>>> integer liHour liMinute liSecond liMilli
109461>>>>> string lsValue
109461>>>>> get MilliSeconds_Systime to lsValue
109462>>>>> getbuff from lsValue at Dates$SystemTime.iHour to liHour
109463>>>>> getbuff from lsValue at Dates$SystemTime.iMinute to liMinute
109464>>>>> getbuff from lsValue at Dates$SystemTime.iSecond to liSecond
109465>>>>> getbuff from lsValue at Dates$SystemTime.iMilliseconds to liMilli
109466>>>>> function_return (liHour*10000+liMinute*10000+liSecond*10000+liMilli)
109467>>>>> end_function
109468>>>>> procedure Create100 number lnId integer liFile
109471>>>>> integer liCount
109471>>>>> number lnCreateTime
109471>>>>> repeat
109471>>>>>>
109471>>>>> clear liFile
109472>>>>> get nSysTime to lnCreateTime
109473>>>>> set_field_value liFile 1 to lnCreateTime
109476>>>>> lock
109477>>>>>>
109477>>>>> vFind liFile 1 EQ
109479>>>>> ifnot (found) begin
109481>>>>> set_field_value liFile 2 to lnId
109484>>>>> saverecord liFile
109485>>>>> increment liCount
109486>>>>> end
109486>>>>>>
109486>>>>> unlock
109487>>>>>>
109487>>>>> until (liCount>=50)
109489>>>>> end_procedure
109490>>>>> procedure Mark100 number lnId integer liFile
109493>>>>> integer liCount lbFound
109493>>>>> number lnDeleteBy
109493>>>>> clear liFile
109494>>>>> repeat
109494>>>>>>
109494>>>>> lock
109495>>>>>>
109495>>>>> vFind liFile 1 GT
109497>>>>> move (found) to lbFound
109498>>>>> if (found) begin
109500>>>>> get_field_value liFile 3 to lnDeleteBy
109503>>>>> if (lnDeleteBy=0) begin
109505>>>>> set_field_value liFile 3 to lnId
109508>>>>> saverecord liFile
109509>>>>> increment liCount
109510>>>>> end
109510>>>>>>
109510>>>>> end
109510>>>>>>
109510>>>>> unlock
109511>>>>>>
109511>>>>> until (liCount>=50 or lbFound=0)
109513>>>>> end_procedure
109514>>>>> procedure Delete100 number lnId integer liFile
109517>>>>> integer lbFound
109517>>>>> number lnDeleteBy
109517>>>>> clear liFile
109518>>>>> set_field_value liFile 3 to lnId
109521>>>>> repeat
109521>>>>>>
109521>>>>> vfind liFile 2 GT
109523>>>>> get_field_value liFile 3 to lnDeleteBy
109526>>>>> move (found) to lbFound
109527>>>>> if lbFound move (lnDeleteBy=lnId) to lbFound
109530>>>>> if lbFound delete liFile
109533>>>>> until (not(lbFound))
109535>>>>> end_procedure
109536>>>>> procedure DoTest
109539>>>>> integer liFile liCount lbBreak li1000
109539>>>>> number lnId lnTime
109539>>>>> string lsStart lsStop
109539>>>>> get piFile.i of oSystemPounder_TableAccess 0 to liFile
109540>>>>> get nSysTime to lnId
109541>>>>> move 0 to liCount
109542>>>>> send delete_data of oEdit
109543>>>>> send batch_on of oWait lnId
109544>>>>> get MilliSeconds_Systime to lsStart
109545>>>>> move 0 to li1000
109546>>>>> repeat
109546>>>>>>
109546>>>>> increment liCount
109547>>>>> send batch_update of oWait (li1000*1000+liCount)
109548>>>>> send WriteLn liCount ("Iteration "+string(liCount)+": Create")
109549>>>>> send batch_update2 of oWait "Create"
109550>>>>> send Create100 lnId liFile
109551>>>>> send WriteLn liCount ("Iteration "+string(liCount)+": Mark")
109552>>>>> send batch_update2 of oWait "Mark"
109553>>>>> send Mark100 lnId liFile
109554>>>>> send WriteLn liCount ("Iteration "+string(liCount)+": Delete")
109555>>>>> send batch_update2 of oWait "Delete"
109556>>>>> send Delete100 lnId liFile
109557>>>>> get MilliSeconds_Systime to lsStop
109558>>>>> get MilliSeconds_Elapsed lsStart lsStop to lnTime
109559>>>>> send WriteLn liCount (sSysTime()+" Iteration "+string(li1000*1000+liCount)+": "+NumToStrTS(lnTime/1000,3)+" s")
109560>>>>>
109560>>>>> get Check_StatusPanel of oWait to lbBreak
109561>>>>> move lsStop to lsStart
109562>>>>> if (liCount=1000) begin
109564>>>>> send delete_data of oEdit
109565>>>>> move 0 to liCount
109566>>>>> increment li1000
109567>>>>> end
109567>>>>>>
109567>>>>> until lbBreak
109569>>>>>
109569>>>>> end_procedure
109570>>>>> object oBtn1 is a aps.Multi_Button
109572>>>>> on_item "Run Test" send DoTest
109573>>>>> set peAnchors to (anRight+anBottom)
109574>>>>> end_object
109575>>>>> object oBtn1 is a aps.Multi_Button
109577>>>>> on_item "Close" send close_panel
109578>>>>> set peAnchors to (anRight+anBottom)
109579>>>>> end_object
109580>>>>> send aps_locate_multi_buttons
109581>>>>> procedure popup
109584>>>>> integer lbOK
109584>>>>> send OpenStat_RegisterFiles
109585>>>>> send OpenStat_CloseAllFiles
109586>>>>> get SysPound_OpenTables to lbOK
109587>>>>> ifnot lbOK begin
109589>>>>> send SysPound_CreateTables
109590>>>>> get SysPound_OpenTables to lbOK
109591>>>>> if lbOK send obs "Test table has been succesfully created"
109594>>>>> end
109594>>>>>>
109594>>>>> ifnot lbOK error 772 "FvSysPnd could not be opened (or created)"
109597>>>>> else begin
109598>>>>> forward send popup
109600>>>>> get SysPound_DropTables to lbOK
109601>>>>> if lbOK send obs "Test table has been succesfully dropped"
109604>>>>> end
109604>>>>>>
109604>>>>> send OpenStat_RestoreFiles
109605>>>>> end_procedure
109606>>>>>end_object
109607>>>>>send aps_SetMinimumDialogSize (oSysPound_Panel(self)) // Set minimum size
109608>>>>>
109608>>>>>procedure popup_systempounder
109611>>>>> send popup of oSysPound_Panel
109612>>>>>end_procedure
109613>>>// Use Fv_OddToolbox.vw
109613>>>
109613>>> procedure DoExternalViews
109616>>> if (FastView_GenericDDsApplicable()) begin
109618>>> CREATE_OBJECT_GROUP OG_WorkspaceFunctions
109621>>> end
109621>>>>
109621>>> end_procedure
109622>>>
109622>>> procedure FastView_CreateNewQ
109625>>> send Request_CreateNewQuery
109626>>> end_procedure
109627>>>
109627>>> procedure FastView_CreateNew
109630>>> integer lhDef
109630>>> get FastView_CreateViewDefinition to lhDef
109631>>> send popup.i to (oFastViewWizard(self)) lhDef
109632>>> end_procedure
109633>>>
109633>>> procedure FastView_CloseAll
109636>>> broadcast recursive send Close_Query_View to desktop
109638>>> end_procedure
109639>>>
109639>>> // Close all tables temporarily to allow for access to DB Builder or the like
109639>>> procedure FastView_CloseTables
109642>>> integer lbOk lhPanel liVM lbWarningAlreadyGiven
109642>>>
109642>>> // The warning referred to is a warning about DD packages being newer
109642>>> // than the FastView compile itself.
109642>>> get pbWarningAlreadyGiven of (oWatchedPackages(self)) to lbWarningAlreadyGiven
109643>>> set pbWarningAlreadyGiven of (oWatchedPackages(self)) to true // Disable warnings until we're ready
109644>>>
109644>>> send OpenStat_RegisterFiles // Take a snap shot of the number of open tables
109645>>> send OpenStat_CloseAllFiles // Close all tables
109646>>>
109646>>> move (parent(self)) to lhPanel // Handle for main panel of the FastView application
109647>>> get view_mode of lhPanel to liVM // Get current view_mode
109648>>> set view_mode of lhPanel to VIEWMODE_ICONIZE // Minimize application
109649>>>
109649>>> send obs "Now you can work with Database Builder in exclusive mode" ; "while FastView temporarily sits here." ; "" ; "Click OK when you're done..."
109650>>> repeat
109650>>>>
109650>>> get OpenStat_RestoreFilesFunction 1 to lbOk // Restore open tables according to snap shot (1=Quiet=no error msg)
109651>>> ifnot lbOk begin
109653>>> get MB_Verify4 "FastView could not re-open its tables." ; "" ; "Do you want to it try again?" ; "(If you select 'No' Fastview will terminate)" 1 to lbOk
109654>>> if lbOk begin
109656>>> move 0 to lbOk
109657>>> end
109657>>>>
109657>>> else begin
109658>>> system // Goodbye
109659>>>>
109659>>> end
109659>>>>
109659>>> end
109659>>>>
109659>>> until lbOk
109661>>> set view_mode of lhPanel to liVM // Restore view_mode
109662>>> set pbWarningAlreadyGiven of (oWatchedPackages(self)) to lbWarningAlreadyGiven // Now we're ready
109663>>> // If changes were made (in DB Bldr) and warnings have not yet
109663>>> // been given then warn me:
109663>>> send FastView_Check_UserPackages
109664>>> end_procedure
109665>>>
109665>>> procedure FastView_ExploreDataFolder
109668>>> integer lbOK
109668>>> string lsPath
109668>>> get MB_Verify4 "Explorer will now be launced on the data folder of the workspace." ; "" ; "Please note that editing, deleting or renaming files will destroy the data." ; "Continue?" 0 to lbOK
109669>>> if lbOK begin
109671>>> get SEQ_FindFileAlongDFPath "filelist.cfg" to lsPath
109672>>> send html_StartDoc lsPath
109673>>> end
109673>>>>
109673>>> end_procedure
109674>>>
109674>>> procedure FastView_Open
109677>>> integer lhDef
109677>>> get FastView_CreateViewDefinition to lhDef
109678>>> send DoOpenDefinition to lhDef
109679>>> send PopupPanel to lhDef
109680>>> end_procedure
109681>>>
109681>>> object oFastViewToolThing is a aps.View label "Stuff"
109684>>> send tab_column_define 1 25 20 JMODE_LEFT // Default column setting
109685>>>
109685>>> set p_auto_column to 1
109686>>> object oSnap is a aps.ComboForm label "Snap:" abstract AFT_ASCII10
109690>>> set focus_mode to NONFOCUSABLE
109691>>> end_object
109692>>> object oClass is a aps.ComboForm label "Class:" abstract AFT_ASCII10
109696>>> set focus_mode to NONFOCUSABLE
109697>>> end_object
109698>>> send tab_column_define 1 20 15 JMODE_LEFT // Default column setting
109699>>> object oCbNoLabel is a aps.CheckBox label "No label"
109702>>> set focus_mode to NONFOCUSABLE
109703>>> end_object
109704>>> object oCbNoenter is a aps.CheckBox label "NoEnter"
109707>>> set focus_mode to NONFOCUSABLE
109708>>> end_object
109709>>> object oCbCapslock is a aps.CheckBox label "Capslock"
109712>>> set focus_mode to NONFOCUSABLE
109713>>> end_object
109714>>> object oCbPrompt is a aps.CheckBox label "Prompt"
109717>>> set focus_mode to NONFOCUSABLE
109718>>> end_object
109719>>> object oBtn is a aps.Button
109721>>> set focus_mode to NONFOCUSABLE
109722>>> on_item "Apply" send DoApply
109723>>> end_object
109724>>> procedure DoApply
109727>>> end_procedure
109728>>> end_object
109729>>>
109729>>> procedure FastViewToolPanel
109732>>>// send popup to (oFastViewToolThing(self))
109732>>> end_procedure
109733>>> on_key KEY_CTRL+KEY_F2 send FastViewToolPanel
109734>>>
109734>>> procedure IFL_CreateSimple
109737>>> end_procedure
109738>>> procedure IFL_CreateGrid
109741>>> end_procedure
109742>>> procedure IFL_CreateHD
109745>>> end_procedure
109746>>>
109746>>> object oPopupMenu is a FloatingPopupMenu
109748>>>if (FV_AdminMode()) begin
109750>>> send Add_Item MSG_FastView_CreateNew "Create a view"
109751>>>end
109751>>>>
109751>>> send Add_Item MSG_FastView_CreateNewQ "Create a query"
109752>>> send Add_Item MSG_None ""
109753>>> send Add_Item MSG_FastView_Open "Open view"
109754>>> send Add_Item MSG_FastView_CloseAll "Close all views"
109755>>> send Add_Item MSG_None ""
109756>>> send Add_Item MSG_FastView_OpenLayout "Open view collection"
109757>>> send Add_Item MSG_FastView_SaveLayout "Save view collection"
109758>>> send Add_Item MSG_None ""
109759>>>if (integer(FVSetupValue(FVSETUP_USER_CHG_WS))) begin
109761>>> send Add_Item MSG_Do_Select_WorkSpace "Select workspace"
109762>>> send Add_Item MSG_Do_Select_FileList_Browse "Select filelist"
109763>>> send Add_Item MSG_None ""
109764>>>end
109764>>>>
109764>>> send Add_Item MSG_FastView_WSOptions "Workspace options"
109765>>> send Add_Item MSG_FastView_CloseTables "Close all tables"
109766>>> end_object
109767>>>
109767>>> procedure DoPopupMenu
109770>>> if (FV_AdminMode()) begin
109772>>> send popup to (oPopupMenu(self))
109773>>> end
109773>>>>
109773>>> end_procedure
109774>>> procedure Mouse_Up2 // Right click
109777>>> send DoPopupMenu
109778>>> end_procedure
109779>>> End_Object // Client_Area
109780>>>
109780>>> Object Status_Bar is a cSturesStatusBar
109782>>> End_Object
109783>>>// On_Key Key_Ctrl+Key_1 Send To Client_Area
109783>>> On_Key Key_Ctrl+Key_2 Send Popup_DBD_View To Client_Area
109784>>> On_Key Key_Ctrl+Key_3 Send Popup_PkgDoc_View To Client_Area
109785>>> On_Key Key_Ctrl+Key_9 send Popup_ObjectTree
109786>>>// use tooltip.pkg
109786>>>End_Object // Main
109787>>>
109787>>>send deactivate to (oSplash(self))
109788>>>
109788>>>procedure FastView_OpenDefaultCollection
#REM AMBIGUOUS METHODS ON .DESKTOP. ARE .NOT. RECOMMENDED (OBSOLETE TECHNIQUE)
109790>>> integer lbLoad liChannel lhDef lbViewLoaded
109790>>> string lsHome lsFile lsViewDef
109790>>> send CheckApplicationEntry of oAutoSystemDowner
109791>>>
109791>>> ifnot (FV_NoLoad()) begin
109793>>> get FastView_HomeDirectory to lsHome
109794>>> if (lsHome<>"") begin
109796>>> get FV_CmdLineViewCollection to lsFile
109797>>> if (lsFile="") begin
109799>>> get FV_CmdLineView to lsViewDef
109800>>> move "default.fvc" to lsFile
109801>>> end
109801>>>>
109801>>> get SEQ_ComposeAbsoluteFileName lsHome lsFile to lsFile
109802>>> if (lsViewDef="" and SEQ_FileExists(lsFile)) begin
109804>>> //get MB_Verify "Do you want to load default views for this WS?" 1 to lbLoad
109804>>> move DFTRUE to lbLoad
109805>>> if lbLoad begin
109807>>> get SEQ_DirectInput lsFile to liChannel
109808>>> if (liChannel>=0) begin
109810>>> send SEQ_ReadArrayItems liChannel (oFastViewLayout(self))
109811>>> send SEQ_CloseInput liChannel
109812>>> send OpenLayouts to (oFastViewLayout(self))
109813>>> procedure_return
109814>>> end
109814>>>>
109814>>> end
109814>>>>
109814>>> end
109814>>>>
109814>>> // OK! Maybe he wants to open a single view?
109814>>>
109814>>> move DFFALSE to lbViewLoaded
109815>>> if (lsViewDef<>"") begin
109817>>> get SEQ_ComposeAbsoluteFileName lsHome lsViewDef to lsViewDef
109818>>> if (SEQ_FileExists(lsViewDef)) begin
109820>>> get FastView_CreateViewDefinition to lhDef
109821>>> send SEQ_Read_FileName to lhDef lsViewDef
109822>>> send PopupPanel to lhDef
109823>>> move DFTRUE to lbViewLoaded
109824>>> end
109824>>>>
109824>>> end
109824>>>>
109824>>>
109824>>> ifnot lbViewLoaded begin
109826>>> send ReadDirectory to (oFastViewsOnDisk(self)) lsHome "*.fvw"
109827>>> if (row_count(oFastViewsOnDisk(self))) begin
109829>>> move (sPopup.s(oFastViewOpenFileSL(self),"Open existing FastView definition")) to lsViewDef
109830>>> if (lsViewDef<>"") begin
109832>>> get FastView_CreateViewDefinition to lhDef
109833>>> send SEQ_Read_FileName to lhDef lsViewDef
109834>>> send PopupPanel to lhDef
109835>>> end
109835>>>>
109835>>> end
109835>>>>
109835>>> else move "" to lsViewDef
109837>>> if (lsViewDef="") send FastView_CreateNew to (Client_Area(Main(self)))
109840>>> end
109840>>>>
109840>>> end
109840>>>>
109840>>> end
109840>>>>
109840>>>end_procedure
109841>>>
109841>>>send SetupDefaultWS
109842>>>send FastView_Check_UserPackages
109843>>>send DoExternalViews to (Client_Area(Main(self)))
109844>>>send FastView_RefreshMenuData to (Client_Area(Main(self)))
109845>>>
109845>>>Start_UI
109846>>>
109846>>>
109846>
109846>RegisterRestrictions:
109846>
109846> // The next 5 lines may be set to TRUE (enable) or FALSE (disable).
109846> // If a parameter is set to TRUE it may still be disabled by passing
109846> // the commented symbol that appears after each line on the FastView
109846> // command line:
109846>
109846> // Should FastView check for new package files?
109846> set FVSetupValue FVSETUP_OLD_PKG_CHECK to TRUE // -nopkgcheck
109847>
109847> // Allow the user to edit data?
109847> set FVSetupValue FVSETUP_USER_CHG_DATA to TRUE // -readonly
109848>
109848> // Allow the user to disable WS data dictionaries (thereby bypassing all
109848> // the checks and more)?
109848> set FVSetupValue FVSETUP_USER_BYPASS_WS_DD to TRUE // -noddbypass
109849>
109849> // Allow user to change workspace?
109849> set FVSetupValue FVSETUP_USER_CHG_WS to TRUE // -nowschange
109850>
109850> // Allow user to create new or edit existing views?
109850> set FVSetupValue FVSETUP_USER_EDIT_VIEWS to TRUE // -user
109851>
109851>
109851> set FVSetupValue FVSETUP_WORKSPACE to "" //"DAW.Sample Applications.Order"
109852> set FVSetupValue FVSETUP_WORKSPACE_NAME to "" //"Order Entry sample"
109853>return
109854>
109854>
109854>DEFINE_OBJECT_GROUP OG_WorkspaceDDs
109855> // Use Help_Ids.inc
109855> // Use Std_Help.pkg
109855> //
109855> // // Include the DataDictionary classes:
109855> // Use Vendor.dd
109855> // Use Invt.dd
109855> // Use Customer.dd
109855> // Use SalesP.dd
109855> // Use OrderHea.dd
109855> // Use OrderDtl.dd
109855> //
109855> // // Tell FastView what classes to use for which tables:
109855> // set DataDictionary_Class Customer.File_Number to U_Customer_DataDictionary
109855> // set DataDictionary_Class Invt.File_Number to U_Invt_DataDictionary
109855> // set DataDictionary_Class Orderdtl.File_Number to U_OrderDtl_DataDictionary
109855> // set DataDictionary_Class Orderhea.File_Number to U_OrderHea_DataDictionary
109855> // set DataDictionary_Class Salesp.File_Number to U_SalesP_DataDictionary
109855> // set DataDictionary_Class Vendor.File_Number to U_Vendor_DataDictionary
109855>END_DEFINE_OBJECT_GROUP
109856>
109856>DEFINE_OBJECT_GROUP OG_WorkspaceVWs
109857> // Do not put anything here. For future enhancements
109857>END_DEFINE_OBJECT_GROUP
109858>DEFINE_OBJECT_GROUP OG_WorkspaceFunctions
109859> // Do not put anything here. For future enhancements
109859>END_DEFINE_OBJECT_GROUP
109860>
109860>RegisterReferencedTables:
109860> CALL4200TIMES // Don't ask...
109862>return
109863>
Summary
Memory Available: 1238749184
Total Warnings : 0
Total Errors : 0
Total Symbols : 51770
Total Resources: 0
Total Commands : 109862
Total Windows : 1
Total Pages : 7
Static Data : 846206
Message area : 682362
Total Blocks : 37714