// Use DfQuery.vw // View for querying tables // Tr‘ ting eller alfabetisk r‘kkef›lge af tabeller i tabel v‘lger Use App.utl // Character Mode classes Use DBMS.nui // Basic DBMS functions (No User Interface) Use Output.utl // Sequential output to whatever Use DataScan.utl // Data scan classes Use FdxIndex.utl // Index analysing functions Use Buttons.utl // Button texts Use Fdx2.utl // FDX aware object for displaying a table definition Use FdxSelct.utl // Functions iFdxSelectOneFile and iFdxSelectOneField Use Dates.utl // Date manipulation for VDF and DF3.2 Use GridUtil.utl // Grid and List utilities (not for dbGrid's or Table's) Use Focus.utl // Retrieve basic information about object Use Spec0007.utl // Display modal text (DoDisplayText) Use Spec0011.utl // Floating menues on the fly Use Spec0012.utl // Read image to string (sTextDfFromImage function) use DFQuery.utl // Character mode report definitions //use QueryLng.pkg // Language dependant constants Use Query.nui // Basic things needed for a query tool Use QryFldSl.pkg // cFieldInf.Table_List and cFieldInf.Field_List classes Use QryOrder.utl Use ObjGroup.utl // Defining groups of objects define t.DfQuery.SelectTable for "Select table for querying" /DfqLogFileImage 10-10-2001 - On user-contributed-files (0.2) 11-10-2001 - Command line interface fixed - Ruler added to preview (Ctrl+R) 15-10-2001 - Adjust button fixed - Login/Logout added - Advanced table selection added 17-10-2001 - Default values on tab 4 23-10-2001 - Prepared to use constraints of a application DDO to generate a report. 30-10-2001 - File/Field are now indicated when moving up and down the list of printed fields and the list of current selection criteria 07-11-2001 - Call dfbrowse by pressing Alt+B /* procedure DFQ_Dfbrowse global integer liFile local string lsFile if liFile begin get_attribute DF_FILE_LOGICAL_NAME of liFile to lsFile if lsFile ne "" begin chain wait ("dfbrowse "+lsFile) send refresh_screen end end end_procedure /oDfqEmailSelector.hdr ÉÍSelect e-mail recipientsÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» /oDfqEmailSelector.lst º Name Address º º___ ____________________ _____________________________________________ º º___ ____________________ _____________________________________________ º º___ ____________________ _____________________________________________ º º___ ____________________ _____________________________________________ º º___ ____________________ _____________________________________________ º º___ ____________________ _____________________________________________ º º___ ____________________ _____________________________________________ º º___ ____________________ _____________________________________________ º º___ ____________________ _____________________________________________ º /oDfqEmailSelector.btn º ____________ ____________ ____________ º º F2 F5 Esc º ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ /* object oDfqEmailSelector is a app.ModalClient oDfqEmailSelector.hdr set location to 4 6 ABSOLUTE object oArray is a cArray NO_IMAGE // set priv.EmailArray of prtcomm.setup_object_default to self // set priv.EmailArray of prtcomm.setup_object_temporary to self // set priv.EmailArray of prtcomm.setup_object to self end_object on_key kClear send DoClear object oLst is a app.List oDfqEmailSelector.lst set Location To 1 0 RELATIVE set select_mode to MULTI_SELECT set highlight_row_state to true on_key kenter send ok procedure select_toggling integer liItem integer i# local integer liCurrentItem iColumns get Grid_Columns self to iColumns get current_item to liCurrentItem move ((liCurrentItem/iColumns)*iColumns) to liCurrentItem // Redirect to first column forward send select_toggling liCurrentItem i# end_procedure procedure fill_list local integer lhArr liMax liRow liBase set dynamic_update_state to FALSE send delete_data move (oDbQueryConfig(self)) to lhArr get row_count of lhArr to liMax decrement liMax for liRow from 0 to liMax if (piType.i(lhArr,liRow)=1) begin // E-mail get item_count to liBase send add_item MSG_NONE "" set checkbox_item_state item liBase to DFTRUE send add_item MSG_NONE (psName.i(lhArr,liRow)) send add_item MSG_NONE (psValue.i(lhArr,liRow)) end loop send Grid_SetEntryState self DFFALSE set dynamic_update_state to TRUE // set dynamic_update_state to FALSE // send delete_data // s.reg_scan dfds181 by index.2 // send Grid_AddCheckBoxItem self DFFALSE // send add_item MSG_NONE DFDS181.NAME // send add_item MSG_NONE DFDS181.EMAIL // s.reg_scan dfds181 loop // send Grid_SetEntryState self DFFALSE // set dynamic_update_state to TRUE // send delete_data to (oArray(self)) end_procedure procedure AddToArray integer liRow integer liBase local integer lhArr local string lsEMail move (oArray(self)) to lhArr get value item (liBase+2) to lsEMail set value of lhArr item (item_count(lhArr)) to lsEMail end_procedure procedure DoPlaceInArray send delete_data to (oArray(self)) send Grid_RowCallBackSelected self MSG_AddToArray end_procedure procedure SelectCurrentRow local integer liBase if (item_count(self)) begin get Grid_BaseItem self to liBase set select_state item liBase to DFTRUE end end_procedure end_object // oLst procedure DoClear send fill_list to (oLst(self)) send activate to (oLst(self)) end_procedure Object oBtn Is A app.button oDfqEmailSelector.btn set location to 11 0 RELATIVE item_list on_item t.btn.ok send ok on_item t.btn.reset send DoClear on_item t.btn.cancel send cancel end_item_list End_Object procedure popup local integer liRval lhLst liCount lhInvObj lhArr local string lsValue move (focus(desktop)) to lhInvObj move (oLst(self)) to lhLst ifnot (item_count(lhLst)) send fill_list to lhLst if (item_count(lhLst)) begin ui_accept self to liRval if (liRval=MSG_OK) begin // if (Grid_SelectedRows(lhLst)=0) send SelectCurrentRow to lhLst send DoPlaceInArray to lhLst move (oArray(self)) to lhArr get item_count of lhArr to liCount if (liCount=0) move "" to lsValue if (liCount=1) begin #IF LNG_DEFAULT=LNG_DANISH move (string(liCount)+" adresse valgt") to lsValue #ELSE move (string(liCount)+" address selected") to lsValue #ENDIF end if (liCount>1) begin #IF LNG_DEFAULT=LNG_DANISH move (string(liCount)+" adresser valgt") to lsValue #ELSE move (string(liCount)+" addresses selected") to lsValue #ENDIF end set value of lhInvObj item CURRENT to lsValue end end else send obs "No e-mail addresses defined in dbquery.cfg" end_procedure end_object // oDfqEmailSelector /oDfqPortSelector.hdr ÉÍSelect printerÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» /oDfqPortSelector.lst º Name Port º º ________________________ __________________________________________ º º ________________________ __________________________________________ º º ________________________ __________________________________________ º º ________________________ __________________________________________ º º ________________________ __________________________________________ º º ________________________ __________________________________________ º º ________________________ __________________________________________ º º ________________________ __________________________________________ º º ________________________ __________________________________________ º /oDfqPortSelector.btn º ____________ ____________ º º F2 Esc º ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ /* object oDfqPortSelector is a app.ModalClient oDfqPortSelector.hdr set location to 4 7 ABSOLUTE object oLst is a app.List oDfqPortSelector.lst set Location To 1 0 RELATIVE set highlight_row_state to true on_key kenter send ok procedure fill_list local integer lhArr liMax liRow set dynamic_update_state to FALSE send delete_data move (oDbQueryConfig(self)) to lhArr get row_count of lhArr to liMax decrement liMax for liRow from 0 to liMax if (piType.i(lhArr,liRow)=0) begin // Printer send add_item MSG_NONE (psName.i(lhArr,liRow)) send add_item MSG_NONE (psValue.i(lhArr,liRow)) end loop send Grid_SetEntryState self DFFALSE set dynamic_update_state to TRUE end_procedure function sCurrentPort returns string local integer liBase if (item_count(self)) begin get Grid_BaseItem self to liBase function_return (trim(value(self,liBase+1))) end function_return "" end_function end_object // oLst Object oBtn Is A app.button oDfqPortSelector.btn set location to 11 0 RELATIVE item_list on_item t.btn.ok send ok on_item t.btn.cancel send cancel end_item_list End_Object procedure popup local integer liRval lhLst liCount lhInvObj lhArr local string lsValue move (focus(desktop)) to lhInvObj move (oLst(self)) to lhLst ifnot (item_count(lhLst)) send fill_list to lhLst if (item_count(lhLst)) begin ui_accept self to liRval if (liRval=MSG_OK) begin get sCurrentPort of (oLst(self)) to lsValue set value of lhInvObj item CURRENT to lsValue end end else send obs "No printer ports defined in dbquery.cfg" end_procedure end_object // oDfqPortSelector /oDfqSelectTable.hdr ÉÍ___________________________________ÍÍÍÍÍÍÍ» /oDfqSelectTable.lst º º º ________________________________ º º ________________________________ º º ________________________________ º º ________________________________ º º ________________________________ º º ________________________________ º º ________________________________ º º ________________________________ º º ________________________________ º º º /oDfqSelectTable.btn º ______ ________________ ______ _________ º º F2 Alt+F1 F4 Esc º ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ /* object oDfqSelectTable is a app.ModalClient oDfqSelectTable.hdr property integer piFile public 0 property integer pbNumbersOn public DFTRUE set location to 4 18 ABSOLUTE set window_color item 0 to 2 set value item 0 to (t.DfQuery.SelectTable+"ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ") on_key ksave_record send ok on_key kcancel send cancel on_key kUser send DoToggleNumbers on_key kprompt send prompt property integer piSelectedFile public 0 procedure prompt local integer liFile get iFdxSelectOneFile 0 0 to liFile if liFile begin set piSelectedFile to liFile procedure_return MSG_PROMPT end end_procedure object oLst is a List oDfqSelectTable.lst set location to 1 0 RELATIVE on_key kEnter send ok procedure AddTable integer liFile local integer liBase local string lsDisplayName get_attribute DF_FILE_DISPLAY_NAME of liFile to lsDisplayName ifnot (left(lsDisplayName,1)="@") begin get item_count to liBase if (pbNumbersOn(self)) send add_item msg_none (string(liFile)+". "+lsDisplayName) else send add_item msg_none lsDisplayName set aux_value item liBase to liFile end end_procedure procedure fill_list send delete_data set dynamic_update_state to DFFALSE // Defined in DBMS.nui: send DBMS_Callback_FilelistEntries FLEC_ALL MSG_AddTable self // (FLEC_NOT_BAD+FLEC_NO_ALIAS) set dynamic_update_state to DFTRUE end_procedure end_object procedure DoToggleNumbers local integer liItem get current_item of (oLst(self)) to liItem set pbNumbersOn to (not(pbNumbersOn(self))) send fill_list to (oLst(self)) set current_item of (oLst(self)) to liItem end_procedure object oBtn is a app.Button oDfqSelectTable.btn set location to 12 0 RELATIVE item_list on_item t.btn.ok send ok on_item "Toggle numbers" send DoToggleNumbers on_item "Adv." send prompt on_item t.btn.cancel send cancel end_item_list end_object function iPopup.i integer liFiles returns integer local integer liRval ui_accept self to liRval if liRval eq MSG_OK function_return (aux_value(oLst(self),CURRENT)) if liRval eq MSG_PROMPT function_return (piSelectedFile(self)) function_return 0 // User pressed cancel end_function procedure DoQueryInit set delegation_mode to DELEGATE_TO_PARENT send fill_list to (oLst(self)) end_procedure end_object // oDfqSelectTable /oDfqSelectionCrit.hdr ÉÍ___________________________________ÍÍÍÍÍÍÍ» /oDfqSelectionCrit.lst º º º ________________________________ º º ________________________________ º º ________________________________ º º ________________________________ º º ________________________________ º º ________________________________ º º ________________________________ º º ________________________________ º º º /oDfqSelectionCrit.frm º Value: _____________________________ º º º /oDfqSelectionCrit.btn º ______ __________ _________ º º F2 Ctrl+D Esc º ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ /* enumeration_list define DFQSC_FILE define DFQSC_FIELD define DFQSC_FIELDNAME define DFQSC_FIELDTYPE define DFQSC_COMPMODE define DFQSC_VALUE1 define DFQSC_VALUE2 end_enumeration_list object oDfqScParameters is a cArray NO_IMAGE end_object object oDfqSelectionCritPanel is a app.ModalClient oDfqSelectionCrit.hdr set location to 4 18 ABSOLUTE set window_color item 0 to 2 on_key ksave_record send close_ok on_key kcancel send cancel property integer pbCalendarEnabled public DFFALSE object oLst is a app.List oDfqSelectionCrit.lst set highlight_row_state to DFTRUE set location to 1 0 RELATIVE procedure add_item.ii integer liCurrent integer liAux send add_item MSG_NEXT (DfQuery_CompModeTxt_Long(liAux)+" ("+DfQuery_CompModeTxt_Short(liAux)+")") liAux set aux_value item (item_count(self)-1) to liAux if liCurrent eq liAux set current_item to (item_count(self)-1) end_procedure procedure fill_list.ii integer liCurrent integer liType send delete_data if liType eq DF_DATE set pbCalendarEnabled to DFTRUE else set pbCalendarEnabled to DFFALSE if liType ne DF_TEXT begin send add_item.ii liCurrent SC_COMP_EQ send add_item.ii liCurrent SC_COMP_LT send add_item.ii liCurrent SC_COMP_LE send add_item.ii liCurrent SC_COMP_GE send add_item.ii liCurrent SC_COMP_GT send add_item.ii liCurrent SC_COMP_NE end send add_item.ii liCurrent SC_COMP_IN send add_item.ii liCurrent SC_COMP_CIN if liType ne DF_TEXT begin // send add_item.ii liCurrent SC_COMP_BETWEEN // send add_item.ii liCurrent SC_COMP_CBETWEEN end else begin send add_item.ii liCurrent SC_COMP_NOT_BLANK send add_item.ii liCurrent SC_COMP_BLANK end end_procedure end_object object oFrm is a Form oDfqSelectionCrit.frm set location to 11 0 RELATIVE on_key KEY_CTRL+KEY_D send DoPopupCalendar procedure DoPopupCalendar local integer lbGarbage if (pbCalendarEnabled(self)) begin send activate get iValidateEntry to lbGarbage send popup to (popup_calendar(self)) end end_procedure item_list on_item "" send next end_item_list end_object function iValidateEntry returns integer // Returns true if OK local integer liRval lhDfqScParameters liOK local integer liFile liField liType liDecs lsDate local date ldDate local string lsValue move DFTRUE to liRval move (oDfqScParameters(self)) to lhDfqScParameters get value of lhDfqScParameters item DFQSC_FILE to liFile get value of lhDfqScParameters item DFQSC_FIELD to liField get value of lhDfqScParameters item DFQSC_FIELDTYPE to liType get value of (oFrm(self)) item 0 to lsValue if liType eq DF_DATE begin move lsValue to ldDate set value of (oFrm(self)) item 0 to ldDate end if liType eq DF_BCD begin get StringIsNumber lsValue (API_AttrValue_GLOBAL(DF_DECIMAL_SEPARATOR)) to liOK ifnot liOK begin move DFFALSE to liRval error 14 // Please enter a number end else begin get FieldInf_DecPoints liFile liField to liDecs move (NumToStr(lsValue,liDecs)) to lsValue set value of (oFrm(self)) item 0 to lsValue end end function_return liRval end_function procedure close_ok if (iValidateEntry(self)) procedure_return MSG_OK else send activate to (oFrm(self)) end_procedure object oBtn is a app.Button oDfqSelectionCrit.btn set location to 13 0 RELATIVE item_list on_item t.btn.ok send close_ok on_item "Calendar" send DoPopupCalendar to (oFrm(self)) on_item t.btn.cancel send cancel end_item_list end_object function iPopup returns integer local integer liRval lhDfqScParameters move (oDfqScParameters(self)) to lhDfqScParameters set value item 0 to (value(lhDfqScParameters,DFQSC_FIELDNAME)+"ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ") send fill_list.ii to (oLst(self)) (value(lhDfqScParameters,DFQSC_COMPMODE)) (value(lhDfqScParameters,DFQSC_FIELDTYPE)) set value of (oFrm(self)) item 0 to (value(lhDfqScParameters,DFQSC_VALUE1)) set shadow_state of (oBtn(self)) item 1 to (not(pbCalendarEnabled(self))) ui_accept self to liRval move (liRval=MSG_OK) to liRval if liRval begin set value of lhDfqScParameters item DFQSC_COMPMODE to (aux_value(oLst(self),CURRENT)) set value of lhDfqScParameters item DFQSC_VALUE1 to (value(oFrm(self),0)) end function_return liRval end_function end_object // oDfqSelection /oDfqView.hdr ÚÄQuery definitionÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ /oDfqView.Frm ³ Table (F4): ____________________________________________________ ³ ³ Report title: ____________________________________________________ ³ /oDfqView.TabSelector ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ_ÄÄ____________________________ÄÄÄÄÄÄÄÄÄAlt+_Ä_Ä_Ä_ÄÄÄ´ /oDfqView.Tab1.Table.Hdr ³________________________³ /oDfqView.Tab1.Table.Lst ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ /oDfqView.Tab1.Fields.Hdr ³________________________³ /oDfqView.Tab1.Fields.Lst ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ /oDfqView.Tab1.Fields.Btn ³ cA____________________ ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁ /oDfqView.Tab1.PrintedFields.Hdr ____________________________ _____ ___ _____ _____ ³ /oDfqView.Tab1.PrintedFields.Lst ____________________________ ___ ___ ___. ___. ³ ____________________________ ___ ___ ___. ___. ³ ____________________________ ___ ___ ___. ___. ³ ____________________________ ___ ___ ___. ___. ³ ____________________________ ___ ___ ___. ___. ³ ____________________________ ___ ___ ___. ___. ³ ____________________________ ___ ___ ___. ___. ³ ____________________________ ___ ___ ___. ___. ³ ____________________________ ___ ___ ___. ___. ³ ____________________________ ___ ___ ___. ___. ³ ____________________________ ___ ___ ___. ___. ³ Ctrl+left/right arrow: narrow/widen a column ³ Ctrl+up/down arrow : swap a field up/down ³ /oDfqView.Tab1.PrintedFields.Btn _____ ________ ____________ ________ ________ ³ Enter Alt+E Shift+F2 Ctrl+X ³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ /oDfqView.Tab2.Table.Hdr ³________________________³ /oDfqView.Tab2.Table.Lst ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ /oDfqView.Tab2.Fields.Hdr ³________________________³ /oDfqView.Tab2.Fields.Lst ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ ³ ______________________ ³ ³ ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁ /oDfqView.Tab2.Selections.Hdr _______________ __ _______________________________ ³ /oDfqView.Tab2.Selections.Lst _______________ __ _______________________________ ³ _______________ __ _______________________________ ³ _______________ __ _______________________________ ³ _______________ __ _______________________________ ³ _______________ __ _______________________________ ³ _______________ __ _______________________________ ³ _______________ __ _______________________________ ³ _______________ __ _______________________________ ³ _______________ __ _______________________________ ³ _______________ __ _______________________________ ³ _______________ __ _______________________________ ³ /oDfqView.Tab2.Selections.Frm __________________________________________________ ³ ³ /oDfqView.Tab2.Selections.Btn ___________ ___________ ____________ ___________ ³ Alt+E Shift+F2 ³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ /oDfqView.Tab3.OutputOrder.TopIndex.Btn ³ Printing order (_________): ³ /oDfqView.Tab3.OutputOrder.TopIndex ³ ___________________________________________________________________ /oDfqView.Tab3.OutputOrder.AdHoc ³ ________ ³ /oDfqView.Tab3.OutputOrder.BreakList ³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ³ ³ Break Field ³ ³ ___ _____________________________________ ³ ³ ___ _____________________________________ ³ ³ ___ _____________________________________ ³ ³ ___ _____________________________________ ³ ³ ___ _____________________________________ ³ ³ ___ _____________________________________ ³ ³ ___ _____________________________________ ³ ³ ___ _____________________________________ ³ ³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ³ /oDfqView.Tab3.OutputOrder.BottomIndex.Btn ³ Search index (_________): ³ /oDfqView.Tab3.OutputOrder.BottomIndex ³ ___________________________________________________________________________ ³ ³ ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ /oDfqView.Tab4.Hdr ³ ³ ³ Output destination: ³ /oDfqView.Tab4.DestinationSelect ³ ___ Screen ³ ___ Printer ³ ___ File ³ ___ E-mail /oDfqView.Tab4.DestinationSelectAux ³ Printer port: _______________________________________ F4=List ³ File name: _______________________________________ ³ E-mail addr.: _______________________________________ F4=List ³ /oDfqView.Tab4.FormatSelect ³ ³ File format: ³ ___ Formattet ³ ___ Comma separated ³ ___ Line separated ³ /oDfqView.Tab4.Other ³ Other options: ³ ___ Print totals only ³ ___ Use ANSI characters ³ ___ Semicolon as delimeter ³ ___ Include column names ³ /oDfqView.Tab4.Frm ³ ³ ³ Lines per page when printing to printer:___. (0 disables page breaks) ³ ³ Update status screen every _____. records ³ ³ ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ /oDfqView.Btn ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ cR__________ cO__________ cS__________ cE__________ÿÄÄÿ /* // Printed fields // Criteria // Ordering // Print class cDFQueryLabel is a Form procedure construct_object integer liImage forward send construct_object liImage set focus_mode to POINTER_ONLY item_list on_item "" send none end_item_list set window_color 0 to 2 // set center_state item 0 to DFTRUE end_procedure procedure set value integer liItem string lsValue forward set value item liItem to (lsValue+":") end_procedure end_class class cDFQueryMultiLabel is a Button procedure construct_object integer liImage forward send construct_object liImage set focus_mode to POINTER_ONLY end_procedure procedure end_construct_object local integer liMax liItem forward send end_construct_object get item_count to liMax decrement liMax for liItem from 0 to liMax set window_color liItem to 2 loop end_procedure end_class class cDfqTab1.TableList is a cFieldInf.Table_List // cDfqTab.TableList procedure DoInformExpressionThingAboutAllowedTables local integer liMax liItem liFile lhQuery_ExprParser move (Query_ExprParser(self)) to lhQuery_ExprParser send AllowedTables_Reset to lhQuery_ExprParser get item_count to liMax decrement liMax for liItem from 0 to liMax get aux_value item liItem to liFile send AllowedTables_Add to lhQuery_ExprParser liFile loop end_procedure end_class class cDfqTab1.PrintedFieldList is a app.List procedure construct_object integer liImage forward send construct_object liImage set highlight_row_state to DFTRUE set select_mode to multi_select on_key KSWITCH send switch on_key KSWITCH_BACK send switch_back on_key KEY_CTRL+KEY_LEFT_ARROW send DoNarrowField on_key KEY_CTRL+KEY_RIGHT_ARROW send DoWidenField on_key KEY_CTRL+KEY_UP_ARROW send DoSwapUp on_key KEY_CTRL+KEY_DOWN_ARROW send DoSwapDown on_key KEY_CTRL+KEY_X send DoAdjustColumns end_procedure procedure DoAdjustColumns local integer liMax liRow liStart liWidth lbCR liBase local integer liFile liField liType liExprRow lhDef lhExprArr move 1 to liStart get Grid_RowCount self to liMax decrement liMax for liRow from 0 to liMax get Grid_RowBaseItem self liRow to liBase get aux_value item liBase to liFile get aux_value item (liBase+1) to liField get select_state item (liBase+2) to lbCR get select_state item (liBase+3) to liExprRow get value item (liBase+4) to liWidth if liFile get FieldInf_FieldType liFile liField to liType else begin get phQueryDefinition to lhDef move (oQuery_ExprArray(lhDef)) to lhExprArr get piType.i of lhExprArr liExprRow to liType end if (liType<>DF_TEXT) begin if lbCR move 1 to liStart set value item (liBase+3) to liStart move (liStart+liWidth+1) to liStart end loop end_procedure procedure DoAdjustCharacters integer liCurRow integer liAt integer liAmount local integer liRow liMax liStart liWidth liBase lbCrHasBeen if (liAt>0) begin // First determine the min row and max row that would be influenced. // get Grid_RowCount self to liMax decrement liMax move DFFALSE to lbCrHasBeen for liRow from liCurRow to liMax get Grid_RowBaseItem self liRow to liBase get value item (liBase+3) to liStart get value item (liBase+4) to liWidth if (liStart>liAt) if (select_state(self,liBase+2)) move DFTRUE to lbCrHasBeen ifnot lbCrHasBeen begin if liStart gt liAt begin if (liStart+liAmount) gt 0 move (liStart+liAmount) to liStart end else if (liStart+liWidth) gt liAt begin if (liWidth+liAmount) gt 0 move (liWidth+liAmount) to liWidth end set value item (liBase+3) to liStart set value item (liBase+4) to liWidth end loop end end_procedure procedure DoNarrowField local integer liCurPos liCurRow if (item_count(self)) begin get value item (base_item(self)+3) to liCurPos get Grid_CurrentRow self to liCurRow send DoAdjustCharacters liCurRow liCurPos -1 end end_procedure procedure DoWidenField local integer liCurPos liCurRow if (item_count(self)) begin get value item (base_item(self)+3) to liCurPos get Grid_CurrentRow self to liCurRow send DoAdjustCharacters liCurRow liCurPos 1 end end_procedure procedure DoSwapUp send Grid_SwapCurrentRowUp self send DoAdjustColumns end_procedure procedure DoSwapDown send Grid_SwapCurrentRowDown self send DoAdjustColumns end_procedure procedure next if ((current_item(self)+1)=item_count(self)) send switch else set current_item to (current_item(self)+1) end_procedure procedure previous if (current_item(self)=0) send switch_back else set current_item to (current_item(self)-1) end_procedure procedure SetRowValue integer liBase integer liFile integer liField ; integer liExprRow string lsHeader string lsUnit ; integer lbTotal integer lbNewLine integer liStart ; integer liWidth local integer liType lhDef lhExprArr get phQueryDefinition to lhDef move (oQuery_ExprArray(lhDef)) to lhExprArr if (liBase=item_count(self)) send Row_Add set aux_value item liBase to liFile set aux_value item (liBase+1) to liField set aux_value item (liBase+2) to liExprRow set checkbox_item_state item (liBase+1) to DFTRUE set checkbox_item_state item (liBase+2) to DFTRUE set value item liBase to lsHeader if liFile get FieldInf_FieldType liFile liField to liType else get piType.i of lhExprArr liExprRow to liType if liType eq DF_BCD begin set shadow_state item (liBase+1) to DFFALSE set select_state item (liBase+1) to lbTotal end else begin set shadow_state item (liBase+1) to DFTRUE set select_state item (liBase+1) to DFFALSE end set select_state item (liBase+2) to lbNewLine if liType eq DF_TEXT begin set value item (liBase+3) to "" set value item (liBase+4) to "" set entry_state item (liBase+3) to DFFALSE set entry_state item (liBase+4) to DFFALSE set select_state item (liBase+2) to DFTRUE set shadow_state item (liBase+2) to DFTRUE end else begin set value item (liBase+3) to liStart set value item (liBase+4) to liWidth set entry_state item (liBase+3) to DFTRUE set entry_state item (liBase+4) to DFTRUE end end_procedure function bIsExprRow integer liBase returns integer function_return (not(aux_value(self,liBase))) end_function procedure DoNewFieldData integer liBase integer liFile integer liField integer liExprRow local integer liType liStart liWidth lhDef lhExprArr local string lsHeader if liBase eq 0 move 1 to liStart else move (integer(value(self,liBase-2))+integer(value(self,liBase-1))+1) to liStart if liFile begin move (FieldInf_FieldLabel_Short(liFile,liField)) to lsHeader move (FieldInf_Field_Width(liFile,liField)) to liWidth end else begin get phQueryDefinition to lhDef move (oQuery_ExprArray(lhDef)) to lhExprArr get psLabel.i of lhExprArr liExprRow to lsHeader get piWidth.i of lhExprArr liExprRow to liWidth end send SetRowValue liBase liFile liField liExprRow lsHeader "" DFFALSE DFFALSE liStart liWidth end_procedure procedure AddField integer liFile integer liField integer liExprRow local integer liBase get item_count to liBase send DoNewFieldData liBase liFile liField liExprRow set current_item to liBase send DoAdjustColumns end_procedure procedure InsertField integer liFile integer liField integer liExprRow local integer liBase get base_item to liBase send request_row_insert send DoNewFieldData liBase liFile liField liExprRow set current_item to liBase send DoAdjustColumns end_procedure procedure DoCcAdd local integer liRow lhExprArr liBase lhDef get phQueryDefinition to lhDef move (oQuery_ExprArray(lhDef)) to lhExprArr send DoInformExpressionThingAboutAllowedTables // Caught by parent get iPopup.ii of (Query_ColumnExpression(self)) lhExprArr -1 to liRow if (liRow<>-1) send AddField 0 0 liRow end_procedure procedure DoCcInsert local integer liRow lhExprArr liBase lhDef get phQueryDefinition to lhDef move (oQuery_ExprArray(lhDef)) to lhExprArr send DoInformExpressionThingAboutAllowedTables // Caught by parent get iPopup.ii of (Query_ColumnExpression(self)) lhExprArr -1 to liRow if (liRow<>-1) send InsertField 0 0 liRow end_procedure procedure DoCcEdit local integer liBase lhExprArr liExprRow liRow lhDef get phQueryDefinition to lhDef move (oQuery_ExprArray(lhDef)) to lhExprArr if (item_count(self)) begin get base_item to liBase if (bIsExprRow(self,liBase)) begin send DoInformExpressionThingAboutAllowedTables // Caught by parent get aux_value item (liBase+2) to liExprRow get iPopup.ii of (Query_ColumnExpression(self)) lhExprArr liExprRow to liRow if (liRow<>-1) send SetRowValue liBase 0 0 liRow (value(self,liBase+0)) "" (select_state(self,liBase+1)) (select_state(self,liBase+2)) (value(self,liBase+3)) (value(self,liBase+4)) end end end_procedure procedure DeleteField local integer liCurrentItem if (item_count(self)) begin get current_item to liCurrentItem send request_row_delete send DoAdjustColumns if (item_count(self)>liCurrentItem) set current_item to liCurrentItem end end_procedure procedure MarkUsedExpressions local integer liRow liMax liExprRow liBase liFile lhExprArr lhDef get phQueryDefinition to lhDef move (oQuery_ExprArray(lhDef)) to lhExprArr get Grid_RowCount self to liMax decrement liMax for liRow from 0 to liMax get Grid_RowBaseItem self liRow to liBase get aux_value item liBase to liFile ifnot liFile begin get aux_value item (liBase+2) to liExprRow send CleanUp_MarkAsUsed to lhExprArr liExprRow end loop end_procedure procedure GetNewExpressionIDs local integer liRow liMax liExprRow liBase liFileField lhExprArr lhDef get phQueryDefinition to lhDef move (oQuery_ExprArray(lhDef)) to lhExprArr get Grid_RowCount self to liMax decrement liMax for liRow from 0 to liMax get Grid_RowBaseItem self liRow to liBase get aux_value item liBase to liFileField ifnot liFileField begin get aux_value item (liBase+2) to liExprRow get pbCleanupNewRow.i of lhExprArr liExprRow to liExprRow set aux_value item (liBase+2) to liExprRow end loop end_procedure procedure DoReset send delete_data end_procedure procedure WriteToDefinition integer lhQueryDefinition local integer liMax liRow lhDef liBase local integer liFile local integer liField local integer lbTotal local integer lbNewLine local integer liStart local integer liWidth local integer liExprRow local string lsHeader local string lsUnit move (oQueryDefColumnInfo(lhQueryDefinition)) to lhDef send delete_data to lhDef get row_count to liMax decrement liMax for liRow from 0 to liMax get row_base_item liRow to liBase get aux_value item liBase to liFile get aux_value item (liBase+1) to liField get aux_value item (liBase+2) to liExprRow get value item liBase to lsHeader move "" to lsUnit get select_state item (liBase+1) to lbTotal get select_state item (liBase+2) to lbNewLine get value item (liBase+3) to liStart get value item (liBase+4) to liWidth send AddField to lhDef liFile liField liExprRow lsHeader lsUnit lbTotal lbNewLine liStart liWidth loop end_procedure procedure ReadFromDefinition integer lhQueryDefinition local integer lhDef liMax liRow liBase local integer liFile local integer liField local integer liExprRow local integer lbTotal local integer lbNewLine local integer liStart local integer liWidth local string lsHeader local string lsUnit send delete_data move (oQueryDefColumnInfo(lhQueryDefinition)) to lhDef get row_count of lhDef to liMax decrement liMax for liRow from 0 to liMax get piFile.i of lhDef liRow to liFile get piField.i of lhDef liRow to liField get piExprRow.i of lhDef liRow to liExprRow get psHeader.i of lhDef liRow to lsHeader get psUnit.i of lhDef liRow to lsUnit get pbTotal.i of lhDef liRow to lbTotal get pbNewLine.i of lhDef liRow to lbNewLine get piStart.i of lhDef liRow to liStart get piWidth.i of lhDef liRow to liWidth get item_count to liBase send SetRowValue liBase liFile liField liExprRow lsHeader lsUnit lbTotal lbNewLine liStart liWidth loop end_procedure procedure OnRowChange integer liFromRow integer liToRow end_procedure procedure item_change integer from# integer to# returns integer local integer rval# liFromRow liToRow liColumns forward get msg_item_change from# to# to rval# get Grid_Columns self to liColumns move (from#/liColumns) to liFromRow move (to#/liColumns) to liToRow if (liFromRow<>liToRow) send OnRowChange liFromRow liToRow procedure_return rval# end_procedure end_class // cDfqTab1.PrintedFieldList class cDfqTab2.TableList is a cFieldInf.Table_List // cDfqTab.TableList end_class class cDfqTab2.SelectionsList is a app.List procedure construct_object integer liImage forward send construct_object liImage on_key kenter send DoEditEntry on_key kdelete_record send DoDeleteEntry on_key kswitch send switch on_key kswitch_back send switch_back property integer piExprRow public -1 end_procedure procedure OnExprCriteriaChanged end_procedure // Procedures MarkUsedExpressions and GetNewExpressionIDs are called // manually from the outside. procedure MarkUsedExpressions local integer lhDef lhExprArr liExprRow get phQueryDefinition to lhDef move (oQuery_ExprArray(lhDef)) to lhExprArr get piExprRow to liExprRow if (liExprRow<>-1) send CleanUp_MarkAsUsed to lhExprArr liExprRow end_procedure procedure GetNewExpressionIDs local integer lhDef lhExprArr liExprRow get phQueryDefinition to lhDef move (oQuery_ExprArray(lhDef)) to lhExprArr get piExprRow to liExprRow if (liExprRow<>-1) set piExprRow to (pbCleanupNewRow.i(lhExprArr,liExprRow)) end_procedure // Call user interface for entering an expressional selection criteria procedure DoCritExpression local integer lbOk liExprRow lhExprArr lhDef local string lsExpression get phQueryDefinition to lhDef move (oQuery_ExprArray(lhDef)) to lhExprArr get piExprRow to liExprRow if (liExprRow=-1) begin get row_count of lhExprArr to liExprRow set psLongLabel.i of lhExprArr liExprRow to "Selection criteria" set psLabel.i of lhExprArr liExprRow to "Criteria" set piType.i of lhExprArr liExprRow to DF_BCD set piDecimals.i of lhExprArr liExprRow to 0 set psExpression.i of lhExprArr liExprRow to "" end get psExpression.i of lhExprArr liExprRow to lsExpression send DoInformExpressionThingAboutAllowedTables // get iPopup.sis of (Query_EditCriteriaExpression(self)) lsExpression TYPE.INTEGER "Udvalgskriterie (udtryk)" to lbOk get iPopup.sis of (Query_EditCriteriaExpression(self)) lsExpression TYPE.INTEGER "Selection criteria (expressional)" to lbOk if (lbOk<>-1) begin get psExpression of (Query_EditCriteriaExpression(self)) to lsExpression move (trim(Text_CompressSubstCr(lsExpression,""))) to lsExpression if (lsExpression<>"") begin set psExpression.i of lhExprArr liExprRow to lsExpression set piExprRow to liExprRow end else set piExprRow to -1 end send OnExprCriteriaChanged end_procedure // Called to add criteria to the list procedure AddCriteria local integer lhDfqScParameters liBase move (oDfqScParameters(self)) to lhDfqScParameters get item_count to liBase send add_item MSG_NONE (value(lhDfqScParameters,DFQSC_FIELDNAME)) send add_item MSG_NONE (DfQuery_CompModeTxt_Short(value(lhDfqScParameters,DFQSC_COMPMODE))) send add_item MSG_NONE (value(lhDfqScParameters,DFQSC_VALUE1)) set aux_value item liBase to (value(lhDfqScParameters,DFQSC_FILE)) set aux_value item (liBase+1) to (value(lhDfqScParameters,DFQSC_FIELD)) set aux_value item (liBase+2) to (value(lhDfqScParameters,DFQSC_COMPMODE)) end_procedure procedure OnRowChange integer liFromRow integer liToRow end_procedure procedure item_change integer from# integer to# returns integer local integer rval# liFromRow liToRow liColumns forward get msg_item_change from# to# to rval# get Grid_Columns self to liColumns move (from#/liColumns) to liFromRow move (to#/liColumns) to liToRow if (liFromRow<>liToRow) send OnRowChange liFromRow liToRow procedure_return rval# end_procedure procedure DoExpression end_procedure procedure DoEditEntry local integer lhDfqScParameters liBase liFile liField liRval move (oDfqScParameters(self)) to lhDfqScParameters if (item_count(self)) begin get base_item to liBase get aux_value item liBase to liFile get aux_value item (liBase+1) to liField set value of lhDfqScParameters item DFQSC_FILE to liFile set value of lhDfqScParameters item DFQSC_FIELD to liField set value of lhDfqScParameters item DFQSC_FIELDNAME to (FieldInf_FieldLabel_Long(liFile,liField)) set value of lhDfqScParameters item DFQSC_FIELDTYPE to (FieldInf_FieldType(liFile,liField)) set value of lhDfqScParameters item DFQSC_COMPMODE to (aux_value(self,liBase+2)) set value of lhDfqScParameters item DFQSC_VALUE1 to (value(self,liBase+2)) set value of lhDfqScParameters item DFQSC_VALUE2 to "" get iPopup of (oDfqSelectionCritPanel(self)) to liRval if liRval begin set value item (liBase+1) to (DfQuery_CompModeTxt_Short(value(lhDfqScParameters,DFQSC_COMPMODE))) set value item (liBase+2) to (value(lhDfqScParameters,DFQSC_VALUE1)) set aux_value item (liBase+2) to (value(lhDfqScParameters,DFQSC_COMPMODE)) end end end_procedure procedure DoDeleteEntry if (item_count(self)) send request_row_delete end_procedure procedure DoReset send delete_data end_procedure procedure WriteToDefinition integer lhQueryDefinition local integer lhDef liBase liRow liMax local integer liFile local integer liField local integer liComperator local string lsValue1 local string lsValue2 local string lsName move (oQueryDefCriteria(lhQueryDefinition)) to lhDef send delete_data to lhDef get row_count to liMax decrement liMax for liRow from 0 to liMax get row_base_item liRow to liBase get value item liBase to lsName get aux_value item liBase to liFile get aux_value item (liBase+1) to liField get aux_value item (liBase+2) to liComperator get value item (liBase+2) to lsValue1 move "" to lsValue2 send AddCriteria to lhDef liFile liField lsName liComperator lsValue1 lsValue2 loop set value of lhQueryDefinition item DFQ_CRITERIA_EXPR_ROW to (piExprRow(self)) end_procedure procedure ReadFromDefinition integer lhQueryDefinition local integer lhDef liRow liMax lhDfqScParameters local integer liFile local integer liField local integer liComperator local string lsValue1 local string lsValue2 move (oQueryDefCriteria(lhQueryDefinition)) to lhDef move (oDfqScParameters(self)) to lhDfqScParameters send delete_data get row_count of lhDef to liMax decrement liMax for liRow from 0 to liMax get piFile.i of lhDef liRow to liFile get piField.i of lhDef liRow to liField get piComperator.i of lhDef liRow to liComperator get psValue1.i of lhDef liRow to lsValue1 get psValue2.i of lhDef liRow to lsValue2 set value of lhDfqScParameters item DFQSC_FILE to liFile set value of lhDfqScParameters item DFQSC_FIELD to liField set value of lhDfqScParameters item DFQSC_FIELDNAME to (FieldInf_FieldLabel_Long(liFile,liField)) set value of lhDfqScParameters item DFQSC_FIELDTYPE to (FieldInf_FieldType(liFile,liField)) set value of lhDfqScParameters item DFQSC_COMPMODE to liComperator set value of lhDfqScParameters item DFQSC_VALUE1 to lsValue1 set value of lhDfqScParameters item DFQSC_VALUE2 to lsValue2 send AddCriteria loop set piExprRow to (value(lhQueryDefinition,DFQ_CRITERIA_EXPR_ROW)) send OnExprCriteriaChanged end_procedure end_class // class cDfqTab2.OutputOrder is a app.List // procedure construct_object integer liImage // forward send construct_object liImage // set highlight_row_state to DFTRUE // end_procedure // procedure AddIndex integer liFile integer liIndex string lsIndexDef string lsFields // send add_item MSG_NONE (string(liIndex)+": "+FDX_IndexAsFieldNames(0,liFile,liIndex,0)) // set aux_value item (item_count(self)-1) to liIndex // end_procedure // procedure AddBatchIndex integer liFile integer liIndex string lsFields integer liType // send add_item MSG_NONE ("Batch: "+FDX_IndexAsFieldNames(0,liFile,liIndex,0)) // set aux_value item (item_count(self)-1) to liIndex // end_procedure // procedure fill_list // local integer liFile // set dynamic_update_state to DFFALSE // send delete_data // get iMainFile to liFile // if liFile begin // send add_item MSG_NONE "0: Recnum" // send FDX_IndexCallback 0 liFile DF_INDEX_TYPE_ONLINE MSG_AddIndex self // send FDX_IndexCallback 0 liFile DF_INDEX_TYPE_BATCH MSG_AddBatchIndex self // if (item_count(self)>1) set current_item to 1 // end // set dynamic_update_state to DFTRUE // end_procedure // procedure WriteToDefinition integer lhQueryDefinition // local integer liOrdering lhDef // move lhQueryDefinition to lhDef // get aux_value item CURRENT to liOrdering // set value of lhDef item DFQ_ORDERING to liOrdering // end_procedure // procedure ReadFromDefinition integer lhQueryDefinition // local integer liOrdering lhDef liItem liMax // move lhQueryDefinition to lhDef // get value of lhDef item DFQ_ORDERING to liOrdering // get item_count to liMax // decrement liMax // for liItem from 0 to liMax // if (liOrdering=aux_value(self,liItem)) set current_item to liItem // loop // end_procedure // end_class object oQueryDefinition is a cQueryDefinition NO_IMAGE property string psDefaultPort public "" send DoReset procedure DoDefaults forward send DoDefaults if (psDefaultPort(self)<>"") set value item DFQ_PORT to (psDefaultPort(self)) end_procedure end_object activate_view Activate_Query_View for oDFQueryView object oDFQueryView is a app.Client oDfqView.hdr action_bar (main_menu(self)) property integer phQueryDefinition public (oQueryDefinition(self)) property integer phDDO public 0 on_key KEY_CTRL+KEY_R send DoRun on_key KEY_CTRL+KEY_O send DoOpen on_key KEY_CTRL+KEY_S send DoSave on_key KEY_CTRL+KEY_E send DoSaveAs // on_key KEY_CTRL+KEY_L send DoDisplayDfqLog on_key KEY_ALT+KEY_B send DoDFBrowse on_key kuser send ChangeSkin set window_color item 0 to 2 procedure DoDFBrowse local integer liFile get iMainFile to liFile // if liFile send DFQ_Dfbrowse liFile end_procedure procedure DoDisplayDfqLog local string lsValue get sTextFromDfImage DfqLogFileImage.N to lsValue send DoDisplayText "DFQuery log file" lsValue end_procedure procedure set FileNameLabel string lsValue // set value item 0 to lsValue // if lsValue eq "" set value item 0 to (repeat("Ä",80)) // else set value item 0 to (" ("+lsValue+")"+repeat("Ä",80)) end_procedure set FileNameLabel to "" function iMainFile returns integer function_return (value(phQueryDefinition(self),DFQ_MAIN_FILE)) end_function set location to 2 0 ABSOLUTE object oFrm is a app.Form oDfqView.Frm set location to 1 0 RELATIVE on_key kPrompt send prompt procedure switch send Current_Tab end_procedure procedure switch_back send Current_Tab end_procedure procedure prompt local integer liFile if (current_item(self)=0) begin get iPopup.i of (oDfqSelectTable(self)) to liFile if liFile begin send DoReset to (phQueryDefinition(self)) set piMainFile of (phQueryDefinition(self)) to liFile send ReadFromDefinition end end end_procedure procedure prompt_or_next if (iMainFile(self)) send next else send prompt end_procedure item_list on_item "" send prompt_or_next set entry_state to DFFALSE on_item "" send next end_item_list procedure fill_form if (iMainFile(self)) set value item 0 to (DBMS_DisplayName(iMainFile(self))) else set value item 0 to "" set value item 1 to "" end_procedure end_object property string psSkin public "" object oTabSelector is a Button oDfqView.TabSelector set location to 3 0 relative set focus_mode to POINTER_ONLY item_list on_item "" send none on_item "" send none on_item "" send Activate_Tab1 on_item "" send Activate_Tab2 on_item "" send Activate_Tab3 on_item "" send Activate_Tab4 end_item_list set window_color 0 to 2 set window_color 1 to 2 function sFormatHeader string lsValue returns string local integer liLength liOtherLength move (" "+lsValue+" ") to lsValue move (length(lsValue)) to liLength move (28-liLength/2) to liOtherLength function_return (repeat("Ä",liOtherLength)+lsValue+repeat("Ä",liOtherLength+1)) end_function procedure UpdateTab integer liTab local string lsMarker get psSkin to lsMarker set value item 2 to "1" set value item 3 to "2" set value item 4 to "3" set value item 5 to "4" if liTab eq 1 begin set value item 1 to (sFormatHeader(self,"Printed fields")) set value item 0 to "Â" set value item 2 to lsMarker end if liTab eq 2 begin set value item 1 to (sFormatHeader(self,"Selection criteria")) set value item 0 to "Â" set value item 3 to lsMarker end if liTab eq 3 begin set value item 1 to (sFormatHeader(self,"Output order")) set value item 0 to "Ä" set value item 4 to lsMarker end if liTab eq 4 begin set value item 1 to (sFormatHeader(self,"Output parameters")) set value item 0 to "Ä" set value item 5 to lsMarker end end_procedure send UpdateTab 1 end_object // oTabSelector property integer piCurrentTab public 1 procedure ChangeSkin #IFDEF _UNIX_ #ELSE if (psSkin(self)="") begin set psSkin to "" // Summer of love send UpdateTab to (oTabSelector(self)) (piCurrentTab(self)) send obs "Skin has been set to 'Summer of love'" end else begin set psSkin to "" // Pythagoras send UpdateTab to (oTabSelector(self)) (piCurrentTab(self)) send obs "Skin has been set to 'Pythagoras'" end #ENDIF end_procedure procedure Activate_Tab1 send Activate_Tab 1 end_procedure procedure Activate_Tab2 send Activate_Tab 2 end_procedure procedure Activate_Tab3 send Activate_Tab 3 end_procedure procedure Activate_Tab4 send Activate_Tab 4 end_procedure procedure Current_Tab send Activate_Tab (piCurrentTab(self)) end_procedure procedure Next_Tab local integer liTab get piCurrentTab to liTab increment liTab if liTab gt 4 move 1 to liTab send Activate_Tab liTab end_procedure procedure Previous_Tab local integer liTab get piCurrentTab to liTab decrement liTab if liTab lt 1 move 4 to liTab send Activate_Tab liTab end_procedure on_key KEY_ALT+KEY_1 send Activate_Tab1 on_key KEY_ALT+KEY_2 send Activate_Tab2 on_key KEY_ALT+KEY_3 send Activate_Tab3 on_key KEY_ALT+KEY_4 send Activate_Tab4 on_key KEY_CTRL+KEY_F1 send Activate_Tab1 on_key KEY_CTRL+KEY_F2 send Activate_Tab2 on_key KEY_CTRL+KEY_F3 send Activate_Tab3 on_key KEY_CTRL+KEY_F4 send Activate_Tab4 on_key KEY_CTRL+KEY_PGUP send Previous_Tab on_key KEY_CTRL+KEY_PGDN send Next_Tab // *** TAB 1 ************************************************ register_object oTab1_PrintedFieldsButton object oTab1_TableHeader is a cDFQueryLabel oDfqView.Tab1.Table.Hdr set location to 4 0 RELATIVE set value item 0 to t.DfQuery.DBMSfiles procedure rotate_up if (piCurrentTab(self)=1) forward send rotate_up end_procedure end_object object oTab1_TableSelect is a cDfqTab1.TableList oDfqView.Tab1.Table.Lst set location to 5 0 RELATIVE register_object oTab1_FieldsSelect on_key KDELETE_RECORD send Tab1_DeleteField procedure rotate_up if (piCurrentTab(self)=1) forward send rotate_up end_procedure procedure switch_back send activate to (oFrm(self)) end_procedure procedure OnNewFile integer liFile send fill_list.i to (oTab1_FieldsSelect(self)) liFile end_procedure on_key KEY_ALT+KEY_E send PopupFM to (oTab1_PrintedFieldsButton(self)) end_object object oTab1_FieldsHeader is a cDFQueryLabel oDfqView.Tab1.Fields.Hdr set location to 9 0 RELATIVE set value item 0 to t.DfQuery.DBMSfields procedure rotate_up if (piCurrentTab(self)=1) forward send rotate_up end_procedure end_object object oTab1_FieldsSelect is a cFieldInf.Field_List oDfqView.Tab1.Fields.Lst on_key kenter send Tab1_AddField set location to 10 0 RELATIVE on_key KDELETE_RECORD send Tab1_DeleteField procedure rotate_up if (piCurrentTab(self)=1) forward send rotate_up end_procedure procedure AddAllFields local integer liMax liItem liCurrentItem liFile liField liType if (item_count(self)) begin get aux_value of (oTab1_TableSelect(self)) item CURRENT to liFile get current_item to liCurrentItem get item_count to liMax decrement liMax // First add non-text fields for liItem from liCurrentItem to liMax get aux_value item liItem to liField get FieldInf_FieldType liFile liField to liType if liType NE DF_TEXT begin set current_item to liItem send Tab1_AddField end loop // Then add text fields for liItem from liCurrentItem to liMax get aux_value item liItem to liField get FieldInf_FieldType liFile liField to liType if liType EQ DF_TEXT begin set current_item to liItem send Tab1_AddField end loop end end_procedure on_key KEY_CTRL+KEY_A send AddAllFields on_key KEY_ALT+KEY_E send PopupFM to (oTab1_PrintedFieldsButton(self)) end_object object oTab1_FieldsSelectButton is a app.Button oDfqView.Tab1.Fields.Btn set location to 19 0 RELATIVE on_key KDELETE_RECORD send Tab1_DeleteField on_key KEY_CTRL+KEY_A send AddAllFields procedure rotate_up if (piCurrentTab(self)=1) forward send rotate_up end_procedure item_list on_item "All fields" send AddAllFields to (oTab1_FieldsSelect(self)) end_item_list on_key KEY_ALT+KEY_E send PopupFM to (oTab1_PrintedFieldsButton(self)) end_object object oTab1_PrintedFieldsHeader is a cDFQueryMultiLabel oDfqView.Tab1.PrintedFields.Hdr set location to 4 26 RELATIVE // 19+7 procedure rotate_up if (piCurrentTab(self)=1) forward send rotate_up end_procedure item_list on_item "Label" send none on_item "Total" send none on_item "Cr" send none on_item "Start" send none on_item "Width" send none end_item_list end_object object oTab1_PrintedFields is a cDfqTab1.PrintedFieldList oDfqView.Tab1.PrintedFields.Lst set location to 5 26 RELATIVE // 19+7 on_key KDELETE_RECORD send Tab1_DeleteField on_key KEY_ALT+KEY_MINUS send Tab1_DeleteField on_key KEY_CTRL+KEY_X send Tab1_AdjustWidth procedure rotate_up if (piCurrentTab(self)=1) forward send rotate_up end_procedure procedure OnRowChange integer liFromRow integer liToRow local integer liFile liField liBase if (item_count(self)) begin get Grid_RowBaseItem self liToRow to liBase get aux_value item liBase to liFile get aux_value item (liBase+1) to liField send Tab1_GotoFileField liFile liField end end_procedure on_key KEY_ALT+KEY_E send PopupFM to (oTab1_PrintedFieldsButton(self)) end_object procedure Tab1_DoCcAdd send DoCcAdd to (oTab1_PrintedFields(self)) end_procedure procedure Tab1_DoCcInsert send DoCcInsert to (oTab1_PrintedFields(self)) end_procedure procedure Tab1_DoCcEdit send DoCcEdit to (oTab1_PrintedFields(self)) end_procedure object oTab1_PrintedFieldsButton is a app.Button oDfqView.Tab1.PrintedFields.Btn set location to 18 26 RELATIVE // 19+7 procedure rotate_up if (piCurrentTab(self)=1) forward send rotate_up end_procedure procedure switch send activate to (oFrm(self)) end_procedure procedure PopupFM // Tab1_DoExpression send FLOATMENU_PrepareAddItem msg_Tab1_DoCcAdd "Add expression" send FLOATMENU_PrepareAddItem msg_Tab1_DoCcInsert "Insert expression" send FLOATMENU_PrepareAddItem msg_Tab1_DoCcEdit "Edit expression" send popup to (FLOATMENU_Apply(self)) end_procedure item_list on_item "Add" send Tab1_AddField on_item "Insert" send Tab1_InsertField on_item "Expression" send PopupFM on_item "Delete" send Tab1_DeleteField on_item "Adjust" send Tab1_AdjustWidth end_item_list on_key KEY_ALT+KEY_E send PopupFM to (oTab1_PrintedFieldsButton(self)) end_object procedure DoInformExpressionThingAboutAllowedTables send DoInformExpressionThingAboutAllowedTables to (oTab1_TableSelect(self)) end_procedure function Tab1_CurrentFile returns integer function_return (aux_value(oTab1_TableSelect(self),CURRENT)) end_function function Tab1_CurrentField returns integer function_return (aux_value(oTab1_FieldsSelect(self),CURRENT)) end_function procedure Tab1_AddField send AddField to (oTab1_PrintedFields(self)) (Tab1_CurrentFile(self)) (Tab1_CurrentField(self)) 0 send key to (oTab1_FieldsSelect(self)) kdownarrow end_procedure procedure Tab1_InsertField send InsertField to (oTab1_PrintedFields(self)) (Tab1_CurrentFile(self)) (Tab1_CurrentField(self)) 0 end_procedure procedure Tab1_DeleteField send DeleteField to (oTab1_PrintedFields(self)) end_procedure procedure Tab1_DoExpression send DoExpression to (oTab1_PrintedFields(self)) end_procedure procedure Tab1_AdjustWidth send DoAdjustColumns to (oTab1_PrintedFields(self)) end_procedure procedure Tab1_GotoFileField integer liFile integer liField send GoToFile to (oTab1_TableSelect(self)) liFile send GoToField to (oTab1_FieldsSelect(self)) liField end_procedure // *** TAB 2 ************************************************ register_object oTab2_Selections object oTab2_TableHeader is a cDFQueryLabel oDfqView.Tab2.Table.Hdr set location to 4 0 RELATIVE set value item 0 to t.DfQuery.DBMSfiles procedure rotate_up if (piCurrentTab(self)=2) forward send rotate_up end_procedure end_object object oTab2_TableSelect is a cDfqTab2.TableList oDfqView.Tab2.Table.Lst set location to 5 0 RELATIVE register_object oTab2_FieldsSelect on_key KEY_ALT+KEY_E send DoCritExpression to (oTab2_Selections(self)) procedure rotate_up if (piCurrentTab(self)=2) forward send rotate_up end_procedure procedure switch_back send activate to (oFrm(self)) end_procedure procedure OnNewFile integer liFile send fill_list.i to (oTab2_FieldsSelect(self)) liFile end_procedure end_object object oTab2_FieldsHeader is a cDFQueryLabel oDfqView.Tab2.Fields.Hdr set location to 9 0 RELATIVE set value item 0 to t.DfQuery.DBMSfields procedure rotate_up if (piCurrentTab(self)=2) forward send rotate_up end_procedure end_object object oTab2_FieldsSelect is a cFieldInf.Field_List oDfqView.Tab2.Fields.Lst on_key kenter send Tab2_AddCriteria set location to 10 0 RELATIVE on_key KEY_ALT+KEY_E send DoCritExpression to (oTab2_Selections(self)) procedure rotate_up if (piCurrentTab(self)=2) forward send rotate_up end_procedure end_object object oTab2_SelectionsHeader is a cDFQueryMultiLabel oDfqView.Tab2.Selections.Hdr set location to 4 26 RELATIVE // 19+7 procedure rotate_up if (piCurrentTab(self)=2) forward send rotate_up end_procedure item_list on_item "Select by field" send none on_item "" send none on_item "Value" send none end_item_list end_object register_object oTab2_SelectionsForm object oTab2_Selections is a cDfqTab2.SelectionsList oDfqView.Tab2.Selections.Lst set location to 5 26 RELATIVE // 19+7 on_key KEY_ALT+KEY_E send DoCritExpression to (oTab2_Selections(self)) procedure rotate_up if (piCurrentTab(self)=2) forward send rotate_up end_procedure procedure OnRowChange integer liFromRow integer liToRow local integer liFile liField liBase if (item_count(self)) begin get Grid_RowBaseItem self liToRow to liBase get aux_value item liBase to liFile get aux_value item (liBase+1) to liField send Tab2_GotoFileField liFile liField end end_procedure procedure OnExprCriteriaChanged local integer liExprRow local string lsValue get piExprRow to liExprRow if (liExprRow=-1) move "" to lsValue else begin move t.DfQuery.ExprCritAdded to lsValue end set value of (oTab2_SelectionsForm(self)) item 0 to lsValue end_procedure end_object object oTab2_SelectionsForm is a Form oDfqView.Tab2.Selections.Frm set location to 16 26 RELATIVE // 19+7 set focus_mode to POINTER_ONLY procedure rotate_up if (piCurrentTab(self)=2) forward send rotate_up end_procedure set center_state item 0 to DFTRUE item_list on_item "" send none end_item_list end_object object oTab2_SelectionsButton is a app.Button oDfqView.Tab2.Selections.Btn set location to 18 26 RELATIVE // 19+7 on_key KEY_ALT+KEY_E send DoCritExpression to (oTab2_Selections(self)) procedure rotate_up if (piCurrentTab(self)=2) forward send rotate_up end_procedure procedure switch send activate to (oFrm(self)) end_procedure item_list on_item "Add" send Tab2_AddCriteria on_item "Edit" send DoEditEntry to (oTab2_Selections(self)) on_item "Expression" send DoCritExpression to (oTab2_Selections(self)) on_item "Delete" send DoDeleteEntry to (oTab2_Selections(self)) end_item_list end_object function Tab2_CurrentFile returns integer function_return (aux_value(oTab2_TableSelect(self),CURRENT)) end_function function Tab2_CurrentField returns integer function_return (aux_value(oTab2_FieldsSelect(self),CURRENT)) end_function procedure Tab2_AddCriteria local integer lhDfqScParameters liFile liField liRval move (oDfqScParameters(self)) to lhDfqScParameters send delete_data to lhDfqScParameters get Tab2_CurrentFile to liFile get Tab2_CurrentField to liField set value of lhDfqScParameters item DFQSC_FILE to liFile set value of lhDfqScParameters item DFQSC_FIELD to liField set value of lhDfqScParameters item DFQSC_FIELDNAME to (FieldInf_FieldLabel_Long(liFile,liField)) set value of lhDfqScParameters item DFQSC_FIELDTYPE to (FieldInf_FieldType(liFile,liField)) set value of lhDfqScParameters item DFQSC_COMPMODE to 0 set value of lhDfqScParameters item DFQSC_VALUE1 to "" set value of lhDfqScParameters item DFQSC_VALUE2 to "" get iPopup of (oDfqSelectionCritPanel(self)) to liRval if liRval send AddCriteria to (oTab2_Selections(self)) end_procedure procedure Tab2_GotoFileField integer liFile integer liField send GoToFile to (oTab2_TableSelect(self)) liFile send GoToField to (oTab2_FieldsSelect(self)) liField end_procedure // *** TAB 3 ************************************************ register_object oTab3_PrintIndex object oTab3_PrintIndexBtn is a Button oDfqView.Tab3.OutputOrder.TopIndex.Btn set location to 4 0 RELATIVE set focus_mode to POINTER_ONLY item_list on_item "F4=Prompt" send Prompt to (oTab3_PrintIndex(self)) end_item_list procedure rotate_up if (piCurrentTab(self)=3) forward send rotate_up end_procedure end_object function iTranslateToLegalIndex integer liFile integer liIndex returns integer if (liIndex>0 and liIndex<=16) begin decrement liIndex get FDX_IndexFindAny 0 liFile liIndex DFFALSE DFFALSE to liIndex ifnot liIndex get FDX_IndexFindAny 0 liFile liIndex DFFALSE DFFALSE to liIndex end function_return liIndex end_function object oTab3_PrintIndex is a Form oDfqView.Tab3.OutputOrder.TopIndex set location to 5 0 RELATIVE on_key KSWITCH send switch on_key KSWITCH_BACK send switch_back property integer priv.piOrdering public 0 procedure set piOrdering integer liIndex local integer liFile lhObj get iMainFile to liFile if (liFile<>0) begin get iTranslateToLegalIndex liFile liIndex to liIndex set priv.piOrdering to liIndex if (liIndex<256) begin // Normal index set value item 0 to (string(liIndex)+": "+FDX_IndexAsFieldNames(0,liFile,liIndex,0)) end else if (liIndex=1023) begin // Ad hoc set value item 0 to "Ad hoc" end else begin // Programmed index get FieldInf_VirtualIndices_Object liFile to lhObj if lhObj set value item 0 to (psIndexName.i(lhObj,liIndex-256)) else set value item 0 to "Index not defined. Please select another" end end end_procedure function piOrdering returns integer function_return (priv.piOrdering(self)) end_function procedure prompt local integer liIndex liFile get piOrdering to liIndex get iMainFile to liFile get iPopup.iii of (oQueryIndexSelectionList(self)) liFile liIndex DFFALSE to liIndex if (liIndex<>-1) begin set piOrdering to liIndex send Fill_Break_List end end_procedure on_key KPROMPT send prompt item_list on_item "" send none set entry_state to DFFALSE end_item_list procedure rotate_up if (piCurrentTab(self)=3) forward send rotate_up end_procedure procedure switch_back send activate to (oFrm(self)) end_procedure end_object object oTab3_AdHoc is a app.Button oDfqView.Tab3.OutputOrder.AdHoc set location to 4 69 RELATIVE // 62+7 on_key KSWITCH send switch on_key KSWITCH_BACK send switch_back procedure rotate_up if (piCurrentTab(self)=3) forward send rotate_up end_procedure item_list on_item "Ad hoc" send DoAdHoc end_item_list end_object procedure DoAdHoc local integer lhOrderExpression liFile lhDef liRval if (piOrdering(oTab3_PrintIndex(self))=1023) begin get phQueryDefinition to lhDef move (oQueryOrderExpression(lhDef)) to lhOrderExpression get iMainFile to liFile get iPopup.ii of (oQueryDefineAdhocIndexPn(self)) liFile lhOrderExpression to liRval if liRval send Fill_Break_List end end_procedure object oTab3_BreakList is a cFieldInf.IndexBreakList oDfqView.Tab3.OutputOrder.BreakList set location to 6 0 RELATIVE on_key KSWITCH send switch on_key KSWITCH_BACK send switch_back procedure rotate_up if (piCurrentTab(self)=3) forward send rotate_up end_procedure register_object oTab3_SearchIndex procedure WriteToDefinition integer lhQueryDefinition local integer liMax liRow liBase lhBreakInfo liFile liField liExprRow move (oBreakInfo(lhQueryDefinition)) to lhBreakInfo set value of lhQueryDefinition item DFQ_ORDERING to (piOrdering(oTab3_PrintIndex(self))) set value of lhQueryDefinition item DFQ_ORDERING_SEARCH to (piOrdering(oTab3_SearchIndex(self))) get Grid_RowCount self to liMax send delete_data to lhBreakInfo decrement liMax for liRow from 0 to liMax get Grid_RowBaseItem self liRow to liBase get aux_value item liBase to liFile move (low(liFile)) to liField move (hi(liFile)) to liFile get aux_value item (liBase+1) to liExprRow send add_break_info to lhBreakInfo liRow liFile liField liExprRow (select_state(self,liBase)) (value(self,liBase+1)) loop // send Array_DoWriteToFile lhBreakInfo "test1.txt" end_procedure procedure ReadFromDefinition integer lhQueryDefinition local integer liMax liRow liBase lhBreakInfo set piOrdering of (oTab3_PrintIndex(self)) to (value(lhQueryDefinition,DFQ_ORDERING)) set piOrdering of (oTab3_SearchIndex(self)) to (value(lhQueryDefinition,DFQ_ORDERING_SEARCH)) move (oBreakInfo(lhQueryDefinition)) to lhBreakInfo set dynamic_update_state to DFFALSE send delete_data get row_count of lhBreakInfo to liMax decrement liMax for liRow from 0 to liMax get item_count to liBase send add_item MSG_NONE "" set checkbox_item_state item liBase to DFTRUE set select_state item liBase to (pbSelect.i(lhBreakInfo,liRow)) send add_item MSG_NONE (psLabel.i(lhBreakInfo,liRow)) set aux_value item liBase to (piFile.i(lhBreakInfo,liRow)*65536+piField.i(lhBreakInfo,liRow)) set aux_value item (liBase+1) to (piExprRow.i(lhBreakInfo,liRow)) set entry_state item (liBase+1) to DFTRUE loop set dynamic_update_state to DFTRUE end_procedure end_object // oTab3_BreakList register_object oTab3_SearchIndex object oTab3_SearchIndexBtn is a Button oDfqView.Tab3.OutputOrder.BottomIndex.Btn set location to 17 0 RELATIVE set focus_mode to POINTER_ONLY item_list on_item "F4=Prompt" send Prompt to (oTab3_SearchIndex(self)) end_item_list procedure rotate_up if (piCurrentTab(self)=3) forward send rotate_up end_procedure end_object // oTab3_SearchIndex object oTab3_SearchIndex is a Form oDfqView.Tab3.OutputOrder.BottomIndex set location to 18 0 RELATIVE on_key KSWITCH send switch on_key KSWITCH_BACK send switch_back property integer priv.piOrdering public 0 procedure set piOrdering integer liIndex local integer liFile get iMainFile to liFile if (liFile<>0) begin get iTranslateToLegalIndex liFile liIndex to liIndex set priv.piOrdering to liIndex set value item 0 to (string(liIndex)+": "+FDX_IndexAsFieldNames(0,liFile,liIndex,0)) end end_procedure function piOrdering returns integer function_return (priv.piOrdering(self)) end_function procedure prompt local integer liIndex liFile get piOrdering to liIndex get iMainFile to liFile get iPopup.iii of (oQueryIndexSelectionList(self)) liFile liIndex DFTRUE to liIndex if (liIndex<>-1) set piOrdering to liIndex end_procedure on_key KPROMPT send prompt item_list on_item "" send none set entry_state to DFFALSE end_item_list procedure rotate_up if (piCurrentTab(self)=3) forward send rotate_up end_procedure procedure switch send activate to (oFrm(self)) end_procedure end_object // oTab3_SearchIndex procedure Fill_Break_List local integer liFile liIndex lhOrderExpression lhDef get phQueryDefinition to lhDef move (oQueryOrderExpression(lhDef)) to lhOrderExpression get iMainFile to liFile get piOrdering of (oTab3_PrintIndex(self)) to liIndex send fill_list.iii to (oTab3_BreakList(self)) liFile liIndex lhOrderExpression set shadow_state of (oTab3_AdHoc(self)) item 0 to (liIndex<>1023) set shadow_state of (oTab3_SearchIndexBtn(self)) item 0 to (liIndex<256) set shadow_state of (oTab3_SearchIndex(self)) item 0 to (liIndex<256) end_procedure //object oTab3_OutputOrder is a cDfqTab2.OutputOrder oDfqView.Tab3.OutputOrder.Lst // set location to 4 0 RELATIVE // procedure rotate_up // if (piCurrentTab(self)=3) forward send rotate_up // end_procedure // procedure switch // send activate to (oFrm(self)) // end_procedure // procedure switch_back // send activate to (oFrm(self)) // end_procedure //end_object // *** TAB 4 ************************************************ object oTab4_Header is a Message oDfqView.Tab4.Hdr set location to 4 0 RELATIVE set focus_mode to POINTER_ONLY procedure rotate_up if (piCurrentTab(self)=4) forward send rotate_up end_procedure end_object // oTab4_Header register_object oTab4_DestinationAux object oTab4_Destination is a Radio oDfqView.Tab4.DestinationSelect set location to 6 0 RELATIVE on_key KSWITCH send switch on_key KSWITCH_BACK send switch_back procedure rotate_up if (piCurrentTab(self)=4) forward send rotate_up end_procedure procedure switch_back send activate to (oFrm(self)) end_procedure procedure next send switch end_procedure procedure item_change integer liFrom integer liTo returns integer local integer liRval liDest forward get msg_item_change liFrom liTo to liRval if (liRval=0) move DFQ.DEST.SCREEN to liDest if (liRval=1) move DFQ.DEST.PRINTER to liDest if (liRval=2) move DFQ.DEST.FILE to liDest if (liRval=3) move DFQ.DEST.EMAIL to liDest send shade_aux to (oTab4_DestinationAux(self)) liDest send shade_things procedure_return liRval end_procedure register_object oTab4_DestinationAux register_object oTab4_Format procedure switch local integer liCurrentRadio get current_item to liCurrentRadio set focus_mode of (oTab4_DestinationAux(self)) to (if(liCurrentRadio=0,POINTER_ONLY,FOCUSABLE)) if liCurrentRadio eq 0 send activate to (oTab4_Format(self)) else begin if liCurrentRadio eq 1 set current_item of (oTab4_DestinationAux(self)) to 0 if liCurrentRadio eq 2 set current_item of (oTab4_DestinationAux(self)) to 1 if liCurrentRadio eq 3 set current_item of (oTab4_DestinationAux(self)) to 2 send activate to (oTab4_DestinationAux(self)) end end_procedure item_list on_item // DFQ.DEST.SCREEN on_item // DFQ.DEST.PRINTER on_item // DFQ.DEST.FILE on_item // DFQ.DEST.EMAIL end_item_list procedure shade_options local string lsEmailProg get psSendMailProgramPath of (oDFQ_Output(self)) to lsEmailProg set shadow_state item 3 to (lsEmailProg="") end_procedure end_object // oTab4_Destination object oTab4_DestinationAux is a Form oDfqView.Tab4.DestinationSelectAux set location to 6 14 RELATIVE on_key KSWITCH send switch on_key KSWITCH_BACK send switch_back on_key KPROMPT send prompt set auto_top_item_state to DFFALSE procedure rotate_up if (piCurrentTab(self)=4) forward send rotate_up end_procedure procedure prompt if (current_item(self)=0) send popup to (oDfqPortSelector(self)) if (current_item(self)=2) send popup to (oDfqEmailSelector(self)) end_procedure item_list on_item // Printer port on_item // File name on_item // E-mail address end_item_list procedure next send switch end_procedure procedure previous send switch_back end_procedure procedure shade_aux integer liDest set shadow_state item 0 to (not(liDest=DFQ.DEST.PRINTER)) set shadow_state item 1 to (not(liDest=DFQ.DEST.FILE)) set shadow_state item 2 to (not(liDest=DFQ.DEST.EMAIL)) end_procedure end_object // oTab4_DestinationAux object oTab4_Format is a Radio oDfqView.Tab4.FormatSelect set location to 10 0 RELATIVE on_key KSWITCH send switch on_key KSWITCH_BACK send switch_back procedure rotate_up if (piCurrentTab(self)=4) forward send rotate_up end_procedure item_list on_item // Formattet on_item // Comma on_item // Line end_item_list procedure item_change integer from# integer to# returns integer local integer rval# forward get msg_item_change from# to# to rval# send shade_things procedure_return rval# end_procedure end_object object oTab4_Things is a Form oDfqView.Tab4.Other set location to 10 27 RELATIVE on_key KSWITCH send switch on_key KSWITCH_BACK send switch_back set select_mode to MULTI_SELECT procedure rotate_up if (piCurrentTab(self)=4) forward send rotate_up end_procedure item_list on_item // Print totals only on_item // Use ANSI characters on_item // Semicolon as delimeter on_item // Include column names end_item_list set checkbox_item_state item 0 to DFTRUE set checkbox_item_state item 1 to DFTRUE set checkbox_item_state item 2 to DFTRUE set checkbox_item_state item 3 to DFTRUE procedure shade_things local integer liDest liFormat liItem get current_item of (oTab4_Format(self)) to liItem if (liItem=0) move DFQ.FORMAT.PRINT to liFormat if (liItem=1) move DFQ.FORMAT.CD to liFormat if (liItem=2) move DFQ.FORMAT.LD to liFormat get current_item of (oTab4_Destination(self)) to liItem if (liItem=0) move DFQ.DEST.SCREEN to liDest if (liItem=1) move DFQ.DEST.PRINTER to liDest if (liItem=2) move DFQ.DEST.FILE to liDest if (liItem=3) move DFQ.DEST.EMAIL to liDest set shadow_state item 0 to (not(liFormat=DFQ.FORMAT.PRINT)) // Print totals only set shadow_state item 1 to (not(liDest=DFQ.DEST.FILE or liDest=DFQ.DEST.EMAIL)) // Use ANSI characters set shadow_state item 2 to (not(liFormat=DFQ.FORMAT.CD)) // Semicolon as delimeter set shadow_state item 3 to (not(liFormat=DFQ.FORMAT.CD)) // Include column names end_procedure end_object // oTab4_Things procedure shade_things local integer lhObj move (oTab4_Things(self)) to lhObj send deferred_message MSG_Shade_Things lhObj end_procedure object oTab4_Other is a Form oDfqView.Tab4.Frm set location to 16 0 RELATIVE on_key KSWITCH send switch on_key KSWITCH_BACK send switch_back procedure rotate_up if (piCurrentTab(self)=4) forward send rotate_up end_procedure item_list on_item on_item end_item_list procedure switch send activate to (oFrm(self)) end_procedure end_object procedure ReadFromDefinitionOther integer lhQueryDefinition local integer lhDef liDest liFormat move lhQueryDefinition to lhDef // Destination get value of lhDef item DFQ_DESTINATION to liDest if liDest eq DFQ.DEST.PRINTER set current_item of (oTab4_Destination(self)) to 1 if liDest eq DFQ.DEST.SCREEN set current_item of (oTab4_Destination(self)) to 0 if liDest eq DFQ.DEST.FILE set current_item of (oTab4_Destination(self)) to 2 if liDest eq DFQ.DEST.EMAIL set current_item of (oTab4_Destination(self)) to 3 // Printer port, File name set value of (oTab4_DestinationAux(self)) item 0 to (value(lhDef,DFQ_PORT)) set value of (oTab4_DestinationAux(self)) item 1 to (value(lhDef,DFQ_FILE_NAME)) set value of (oTab4_DestinationAux(self)) item 2 to (value(lhDef,DFQ_EMAIL_ADDRESS)) // File format get value of lhDef item DFQ_FORMAT to liFormat if liFormat eq DFQ.FORMAT.CD set current_item of (oTab4_Format(self)) to 1 if liFormat eq DFQ.FORMAT.LD set current_item of (oTab4_Format(self)) to 2 if liFormat eq DFQ.FORMAT.PRINT set current_item of (oTab4_Format(self)) to 0 // Update status screen and lines per page set value of (oTab4_Other(self)) item 0 to (value(lhDef,DFQ_LINES_PER_PAGE)) set value of (oTab4_Other(self)) item 1 to (value(lhDef,DFQ_UPDATE_FREQ)) // Things set select_state of (oTab4_Things(self)) item 0 to (value(lhDef,DFQ_PRINT_TOTALS_ONLY)) set select_state of (oTab4_Things(self)) item 1 to (value(lhDef,DFQ_USE_ANSI)) set select_state of (oTab4_Things(self)) item 2 to (value(lhDef,DFQ_SEMICOLON)) set select_state of (oTab4_Things(self)) item 3 to (value(lhDef,DFQ_INCL_COLUMN_NAMES)) // Report title set value of (oFrm(self)) item 1 to (value(lhDef,DFQ_REPORT_TITLE)) end_procedure procedure WriteToDefinitionOther integer lhQueryDefinition local integer lhDef liItem lhArr liItm liMax local string lsValue move lhQueryDefinition to lhDef // Destination get current_item of (oTab4_Destination(self)) to liItem if liItem eq 0 set value of lhDef item DFQ_DESTINATION to DFQ.DEST.SCREEN if liItem eq 1 set value of lhDef item DFQ_DESTINATION to DFQ.DEST.PRINTER if liItem eq 2 set value of lhDef item DFQ_DESTINATION to DFQ.DEST.FILE if liItem eq 3 set value of lhDef item DFQ_DESTINATION to DFQ.DEST.EMAIL // Printer port, File name set value of lhDef item DFQ_PORT to (value(oTab4_DestinationAux(self),0)) set value of lhDef item DFQ_FILE_NAME to (value(oTab4_DestinationAux(self),1)) set value of lhDef item DFQ_EMAIL_ADDRESS to (value(oTab4_DestinationAux(self),2)) // File format get current_item of (oTab4_Format(self)) to liItem if liItem eq 0 set value of lhDef item DFQ_FORMAT to DFQ.FORMAT.PRINT if liItem eq 1 set value of lhDef item DFQ_FORMAT to DFQ.FORMAT.CD if liItem eq 2 set value of lhDef item DFQ_FORMAT to DFQ.FORMAT.LD // Update status screen and lines per page set value of lhDef item DFQ_LINES_PER_PAGE to (value(oTab4_Other(self),0)) set value of lhDef item DFQ_UPDATE_FREQ to (value(oTab4_Other(self),1)) // Things set value of lhDef item DFQ_PRINT_TOTALS_ONLY to (select_state(oTab4_Things(self),0)) set value of lhDef item DFQ_USE_ANSI to (select_state(oTab4_Things(self),1)) set value of lhDef item DFQ_SEMICOLON to (select_state(oTab4_Things(self),2)) set value of lhDef item DFQ_INCL_COLUMN_NAMES to (select_state(oTab4_Things(self),3)) // Report title set value of lhDef item DFQ_REPORT_TITLE to (value(oFrm(self),1)) // E-mail recipients send reset_recipients to lhDef get value of (oTab4_DestinationAux(self)) item 2 to lsValue if (lsValue contains "@") send add_recipient to lhDef "" lsValue else begin move (oArray(oDfqEmailSelector(self))) to lhArr get item_count of lhArr to liMax decrement liMax for liItm from 0 to liMax send add_recipient to lhDef "" (value(lhArr,liItm)) loop end end_procedure //object oBtn is a app.Button oDfqView.Btn // set location to 19 0 RELATIVE // set focus_mode to POINTER_ONLY // item_list // on_item "Run" send DoRun // on_item "Open" send DoOpen // on_item "Save" send DoSave // on_item "Save As" send DoSaveAs // end_item_list //end_object procedure rotate_up_tab integer liTab if liTab eq 1 begin send rotate_up to (oTab1_TableHeader(self)) send rotate_up to (oTab1_TableSelect(self)) send rotate_up to (oTab1_FieldsHeader(self)) send rotate_up to (oTab1_FieldsSelect(self)) send rotate_up to (oTab1_FieldsSelectButton(self)) send rotate_up to (oTab1_PrintedFieldsHeader(self)) send rotate_up to (oTab1_PrintedFields(self)) send rotate_up to (oTab1_PrintedFieldsButton(self)) end if liTab eq 2 begin send rotate_up to (oTab2_TableHeader(self)) send rotate_up to (oTab2_TableSelect(self)) send rotate_up to (oTab2_FieldsHeader(self)) send rotate_up to (oTab2_FieldsSelect(self)) send rotate_up to (oTab2_SelectionsHeader(self)) send rotate_up to (oTab2_Selections(self)) send rotate_up to (oTab2_SelectionsForm(self)) send rotate_up to (oTab2_SelectionsButton(self)) end if liTab eq 3 begin // send rotate_up to (oTab3_OutputOrder(self)) send rotate_up to (oTab3_PrintIndexBtn(self)) send rotate_up to (oTab3_PrintIndex(self)) send rotate_up to (oTab3_AdHoc(self)) send rotate_up to (oTab3_BreakList(self)) send rotate_up to (oTab3_SearchIndexBtn(self)) send rotate_up to (oTab3_SearchIndex(self)) end if liTab eq 4 begin send rotate_up to (oTab4_Header(self)) send rotate_up to (oTab4_Destination(self)) send rotate_up to (oTab4_DestinationAux(self)) send rotate_up to (oTab4_Format(self)) send rotate_up to (oTab4_Things(self)) send rotate_up to (oTab4_Other(self)) end end_procedure procedure Activate_Tab integer liTab send UpdateTab to (oTabSelector(self)) liTab set piCurrentTab to liTab if liTab eq 1 send activate to (oTab1_TableSelect(self)) if liTab eq 2 send activate to (oTab2_TableSelect(self)) if liTab eq 3 send activate to (oTab3_PrintIndex(self)) if liTab eq 4 send activate to (oTab4_Destination(self)) send rotate_up_tab liTab end_procedure procedure OnNewMainFile integer liFile set FileNameLabel to "" set piMainFile of (phQueryDefinition(self)) to liFile send fill_form to (oFrm(self)) send fill_list.i to (oTab1_TableSelect(self)) liFile send OnNewFile to (oTab1_TableSelect(self)) liFile send DoReset to (oTab1_PrintedFields(self)) send fill_list.i to (oTab2_TableSelect(self)) liFile send OnNewFile to (oTab2_TableSelect(self)) liFile send DoReset to (oTab2_Selections(self)) //// send fill_list to (oTab3_OutputOrder(self)) end_procedure procedure DoQueryInit set delegation_mode to DELEGATE_TO_PARENT end_procedure procedure activate_scope forward send activate_scope send Activate_Tab 1 send activate to (oFrm(self)) set phDDO to 0 send shade_options to (oTab4_Destination(self)) // E-mail option in particular end_procedure procedure ReadFromDefinition local integer lhQueryDefinition get phQueryDefinition to lhQueryDefinition send OnNewMainFile (piMainFile(lhQueryDefinition)) set FileNameLabel to (value(lhQueryDefinition,DFQ_SAVED_AS_FILE_NAME)) send ReadFromDefinition to (oTab1_PrintedFields(self)) lhQueryDefinition send ReadFromDefinition to (oTab2_Selections(self)) lhQueryDefinition send ReadFromDefinition to (oTab3_BreakList(self)) lhQueryDefinition send ReadFromDefinitionOther lhQueryDefinition set FileNameLabel to (value(lhQueryDefinition,DFQ_SAVED_AS_FILE_NAME)) // send Fill_Break_List end_procedure procedure WriteToDefinition local integer lhQueryDefinition get phQueryDefinition to lhQueryDefinition send CleanUpExpressions // Remove expressions not used send WriteToDefinition to (oTab1_PrintedFields(self)) lhQueryDefinition send WriteToDefinition to (oTab2_Selections(self)) lhQueryDefinition send WriteToDefinition to (oTab3_BreakList(self)) lhQueryDefinition send WriteToDefinitionOther lhQueryDefinition // send Array_DoWriteToFile (oQueryDefColumnInfo(lhQueryDefinition)) "c:\error.x" // send obs "Check" set phDDO of lhQueryDefinition to (phDDO(self)) end_procedure procedure DoPromptNewFile send prompt to (oFrm(self)) end_procedure procedure DoSaveAs local string lsFileName get SEQ_SelectOutFile "Save query definition as" "*.dbq" to lsFileName if lsFileName ne "" begin set value of (phQueryDefinition(self)) item DFQ_SAVED_AS_FILE_NAME to lsFileName send WriteToDefinition send SEQ_WriteFileName to (phQueryDefinition(self)) lsFileName set FileNameLabel to lsFileName end end_procedure procedure DoSave local string lsFileName get value of (phQueryDefinition(self)) item DFQ_SAVED_AS_FILE_NAME to lsFileName if lsFileName eq "" send DoSaveAs else begin send WriteToDefinition send SEQ_WriteFileName to (phQueryDefinition(self)) lsFileName set FileNameLabel to lsFileName send obs "Query definition saved." ("("+lsFileName+")") end end_procedure procedure LoadDefinition string lsFileName if lsFileName ne "" begin if (SEQ_FileExists(lsFileName)=SEQIT_FILE) begin send SEQ_ReadFileName to (phQueryDefinition(self)) lsFileName // Make sure it saves correctly even if renamed: set value of (phQueryDefinition(self)) item DFQ_SAVED_AS_FILE_NAME to lsFileName send ReadFromDefinition end else send obs "File not found!" ("("+lsFileName+")") end end_procedure procedure LoadOldDefinition string lsFileName if lsFileName ne "" begin if (SEQ_FileExists(lsFileName)=SEQIT_FILE) begin send SEQ_ReadOldFileName to (phQueryDefinition(self)) lsFileName // Make sure it saves correctly even if renamed: set value of (phQueryDefinition(self)) item DFQ_SAVED_AS_FILE_NAME to lsFileName send ReadFromDefinition end else send obs "File not found!" ("("+lsFileName+")") end end_procedure procedure DoOpen local string lsFileName get SEQ_SelectInFile "Open query definition" "*.dbq" to lsFileName if lsFileName ne "" send LoadDefinition lsFileName end_procedure procedure DoOldOpen local string lsFileName get SEQ_SelectInFile "Open 3.1 query definition" "*.qry" to lsFileName if lsFileName ne "" send LoadOldDefinition lsFileName end_procedure procedure DoRun local integer lhExprArr lbInterpretOK local integer lhQueryDefinition get phQueryDefinition to lhQueryDefinition if (iMainFile(self)) begin send WriteToDefinition // send DoInformExpressionThingAboutAllowedTables // move (oQuery_ExprArray(phQueryDefinition(self))) to lhExprArr // get iInterpretAll of lhExprArr to lbInterpretOK // // if lbInterpretOK send run_querydefinition to (oDFQ_DataScanner(self)) (phQueryDefinition(self)) // else send DisplayErrors to lhExprArr send run_querydefinition to (oDFQ_DataScanner(self)) lhQueryDefinition end end_procedure procedure CleanUpExpressions // Remove expressions not used local integer lhExprArr move (oQuery_ExprArray(phQueryDefinition(self))) to lhExprArr send CleanUp_Prepare to lhExprArr send MarkUsedExpressions to (oTab1_PrintedFields(self)) send MarkUsedExpressions to (oTab2_Selections(self)) // send MarkUsedExpressions to (oQueryOrderExpression(self)) send CleanUp_CalcNewRow to lhExprArr send GetNewExpressionIDs to (oTab1_PrintedFields(self)) send GetNewExpressionIDs to (oTab2_Selections(self)) // send GetNewExpressionIDs to (oQueryOrderExpression(self)) send CleanUp_Purge to lhExprArr end_procedure procedure DoReset send DoReset to (phQueryDefinition(self)) set piMainFile of (phQueryDefinition(self)) to 0 send ReadFromDefinition end_procedure end_object // oDFQueryView broadcast recursive send DoQueryInit to desktop procedure Activate_Query_View_Clear send Activate_Query_View send DoReset to (oDFQueryView(self)) send DoPromptNewFile to (oDFQueryView(self)) end_procedure procedure Query_View_Open send Activate_Query_View send DoOpen to (oDFQueryView(self)) end_procedure procedure Query_View_OldOpen send Activate_Query_View send DoOldOpen to (oDFQueryView(self)) end_procedure procedure Query_View_Run if (active_state(oDFQueryView(self))) send DoRun to (oDFQueryView(self)) end_procedure procedure Query_View_Save if (active_state(oDFQueryView(self))) send DoSave to (oDFQueryView(self)) end_procedure procedure Query_View_SaveAs if (active_state(oDFQueryView(self))) send DoSaveAs to (oDFQueryView(self)) end_procedure procedure Activate_Query_View_PrepareTable integer liFile send Activate_Query_View send DoReset to (oDFQueryView(self)) send OnNewMainFile to (oDFQueryView(self)) liFile end_procedure procedure Activate_Query_View_LoadDef string lsFileName send Activate_Query_View send DoReset to (oDFQueryView(self)) send LoadDefinition to (oDFQueryView(self)) lsFileName end_procedure procedure Activate_Query_View_DDO local integer lhDD liFile send Focus_Analyze_Focus send Activate_Query_View send DoReset to (oDFQueryView(self)) get Focus_Info FOCUS_DD to lhDD if lhDD begin get Focus_Info FOCUS_ITEM_FILE to liFile send OnNewMainFile to (oDFQueryView(self)) liFile set phDDO of (oDFQueryView(self)) to lhDD end end_procedure procedure Query_View_Display_Tab1 send Activate_Query_View send Activate_Tab to (oDFQueryView(self)) 1 end_procedure procedure Query_View_Display_Tab2 send Activate_Query_View send Activate_Tab to (oDFQueryView(self)) 2 end_procedure procedure Query_View_Display_Tab3 send Activate_Query_View send Activate_Tab to (oDFQueryView(self)) 3 end_procedure procedure Query_View_Display_Tab4 send Activate_Query_View send Activate_Tab to (oDFQueryView(self)) 4 end_procedure